Category : OS/2 Files
Archive   : OS2CMAPI.ZIP
Filename : ACDIPRCV.PAS

 
Output of file : ACDIPRCV.PAS contained in archive : OS2CMAPI.ZIP
PROGRAM ACDIPRCV (INPUT,OUTPUT);

(************************************************************************)
(* *)
(* MODULE NAME: ACDIPRCV.PAS *)
(* *)
(* DESCRIPTIVE NAME: ACDI PASCAL SAMPLE RECEIVE PROGRAM *)
(* OS/2 EXTENDED EDITION *)
(* *)
(* COPYRIGHT: (C) COPYRIGHT IBM CORP. 1988 *)
(* LICENSED MATERIAL - PROGRAM PROPERTY OF IBM *)
(* ALL RIGHTS RESERVED *)
(* *)
(* STATUS: LPP Release 1 Modification 0 *)
(* *)
(* FUNCTION: The sample program will use the ACDI interface to echo *)
(* line by line screen image from the first Personal *)
(* Computer on the second Personal Computer connected *)
(* through asynchronous line. *)
(* The RECEIVE PROGRAM, is executed in the second Personal *)
(* Computer. *)
(* *)
(* Uses the following ACDI Verbs: *)
(* *)
(* COMOPEN *)
(* COMDEFOUTPUTBUFF *)
(* COMDEFINPUT *)
(* COMSETBITRATE *)
(* COMSETLINECTRL *)
(* COMCONNECT *)
(* COMSETTIMEOUTS *)
(* COMREADEVENT *)
(* COMREADCHARSTRING *)
(* COMDISCONNECT *)
(* COMCLOSE *)
(* *)
(* NOTE: The asynchronous device name to be used in this *)
(* program is COM1. If this is to be changed it must *)
(* be changed in the main header. *)
(* *)
(* This program is designed to run with connect type 4 *)
(* only. *)
(* *)
(* MODULE TYPE = IBM Personal Computer Pascal/2 Compiler Version 1.00 *)
(* (Compiles with Small Memory Model) *)
(* *)
(* PREREQS = Requires Message file "ACX.MSG" at runtime. *)
(* *)
(************************************************************************)

(*$INCLUDE: 'ACDI_P.INC'*)
(*$INCLUDE: 'DOSCALLS.INT'*)
(*$INCLUDE: 'SUBCALLS.INT'*)

CONST
AA_OK = 0;
TIMEOUT = 16#0054;
CONNECTTIMEOUT1 = 0;
CONNECTTIMEOUT2 = 30;
ERRORMASK = 0;
OUTPUTBUFFLENGTH = 80; (* output buffer length *)
INPUTBUFFLENGTH = 80; (* input buffer length *)
STACK_LENGTH = 4096;
SESSION_ACTIVE = 1;
SESSION_ENDED = 0;
CAR_RET = 16#0D; (* value for Enter key *)
ESCAPE = 16#1B; (* value for Esc key *)


TYPE
ADS_OPEN = ADS OF COMOPEN_CB;
ADS_DEF_BUFF = ADS OF COMDEFOUTPUTBUFF_CB;
ADS_INPUT_BUFF = ADS OF COMDEFINPUT_CB;
ADS_BIT_RATE = ADS OF COMSETBITRATE_CB;
ADS_LINE_CTRL = ADS OF COMSETLINECTRL_CB;
ADS_CONNECT = ADS OF COMCONNECT_CB;
ADS_DISCONNECT = ADS OF COMDISCONNECT_CB;
ADS_CLOSE = ADS OF COMCLOSE_CB;
ADS_READEVENT = ADS OF COMREADEVENT_CB;
ADS_MASKS = ADS OF MASKS;
ADS_EVNTSTRUCT = ADS OF EVENT_STRUCT;
ADS_READ_CHAR = ADS OF COMREADCHARSTRING_CB;
ADS_TIMEOUT = ADS OF COMSETTIMEOUTS_CB;
ADS_OUTPUTBUFF = ADS OF ARRAY [1..80] OF BYTE;
ADS_INPUTBUFF = ADS OF ARRAY [1..80] OF BYTE;
STACKBUFF = PACKED ARRAY [0..STACK_LENGTH] OF BYTE;

