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

 
Output of file : FILEPREQ.PAS contained in archive : OS2CMAPI.ZIP
PROGRAM PREQST (INPUT,OUTPUT);
(************************************************************************)
(* *)
(* MODULE NAME: FILEPREQ.PAS *)
(* *)
(* DESCRIPTIVE NAME: APPC FILE REQUESTER 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 = Issues a request for a file to a server and *)
(* transfers the file to the default local disk *)
(* (current directory). All data transfer is to *)
(* a peer server via APPC calls. The program is *)
(* invoked: *)
(* *)
(* FILEPREQ filename *)
(* *)
(* The filename is a valid DOS filename on the server *)
(* system. Both the server and requester sample programs *)
(* use this filename for DOSOPEN so any subdirectory *)
(* specified must be valid on both systems. *)
(* *)
(* Uses the following APPC Verbs: *)
(* *)
(* TP_STARTED *)
(* MC_ALLOCATE *)
(* MC_SEND_DATA *)
(* MC_RECEIVE_AND_WAIT *)
(* MC_CONFIRMED *)
(* TP_ENDED *)
(* *)
(* Uses the following General Services verbs: *)
(* *)
(* CONVERT *)
(* *)
(* MODULE TYPE: IBM Personal Computer Pascal/2 Compiler *)
(* (Compiles with Small Memory Model) *)
(* *)
(* Requires message file "APX.MSG" at runtime. *)
(* *)
(************************************************************************)

(*$DEBUG+*)
(*$LINE+*)

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

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


TYPE
ADS_ALLOCATE = ADS OF MC_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_TPSTARTED = ADS OF TP_STARTED;
ADS_CONVERT = ADS OF CONVERT;

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



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

FILENAME : LSTRING(100); (* Filename *)
FILENAME_PTR : ADS OF LSTRING(100); (* Pointer to filename *)
FILEHANDLE : WORD; (* Handle from DOSOPEN *)
FOPEN_FLAG : WORD;
FOPEN_MODE : WORD;
FLAGS : WORD;
ACTION : WORD;
BYTES_WRITTEN : WORD;

LENGTH : WORD;
BYTE_COUNT : INTEGER4; (* Cumulative bytes written *)

(* Vars for Msg. Processing *)
MSG_FILENAME : STRING(8); (* Message filename *)
MSG_BUFFER : LSTRING(255); (* String to get Msg. Text *)
MSG_BUFFER_PTR : ADS OF LSTRING(255); (* Pointer to the Msg. Str. *)
MSG_LEN : WORD; (* Message text length *)


(* APPC variables *)
CONVERSATION_ID : INTEGER4; (* Conversation_id *)
MY_TP_ID : STRING(8); (* TP_id *)
MY_TP_NAME : STRING(64); (* tp_name *)
P_TP_NAME : STRING(64); (* Partners tp_name *)
MODE : STRING(8); (* Mode name *)

ANBPTR : ADS_BUFFER; (* AlphaNum. Buffer pointer *)

(* Savearea for return codes *)
LAST_ERR_P : WORD; (* APPC Primary return code *)
LAST_ERR_S : INTEGER4; (* APPC Secondary return code *)
DOS_RC : WORD; (* DOS (OS/2) Return code *)

ENV_SEG : WORD;
ENV_OFFSET : WORD;
ENV_POINTER : ADS OF CHAR;

VCB : ARRAY [0..512] OF BYTE;(* Communications Control Block *)
VCBPTR1 : ADS_ALLOCATE;
VCBPTR2 : ADS_RCV_AND_WAIT;
VCBPTR3 : ADS_SEND_DATA;
VCBPTR4 : ADS_CONFIRMED;
VCBPTR5 : ADS_SEND_ERROR;
VCBPTR6 : ADS_DEALLOCATE;
VCBPTR7 : ADS_TPENDED;
VCBPTR8 : ADS_TPSTARTED;
VCBPTR9 : ADS_CONVERT;

VALUE
SYSTEM_ERROR := FALSE;
PGM_DONE := FALSE;
FIRST_TIME := TRUE;
BYTE_COUNT := 0;

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

