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

 
Output of file : PSAMPL.PAS contained in archive : OS2CMAPI.ZIP
(****************************PROLOGUE****************************
* *
* MODULE NAME = PSAMPL.PAS *
* *
* DESCRIPTIVE NAME = Pascal Sample Program *
* *
* COPYRIGHT: (C) COPYRIGHT IBM CORP. 1988 *
* LICENSED MATERIAL - PROGRAM PROPERTY OF IBM *
* ALL RIGHTS RESERVED *
* *
* STATUS: Release 1 Modification 0 *
* *
* FUNCTION = Invoke a hypothetical server via the Pascal *
* interface routines. *
* *
* This sample program reads a customer record *
* from a host computer, examines the customer's *
* balance, and writes the customer record to *
* a file containing customer records with a *
* balance due. *
* *
* NOTES = *
* *
* RESTRICTIONS = This sample program is provided soley as *
* an example of how the Pascal interface *
* routines can be used to invoke a server. *
* *
* MODULE TYPE = IBM Pascal Compiler/2 Version 1.00 *
************************END PROLOGUE****************************)
(***********************DEFINITIONS*****************************)
program psampl;
(*$SUBTITLE : 'CPRB Record Definition'*)
(*$PAGE+*)
(*$INCLUDE: 'UUPCPRB.INC'*)
(*$SUBTITLE : 'Definitions Section'*)
(*$INCLUDE: 'UUPPROCS.INC'*)

const (* Miscellaneous consts*)
pfunc1 = 1; (* Get Record *)
pfunc2 = 2; (* Update AR file *)

pcrecsiz = 109; (* Customer Record size*)

prcok = #00000000; (* Server Ret. Code OK *)
plstr = #00000004; (* Last Record *)

poper = 'ADMIN '; (* Default operator *)
pserver = 'IBMabase'; (* Server Name *)

type custrec = record (* Customer Record *)
cusname [00]: string(25); (* Customer Name *)
cusaddr [25]: string(25); (* Street Address *)
cuscity [50]: string(15); (* City *)
cusstat [65]: string(15); (* State *)
cuszip [80]: string(9); (* Zip Code *)
cusacct [89]: string(16); (* Account Number *)
cusbal [105]: integer4; (* Balance *)
end;

type qparms = record (* Request Parameters *)
qpaflags [00]: byte; (* Processing Flags *)
qpaoper [01]: string(8); (* Requesting Operator *)
end;
const (* Values for qpaflags *)
qpalog = #01; (* Log the transaction *)
qpacom = #02; (* Commit transaction *)

var pcprb : uercprb; (* CPRB record *)
pcustrec : custrec; (* Customer Record *)
pqparms : qparms; (* Request Parameters *)
pretcod : integer4; (* SRPI Return Code *)
pcprbads : UERCPRBPTR; (* CPRB address *)

(***************************END DEFINITIONS**********************)
(*$SUBTITLE: 'Main procedure'*)
(*$PAGE+*)
(***************************PSEUDOCODE***************************)
(* PROC (MAIN) *)
(* 1. SET PROCESSING OPTION = COMMIT *)
(* TRANSACTION *)
(* 1. SET REQUESTING OPERATOR ID *)
(* 1. INITIALIZE SRPI RETURN CODE *)
(* 1. INITIALIZE SERVER RETURN CODE *)
(* 1. DO WHILE SERVER RETURN CODE IS NOT *)
(* LAST RECORD AND SRPI RETURN CODE *)
(* IS GOOD *)
(* 2. . INITIALIZE THE CPRB RECORD *)
(* *)
(* 2. . MOVE SERVER NAME AND FUNCTION (GET *)
(* RECORD) INTO CPRB RECORD *)
(* 2. . SET CPRB REQUEST PARAMETERS BUFFER *)
(* INFORMATION *)
(* 2. . SET CPRB REPLY DATA BUFFER *)
(* INFORMATION *)
(* 2. . SEND THE REQUEST TO THE SERVER *)
(* *)
(* 2. . IF THE SRPI RETURN CODE IS GOOD *)
(* 3. . . IF THE SERVER RETURN CODE IS *)
(* GOOD *)
(* 4. . . . IF THE ACCOUNT BALANCE IS *)
(* POSITIVE *)
(* 5. . . . . SET CPRB FUNCTION = UPDATE *)
(* ACCOUNTS RECEIVABLE *)
(* 5. . . . . SET CPRB REQUEST DATA = *)
(* CUSTOMER RECORD *)
(* 5. . . . . UPDATE THE ACCOUNTS *)
(* RECEIVABLE FILE *)
(* *)
(* 4. . . . ENDIF *)
(* 3. . . ENDIF *)
(* 2. . ENDIF *)
(* 1. ENDWHILE *)
(* END PROC (MAIN) *)
(************************END PSEUDOCODE**************************)
(************************PROCEDURE*******************************)
begin (* PROC (MAIN) *)

pqparms.qpaflags := qpacom; (* SET PROCESSING OPTION= *)
(* COMMIT TRANSACTION *)

pqparms.qpaoper := poper; (* SET REQUEST OPERATOR ID *)

pretcod := UERERROK; (* INITIALIZE SRPI RETURN CODE *)
pcprb.uerservrc := prcok; (* INITIALIZE SERVER RETURN CODE*)
while (pcprb.uerservrc <> plstr) and (pretcod = UERERROK) do
begin (* DO WHILE SERVER RETURN CODE *)
(* IS NOT LAST RECORD AND SRPI *)
(* RETURN CODE IS GOOD *)

pcprbads := ADS pcprb; (* INITIALIZE THE CPRB RECORD *)
init_send_req_parms(pcprbads); (*
pcprb.uerserver := pserver; (* MOVE SERVER NAME AND *)
pcprb.uerfunct := pfunc1; (* FUNCTION INTO CPRB *)

pcprb.uerqparml := sizeof(pqparms); (* SET CPRB REQUEST PARAMETERS *)
pcprb.uerqparmad := ADS pqparms; (* BUFFER INFORMATION *)

pcprb.uerrdatal := pcrecsiz; (* SET CPRB REPLY DATA *)
pcprb.uerrdataad := ADS pcustrec; (* BUFFER INFORMATION *)

pretcod := sendrequest(pcprbads); (* SEND THE REQUEST TO SERVER *)
(* *)

if pretcod = UERERROK then (* IF THE SRPI RETURN *)
(* CODE IS GOOD *)
begin

if pcprb.uerservrc = prcok then (* IF THE SERVER RETURN CODE *)
(* IS GOOD *)
begin

if pcustrec.cusbal > 0 then (* IF THE ACCOUNT BALANCE *)
(* IS POSITIVE *)
begin

pcprb.uerfunct := pfunc2; (* SET CPRB FUNCTION = UPDATE *)
(* ACCOUNTS RECEIVABLE *)

pcprb.uerqdatal := pcrecsiz; (* SET CPRB REQUEST DATA*)
pcprb.uerqdataad:= ADS pcustrec; (* = CUSTOMER RECORD *)

pretcod := sendrequest(pcprbads); (* UPDATE THE ACCOUNTS *)
(* RECEIVABLE FILE *)
(* *)

end; (* ENDIF *)
end; (* ENDIF *)
end; (* ENDIF *)
end; (* ENDWHILE *)
end. (* ENDPROC (MAIN) *)
(*****************************END PROCEDURE******************************)



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