VAR
VCB : ARRAY [0..512] OF BYTE;
(* ACDI VERB CONTROL BLOCK (VCB)*)
VCBPTR1 : ADS_OPEN; (* Pointers (ptrs) to the VCB *)
VCBPTR2 : ADS_DEF_BUFF;
VCBPTR3 : ADS_INPUT_BUFF;
VCBPTR4 : ADS_BIT_RATE;
VCBPTR5 : ADS_LINE_CTRL;
VCBPTR6 : ADS_CONNECT;
VCBPTR7 : ADS_DISCONNECT;
VCBPTR8 : ADS_CLOSE;
VCBPTR9 : ADS_READ_CHAR;
VCBPTR13 : ADS_TIMEOUT;

MASKVCB : ARRAY [0..512] OF BYTE;
(* EVENT MASK CONTROL BLOCK *)
VCBPTR10 : ADS_MASKS;
VCBPTR11 : ADS_EVNTSTRUCT;

READVCB : ARRAY [0..512] OF BYTE;
(* READEVENT VERB CONTROL BLOCK *)
VCBPTR12 : ADS_READEVENT;

ANBPTR : ADS_OUTPUTBUFF; (* pointer for output buffer *)
ANBPTR1 : ADS_INPUTBUFF; (* pointer for input buffer *)

CHARACTER : BYTE;
CELL : WORD; (* used for VioScrollUp *)
DEVICE_HANDLE : WORD; (* returned by COMOPEN *)

BYTESFREED : WORD; (* parameters for *)
READBYTESNEEDED : WORD; (* COMREADCHARSTRING *)

INITWAIT : WORD; (* Initial wait for *)
(* COMREADCHARSTRING *)
DOS_RC : WORD; (* save area for return codes *)
DOS_VIO_RC : WORD;

STCKPTR : ADSMEM; (* stack pointer thread id for *)
THREAD_ID : WORD; (* DOSCREATETHREAD *)

SEMHANDLE : INTEGER4; (* Returned from DOSCREATESEM *)

RETURN_CODE : WORD;
OPCODE : WORD;

SYSTEM_ERROR : BOOLEAN; (* System error flag *)

ROW : WORD; (* row indicator for VIO calls *)
COL : WORD; (* col indicator for VIO calls *)

IDX : INTEGER; (* loop controls *)
VCBIDX : INTEGER;
INDEX : WORD;
ACDIEVENTFLAG : WORD;

MSG_FILENAME : STRING(129); (* OS/2 message filename *)
MSG_BUFFER : LSTRING(255); (* Message text buffer *)
MSG_BUFFER_PTR : ADS OF LSTRING(255); (* Pointer to buffer *)
MSG_LEN : WORD; (* Message length from OS/2 *)


(****************************************************************************)
(* EXTERNAL DECLARATIONS *)
(****************************************************************************)

PROCEDURE ACDI(CB_PTR : ADSMEM); EXTERN;

(****************************************************************************)
(* UTILITY FUNCTIONS *)
(****************************************************************************)

PROCEDURE CLEAR_VCB;
(* This procedure will blank out the first 200 bytes of the Verb *)
(* Control Block to 00, since it is used multiple times. *)

BEGIN
FOR IDX := 0 to 200 DO
VCB [IDX] := 16#00;
END; (* CLEAR_VCB *)


PROCEDURE INIT_SELF;
(* Initializes Address Pointers *)

BEGIN
VCBPTR1 := ADS VCB; (* Set ptrs to verb control *)
VCBPTR2 := ADS VCB; (* block *)
VCBPTR3 := ADS VCB;
VCBPTR4 := ADS VCB;
VCBPTR5 := ADS VCB;
VCBPTR6 := ADS VCB;
VCBPTR7 := ADS VCB;
VCBPTR8 := ADS VCB;
VCBPTR9 := ADS VCB;
VCBPTR13 := ADS VCB;

VCBPTR10 := ADS MASKVCB;
VCBPTR11 := ADS MASKVCB;

VCBPTR12 := ADS READVCB;

MSG_BUFFER_PTR := ADS MSG_BUFFER;
MSG_BUFFER_PTR.R := MSG_BUFFER_PTR.R + 1;
(* Skip past LL at offset 0 *)
COPYSTR('ACX.MSG' * CHR(0),MSG_FILENAME);
(* Must be an ASCIIZ string *)
END; (* INITIALIZE *)

