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

 
Output of file : FILEPSVR.PAS contained in archive : OS2CMAPI.ZIP
PROGRAM PSERVER (INPUT,OUTPUT);
(************************************************************************)
(* *)
(* MODULE NAME: FILEPSVR.PAS *)
(* *)
(* DESCRIPTIVE NAME: APPC FILE SERVER PASCAL SAMPLE PROGRAM FOR *)
(* OPERATING SYSTEM/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 = Receives a request for a file from a peer *)
(* requester program. This program opens the file *)
(* and transfers data (or an error indication if *)
(* the file does not exist) back to the requester. *)
(* *)
(* Uses the following APPC Verbs: *)
(* *)
(* RECEIVE_ALLOCATE *)
(* MC_SEND_DATA *)
(* MC_RECEIVE_AND_WAIT *)
(* MC_CONFIRMED *)
(* MC_SEND_ERROR *)
(* MC_DEALLOCATE *)
(* TP_ENDED *)
(* *)
(* Uses the following General Services Verbs: *)
(* *)
(* CONVERT *)
(* LOG_MESSAGE *)
(* *)
(* MODULE TYPE: IBM Personal Computer Pascal/2 Compiler *)
(* (Compiles with Small Memory Model) *)
(* *)
(* Requires message file "APX.MSG" at runtime. *)
(* *)
(************************************************************************)


(*$INCLUDE:'APPC_CON.INC'*) (* APPC constantants definition *)
(*$INCLUDE:'ACSSVCP1.INC'*) (* General Services constants *)

(*$INCLUDE:'APPC_TYP.INC'*) (* APPC types definition *)
(*$INCLUDE:'ACSSVCP2.INC'*) (* General Services types def. *)


TYPE
ADS_RCV_ALLOC = ADS OF RECEIVE_ALLOCATE;
ADS_RCV_AND_WAIT = ADS OF MC_RECEIVE_AND_WAIT;
ADS_SEND_DATA = ADS OF MC_SEND_DATA;
ADS_CONFIRMED = ADS OF MC_CONFIRMED;
ADS_SEND_ERROR = ADS OF MC_SEND_ERROR;
ADS_DEALLOCATE = ADS OF MC_DEALLOCATE;
ADS_TPENDED = ADS OF TP_ENDED;
ADS_CONVERT = ADS OF CONVERT;
ADS_LOG_MESSAGE = ADS OF LOG_MESSAGE;

ADS_BUFFER = ADS OF ARRAY[0..4096] OF BYTE;
ADS_FILENAME = ADS OF ARRAY[0..100] OF BYTE;



VAR (* Status Flags *)
SYSTEM_ERROR : BOOLEAN; (* Global system error flag *)
PGM_DONE : BOOLEAN; (* Program complete flag *)
DOS_EOF : BOOLEAN; (* End of file flag *)
BAD_FILENAME : BOOLEAN; (* Unable to open file *)

LENGTH : WORD;

BYTES_READ : WORD; (* DOS file variables *)
ACTION_PTR : ADS OF WORD;
ACTION : WORD;
FILEHANDLE : WORD; (* Handle from DOSOPEN *)
HANDLE_PTR : ADS OF WORD;
FILESIZE : INTEGER4;
FOPEN_FLAG : WORD;
FOPEN_MODE : WORD;
FILENAME : LSTRING(100); (* Filename to open *)
FILENAME_PTR : ADS_FILENAME; (* Pointer to the name *)

(* APPC variables *)
CONVERSATION_ID : INTEGER4; (* Conversation id *)
MY_TP_ID : STRING(8); (* Trans Pgm id *)
MY_TP_NAME : STRING(64); (* Trans Pgm name *)
ANBPTR : ADS_BUFFER; (* AlphaNumeric buffer addr *)

(* Return code save area *)
LAST_ERR_P : WORD; (* APPC primary retcode *)
LAST_ERR_S : INTEGER4; (* APPC secondary retcode *)
DOS_RC : WORD; (* OS/2 return code *)