(*$INCLUDE:'APPC_EXT.INC'*) (* APPC External Procedure definition *)
(*$INCLUDE:'ACSSVCP3.INC'*) (* General Services External procedure def. *)

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

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

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

FUNCTION DOSWRITE (FILEHANDLE:WORD; ANBPTR:ADSMEM; LENGTH:WORD;
BYTES_WRITTEN: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 DOSGETENV (ENV_PTR:ADSMEM; CMD_OFFS:ADSMEM):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;
(* Sets up the various address pointers *)

BEGIN (* Set pointers to the VCB *)
VCBPTR1 := ADS VCB; (* (Reuse same area as a *)
VCBPTR2 := ADS VCB; (* common control block) *)
VCBPTR3 := ADS VCB;
VCBPTR4 := ADS VCB;
VCBPTR5 := ADS VCB;
VCBPTR6 := ADS VCB;
VCBPTR7 := ADS VCB;
VCBPTR8 := ADS VCB;
VCBPTR9 := ADS VCB;

FILENAME_PTR := ADS FILENAME; (* Set pointer to the filename *)
FILENAME_PTR.R := FILENAME_PTR.R + 1; (* Skip start of LSTRING w/ *)
(* Length byte *)

MSG_BUFFER_PTR := ADS MSG_BUFFER; (* Set pointer to mes. buffer *)
MSG_BUFFER_PTR.R := MSG_BUFFER_PTR.R + 1;

MSG_FILENAME := 'APX.MSG' * CHR(0);

COPYSTR('FILEMREQ',MY_TP_NAME); (* Set the tp_name *)
CLEAR_VCB; (* Now CONVERT to EBCDIC *)
WITH VCBPTR9@ DO
BEGIN
OPCODE := SV_CONVERT; (* Convert verb code *)
DIRECTION := SV_ASCII_TO_EBCDIC; (* Convert ASCII to EBCDIC *)
CHARACTER_SET := SV_AE; (* Use the AE xlate table *)
LEN := 64; (* TP_NAME is 64 bytes *)
SOURCE_PTR := ADS MY_TP_NAME; (* Addr of the data *)
TARGET_PTR := ADS MY_TP_NAME; (* SRCE=TGT = cnvt in place *)
END;
ACSSVC_P (VCBPTR9); (* Convert to EBCDIC *)

COPYSTR('FILEMSVR',P_TP_NAME); (* Set partners tp_name *)
CLEAR_VCB; (* Now CONVERT to EBCDIC *)
WITH VCBPTR9@ DO
BEGIN
OPCODE := SV_CONVERT; (* Convert verb code *)
DIRECTION := SV_ASCII_TO_EBCDIC; (* Convert ASCII to EBCDIC *)
CHARACTER_SET := SV_AE; (* Use the AE xlate table *)
LEN := 64; (* TP_NAME is 64 bytes *)
SOURCE_PTR := ADS P_TP_NAME; (* Addr of the data *)
TARGET_PTR := ADS P_TP_NAME; (* SRCE=TGT = cnvt in place *)
END;
ACSSVC_P (VCBPTR9); (* Convert to EBCDIC *)

MODE := 'MODE1 '; (* Set mode *)
CLEAR_VCB; (* Zero the VCB *)
WITH VCBPTR9@ DO
BEGIN
OPCODE := SV_CONVERT; (* Convert General Service *)
DIRECTION := SV_ASCII_TO_EBCDIC; (* ASCII to EBCDIC *)
CHARACTER_SET := SV_A; (* Character set - A *)
LEN := 8; (* Mode is 8 bytes long *)
SOURCE_PTR := ADS MODE; (* Set the addresses *)
TARGET_PTR := ADS MODE;
END;
ACSSVC_P (VCBPTR9); (* Convert mode to EBCDIC *)

END; (* INITIALIZE *)

PROCEDURE SHOWMSG(MSGNO:WORD);
(* Gets and displays a message from the message dataset - APX.MSG *)

VAR MSG_RC : WORD;
BEGIN (* Go get the message text *)

MSG_RC := DOSGETMESSAGE (ADS MSG_FILENAME, 0, MSG_BUFFER_PTR, 255,
MSGNO, ADS MSG_FILENAME, ADS MSG_LEN);

IF MSG_RC <> 0 THEN (* Display an error if we can't *)
BEGIN (* process the message 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 string *)
WRITE (MSG_BUFFER); (* Display the message *)
END; (* SHOWMSG *)

PROCEDURE SHOWERR;
BEGIN
SHOWMSG (010); (* APPC ERROR, Primary RC Msg. *)
WRITELN (LAST_ERR_P:4:16); (* Display the rc in hex *)
SHOWMSG (011); (* Secondary RC Msg. *)
WRITELN (LAST_ERR_S:8:16); (* Display Sec. rc in hex *)
SHOWMSG (018); (* APPC Verb in Error Msg. *)
WRITELN ([email protected]:4:16); (* Display verb in hex *)
END; (* SHOWERR *)

PROCEDURE SHOW_DOS_ERROR;
BEGIN
SHOWMSG (012); (* OS/2 Error, RC = Msg. *)
WRITELN (DOS_RC:4:16); (* Show retcode in hex *)
END; (* SHOW_DOS_ERROR *)

PROCEDURE PARSE_FILENAME;
(* Get the command line filename from the current environment. *)

VAR I : INTEGER;


BEGIN (* Parse command line in env. *)
DOS_RC := DOSGETENV(ADS ENV_SEG, ADS ENV_OFFSET);
(* Get env string address *)
IF DOS_RC <> 0 THEN SHOW_DOS_ERROR;
ENV_POINTER.S := ENV_SEG;
ENV_POINTER.R := ENV_OFFSET;
FILENAME := NULL;
I := 1; (* Skip prog. name ASCIIZ str. *)
REPEAT (* By looking for the 00 *)
ENV_POINTER.R := ENV_POINTER.R + 1;
UNTIL (I > 100) OR (ENV_POINTER@ = CHR(0));
ENV_POINTER.R := ENV_POINTER.R + 1; (* Skip the 00 *)
FOR I := 1 TO 100 DO (* Get first command line parm *)
BEGIN
IF ENV_POINTER@ <> CHR(0) THEN (* First parm will be *)
(* 00 terminated *)
BEGIN
IF ENV_POINTER@ <> ' ' THEN (* Take any non blank character *)
CONCAT(FILENAME,ENV_POINTER@);
ENV_POINTER.R := ENV_POINTER.R + 1;
END
ELSE
BEGIN
CONCAT(FILENAME,CHR(0)); (* Make it 00 terminated to *)
RETURN; (* be an ASCIIZ string with a *)
END; (* PASCAL Lstring format *)
END;
END; (* PARSE_FILENAME *)


PROCEDURE ALLOC_SHARED_BUFFER;
(* APPC requires a shared unnamed segment to use as a data buffer *)

BEGIN (* Allocate a 4K shared segment *)
DOS_RC := DOSALLOCSEG (4096,ANBPTR.S,1);
IF DOS_RC <> 0 THEN
BEGIN
SHOW_DOS_ERROR;
SYSTEM_ERROR := TRUE;
END
END; (* ALLOC_SHARED_BUFFER *)


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

PROCEDURE DO_TP_STARTED;
BEGIN
CLEAR_VCB; (* Zero the VCB *)
WITH VCBPTR8@ DO
BEGIN
OPCODE := AP_TP_STARTED; (* Verb = TP_STARTED *)
LU_ALIAS := 'FILEREQ '; (* Set LU_ALIAS *)
TP_NAME := MY_TP_NAME; (* Set my tp_name *)
END;

APPC_P(VCBPTR8); (* Call APPC *)

MY_TP_ID := [email protected]_ID; (* Get the tp_id *)
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
SHOWERR;
SYSTEM_ERROR := TRUE;
RETURN;
END;
END; (* DO_TP_STARTED *)



PROCEDURE DO_MC_ALLOCATE;
BEGIN
CLEAR_VCB; (* Zero the VCB *)
WITH VCBPTR1@ DO
BEGIN
OPCODE := AP_M_ALLOCATE; (* Verb = MC_ALLOCATE *)
OPEXT := AP_MAPPED_CONVERSATION; (* Mapped conversation *)
TP_ID := MY_TP_ID; (* Set my tp_id *)
SYNC_LEVEL := AP_CONFIRM_SYNC_LEVEL;(* sync_level = CONFIRM *)
RTN_CTL := AP_WHEN_SESSION_ALLOCATED;
(* Don't return until allocated *)
PLU_ALIAS := 'FILESVR '; (* Set partner's name *)
MODE_NAME := MODE; (* Set mode name *)
TP_NAME := P_TP_NAME; (* Partners tp_name *)
SECURITY := AP_NONE; (* No security *)
END;

APPC_P(VCBPTR1); (* Call APPC *)

CONVERSATION_ID := [email protected]_ID; (* Save conversation id *)
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
SHOWERR;
SYSTEM_ERROR := TRUE;
RETURN;
END;
END; (* DO_MC_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 the tp_id *)
CONV_ID := CONVERSATION_ID; (* Set the conversation_id *)
MAX_LEN := 4096; (* We'll take up to 4096 bytes *)
DATA_PTR := ANBPTR; (* Set buff ptr in shared seg *)
END;

APPC_P(VCBPTR2); (* Call APPC *)

LENGTH := WRD([email protected]_LEN); (* Save actual len. transfered *)
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
SHOWERR;
SYSTEM_ERROR := TRUE;
RETURN;
END;
END; (* DO_RECEIVE_AND_WAIT *)

PROCEDURE SEND_DOS_FILENAME;
BEGIN
MOVESR (ADS FILENAME, ANBPTR, 100); (* Move requested filename into *)
CLEAR_VCB; (* a shared segment. Zero 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_PTR := ANBPTR; (* Set pointer to shared buffer *)
DATA_LEN := 100; (* Max len. for filename = 100 *)
END;

APPC_P(VCBPTR3); (* 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 error *)
BEGIN
SHOWERR;
SYSTEM_ERROR := TRUE;
RETURN;
END;
END; (* SEND_DOS_FILENAME *)

PROCEDURE DO_MC_CONFIRMED;
BEGIN
CLEAR_VCB; (* Zero the VCB *)
WITH VCBPTR4@ DO
BEGIN
OPCODE := AP_M_CONFIRMED; (* Verb = MC_CONFIRMED *)
OPEXT := AP_MAPPED_CONVERSATION; (* Mapped conversation *)
TP_ID := MY_TP_ID; (* Set tp_id *)
CONV_ID := CONVERSATION_ID; (* Set conversation_id *)
END;

APPC_P(VCBPTR4); (* 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
SHOWERR;
SYSTEM_ERROR := TRUE;
RETURN;
END;
END; (* DO_MC_CONFIRMED *)

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 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
SHOWERR;
SYSTEM_ERROR := TRUE;
RETURN;
END;
END; (* DO_TP_ENDED *)

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

PROCEDURE OPEN_DOS_FILE;
BEGIN
DOS_EOF := FALSE;
FOPEN_MODE := 16#0022; (* Deny write share,open RD/WRT *)
FOPEN_FLAG := 16#0012; (* Open if no file, *)
(* Repl if its there *)
DOS_RC := DOSOPEN(FILENAME_PTR, (* Addr of file & path name *)
ADS FILEHANDLE, (* Addr of filehandle - *)
(* returned be dos *)
ADS ACTION, (* Addr of action taken by dos *)
0, (* 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
(* Flag a good open *)
ELSE
BEGIN (* Else, handle as an error *)
SHOW_DOS_ERROR;
BAD_FILENAME := TRUE;
END;

END; (* OPEN_DOS_FILE *)

PROCEDURE WRITE_DOS_DATA;
BEGIN
IF FIRST_TIME THEN (* First time, open the file *)
BEGIN
OPEN_DOS_FILE; (* Do the open *)
FIRST_TIME := FALSE; (* Only open the first time *)
IF BAD_FILENAME THEN (* Handle any error on open *)
BEGIN
SHOWMSG (013); WRITELN; (* "File Error- Unable to open" *)
SYSTEM_ERROR := TRUE; (* Global error flag on *)
RETURN; (* Error - just return *)
END;
END;
DOS_RC := DOSWRITE(FILEHANDLE,ANBPTR,LENGTH,ADS BYTES_WRITTEN);
(* Write the data *)
IF DOS_RC <> 0 THEN (* Handle any error *)
BEGIN
WRITELN; (* Skip a line *)
SHOW_DOS_ERROR; (* Display the dos retcode *)
SYSTEM_ERROR := TRUE; (* Global error flag on *)
RETURN; (* And return *)
END;
BYTE_COUNT := BYTE_COUNT + BYLONG(0,BYTES_WRITTEN);
(* Cumulative bytes-wrtn count *)
SHOWMSG (007); (* Display byte count prog msg. *)
WRITE (BYTE_COUNT,CHR(13)); (* Force a LF w/ NO CR *)

END; (* WRITE_DOS_DATA *)

PROCEDURE CLOSE_DOS_FILE;
BEGIN
DOS_RC := DOSCLOSE(FILEHANDLE); (* Close the file *)
IF DOS_RC <> 0 THEN (* Show any errors *)
BEGIN
SHOW_DOS_ERROR;
SYSTEM_ERROR := TRUE;
END;
END; (* CLOSE_DOS_FILE *)
(****************************************************************************)
(* MAIN REQUESTER LOGIC *)
(****************************************************************************)

BEGIN
INITIALIZE; (* Do address setup (etc.) *)
SHOWMSG (002); (* Requester message *)
PARSE_FILENAME; (* Get the requested filename *)
ALLOC_SHARED_BUFFER; (* Allocate a shared buffer *)
WHILE ((NOT SYSTEM_ERROR) AND (NOT PGM_DONE)) DO
BEGIN
DO_TP_STARTED; (* Indicate a tp has started *)
IF (NOT SYSTEM_ERROR) THEN
BEGIN
DO_MC_ALLOCATE; (* Allocate a ses. & a conv. *)
SEND_DOS_FILENAME; (* Send filename to Server *)

WHILE ((NOT SYSTEM_ERROR) AND (NOT BAD_FILENAME) AND
(NOT DOS_EOF)) DO
BEGIN
DO_RECEIVE_AND_WAIT; (* Wait for the server to reply *)
IF ((LAST_ERR_P <> AP_OK) AND
(LAST_ERR_P <> AP_PROG_ERROR_NO_TRUNC)) THEN
(* Should be ok or prog_err *)
BEGIN
WRITELN; (* Error if not ok or prog_err *)
SYSTEM_ERROR := TRUE;
SHOWERR;
END
ELSE
BEGIN
IF LAST_ERR_P = AP_PROG_ERROR_NO_TRUNC THEN
(* Pgm_error = file not found *)
BEGIN
SHOWMSG (0014);
(* File not found msg. *)
DOS_EOF := TRUE;
(* Force EOF *)
CYCLE;
END;
IF (([email protected]_RCVD <> AP_DATA_COMPLETE) AND
([email protected]_RCVD <> AP_CONFIRM_DEALLOCATE)) THEN
BEGIN
SHOWMSG (0015);
(* Unexpected data rcvd msg *)
WRITELN ([email protected]_RCVD:4:16);
(* Show what_rcvd value *)
SYSTEM_ERROR := TRUE;
CYCLE;
END;
IF [email protected]_RCVD = AP_DATA_COMPLETE THEN
(* Did we get good data ? *)
BEGIN
WRITE_DOS_DATA;
(* If so, write it to disk *)
END;
IF [email protected]_RCVD = AP_CONFIRM_DEALLOCATE THEN
(* Dealloc = done *)
BEGIN
DOS_EOF := TRUE;
(* If so, set EOF to true *)
DO_MC_CONFIRMED;
(* CONFIRM we are finished *)
END;
END;

END; (* WHILE NOT DOS_EOF *)
WRITELN;
IF (NOT BAD_FILENAME) THEN CLOSE_DOS_FILE;
(* If we opened it, close file *)
PGM_DONE := TRUE; (* Set program_done flag on *)
DO_TP_ENDED; (* Tell APPC we are finished *)
END;

END;

DOS_RC := DOSFREESEG(ANBPTR.S); (* Free the allocated memory *)
SHOWMSG (003); (* Function complete message *)
END. (* program prequest *)


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