PROCEDURE SHOWMSG(MSGNO:WORD);
(* This function displays error messages using argument MSGNO ( message *)
(* number) from the message file "ACX.MSG" *)
VAR MSG_RC : WORD;

BEGIN
MSG_RC := DOSGETMESSAGE (ADS MSG_FILENAME,0,MSG_BUFFER_PTR,255,
MSGNO,MSG_FILENAME,MSG_LEN);
(* doscall to get message from *)
(* message file *)

IF MSG_RC <> 0 THEN (* Directly display a message *)
BEGIN (* if unable to handle msg file *)
WRITELN ('UNABLE TO PROCESS MESSAGE FILE, RC = ',MSG_RC);
WRITELN ('MESSAGE NUMBER - ',MSGNO);
RETURN;
END;
MSG_BUFFER[0] := CHR(MSG_LEN); (* Make it a Pascal Lstring *)
(* with length *)
WRITE (MSG_BUFFER); (* Display the message *)
END; (* SHOWMSG *)

PROCEDURE SHOW_ERR;
(* This function shows errors relating to ACDI verbs. *)

BEGIN
SHOWMSG (2); (* msg 2 - ACDI Verb in Error *)
WRITELN (OPCODE:4:16); (* Display verb opcode in hex *)
SHOWMSG (3); (* msg 3 - ACDI Error RC = *)
WRITELN (RETURN_CODE:4:16); (* Display return_code in hex *)
END; (* SHOW_ERR *)

PROCEDURE SHOW_DOS_ERR;
(* This function shows errors relating to DOS function calls. *)

BEGIN
SHOWMSG(4); (* OS/2 Doscall in Error *)
WRITELN(DOS_RC:4:16); (* Display return code in hex *)
END;

PROCEDURE SHOW_VIO_ERR;
(* This function shows errors relating to Vio function calls. *)

BEGIN
SHOWMSG(5); (* OS/2 Vio call in Error *)
WRITELN(DOS_VIO_RC:4:16); (* Display return code in hex *)
END; (* SHOW_VIO_ERR *)

(****************************************************************************)
(* ACDI RELATED PROCEDURES *)
(****************************************************************************)

(* To issue an acdi verb the program has to build the control block struc. *)
(* with the parameters and pass the pointer to the control block to the *)
(* acdi subsystem. Each of following subroutines, when called, will build *)
(* the control block structure and then call acdi. When the acdi subsystem *)
(* returns the subroutine will check the return code, call SHOW_ERR process *)
(* if the return code is bad, otherwise return to the calling process. *)

PROCEDURE OPEN;
(* This subroutine will issue com_open verb to open the specified com. *)
(* device for communication *)

BEGIN
CLEAR_VCB; (* clear the control block *)
WITH VCBPTR1@ DO
BEGIN
COMMON.FUNCTION_CODE := COM_OPEN; (* Verb equals COM_OPEN *)
COPYSTR('COM1 ' * CHR(0),COM_DEV_NAME);
(* Device name equals COM1 *)
END;
ACDI(VCBPTR1); (* Issue the verb *)
DEVICE_HANDLE := [email protected]_DEV_HANDLE;
(* Save the handle *)
IF ([email protected]_CODE <> AA_OK) THEN
BEGIN
OPCODE := COM_OPEN;
RETURN_CODE := [email protected]_CODE;
SHOW_ERR;
SYSTEM_ERROR := TRUE; (* Check return code and *)
END; (* handle any error *)
END; (* OPEN *)

PROCEDURE DEF_OUTPUT_BUF;
(* This subroutine will issue com_def_output_buff to define output buffer *)

BEGIN
CLEAR_VCB; (* clear the control block *)
WITH VCBPTR2@ DO
BEGIN
COMMON.FUNCTION_CODE := COM_DEF_OUTPUT_BUFF;
COMMON.COM_DEV_HANDLE := DEVICE_HANDLE;
OUTPUT_BUFF := ANBPTR;
OUT_BUFF_LENGTH := OUTPUTBUFFLENGTH;
END; (* fill in control block with *)
(* function code and parameters *)
ACDI(VCBPTR2); (* Issue the verb *)