MSG_FILENAME : STRING(8); (* 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 *)

VCB : ARRAY [0..512] OF BYTE;(* Communications Control Block *)
VCBPTR1 : ADS_RCV_ALLOC; (* Pointers to the VCB *)
VCBPTR2 : ADS_RCV_AND_WAIT;
VCBPTR3 : ADS_SEND_DATA;
VCBPTR4 : ADS_CONFIRMED;
VCBPTR5 : ADS_SEND_ERROR;

VCBPTR6 : ADS_DEALLOCATE;
VCBPTR7 : ADS_TPENDED;
VCBPTR8 : ADS_CONVERT;
VCBPTR9 : ADS_LOG_MESSAGE;

VALUE
SYSTEM_ERROR := FALSE;
PGM_DONE := FALSE;

MSG_FILENAME := 'APX.MSG' * CHR(0); (* Must be an ASCIIZ string *)


(****************************************************************************)
(* DEFINE EXTERNAL PROCEDURES *)
(****************************************************************************)

(*$INCLUDE:'APPC_EXT.INC'*)
(*$INCLUDE:'ACSSVCP3.INC'*)

FUNCTION DOSALLOCSEG (SIZE:INTEGER; VARS SELECTOR:WORD; FLAGS:WORD): WORD;
EXTERN;

FUNCTION DOSFREESEG (SELECTOR:WORD): WORD; EXTERN;

FUNCTION DOSCLOSE (FILEHANDLE:WORD): WORD; EXTERN;

FUNCTION DOSREAD (FILEHANDLE:WORD; ANBPTR:ADSMEM; LENGTH:WORD;
BYTES_READ:ADSMEM):WORD; EXTERN;

FUNCTION DOSOPEN (FILENAME_PTR:ADSMEM; HANDLE_PTR:ADSMEM; ACTION_PTR:ADSMEM;
FILESIZE:INTEGER4; FATTRB:WORD; FOPEN_FLAG:WORD;
FOPEN_MODE:WORD; ZERO:INTEGER4):WORD; EXTERN;

FUNCTION DOSGETMESSAGE (TABLE_PTR:ADSMEM; NVARS:WORD; BUFFER_PTR:ADSMEM;
BUFF_LEN:WORD; MSG_NUM:WORD; MSG_FILNAM_PTR:ADSMEM;
MSG_LEN_PTR:ADSMEM):WORD; EXTERN;

(****************************************************************************)
(* UTILITY PROCEDURES *)
(****************************************************************************)


PROCEDURE CLEAR_VCB;
(* APPC requires some reserved fields to equal binary 00. This routine *)
(* initializes all of the Command Control Block to 00 *)

VAR I : INTEGER;

BEGIN
FOR I := 0 TO 200 DO
VCB [I] := 0;
END; (* CLEAR_VCB *)

PROCEDURE INITIALIZE;
(* Initializes Address Pointers *)
BEGIN
VCBPTR1 := ADS VCB;
VCBPTR2 := ADS VCB;
VCBPTR3 := ADS VCB;
VCBPTR4 := ADS VCB;
VCBPTR5 := ADS VCB;
VCBPTR6 := ADS VCB;
VCBPTR7 := ADS VCB;
VCBPTR8 := ADS VCB;
VCBPTR9 := ADS VCB; (* Set pointers to a common *)
(* VCB control block *)

FILENAME_PTR := ADS FILENAME[1]; (* For DOSOPEN need data addr. *)
(* not the lstring length hdr. *)

ACTION_PTR := ADS ACTION; (* Set pointer variables *)
HANDLE_PTR := ADS FILEHANDLE;

MSG_BUFFER_PTR := ADS MSG_BUFFER[1]; (* Skip past length at offset 0 *)