IF ([email protected]_CODE <> AA_OK) THEN
BEGIN
OPCODE := COM_DEF_OUTPUT_BUFF;
RETURN_CODE := [email protected]_CODE;
SHOW_ERR;
SYSTEM_ERROR := TRUE; (* Check return code and *)
END; (* handle any error *)
END; (* DEF_OUTPUT_BUF *)

PROCEDURE DEF_INPUT_BUF;
(* This subroutine will issue com_def_input verb to define input buffer *)

BEGIN
CLEAR_VCB; (* clear the control block *)
WITH VCBPTR3@ DO
BEGIN
COMMON.FUNCTION_CODE := COM_DEF_INPUT;
COMMON.COM_DEV_HANDLE := DEVICE_HANDLE;
INPUT_BUFF := ANBPTR;
IN_BUFF_LENGTH := INPUTBUFFLENGTH;
INPUT_MODE := AA_CHAR_MODE;
END; (* fill in control block with *)
(* function code and parameters *)
ACDI(VCBPTR3); (* Issue the verb *)

IF ([email protected]_CODE <> AA_OK) THEN
BEGIN
OPCODE := COM_DEF_INPUT;
RETURN_CODE := [email protected]_CODE;
SHOW_ERR;
SYSTEM_ERROR := TRUE; (* Check return code and *)
END; (* handle any error *)
END; (* DEF_INPUT_BUF *)

PROCEDURE SET_BIT_RATE;
(* This subroutine will issue com_set_bit_rate verb to set up the line *)
(* data rates (bps). *)

BEGIN
CLEAR_VCB; (* clear the control block *)
WITH VCBPTR4@ DO
BEGIN
COMMON.FUNCTION_CODE := COM_SET_BIT_RATE;
COMMON.COM_DEV_HANDLE := DEVICE_HANDLE;
BIT_RATE_RCV := AA_300_BPS;
BIT_RATE_SEND := AA_300_BPS;
END; (* fill in control block with *)
(* function code and parameters *)
ACDI(VCBPTR4); (* Issue the verb *)

IF ([email protected]_CODE <> AA_OK) THEN
BEGIN
OPCODE := COM_SET_BIT_RATE;
RETURN_CODE := [email protected]_CODE;
SHOW_ERR;
SYSTEM_ERROR := TRUE; (* Check return code and *)
END; (* handle any error *)
END; (* SET_BIT_RATE *)

PROCEDURE LINE_CONTROL;
(* This subroutine will issue com_set_line_ctrl to set up line control *)
(* values. *)

BEGIN
CLEAR_VCB; (* clear the control block *)
WITH VCBPTR5@ DO
BEGIN
COMMON.FUNCTION_CODE := COM_SET_LINE_CTRL;
COMMON.COM_DEV_HANDLE := DEVICE_HANDLE;
STOP_BITS := AA_1_STOP_BIT;
PARITY := AA_EVEN_PARITY;
DATA_BITS := AA_7_DATA_BITS;
END; (* fill in control block with *)
(* function code and parameters *)
ACDI(VCBPTR5); (* Issue the verb *)

IF ([email protected]_CODE <> AA_OK) THEN
BEGIN
OPCODE := COM_SET_LINE_CTRL;
RETURN_CODE := [email protected]_CODE;
SHOW_ERR;
SYSTEM_ERROR := TRUE; (* Check return code and *)
END; (* handle any error *)
END; (* LINE_CONTROL *)

PROCEDURE CONNECT;
(* This subroutine will issue com_connect to establish connection *)

BEGIN
CLEAR_VCB; (* clear the control block *)
WITH VCBPTR6@ DO
BEGIN
COMMON.FUNCTION_CODE := COM_CONNECT;
COMMON.COM_DEV_HANDLE := DEVICE_HANDLE;
CONNECT_TYPE := AA_CONNECT_TYPE_4;
CONNECT_TIMEOUT_1 := CONNECTTIMEOUT1;
CONNECT_TIMEOUT_2 := CONNECTTIMEOUT2;
END; (* fill in control block with *)
(* function code and parameters *)
ACDI(VCBPTR6); (* Issue the verb *)