COPYSTR('FILEMSVR',MY_TP_NAME); (* Set the tp_name *)
CLEAR_VCB; (* Need to convert it to EBCDIC *)
WITH VCBPTR8@ DO
BEGIN
OPCODE := SV_CONVERT; (* Convert verb *)
DIRECTION := SV_ASCII_TO_EBCDIC; (* ASCII to EBCDIC *)
CHARACTER_SET := SV_AE; (* Use the AE transalate table *)
LEN := 64; (* Tp_name is 64 bytes *)
SOURCE_PTR := ADS MY_TP_NAME; (* Set source address *)
TARGET_PTR := ADS MY_TP_NAME; (* Target = Source says convert *)
(* in place *)
END;
ACSSVC_P (VCBPTR8); (* Call Gen. Services to conv. *)

END; (* INITIALIZE *)

PROCEDURE SHOWMSG(MSGNO:WORD);
(* Procedure to get and display a message from msg. file - APX.MSG *)
VAR MSG_RC : WORD;
BEGIN
MSG_RC := DOSGETMESSAGE (ADS MSG_FILENAME,0,MSG_BUFFER_PTR,255,
MSGNO,ADS MSG_FILENAME,ADS MSG_LEN);
(* Call OS/2 to get message *)
(* from "APX.MSG" 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 Pascal Lstr. w/ len *)
WRITE (MSG_BUFFER); (* Display the message *)

(* Also, log a message to the system message file with LOG_MESSAGE *)