IF ([email protected]_CODE <> AA_OK) THEN
BEGIN
OPCODE := COM_CONNECT;
RETURN_CODE := [email protected]_CODE;
SHOW_ERR;
SYSTEM_ERROR := TRUE; (* Check return code and *)
END; (* handle any error *)
END; (* CONNECT *)

PROCEDURE SET_TIMEOUT;
(* This subroutine will issue com_set_timeouts to set the timeout values *)
(* for read and write. *)

VAR
READTIMEOUTBLOCK : WORD; (* Timeout - COMREADBLOCK *)
READTIMEOUTCHAR : WORD; (* Timeout - COMREADCHARSTRING *)
WRITETIMEOUT : WORD; (* Timeout - COMWRITECHARSTRING *)

BEGIN
READTIMEOUTBLOCK := 0; (* set all timeout values to 0 *)
READTIMEOUTCHAR := 1;
WRITETIMEOUT := 0;
CLEAR_VCB; (* clear the control block *)
WITH VCBPTR13@ DO
BEGIN
COMMON.FUNCTION_CODE := COM_SET_TIMEOUTS;
COMMON.COM_DEV_HANDLE := DEVICE_HANDLE;
READ_TIMEOUT_BLOCK := READTIMEOUTBLOCK;
READ_TIMEOUT_CHAR := READTIMEOUTCHAR;
WRITE_TIMEOUT := WRITETIMEOUT;
END; (* fill in control block with *)
(* function code and parameters *)
ACDI(VCBPTR13); (* Issue the verb *)

IF ([email protected]_CODE <> AA_OK) THEN
BEGIN
RETURN_CODE := [email protected]_CODE;
OPCODE := COM_SET_TIMEOUTS;
SHOW_ERR;
SYSTEM_ERROR := TRUE; (* Check return code and *)
END; (* handle any error *)
END; (* SET_TIMEOUT *)

PROCEDURE READ_CHAR;
(* This subroutine will issue com_read_char_string verb to enable program *)
(* to read data that has been received over the line and is put in the *)
(* input buffer. *)

BEGIN
CLEAR_VCB; (* clear the control block *)
WITH VCBPTR9@ DO
BEGIN
COMMON.FUNCTION_CODE := COM_READ_CHAR_STRING;
COMMON.COM_DEV_HANDLE := DEVICE_HANDLE;
BYTES_FREED := BYTESFREED;
READ_BYTES_NEEDED := READBYTESNEEDED;
INITIAL_WAIT := INITWAIT;
END; (* fill in control block with *)
(* function code and parameters *)
ACDI(VCBPTR9); (* Issue the verb *)

IF (([email protected]_CODE <> AA_OK) AND
([email protected]_CODE <> TIMEOUT)) THEN
BEGIN
OPCODE := COM_READ_CHAR_STRING;
RETURN_CODE := [email protected]_CODE;
SYSTEM_ERROR := TRUE;
SHOW_ERR; (* Check return code and *)
END; (* handle any error *)
END;

PROCEDURE COMREADEVENT;
(* This subroutine will issue comreadevent verb so that the calling process *)
(* can wait on the semaphore to be cleared. *)

BEGIN
CLEAR_VCB; (* clear the control block *)
WITH VCBPTR12@ DO
BEGIN
COMMON.FUNCTION_CODE := COM_READ_EVENT;
COMMON.COM_DEV_HANDLE := DEVICE_HANDLE;
SEM_HANDLE := SEMHANDLE;
BUFFER_ADDRESS := VCBPTR11;
EVENT_MASKS := VCBPTR10;
END; (* fill in control block with *)
(* function code and parameters *)
ACDI(VCBPTR12); (* Issue the verb *)

IF ([email protected]_CODE <> AA_OK) THEN
BEGIN
OPCODE := COM_READ_EVENT;
RETURN_CODE := [email protected]_CODE;
SHOW_ERR;
SYSTEM_ERROR := TRUE; (* Check return code and *)
END; (* handle any error *)
END;

PROCEDURE DISCONNECT;
(* This subroutine will issue com_disconnect to break the connection. *)

BEGIN
CLEAR_VCB; (* clear the control block *)
WITH VCBPTR8@ DO
BEGIN
COMMON.FUNCTION_CODE := COM_DISCONNECT;
COMMON.COM_DEV_HANDLE := DEVICE_HANDLE;
END; (* fill in control block with *)
(* function code and parameters *)
ACDI(VCBPTR8); (* Issue the verb *)