CLEAR_VCB; (* Zero the VCB, *)
(* also clears last error *)
WITH VCBPTR9@ DO
BEGIN
OPCODE := SV_LOG_MESSAGE; (* Verb = LOG_MESSAGE *)
MSG_NUM := MSGNO; (* Message = "Sample Server *)
(* has APPC error" *)
MSG_FILE_NAME := 'APX'; (* Set message file name "APX" *)
MSG_ACT := SV_NO_INTRV; (* Specify no intervention *)
END;
ACSSVC_P (VCBPTR9); (* Call ACS General Services *)
(* to log mes in system mes file*)
END; (* SHOWMSG *)

PROCEDURE SHOW_DOS_ERROR;
(* Common Procedure to display OS/2 Error Return Code *)
BEGIN
SHOWMSG (012); (* OS/2 Error, RC = *)
WRITELN (DOS_RC); (* Display the return code *)
END; (* SHOW_DOS_ERROR *)


PROCEDURE ALLOC_SHARED_BUFFER;
(* Get a shared unnamed segment to use for an APPC data buffer *)
(* The buffer is 4K, its selector is ANBPTR.S *)
BEGIN
DOS_RC := DOSALLOCSEG (4096,ANBPTR.S,1);(* Call OS/2 DOSALLOCSEG to *)
(* get the buffer *)
IF DOS_RC <> 0 THEN (* Display any errors *)
BEGIN
SHOW_DOS_ERROR;
SYSTEM_ERROR := TRUE;
END;
END; (* ALLOC_SHARED_BUFFER *)

PROCEDURE GET_DOS_FILENAME;
BEGIN
(* Move filename data from APPC buffer to local variable *)

LENGTH := WRD([email protected]_LEN); (* Get data length *)
IF LENGTH > 100 THEN LENGTH := 100; (* If required, *)
(* force a truncation to fit *)
MOVESR ([email protected]_PTR, ADS FILENAME, LENGTH);
(* Filename into local storage *)
END; (* GET_DOS_FILENAME *)

(****************************************************************************)
(* OS/2 RELATED PROCEDURES *)
(****************************************************************************)

PROCEDURE OPEN_DOS_FILE;
BEGIN
DOS_EOF := FALSE;
FOPEN_MODE := 16#0020; (* Deny Write Access, File R/O *)
FOPEN_FLAG := 16#0001; (* Fail if no file, *)
(* open if its there *)
DOS_RC := DOSOPEN(FILENAME_PTR, (* Addr of filename & path *)
HANDLE_PTR, (* Addr of filehandle - *)
(* returned by dos *)
ACTION_PTR, (* Addr of action taken by dos *)
FILESIZE, (* File primary allocation *)
0, (* File attribute *)
FOPEN_FLAG, (* Type of function to be done *)
FOPEN_MODE, (* Open mode of the file *)
0); (* Reserved double word *)
(* Dos call to open the file *)
IF DOS_RC = 0 THEN BAD_FILENAME := FALSE
(* If open was good, set flag *)
ELSE
BEGIN (* RC=110 = fail, no such file *)
IF DOS_RC <> 110 THEN SHOW_DOS_ERROR;
(* Log rc from DOSOPEN unless *)
(* a simple file not found *)
BAD_FILENAME := TRUE; (* Indicate bad filename *)
END;
END; (* OPEN_DOS_FILE *)

PROCEDURE DO_DOSREAD;
(* Read the requested file into the buffer in 4096 byte blocks. *)
(* ANBPTR points to the buffer in shared unnamed storage that will be *)
(* passed to APPC. *)
BEGIN
DOS_RC := DOSREAD(FILEHANDLE,ANBPTR,4096,ADS BYTES_READ);
IF DOS_RC <> 0 THEN (* Displ. err on non 0 ret code *)
BEGIN
SHOW_DOS_ERROR;
SYSTEM_ERROR := TRUE;
RETURN;
END;
IF BYTES_READ = 0 THEN DOS_EOF := TRUE; (* Set EOF flag if end of file *)
END; (* DO_DOSREAD *)

PROCEDURE CLOSE_DOS_FILE;

BEGIN
DOS_RC := DOSCLOSE(FILEHANDLE); (* Close the file *)
IF DOS_RC <> 0 THEN (* Handle any error *)
BEGIN
SHOW_DOS_ERROR;
SYSTEM_ERROR := TRUE;
END;
END; (* CLOSE_DOS_FILE *)

(****************************************************************************)
(* APPC RELATED PROCEDURES *)
(****************************************************************************)

PROCEDURE DO_RECEIVE_ALLOCATE;
BEGIN
CLEAR_VCB; (* Zero the VCB *)
WITH VCBPTR1@ DO
BEGIN
OPCODE := AP_RECEIVE_ALLOCATE; (* Verb = RECEIVE_ALLOCATE *)
TP_NAME := MY_TP_NAME; (* Set tp_name *)
END;

APPC_P(VCBPTR1); (* Call APPC *)

LAST_ERR_P := [email protected]_RC;
LAST_ERR_S := [email protected]_RC; (* Save return codes *)
IF LAST_ERR_P <> AP_OK THEN (* Handle any errors *)
BEGIN
SHOWMSG(9);
SYSTEM_ERROR := TRUE;
RETURN;
END;
CONVERSATION_ID := [email protected]_ID; (* Save conversation_id *)
MY_TP_ID := [email protected]_ID; (* Save tp_id *)
END; (* DO_RECEIVE_ALLOCATE *)

PROCEDURE DO_RECEIVE_AND_WAIT;
BEGIN
CLEAR_VCB; (* Zero the VCB *)
WITH VCBPTR2@ DO
BEGIN
OPCODE := AP_M_RECEIVE_AND_WAIT; (* Verb = MC_RECEIVE_AND_WAIT *)
OPEXT := AP_MAPPED_CONVERSATION; (* Mapped conversation *)
TP_ID := MY_TP_ID; (* Set tp_id *)
CONV_ID := CONVERSATION_ID; (* Set conversation_id *)
MAX_LEN := 100; (* We will take up to 100 bytes *)
DATA_PTR := ANBPTR; (* Set buffer pointer *)
END;

APPC_P(VCBPTR2); (* Call APPC *)

LAST_ERR_P := [email protected]_RC;
LAST_ERR_S := [email protected]_RC; (* Save return codes *)
IF LAST_ERR_P <> AP_OK THEN (* Handle any errors *)
BEGIN
SYSTEM_ERROR := TRUE;
SHOWMSG(9);
RETURN;
END;
END; (* DO_RECEIVE_AND_WAIT *)

PROCEDURE WAIT_FOR_A_REQUEST;
BEGIN
DO_RECEIVE_AND_WAIT; (* Wait for a filename *)
IF [email protected]_RCVD <> AP_DATA_COMPLETE THEN
(* Is data received complete ? *)
BEGIN
SYSTEM_ERROR := TRUE; (* If not, it is an error *)
SHOWMSG (016); (* Data was not complete msg. *)
RETURN;
END;
END; (* WAIT_FOR_A_REQUEST *)

PROCEDURE GET_SEND_CONTROL;
BEGIN
DO_RECEIVE_AND_WAIT; (* Wait to get send control *)
IF [email protected]_RCVD <> AP_SEND THEN (* Did we get permit to send ? *)
BEGIN
SYSTEM_ERROR := TRUE; (* It is an error if we did not *)
SHOWMSG (017); (* Permit to Send Not Rcvd. Msg *)
SHOWMSG (015); (* What_RCVD Code = Msg. *)
WRITELN ([email protected]_RCVD:4:16);
RETURN;
END;
END; (* GET_SEND_CONTROL *)

PROCEDURE DO_MC_SEND_ERROR;
BEGIN
CLEAR_VCB; (* Zero the VCB *)
WITH VCBPTR5@ DO
BEGIN
OPCODE := AP_M_SEND_ERROR; (* Verb = MC_SEND_ERROR *)
OPEXT := AP_MAPPED_CONVERSATION; (* Mapped conversation *)
TP_ID := MY_TP_ID; (* Set tp_id *)
CONV_ID := CONVERSATION_ID; (* Set conversation_id *)
END;

APPC_P(VCBPTR5); (* Call APPC *)

LAST_ERR_P := [email protected]_RC;
LAST_ERR_S := [email protected]_RC; (* Save APPC return codes *)
IF LAST_ERR_P <> AP_OK THEN (* Handle any errors *)
BEGIN
SHOWMSG(9);
SYSTEM_ERROR := TRUE;
RETURN;
END;
END; (* DO_MC_SEND_ERROR *)

PROCEDURE DO_MC_SEND_DATA;
BEGIN
CLEAR_VCB; (* Zero the VCB *)
WITH VCBPTR3@ DO
BEGIN
OPCODE := AP_M_SEND_DATA; (* Verb = MC_SEND_DATA *)
OPEXT := AP_MAPPED_CONVERSATION; (* Mapped conversation *)
TP_ID := MY_TP_ID; (* Set tp_id *)
CONV_ID := CONVERSATION_ID; (* Set conversation_id *)
DATA_LEN := (BYTES_READ); (* Length to send = *)
(* length read from file *)
DATA_PTR := ANBPTR; (* Set buffer pointer *)
END;

APPC_P(VCBPTR3); (* Call APPC *)

LAST_ERR_P := [email protected]_RC;
LAST_ERR_S := [email protected]_RC; (* Save APPC return codes *)
IF LAST_ERR_P <> AP_OK THEN (* Handle any errors *)
BEGIN
DOS_EOF := TRUE;
(* DEALLOC_ABEND results from *)
(* CTRL_BREAK on the requester *)
(* So just return and ignore it.*)
IF LAST_ERR_P = AP_DEALLOC_ABEND THEN RETURN;
SYSTEM_ERROR := TRUE; (* Otherwise, it is a real error*)
SHOWMSG(9);
RETURN;
END;
END; (* DO_MC_SEND_DATA *)

PROCEDURE DO_MC_DEALLOCATE;
BEGIN
CLEAR_VCB; (* Zero the VCB *)
WITH VCBPTR6@ DO
BEGIN
OPCODE := AP_M_DEALLOCATE; (* Verb = MC_DEALLOCATE *)
OPEXT := AP_MAPPED_CONVERSATION; (* Mapped conversation *)
TP_ID := MY_TP_ID; (* Set the tp_id *)
CONV_ID := CONVERSATION_ID; (* Set the conversation_id *)
IF ((BAD_FILENAME) OR (SYSTEM_ERROR)) THEN
(* If abnormal, deallocate abend*)
DEALLOC_TYP := AP_ABEND
ELSE
DEALLOC_TYP := AP_SYNC_LEVEL; (* Else, make it normal *)
END;

APPC_P(VCBPTR6); (* Call APPC *)

LAST_ERR_P := [email protected]_RC;
LAST_ERR_S := [email protected]_RC; (* Save the return codes *)
IF LAST_ERR_P <> AP_OK THEN (* Handle any errors *)
BEGIN
SHOWMSG(9);
SYSTEM_ERROR := TRUE;
IF LAST_ERR_S = AP_BAD_CONV_ID THEN
(* If Requester side issues a *)
(* DEALLOC_ABEND id will be bad *)
(* However, this isn't really a *)
(* server side error-ignore it. *)
BEGIN
SYSTEM_ERROR := FALSE;
END;
RETURN;
END;
END; (* DO_MC_DEALLOCATE *)

PROCEDURE DO_TP_ENDED;
BEGIN
CLEAR_VCB; (* Zero the VCB *)
WITH VCBPTR7@ DO
BEGIN
OPCODE := AP_TP_ENDED; (* Verb = TP_ENDED *)
TP_ID := MY_TP_ID; (* Set the tp_id *)
END;
APPC_P(VCBPTR7); (* Call APPC *)
LAST_ERR_P := [email protected]_RC;
LAST_ERR_S := [email protected]_RC; (* Save return codes *)
IF LAST_ERR_P <> AP_OK THEN (* Handle any errors *)
BEGIN
SHOWMSG(9);
SYSTEM_ERROR := TRUE;
RETURN;
END;
END; (* DO_TP_ENDED *)

(****************************************************************************)
(* *)
(* MAIN SERVER APPLICATION LOGIC *)
(* *)
(****************************************************************************)

BEGIN
INITIALIZE; (* Do initialization *)
ALLOC_SHARED_BUFFER; (* APPC buffer in a
(* shared unnamed segment *)
DO_RECEIVE_ALLOCATE; (* Get info from incoming alloc *)

IF (NOT(SYSTEM_ERROR)) THEN
BEGIN
WAIT_FOR_A_REQUEST; (* Wait for requester *)
(* to send a filename *)
GET_DOS_FILENAME; (* Filename in a local variable *)
GET_SEND_CONTROL; (* We will send next *)

OPEN_DOS_FILE; (* Open the requested filename *)
IF BAD_FILENAME THEN DO_MC_SEND_ERROR;(* Notify req. if bad filename *)


WHILE (NOT(SYSTEM_ERROR) AND NOT(DOS_EOF) AND
NOT(BAD_FILENAME)) DO
BEGIN (* Main processing loop *)
DO_DOSREAD; (* Read 4K of the file *)
IF SYSTEM_ERROR THEN
DO_MC_SEND_ERROR (* Handle any errors *)
ELSE
IF (NOT(DOS_EOF)) THEN DO_MC_SEND_DATA;
(* Send the data *)
END;
IF (NOT (BAD_FILENAME)) THEN CLOSE_DOS_FILE;
(* If open, close the file *)
DO_MC_DEALLOCATE; (* Dealloc the conversation *)
DO_TP_ENDED; (* Tell APPC we are done *)
END;
DOS_RC := DOSFREESEG(ANBPTR.S); (* Free the APPC data buffer *)
END. (* program server *)


  3 Responses to “Category : OS/2 Files
Archive   : OS2CMAPI.ZIP
Filename : FILEPSVR.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/