IF ([email protected]_CODE <> AA_OK) THEN
BEGIN
OPCODE := COM_DISCONNECT;
RETURN_CODE := [email protected]_CODE;
SHOW_ERR;
SYSTEM_ERROR := TRUE; (* Check return code and *)
END; (* handle any error *)
END; (* DISCONNECT *)

PROCEDURE CLOSE;
(* This subroutine will issue com_close to close the communication device. *)

BEGIN
CLEAR_VCB; (* clear the control block *)
WITH VCBPTR9@ DO
BEGIN
COMMON.FUNCTION_CODE := COM_CLOSE;
COMMON.COM_DEV_HANDLE := DEVICE_HANDLE;
END; (* fill in control block with *)
(* function code and parameters *)
ACDI(VCBPTR9); (* Issue the verb *)

IF ([email protected]_CODE <> AA_OK) THEN
BEGIN
OPCODE := COM_CLOSE;
RETURN_CODE := [email protected]_CODE;
SHOW_ERR;
SYSTEM_ERROR := TRUE; (* Check return code and *)
END; (* handle any error *)
END; (* CLOSE *)
(****************************************************************************)
(* 0S/2 RELATED FUNCTIONS *)
(****************************************************************************)

PROCEDURE CLEAR_SCREEN;
(* This function clears the screen to prepare to display message received. *)
(* Writes null on the whole screen *)

CONST SCREENSIZE = 2000;

VAR
BLANK : BYTE;

BEGIN
BLANK := 16#20; (* Set BLANK to ' ' *)
DOS_VIO_RC := VIOWRTNCHAR(BLANK,SCREENSIZE,0,0,0);
(* Call VioWrtChar *)
IF (DOS_VIO_RC <> 0) THEN (* Check for errors *)
BEGIN
SHOW_VIO_ERR;
SYSTEM_ERROR := TRUE;
END;
END;

PROCEDURE MOVE_CURSOR(ROW_NO : WORD;COL_NO : WORD);
(* This procedure will set the cursor at the specified row and column. *)

BEGIN
DOS_VIO_RC := VIOSETCURPOS(ROW_NO,COL_NO,0);
(* Call VioSetCurPos *)
IF (DOS_VIO_RC <> 0) THEN (* Check for errors *)
BEGIN
SHOW_VIO_ERR;
SYSTEM_ERROR := TRUE;
END;
END;

PROCEDURE CREATETHREAD(PROCADDR : ADSPROC);
(* This procedure will create a thread for execution *)

VAR
STACK : ^STACKBUFF;

BEGIN
NEW(STACK); (* Initialize pointer *)
STCKPTR := ADS STACK^; (* Initialize pointer *)
STCKPTR.R := STCKPTR.R + STACK_LENGTH; (* Point to end of stack *)
DOS_RC := DOSCREATETHREAD(PROCADDR,THREAD_ID,STCKPTR);

IF (DOS_RC <> AA_OK) THEN (* Check for errors *)
BEGIN
SHOW_DOS_ERR;
SYSTEM_ERROR := TRUE;
END;
END;

PROCEDURE CREATE_SEMAPHOR;
(* This function creates a semaphore "\SEM\EVENT.LCK" and returns the *)
(* semaphore handle returned by DOSCREATETHREAD *)

CONST NOEXCLUSIVE = 1;
VAR
SEM_NAME : STRING(129); (* Semaphore name *)

BEGIN
COPYSTR('\SEM\EVENT.LCK' * CHR(0),SEM_NAME);
(* Must be an ASCIIZ string *)
DOS_RC := DOSCREATESEM(NOEXCLUSIVE,SEMHANDLE,SEM_NAME);

IF (DOS_RC <> AA_OK) THEN (* Check for errors *)
BEGIN
SHOW_DOS_ERR;
SYSTEM_ERROR := TRUE;
END;
END;

PROCEDURE SET_SEM;
(* This function sets semaphore. *)

BEGIN
DOS_RC := DOSSEMSET(SEMHANDLE);
IF (DOS_RC <> AA_OK) THEN (* Check for errors *)
BEGIN
SHOW_DOS_ERR;
SYSTEM_ERROR := TRUE;
END;
END;

PROCEDURE SEM_WAIT;
(* This function waits till the semaphore is cleared. *)

VAR
INFINITEWAIT : INTEGER4; (* Time to wait for clear *)

BEGIN
INFINITEWAIT := (-1);
DOS_RC := DOSSEMWAIT(SEMHANDLE,INFINITEWAIT);

IF (DOS_RC <> AA_OK) THEN (* Check for errors *)
BEGIN
SHOW_DOS_ERR;
SYSTEM_ERROR := TRUE;
END;
END;

PROCEDURE WRITECHAR;
(* This procedure will write the received character to the screen *)

VAR
WRTCHAR : BYTE; (* character to be written *)
BEGIN
WRTCHAR := CHARACTER; (* Set character *)
DOS_VIO_RC := VIOWRTNCHAR(WRTCHAR,1,ROW,COL,0);

IF (DOS_VIO_RC <> 0) THEN (* Check for errors *)
BEGIN
SHOW_VIO_ERR;
SYSTEM_ERROR := TRUE;
END;
END;

(****************************************************************************)
(* PROGRAM PROCEDURE *)
(****************************************************************************)

PROCEDURE ACDIREADLINES;
(* This subroutine will clear the screen in preparation for receiving the *)
(* message, issue com_read_char_string verb as long as ACDIEVENTFLAG is on, *)
(* read the message character by character, display it on the screen. It *)
(* will quit when the flag is set to session ended. *)

BEGIN
BYTESFREED := 0; (* initialize parm's for *)
READBYTESNEEDED := 1; (* com_read_char_string *)
INITWAIT := 0; (* set initial wait to 2 sec. *)
INDEX := 0; (* loop counter to 0 *)
ROW := 0; (* row and column to 0's *)
COL := 0;
CELL := 16#720;
CLEAR_SCREEN; (* Blank out the screen *)
MOVE_CURSOR(ROW,COL); (* Set cursor to 0,0 *)

WHILE ((ACDIEVENTFLAG = SESSION_ACTIVE) AND (SYSTEM_ERROR = FALSE)) DO
BEGIN
READ_CHAR; (* issue com_read_char_string *)
IF ([email protected]_CODE <> TIMEOUT) THEN
(* if timeout did not occur, and*)
BEGIN (* no error - a char was recv'd *)
IF (SYSTEM_ERROR = FALSE) THEN
BEGIN
ANBPTR1 := [email protected]_AVAIL_READ_PTR;
(* copy ptr to received char *)
IF (ANBPTR1@[1] = CAR_RET) THEN
BEGIN (* if recv'd char is car_ret *)
ROW := ROW + 1; (* start a new line; increm. row*)
COL := 0;
END
ELSE (* otherwise copy the received *)
BEGIN
CHARACTER := ANBPTR1@[1];
WRITECHAR; (* write the character to screen*)
COL := COL + 1; (* increment the column *)
IF (COL = 80) THEN
COL := 0;
END;

IF (ROW = 24) THEN (* if current row is 24, scroll *)
BEGIN (* up the screen by one row, and*)
DOS_VIO_RC := VIOSCROLLUP(0, 0, 24, 79, 1, CELL, 0);
ROW := 23; (* set current row to 23 again *)
COL := 0; (* set column to 0 of next line *)
END;
MOVE_CURSOR(ROW,COL); (* Set cursor to new position *)
BYTESFREED := 1; (* indicate one byte is read *)
END;
END
ELSE
BYTESFREED := 0; (* if timeout occured, indicate *)
(* zero bytes read & begin again*)
END;
END;

(****************************************************************************)
(* THREAD PROCESS *)
(****************************************************************************)

PROCEDURE ACDIEVENT[PUBLIC];
(* This is the thread process. It will set the EVENTFLAG to zero to enable *)
(* receiving characters by the main process, then set the semaphore; issue *)
(* comreadevent verb, and wait for the semaphore to be cleared by async *)
(* subsystem - which will happen when any one of three events specified - *)
(* break signal, disconnect or a stop is received. When this occurs it *)
(* will set the EVENTFLAG to signal end of session. *)
(* This process runs asynchronously with the main process so that receiving*)
(* message, and watching for the break signal can be done simultaneously *)

BEGIN
ACDIEVENTFLAG := SESSION_ACTIVE; (* set the event flag to active *)

CREATE_SEMAPHOR; (* Call routine to issue *)
(* DOSCREATESEM *)
IF (SYSTEM_ERROR = FALSE) THEN
BEGIN
SET_SEM; (* Call routine issue DOSSETSEM *)
IF (SYSTEM_ERROR = FALSE) THEN
BEGIN (* setting up masks for *)
(* COMREADEVENT verb *)
WITH VCBPTR10@ DO
BEGIN (* events to be read are *)
EVENT_MASK_1[0] := 0;
EVENT_MASK_1[1] := 0;
EVENT_MASK_1[2] := AA_BREAK_RECEIVED;
EVENT_MASK_1[3] := AA_STOP_ISSUED;
EVENT_MASK_2[0] := 0;
EVENT_MASK_2[1] := 0;
EVENT_MASK_2[2] := 0;
EVENT_MASK_2[3] := 0;
END; (* stop issued, break signal *)
(* or connection lost *)
COMREADEVENT; (* issue COMREADEVENT *)

IF (SYSTEM_ERROR = FALSE) THEN
BEGIN
SEM_WAIT; (* issue DOSSEMWAIT *)
END;

ACDIEVENTFLAG := SESSION_ENDED; (* set the event flag to ses.end*)
END;
END;
END;


(****************************************************************************)
(* MAIN PROGRAM BODY *)
(****************************************************************************)

BEGIN
INIT_SELF; (* Initialization routine *)
SHOWMSG(7); (* Msg - Receive Program *)
SYSTEM_ERROR := FALSE;
OPEN; (* issue COMOPEN *)

IF (SYSTEM_ERROR = FALSE) THEN
BEGIN
DOS_RC := DOSALLOCSEG (80,ANBPTR.S,0); (* doscall to get output buffer *)
IF DOS_RC <> 0 THEN (* display any errors *)
BEGIN
SHOW_DOS_ERR;
SYSTEM_ERROR := TRUE;
END;

IF (SYSTEM_ERROR = FALSE) THEN
BEGIN
DEF_OUTPUT_BUF; (* issue COMDEFOUTPUTBUF *)

IF (SYSTEM_ERROR = FALSE) THEN
BEGIN
DOS_RC := DOSALLOCSEG (80,ANBPTR1.S,0); (* doscall to get input buffer *)
IF DOS_RC <> 0 THEN (* display any errors *)
BEGIN
SHOW_DOS_ERR;
SYSTEM_ERROR := TRUE;
END;

IF (SYSTEM_ERROR = FALSE) THEN
BEGIN
DEF_INPUT_BUF; (* issue COMDEFINPUT *)

IF (SYSTEM_ERROR = FALSE) THEN
BEGIN
SET_BIT_RATE; (* issue COMSETBITRATE *)

IF (SYSTEM_ERROR = FALSE) THEN
BEGIN
LINE_CONTROL; (* issue COMSETLINECTRL *)

IF (SYSTEM_ERROR = FALSE) THEN
BEGIN
CONNECT; (* issue COMCONNECT *)

IF (SYSTEM_ERROR = FALSE) THEN
BEGIN
SET_TIMEOUT; (* issue COMSETTIMEOUTS *)

IF (SYSTEM_ERROR = FALSE) THEN
BEGIN
CREATETHREAD(ADS ACDIEVENT); (* doscall to start thread proc *)

IF (SYSTEM_ERROR = FALSE) THEN
BEGIN
ACDIREADLINES;
DISCONNECT; (* issue COMDISCONNECT *)
END;

END; (* DOSCREATETHREAD *)

END; (* SET_TIMEOUTS *)

END; (* CONNECT *)

END; (* LINE_CONTROL *)

END; (* SET_BIT_RATE *)

END; (* DEF_INPUT *)

END; (* ALLOCSEG for Inputbuff *)

END; (* DEF_OUTPUT_BUF *)

END; (* ALLOCSEG for Outputbuff *)

CLOSE; (* issue COMCLOSE *)
END.


  3 Responses to “Category : OS/2 Files
Archive   : OS2CMAPI.ZIP
Filename : ACDIPRCV.PAS

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/