1 / 56

Modern RPG – Unrealized Capabilities as easy as A. B. C…

Modern RPG – Unrealized Capabilities as easy as A. B. C…. Agenda. Procedures – Use them!! Tools in RPGLE SQL Sockets Demo 1 Auto Refresh a screen in a program JDBC in RPGLE User Spaces with Pointers Demo 2 CEE Language and UNIX style API’s ENCRYPTION Random #’s

zody
Download Presentation

Modern RPG – Unrealized Capabilities as easy as A. B. C…

An Image/Link below is provided (as is) to download presentation Download Policy: Content on the Website is provided to you AS IS for your information and personal use and may not be sold / licensed / shared on other websites without getting consent from its author. Content is provided to you AS IS for your information and personal use only. Download presentation by click this link. While downloading, if for some reason you are not able to download a presentation, the publisher may have deleted the file from their server. During download, if you can't get a presentation, the file might be deleted by the publisher.

E N D

Presentation Transcript

  1. Modern RPG – Unrealized Capabilities as easy as A. B. C… Agenda Procedures – Use them!! Tools in RPGLE SQL Sockets Demo 1 Auto Refresh a screen in a program JDBC in RPGLE User Spaces with Pointers Demo 2 CEE Language and UNIX style API’s ENCRYPTION Random #’s PHP Command Line calls Modern RPG – Unrealized Capabilities George L. Slater

  2. A. Procedures – Use Them!!! Procedures – Use them! • ILE Structure – any program can call any other ILE routine • Gained access to C from RPGLE • UNIX socket stuff from RPGLE • Write your own Built-In functions • Locally scoped variables so we don’t step on ourself – i(ndex) used multiple places ok • Recursive calls of procedures • That’s the platform – or basis we’re using – all of these use C language API’s Modern RPG – Unrealized Capabilities George L. Slater

  3. B. Tools in RPGLE Tools in RPGLE • Another way for QCmdExec • Sleep instead of DlyJob • What is System Catalog? • Instead of DSPFFD – SYSCOLUMNS • TABLE_NAME = File Name • TABLE_SCHEMA = Library Modern RPG – Unrealized Capabilities George L. Slater

  4. B. Tools in RPGLE QCmdExec 1 of 4 Another way for QCmdExec The traditional way: C Eval Command = ‘CHKOBJ QTEMP/WORKFILE – C OBJTYPE(*FILE)’ C Eval Length = %Len(Command) C Call ‘QCMDEXC’ 50 C Parm Command C Parm Length Or /Free Command = ‘CHKOBJ QTEMP/WORKFILE OBJTYPE(*FILE)’; Length = %Len(Command); QCMDEXEC(Command:Length); /End-Free Modern RPG – Unrealized Capabilities George L. Slater

  5. B. Tools in RPGLE QCmdExec 2 of 4 Another way for QCmdExec • Drawbacks of traditional way: • Command must be assembled into a variable. • Length of data is required • While you can determine if the command was successful or not, you cannot determine why it might have failed. Modern RPG – Unrealized Capabilities George L. Slater

  6. B. Tools in RPGLE QCmdExec 3 of 4 Another way for QCmdExec The better approach – MODERN RPG: H BndDir(‘QC2LE’) D ExecCmd Pr 10i 0 ExtProc(‘system’) D Command * Value Option(*String) D CPFError s 7 Import(‘_EXCP_MSGID’) /Free   Reset CPFError; ExecCmd(‘CHKOBJ ‘ + %Trim(WorkLib) + ‘/’ + %Trim(WorkFile) + ‘ OBJTYPE(*FILE)’); If CPFError = ‘CPF9084’; // do stuff EndIf;   /End-Free 5/15/2013 Update to source above ** Reset CPFError; Should be Clear CPFError; Modern RPG – Unrealized Capabilities George L. Slater

  7. B. Tools in RPGLE QCmdExec 4 of 4 Another way for QCmdExec • Modern RPG benefits: • Now you can get the same functionality you do in CL programs, including all the • added variable handling, • I/O, and • looping capability that you have in RPG. Modern RPG – Unrealized Capabilities George L. Slater

  8. B. Tools in RPGLE DlyJob 1 of 2 Sleep instead of DlyJob The traditional way: C Eval Command = ‘DLYJOB DLY(@num_sec)’ C Eval Length = %Len(Command) C Call ‘QCMDEXC’ 50 C Parm Command C Parm Length Or /Free Command = ‘DLYJOB DLY(@num_sec)’; Length = %Len(Command); QCMDEXEC(Command:Length); /End-Free Modern RPG – Unrealized Capabilities George L. Slater

  9. B. Tools in RPGLE DlyJob 2 of 2 Sleep instead of DlyJob • The better approach – MODERN RPG: • H BndDir(‘QC2LE’) • D wait Pr extProc(‘sleep’) • D seconds 10u 0 Const • /Free • // have the program wait 10 seconds. • wait(10); • /End-Free Modern RPG – Unrealized Capabilities George L. Slater

  10. B. Tools in RPGLE System Catalog 1 of 1 What is System Catalog? You can use it to create your own display utilities for file definitions and record formats without the need to use DSPFD or DSPFFD, or DSPDBR. QSYS2/SYSTABLES File/Table definitions QSYS2/SYSINDEXES Logical File/Index definitions QSYS2/SYSCOLUMNS Column definitions QSYS2/SYSPINDEX Primary Index (Physical File Key) definitions … and many more Modern RPG – Unrealized Capabilities George L. Slater

  11. C. SQL SQL • Build a String • Return Day of Week • Recursive SQL • Demo • Highlight Union All, etc • IBM web site reference - http://publib.boulder.ibm.com/infocenter/iseries/v5r4/index.jsp?topic=%2Fsqlp%2Frbafyrecursivequeries.htm Modern RPG – Unrealized Capabilities George L. Slater

  12. C. SQL Build a String 1 of 1 Build a string Did you know that you can Execute a SQL statement that does not perform I/O? /Free Exec Sql Select ‘My ’ || ‘Data’ into :Data from SysIbm/SysDummy1; //results in Data containing the value ‘My Data’ /End-Free Modern RPG – Unrealized Capabilities George L. Slater

  13. C. SQL Day of Week 1 of 1 Return Day of Week Another SQL statement that does not perform I/O… /Free Exec Sql Select DayOfWeek(Current Date) into :Today From SysIbm/SysDummy1; //results in Today contains the numeric day of the week for the current // date where Sunday = 1, Monday =2. /End-Free Modern RPG – Unrealized Capabilities George L. Slater

  14. C. SQL Recursive SQL 1 of 5 SQL File Specs for BOM Uses file METHDM: AQPART Parent Part AQMTLP Material Part AQSEQ# Production Sequence AQLIN# Line number AQBLWT Blow Thru Indicator (Phantom) AQMTLD Material Part Description AQQPPC Qty Per AQUNIT Unit of Measure Modern RPG – Unrealized Capabilities George L. Slater

  15. C. SQL Recursive SQL 2 of 5 Recursive SQL for BOM With BOM( Level, Part, SubPart, SequenceNo, Line#, BlowThru, Description, Quantity, UOM, Total_Qty) As ( Select 1, Root.AQPART, Root.AQMTLP, Root.AQSEQ#, Root.AQLIN#, Root.AQBLWT, Root.AQMTLD, Root.AQQPPC, Root.AQUNIT, Root.AQQPPC From MethDm Root Where Root.AQPART not in ( Select AQMTLP From METHDM) Union All Select Parent.Level + 1, Child.AQPART, Child.AQMTLP, Child.AQSEQ#, Child.AQLIN#, Child.AQBLWT, Child.AQMTLD, Child.AQQPPC, Child.AQUNIT, Child.AQQPPC * Parent.Quantity From BOM Parent Join METHDM Child On Parent.SubPart = Child.AQPART Where Parent.Level < 10 and Parent.BlowThru <> ‘ ‘) Search Depth First by Part, SequenceNo, Line# Set SeqCol Select Level, Part, SubPart, SequenceNo, Line#, Quantity, UOM, Total_Qty, From BOM Order by SeqCol Modern RPG – Unrealized Capabilities George L. Slater

  16. C. SQL Recursive SQL 3 of 5 Sample Output of BOM SQL • LEVELPARTSUBPART SEQUENCENOLINE#QUANTITYUOMTOTAL_QTY • 1 A B 10 1 1 1 • 2 B C 10 1 2 2 • 2 B D 10 2 2 2 • 3 D E 10 1 4 8 • 2 B F 10 1 1 1 • 3 F G 10 1 1 1 Modern RPG – Unrealized Capabilities George L. Slater

  17. C. SQL Recursive SQL 4 of 5 Recap of BOM SQL • BOM, Bill of Material, that uses one file: METHDM • With Clause defines a temporary work file • As clause uses 2 SQL statements • UNION ALL inserts the results of each SQL statement whether they duplicate an existing row or not • 1st Select inserts only top row level items(Items that do not appear as components anywhere in the BOM) and sets the level column to “1” Modern RPG – Unrealized Capabilities George L. Slater

  18. C. SQL Recursive SQL 5 of 5 Recap of BOM SQL cont. • 2nd Select statement = MAGIC • Inserts rows into the work file for all children based on join back to work file • That join means that as children are added they update the join so that their children (aka grandchildren) are also part of result of 2nd Select • That causes their children (great-grandchildren) to be added, and their children (great-great) and so on • STOP LOOPING = Parent level is less than 10 • Search Depth children exploded out immediately, also use Search Breadth Modern RPG – Unrealized Capabilities George L. Slater

  19. D. Sockets Demo 1-Sockets 1 of 3 Sockets Demo 1 • Read a file with no F specs • Send to a socket • Write a copy of original file • R_TARGET – • Creates a socket • Starts a listener • R_SOURCE – • Create a socket • Connect to the listener • Once connected & Target accepts connection • Sends data and receives data • SOURCE = Sending • TARGET = Receiving Modern RPG – Unrealized Capabilities George L. Slater

  20. D. Sockets Demo 1-Sockets 2 of 3 Sockets: R_TARGET Demo 1 • R_TARGET • Communications set up • Socket, Bind, Listen • TARGET = Receiving • Receives Bytes_Read • Writes to a PF Member • Performs Add, Clear, OvrDbf, Delete • Processes all entries until *END is received • Cool Prototype: • RrnLocate = Locate file pointer to a specific record in the file (SETLL) Modern RPG – Unrealized Capabilities George L. Slater

  21. D. Sockets Demo 1-Sockets 3 of 3 Sockets: R_SOURCE Demo 1 • R_SOURCE – • Communications setup, connected to listener and Target accepts connection • Sends data and receives data • SOURCE = Sending • Gets listing of members to read • Sends START of refresh • Sends RECORDS and will insert a deleted record for each missing record • Send END of refresh • Cool Prototype: • GetMbrLst = Creates User Space that lists the members of for the file Modern RPG – Unrealized Capabilities George L. Slater

  22. E. Auto Refresh a screen in a program Auto Refresh a screen in a program • Using DataQueue and OvrDspF • Code sample = SPACED • Screen Definitions • DSPF – Wait time on Record Format, Compile Permanently, Limited • ** or ** Data Queue – Stored in QTEMP, not going to hang around afterwards, No issue with wait time and time out for program to get control, Preferred method • ** Gotcha ** • Write Screen with INVITE keyword *ON • Clear Screen with INVITE keyword *OFF • Single subfile = Works great; Multiple subfiles, 2nd Screen F12 complains back, write old subfile • then do clear. Modern RPG – Unrealized Capabilities George L. Slater

  23. F. JDBC in RPGLE JDBC in RPGLE • Scott Klement’s service program • Type 4 JDBC driver • Everything is a string (String and array) • Tell what fields are where and not have to define • Date, Time and Timestamp handling are biggest problems • http://www.scottklement.com/presentations/External%20Databases%20from%20RPG.pdf Modern RPG – Unrealized Capabilities George L. Slater

  24. G. User Spaces with Pointers Demo 2-UsrSpc 1 of 3 User Spaces with Pointers Demo 2 • Display an array and update with no API’s • Run in 2 sessions • Data updated in one session • Refreshing in another session • API = QUSPTRUS, QUSCRTUS • SPACED – • DSPF = SPACED_FM • Read Only • SPACEU – • DSPF = SPACEU_FM • Update, Create & Write Modern RPG – Unrealized Capabilities George L. Slater

  25. G. User Spaces with Pointers Demo 2-UsrSpc 2 of 3 User Spaces with Pointers Demo 2 • Remember…your program imposes the structure onto the Data Area • Forgot and not seeing in debug…dump it • DMPOBJ OBJ(WMSUGEX/DATATEST) OBJTYPE(*USRSPC) • Pointer • * is a pointer variable • Cool Prototype: • GetStatusPtr = Like ChkObj, 0=worked, no length, string on the fly Modern RPG – Unrealized Capabilities George L. Slater

  26. G. User Spaces with Pointers Demo 2-UsrSpc 3 of 3 User Spaces with Pointers Demo 2 • User spaces do not have to look the same • You could define the original data structure so that it just looks at some control information at the beginning of the user space • Then that control information defines what the layout of the rest of the user space is • Guess what? You can then use the pointer to base a data structure of the correct format, or even stack multiple different data structure formats one after another in any number required to represent the data you want to store Modern RPG – Unrealized Capabilities George L. Slater

  27. H. CEE & UNIX style API’s CEE Language & UNIX style API’s • Sockets programming • (TARGET/SOURCE) • H Option(*SrcStmt:*Nodebugio) DftActGrp(*No) ActGrp(*New) • H Debug(*Yes) DatFmt(*ISO) AlwNull(*UsrCtl) BndDir('QC2LE') • File processing without F specs • (TARGET/SOURCE) • //******************************************************************** • // File API's • D OpenFilePr * ExtProc('_Ropen') • D FileName * Options(*String) Value • D Mode * Options(*String) Value Modern RPG – Unrealized Capabilities George L. Slater

  28. I. ENCRYPTION EN-CRYPT-ION • Code page conversion • Encryption • Hex to character’ • Encryption • MD5 – Web – no way to decrypt • RC4 – uses key – way to decrypt and encrypt Modern RPG – Unrealized Capabilities George L. Slater

  29. I. ENCRYPTION Encryption 1 of 12 EN-CRYPT-ION • Display File for encryption example • ======================================================================================= • A DSPSIZ(24 80 *DS3) • A R WDW001 • A CF03(03) • A CF12(12) • A WINDOW(*DFT 12 70) • A WDWBORDER((*COLOR BLU) (*DSPATR RI)- • A (*CHAR ' ')) • A USRRSTDSP • A 1 6'Data Encryption with RPG ' • A DSPATR(HI) • A 11 2'F3=Exit F12=Cancel' • A COLOR(BLU) • A 3 1'Enter' • A 3 7'the' • A 3 11'data' • A 3 16'to' • A 3 19'encrypt:' • A CHARIN 32 I 4 3 • A 6 1'Md5' • A 6 5'Value:' • A 8 1'Rc4' • A 8 5'Value:' • A MD5OUT 64 O 7 3 • A RC4OUT 64 O 9 3 • A R DUMMY ASSUME • A 1 2' ' Modern RPG – Unrealized Capabilities George L. Slater

  30. I. ENCRYPTION Encryption 2 of 12 EN-CRYPT-ION • Source for Encryption Program Example • ====================================================================================== • H DftActGrp(*No) ActGrp(*Caller) BndDir('QC2LE':'QUSAPIBD') • H Option(*SrcStmt:*NoDebugIO) • H Debug(*Yes) • ********************************************************************** • * Modifications • * • ********************************************************************** • FencryptD CF E WorkStn • D SysCmd Pr 10i 0 ExtProc('system') • D Command * Value Options(*String) • D CPFError s 7a import('_EXCP_MSGID') • D Sleep Pr 10i 0 ExtProc('sleep') • D SleepTime 10u 0 Const • D Cleanup Pr • DCipher Pr ExtProc('_CIPHER') • D * Value • D * Value • D * Value Modern RPG – Unrealized Capabilities George L. Slater

  31. I. ENCRYPTION Encryption 3 of 12 EN-CRYPT-ION • DConvert Pr EXTPROC('_XLATEB') • D * Value • D * Value • D 10u 0 Value • Dcvthc Pr ExtProc('cvthc') • D 1 • D 1 • D 10i 0 Value • DGetCvtTbl Pr ExtPgm('QTQCVRT') • D CCSID1 10i 0 • D St1 10i 0 • D StartMap 256 • D L1 10i 0 • D CCSID2 10i 0 • D St2 10i 0 • D GccAsn 10i 0 • D L2 10i 0 • D To819 256 • D L3 10i 0 • D L4 10i 0 • D Fb 12 • D Md5Encode Pr 32 • D InputString 50 Const Modern RPG – Unrealized Capabilities George L. Slater

  32. I. ENCRYPTION Encryption 4 of 12 EN-CRYPT-ION • D rc s 10i 0 • D Lo c Const('abcdefghijklmnopqrstuvwxyz') • D Up c Const('ABCDEFGHIJKLMNOPQRSTUVWXYZ') • D Retry s 1 • D RetryCount s 5i 0 • D encryptScreenData... • D Pr • D RC4Encode Pr 64 • D inputdata 32 Const • /free • DoW Not *In03 and • Not *In12; • ExFmt Wdw001; • encryptScreenData(); • EndDo; • *InLR = *On; • return; • /end-free Modern RPG – Unrealized Capabilities George L. Slater

  33. I. ENCRYPTION Encryption 5 of 12 EN-CRYPT-ION • //===================================================================== • // Encrypt the screen data for redisplay • //===================================================================== • P encryptScreenData... • P B • D encryptScreenData... • D Pi • /Free • If charIn <> *Blanks; • md5out = Md5Encode(charIn); • Rc4Out = Rc4Encode(charIn); • Else; • md5out = *Blanks; • Rc4Out = *Blanks; • endif; • /End-Free • P E • //====================================================================== • // MD5 Encoding routine • // Note: MD5 is a standard encoding method used on the web and can • // not be decrypted. There are websites available, however, • // that let you test passwords by entering them and displaying • // the Md5 encrypted value. These websites should be avoided Modern RPG – Unrealized Capabilities George L. Slater

  34. I. ENCRYPTION Encryption 6 of 12 EN-CRYPT-ION • // They capture the passwords and resulting MD5 hashes so that • // users can also lookup a hash and determine what the original • // password is. For this reason most web applications will not • // use a direct one-time MD5 conversion but will either: • // 1. Perform the MD5 encryption multiple times • // 2. Seed the password with some characters (possibly • // generated randomly) and store that seed along with • // the password so that the seed can be recombined • // with the password for encryption. • // 3. Scramble the password in some fixed way so that the • // entered value is not what is encrypted. • //====================================================================== • P Md5Encode B • D Md5Encode Pi 32 • D InputString 50 Const • DControls DS • D Function 5i 0 inz(5) • D HashAlg 1 inz(x'00') • D Sequence 1 inz(x'00') • D DataLngth 10i 0 inz(15) • D Unused 8 inz(*LOVAL) • D HashCtxPtr * inz(%addr(HashWorkArea)) • DOutputString S 32 • DHashWorkArea S 96 inz(*LOVAL) Modern RPG – Unrealized Capabilities George L. Slater

  35. I. ENCRYPTION Encryption 7 of 12 EN-CRYPT-ION • DMsg S 50 • DReceiverHex S 16 • DReceiverPtr S * inz(%addr(ReceiverHex)) • DReceiverChr S 32 • DSourcePtr S * inz(%addr(Msg)) • DStartMap s 256 • DTo819 s 256 • DCCSID1 s 10i 0 inz(37) • DST1 s 10i 0 inz(0) • DL1 s 10i 0 inz(%size(StartMap)) • DCCSID2 s 10i 0 inz(819) • DST2 s 10i 0 inz(0) • DGCCASN s 10i 0 inz(0) • DL2 s 10i 0 inz(%size(To819)) • DL3 s 10i 0 • DL4 s 10i 0 • DFB s 12 • DUpper c Const('ABCDEF') • DLower c Const('abcdef') • D ds • D x 5i 0 • D LowX 2 2 Modern RPG – Unrealized Capabilities George L. Slater

  36. I. ENCRYPTION Encryption 8 of 12 EN-CRYPT-ION • /Free • // Get all single byte ebcdic hex values • For x = 0 to 255; • %Subst(StartMap:x+1:1) = LowX; • EndFor; • GetCvtTbl(CCSID1: • ST1: • StartMap: • L1: • CCSID2: • ST2: • GccAsn: • L2: • To819: • L3: • L4: • Fb); • // Move the input constant to a variable and get it's length • Msg = InputString; • DataLngth = %Len(%Trim(Msg)); • If DataLngth > *Zero; • // Convert the codepage of the data • Convert( %Addr(Msg): • %Addr(To819): • %Size(Msg)); Modern RPG – Unrealized Capabilities George L. Slater

  37. I. ENCRYPTION Encryption 9 of 12 EN-CRYPT-ION • // Encrypt the data • Cipher(%Addr(ReceiverPtr): • %Addr(Controls): • %Addr(SourcePtr)); • // Convert the encrypted data to hex • CvtHc(ReceiverChr: • ReceiverHex: • %Size(ReceiverChr)); • // Convert the hex characters to lower case since that • // is the standard format of an MD5 hash • OutputString = %XLate(Upper:Lower:ReceiverChr); • Else; • OutputString = *Blanks; • EndIf; • // Return the encrypted data • Return OutputString; • /End-Free Modern RPG – Unrealized Capabilities George L. Slater

  38. I. ENCRYPTION Encryption 10 of 12 EN-CRYPT-ION • //====================================================================== • // RC4 Encryption routine • // Note: Rc4 encryption allows for decrypting the data once it is • // encrypted so long as the original encryption key is known • //====================================================================== • P RC4encode B • D RC4encode Pi 64 • D data2Encrypt 32 Const • D inputData s 32 • D encrypted s 64 Inz(*Blanks) • // This is the key used to encrypt the data • D e_key s 54A varying inz('NowIsTheTimeForAllGoodM- • D enToEncryptTheirDataWithRc4Yeah') • D Ds • D RC4_Controls ds qualified • D funct_id 2A • D datalen 5I 0 • D operation 1A • D reserved 11A • D p_key_ctx * • D key_ctx ds qualified • D stream 256A • D len 5U 0 • D reserved 6A Modern RPG – Unrealized Capabilities George L. Slater

  39. I. ENCRYPTION Encryption 11 of 12 EN-CRYPT-ION • D ds • D HexData s 64 • D p_recv s * • D p_src s * • /Free • // Move input constant to variable for processing • inputData = data2Encrypt; • // Setup the encryption key and processing information • key_ctx = *ALLx'00'; • %subst(key_ctx.stream:1:%len(e_key)) = e_key; • key_ctx.len = %len(e_key); • RC4_Controls = *ALLx'00'; • RC4_Controls.funct_id = x'0013'; • RC4_Controls.datalen = %size(inputData); • RC4_Controls.operation = x'00'; // 0=Encrypt,1=Decrypt • RC4_Controls.p_key_ctx = %addr(key_ctx); Modern RPG – Unrealized Capabilities George L. Slater

  40. I. ENCRYPTION Encryption 12 of 12 EN-CRYPT-ION • // Point to the source and destination values • p_src = %addr(inputData); • p_recv = %addr(Encrypted); • // Encrypt the data • cipher( %addr(p_recv): %addr(RC4_Controls): %addr(p_src)); • // Convert the data to hex for display since the encrypted data • // may contain non-displayable characters. • CvtHc(HexData: • Encrypted: • %Size(Encrypted)); • // Return the encrypted data • Return HexData; • /End-Free • P E Modern RPG – Unrealized Capabilities George L. Slater

  41. J. Random #’s Random #’s • Uses a random number generator • Creates a 5 character confirmation key • User must type in the key to verify that they want to perform a given action Modern RPG – Unrealized Capabilities George L. Slater

  42. J. Random #’s Random # 1 of 4 Random #’s • Display File for Random Number example • =================================================================================== • A DSPSIZ(24 80 *DS3) • A R WDW001 • A WINDOW(*DFT 10 40) • A WDWBORDER((*COLOR BLU) (*DSPATR RI)- • A (*CHAR ' ')) • A USRRSTDSP • A CF03(03) • A CF12(12) • A 1 6'Random Character Generation' • A DSPATR(HI) • A 3 2'Confirm' • A 3 10'by' • A 3 13'typing' • A 3 20'the' • A 3 24'following' • A 3 34'key:' • A @KEY 5A O 5 16DSPATR(HI) • A 7 2'Enter' • A 7 8'Key:' • A @CONFIRM 5A B 7 13 • A 9 2'F3=Exit F12=Cancel' • A COLOR(BLU) • A R DUMMY ASSUME • A 1 2' ' Modern RPG – Unrealized Capabilities George L. Slater

  43. J. Random #’s Random # 2 of 4 Random #’s • Program source for Random Number example • =================================================================================== • H DftActGrp(*No) ActGrp(*Caller) BndDir('QC2LE') • H Option(*SrcStmt:*NoDebugIO) • FRANDOMD CF E WorkStn • D SysCmd Pr 10i 0 ExtProc('system') • D Command * value options(*string) • D CPFError s 7a Import('_EXCP_MSGID') • D Confirmed Pr n • D GetRandomNbr Pr ExtProc('CEERAN0') • D Seed 10i 0 • D Random 8F • D CharArr s 1 Dim(36) CtData PerRcd(36) Modern RPG – Unrealized Capabilities George L. Slater

  44. J. Random #’s Random # 3 of 4 Random #’s • /Free • DoU *InLR; • If Confirmed(); • *InLR = *On; • EndIf; • EndDo; • Return; • /End-Free • P Confirmed B • D Confirmed Pi 1n • D RandomFloat S 8f • D Seed S 10i 0 Inz(0) • D RandomInt S 10i 0 • D I S 5i 0 • /Free • DoU @Confirm = @Key or • *In03 = *On or • *In12 = *On; Modern RPG – Unrealized Capabilities George L. Slater

  45. J. Random #’s Random # 4 of 4 Random #’s • For I = 1 to 5; • DoU RandomInt > *Zero; • GetRandomNbr(Seed:RandomFloat); • RandomInt = %Int(RandomFloat * 36); • RandomFloat = *Zero; • EndDo; • %Subst(@Key:I:1) = CharArr(RandomInt); • EndFor; • ExFmt Wdw001; • EndDo; • Return @Confirm = @Key; • /End-Free • P E • ** CharArr • ABCDEFGHIJKLMNOPQRSTUVWXYZ01234567689 Modern RPG – Unrealized Capabilities George L. Slater

  46. K. PHP Command Line calls PHP Command Line calls • FTP • Image manipulation • Accessing an image from local storage: a form upload, or FTP and storing, displaying, resizing it and converting it to another format • PHP writes classes • Anything else you need it to do such as a web routine that you want to be called at intervals as well as being called from the web. Don’t write it twice. Modern RPG – Unrealized Capabilities George L. Slater

  47. X. EXCLUDED from Presentation - EXCLUSIONS • Scheduling Jobs less than a day Modern RPG – Unrealized Capabilities George L. Slater

  48. MODERNRPG/QSQLSRC Appendix RECURS_SQL • . . . : 1 100 Browse MODERNRPG/QSQLSRC • RECURS_SQL • ...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 ...+... 9 ...+... 0 • *************** Beginning of data *************************************************************************************** • //================================================================= • // All BOM's depth first (in and out of subassemblies as they are • // encountered) • //================================================================= • With BOM(Level, • Part, • SubPart, • SequenceNo, • Line#, • BlowThru, • Description, • Quantity, • UOM, • Total_Qty) • As ( • Select 1, • Root.AQPART, • Root.AQMTLP, • Root.AQSEQ#, • BlowThru, • Description, • Quantity, • UOM, • Total_Qty) • As ( • Select 1, • Root.AQPART, • Root.AQMTLP, • Root.AQSEQ#, • Root.AQLIN#, • Root.AQBLWT, • Root.AQMTLD, • Root.AQQPPC, • Root.AQUNIT, • Root.AQQPPC • From MethDm Root • Where Root.AQPART not in ( Select AQMTLP • From METHDM) • Union All • Root.AQLIN#, • Root.AQBLWT, • Root.AQMTLD, • Root.AQQPPC, • Root.AQUNIT, • Root.AQQPPC • From MethDm Root • Where Root.AQPART not in ( Select AQMTLP • From METHDM) • Union All • Select Parent.Level + 1, • Child.AQPART, • Child.AQMTLP, • Child.AQSEQ#, • Child.AQLIN#, • Child.AQBLWT, • Child.AQMTLD, • Child.AQQPPC, • Child.AQUNIT, • Child.AQQPPC * Parent.Quantity • Select Parent.Level + 1, • Child.AQPART, • Child.AQMTLP, • Child.AQSEQ#, • Child.AQLIN#, • Child.AQBLWT, • Child.AQMTLD, • Child.AQQPPC, • Child.AQUNIT, • Child.AQQPPC * Parent.Quantity • From BOM Parent • Join METHDM Child • On Parent.SubPart = Child.AQPART • Where Parent.Level < 10 and • Parent.BlowThru <> ' ') • Search Depth First by Part, SequenceNo, Line# • Set SeqCol • Select Level, • Part, • SubPart, • From BOM Parent • Join METHDM Child • On Parent.SubPart = Child.AQPART • Where Parent.Level < 10 and • Parent.BlowThru <> ' ') • Search Depth First by Part, SequenceNo, Line# • Set SeqCol • Select Level, • Part, • SubPart, • SequenceNo, • Line#, • Quantity, • UOM, • Total_Qty, • From BOM • Order by SeqCol • //================================================================= • // Single BOM depth first (in and out of subassemblies as they are • SequenceNo, • Line#, • Quantity, • UOM, • Total_Qty, • From BOM • Order by SeqCol • //================================================================= • // Single BOM depth first (in and out of subassemblies as they are • // encountered) • //================================================================= • With BOM(Level, • Part, • SubPart, • SequenceNo, • Line#, • BlowThru, • Description, • Quantity, • // encountered) • //================================================================= • With BOM(Level, • Part, • SubPart, • SequenceNo, • Line#, • BlowThru, • Description, • Quantity, • UOM, • Total_Qty) • As ( • Select 1, • Root.AQPART, • Root.AQMTLP, • Root.AQSEQ#, • Root.AQLIN#, • Root.AQBLWT, • Root.AQMTLD, • UOM, • Total_Qty) • As ( • Select 1, • Root.AQPART, • Root.AQMTLP, • Root.AQSEQ#, • Root.AQLIN#, • Root.AQBLWT, • Root.AQMTLD, • Root.AQQPPC, • Root.AQUNIT, • Root.AQQPPC • From MethDm Root • Where Root.AQPART = 'A8309NF' • Union All • Select Parent.Level + 1, • Child.AQPART, • Child.AQMTLP, • Child.AQSEQ#, • Root.AQQPPC, • Root.AQUNIT, • Root.AQQPPC • From MethDm Root • Where Root.AQPART = 'A8309NF' • Union All • Select Parent.Level + 1, • Child.AQPART, • Child.AQMTLP, • Child.AQSEQ#, • Child.AQLIN#, • Child.AQBLWT, • Child.AQMTLD, • Child.AQQPPC, • Child.AQUNIT, • Child.AQQPPC * Parent.Quantity • From BOM Parent • Join METHDM Child • On Parent.SubPart = Child.AQPART • Where Parent.Level < 10 and • Child.AQLIN#, • Child.AQBLWT, • Child.AQMTLD, • Child.AQQPPC, • Child.AQUNIT, • Child.AQQPPC * Parent.Quantity • From BOM Parent • Join METHDM Child • On Parent.SubPart = Child.AQPART • Where Parent.Level < 10 and • Parent.BlowThru <> ' ') • Search Depth First by Part, SequenceNo, Line# • Set SeqCol • Select Level, • Part, • SubPart, • SequenceNo, • Line#, • Quantity, • UOM, • Parent.BlowThru <> ' ') • Search Depth First by Part, SequenceNo, Line# • Set SeqCol • Select Level, • Part, • SubPart, • SequenceNo, • Line#, • Quantity, • UOM, • Total_Qty, • From BOM • Order by SeqCol • //================================================================= • // Single BOM breadth first (level by level) • //================================================================= • With BOM(Level, • Part, • SubPart, • Total_Qty, • From BOM • Order by SeqCol • //================================================================= • // Single BOM breadth first (level by level) • //================================================================= • With BOM(Level, • Part, • SubPart, • SequenceNo, • Line#, • BlowThru, • Description, • Quantity, • UOM, • Total_Qty) • As ( • Select 1, • Root.AQPART, • SequenceNo, • Line#, • BlowThru, • Description, • Quantity, • UOM, • Total_Qty) • As ( • Select 1, • Root.AQPART, • Root.AQMTLP, • Root.AQSEQ#, • Root.AQLIN#, • Root.AQBLWT, • Root.AQMTLD, • Root.AQQPPC, • Root.AQUNIT, • Root.AQQPPC • From MethDm Root • Where Root.AQPART = 'A8309NF' • Root.AQMTLP, • Root.AQSEQ#, • Root.AQLIN#, • Root.AQBLWT, • Root.AQMTLD, • Root.AQQPPC, • Root.AQUNIT, • Root.AQQPPC • From MethDm Root • Where Root.AQPART = 'A8309NF' • Union All • Select Parent.Level + 1, • Child.AQPART, • Child.AQMTLP, • Child.AQSEQ#, • Child.AQLIN#, • Child.AQBLWT, • Child.AQMTLD, • Child.AQQPPC, • Child.AQUNIT, • Union All • Select Parent.Level + 1, • Child.AQPART, • Child.AQMTLP, • Child.AQSEQ#, • Child.AQLIN#, • Child.AQBLWT, • Child.AQMTLD, • Child.AQQPPC, • Child.AQUNIT, • Child.AQQPPC * Parent.Quantity • From BOM Parent • Join METHDM Child • On Parent.SubPart = Child.AQPART • Where Parent.Level < 10 and • Parent.BlowThru <> ' ') • Search Breadth First by Part, SequenceNo, Line# • Set SeqCol • Select Level, • Part, • Child.AQQPPC * Parent.Quantity • From BOM Parent • Join METHDM Child • On Parent.SubPart = Child.AQPART • Where Parent.Level < 10 and • Parent.BlowThru <> ' ') • Search Breadth First by Part, SequenceNo, Line# • Set SeqCol • Select Level, • Part, • SubPart, • SequenceNo, • Line#, • Quantity, • UOM, • Total_Qty, • From BOM • Order by SeqCol • ****************** End of data ************************** Modern RPG – Unrealized Capabilities George L. Slater

  49. MODERNRPG/QRPGLESRC Appendix R_TARGET • . . . : 6 100 Browse MODERNRPG/QRPGLESRC • R_TARGET • ... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 ...+... 9 ...+... 0 • *************** Beginning of data *************************************************************************************** • //============================================================= • // Modifications * • //===============* • // • // 11/28/2006 Monitor for Locks on Data Areas and Retry up to • // 10 times until a good read is achieved. • // • //============================================================= • H Option(*SrcStmt:*Nodebugio) DftActGrp(*No) ActGrp(*New) • H Debug(*Yes) DatFmt(*ISO) AlwNull(*UsrCtl) BndDir('QC2LE') • D R_Target Pr • D Lib_Name 10 • D File_Name 10 • D R_Target Pi • D Lib_Name 10 • D File_Name 10 • //************************************************************************* • H Debug(*Yes) DatFmt(*ISO) AlwNull(*UsrCtl) BndDir('QC2LE') • D R_Target Pr • D Lib_Name 10 • D File_Name 10 • D R_Target Pi • D Lib_Name 10 • D File_Name 10 • //************************************************************************* • // Sockets API's • D Socket Pr 10i 0 Extproc('socket') • D 10i 0 Value • D 10i 0 Value • D 10i 0 Value • D SetSockOpt Pr 10i 0 Extproc('setsockopt') • D 10i 0 Value • D 10i 0 Value • D 10i 0 Value • // Sockets API's • D Socket Pr 10i 0 Extproc('socket') • D 10i 0 Value • D 10i 0 Value • D 10i 0 Value • D SetSockOpt Pr 10i 0 Extproc('setsockopt') • D 10i 0 Value • D 10i 0 Value • D 10i 0 Value • D * Value • D 10i 0 Value • D Bind Pr 10i 0 Extproc('bind') • D 10i 0 Value • D * Value • D 10i 0 Value • D Listen Pr 10i 0 Extproc('listen') • D 10i 0 Value • D * Value • D 10i 0 Value • D Bind Pr 10i 0 Extproc('bind') • D 10i 0 Value • D * Value • D 10i 0 Value • D Listen Pr 10i 0 Extproc('listen') • D 10i 0 Value • D 10i 0 Value • D Accept Pr 10i 0 Extproc('accept') • D 10i 0 Value • D * Value • D * Value • D Connect Pr 10i 0 Extproc('connect') • D 10i 0 Value • D * Value • D 10i 0 Value • D Accept Pr 10i 0 Extproc('accept') • D 10i 0 Value • D * Value • D * Value • D Connect Pr 10i 0 Extproc('connect') • D 10i 0 Value • D * Value • D 10i 0 Value • D GetHostByName Pr * Extproc('gethostbyname') • D * Value • D GetHostByAddr Pr * Extproc('gethostbyaddr') • D * Value • D 5i 0 Value • D 5i 0 Value • D 10i 0 Value • D GetHostByName Pr * Extproc('gethostbyname') • D * Value • D GetHostByAddr Pr * Extproc('gethostbyaddr') • D * Value • D 5i 0 Value • D 5i 0 Value • D InetAddr Pr 10u 0 Extproc('inet_addr') • D * Value • D Read Pr 10i 0 Extproc('read') • D 10i 0 Value • D * Value • D 10u 0 Value • D Write Pr 10i 0 Extproc('write') • D 10i 0 Value • D InetAddr Pr 10u 0 Extproc('inet_addr') • D * Value • D Read Pr 10i 0 Extproc('read') • D 10i 0 Value • D * Value • D 10u 0 Value • D Write Pr 10i 0 Extproc('write') • D 10i 0 Value • D * Value • D 10u 0 Value • D Close Pr 10i 0 Extproc('close') • D 10i 0 Value • D Cancel pr • D receiveAndWrite... • D Pr • D * Value • D 10u 0 Value • D Close Pr 10i 0 Extproc('close') • D 10i 0 Value • D Cancel pr • D receiveAndWrite... • D Pr • D getBufLength Pr 10u 0 • D File 10 Value • D Library 10 Value • //******************************************************************* • // Sockets Structures • D HostEnt Ds Align Based(Host@) • D HName@ * • D HAliases * • D HAddrType 10i 0 • D getBufLength Pr 10u 0 • D File 10 Value • D Library 10 Value • //******************************************************************* • // Sockets Structures • D HostEnt Ds Align Based(Host@) • D HName@ * • D HAliases * • D HAddrType 10i 0 • D HLength 10i 0 • D HAddrList@ * • D HostEntData Ds Align Based(HostEntData@) • D HName 256a • D HAliasesArr@ * Dim(65) • D HAliasesArr 256a Dim(64) • D HAddrArr@ * Dim(101) • D HAddrArr 10u 0 Dim(100) • D OpenFlag 10i 0 • D HLength 10i 0 • D HAddrList@ * • D HostEntData Ds Align Based(HostEntData@) • D HName 256a • D HAliasesArr@ * Dim(65) • D HAliasesArr 256a Dim(64) • D HAddrArr@ * Dim(101) • D HAddrArr 10u 0 Dim(100) • D OpenFlag 10i 0 • D F0@ * • D FileP0 260a • D HReserved0 150a • D F1@ * • D FileP1 260a • D HReserved1 150a • D F2@ * • D FileP2 260a • D HReserved2 150a • D F0@ * • D FileP0 260a • D HReserved0 150a • D F1@ * • D FileP1 260a • D HReserved1 150a • D F2@ * • D FileP2 260a • D HReserved2 150a • D SocketAddr Ds • D SinFamily 5i 0 • D SinPort 5u 0 • D SinAddr 10u 0 • D SinZero 8a Inz(x'00') • //******************************************************************* • // Sockets Constants / Variables • D AF_INET S 10i 0 Inz(2) • D AF_NS S 10i 0 Inz(6) • D SocketAddr Ds • D SinFamily 5i 0 • D SinPort 5u 0 • D SinAddr 10u 0 • D SinZero 8a Inz(x'00') • //******************************************************************* • // Sockets Constants / Variables • D AF_INET S 10i 0 Inz(2) • D AF_NS S 10i 0 Inz(6) • D AF_UNIX S 10i 0 Inz(1) • D AF_TELEPHONY S 10i 0 Inz(99) • D SOCK_STREAM S 10i 0 Inz(1) • D SOCK_DGRAM S 10i 0 Inz(2) • D SOCK_SEQPACKET S 10i 0 Inz(5) • D SOCK_RAW S 10i 0 Inz(3) • D INADDR_ANY S 10i 0 Inz(0) • D SOL_SOCKET S 10i 0 Inz(-1) • D SO_REUSADDR S 10i 0 Inz(55) • D Bytes_Read S 10i 0 Inz(*Zero) • D AF_UNIX S 10i 0 Inz(1) • D AF_TELEPHONY S 10i 0 Inz(99) • D SOCK_STREAM S 10i 0 Inz(1) • D SOCK_DGRAM S 10i 0 Inz(2) • D SOCK_SEQPACKET S 10i 0 Inz(5) • D SOCK_RAW S 10i 0 Inz(3) • D INADDR_ANY S 10i 0 Inz(0) • D SOL_SOCKET S 10i 0 Inz(-1) • D SO_REUSADDR S 10i 0 Inz(55) • D Bytes_Read S 10i 0 Inz(*Zero) • D Data_Size S 10i 0 Inz(*Zero) • D StartSize S 10i 0 Inz(*Zero) • D Port S 5s 0 Inz(22022) • D Sd S 10i 0 • D Sd2 S 10i 0 • D OptVal S 10u 0 Inz(1) • //ServerName S 255 Inz('FrankieIII.FrankenSeries.com') • D ServerName S 255 Inz('LOOPBACK') • D Local_Addr S 15 Inz('127.0.0.1') • D Data_Size S 10i 0 Inz(*Zero) • D StartSize S 10i 0 Inz(*Zero) • D Port S 5s 0 Inz(22022) • D Sd S 10i 0 • D Sd2 S 10i 0 • D OptVal S 10u 0 Inz(1) • //ServerName S 255 Inz('FrankieIII.FrankenSeries.com') • D ServerName S 255 Inz('LOOPBACK') • D Local_Addr S 15 Inz('127.0.0.1') • D SockAddr S * Inz(%Addr(SocketAddr)) • D AddressLength S 10i 0 • D AddrLen S * Inz(%Addr(AddressLength)) • D RrnCounter S 20i 0 • D RcdLength S 10i 0 • D SIdx s 10i 0 • D CIdx s 10i 0 • D Sql_Stmt s 8192 • D DftDate s d Inz(*LoVal) • D DftTime s t Inz(*LoVal) • D SockAddr S * Inz(%Addr(SocketAddr)) • D AddressLength S 10i 0 • D AddrLen S * Inz(%Addr(AddressLength)) • D RrnCounter S 20i 0 • D RcdLength S 10i 0 • D SIdx s 10i 0 • D CIdx s 10i 0 • D Sql_Stmt s 8192 • D DftDate s d Inz(*LoVal) • D DftTime s t Inz(*LoVal) • D DftStamp s z Inz(*LoVal) • D File_Type s 10 Inz('*FILE') • D ColumnData Ds • D ColumnField 255 • D ColumnType 10 • D C_Field s 255 Dim(4096) • D C_Type s 10 Dim(4096) • D DftStamp s z Inz(*LoVal) • D File_Type s 10 Inz('*FILE') • D ColumnData Ds • D ColumnField 255 • D ColumnType 10 • D C_Field s 255 Dim(4096) • D C_Type s 10 Dim(4096) • D StatusIdSeq s 10u 0 • //******************************************************************* • // Messaging API's • D SndInqMsg Pr 4 • D MsgId 7 Value • D MsgRply Pr 1 • D MsgKey 4 • //****************************************************************** • D StatusIdSeq s 10u 0 • //******************************************************************* • // Messaging API's • D SndInqMsg Pr 4 • D MsgId 7 Value • D MsgRply Pr 1 • D MsgKey 4 • //****************************************************************** • // Port Number conversion • D Ds • D PortParm 15s 5 • D PortNum 5s 0 Overlay(PortParm:6) • //****************************************************************** • // Error Handling / Messaging variables • D MsgKey S 4 • D Timeout S 5i 0 • // Port Number conversion • D Ds • D PortParm 15s 5 • D PortNum 5s 0 Overlay(PortParm:6) • //****************************************************************** • // Error Handling / Messaging variables • D MsgKey S 4 • D Timeout S 5i 0 • //******************************************************************** • // System Command API • D SysCmd Pr 10i 0 ExtProc('system') • D Command * Value Options(*String) • D CPFMsg s 7a Import('_EXCP_MSGID') • //******************************************************************** • // File API's • D OpenFile Pr * ExtProc('_Ropen') • D FileName * Options(*String) Value • //******************************************************************** • // System Command API • D SysCmd Pr 10i 0 ExtProc('system') • D Command * Value Options(*String) • D CPFMsg s 7a Import('_EXCP_MSGID') • //******************************************************************** • // File API's • D OpenFile Pr * ExtProc('_Ropen') • D FileName * Options(*String) Value • D Mode * Options(*String) Value • D CloseFile Pr 10i 0 ExtProc('_Rclose') • D FilePtr * Value • D ReadFirst Pr * ExtProc('_Rreadf') • D FilePtr * Value • D BuffPtr * Value • D BufLen 10u 0 Value • D Options 10i 0 Value • D Mode * Options(*String) Value • D CloseFile Pr 10i 0 ExtProc('_Rclose') • D FilePtr * Value • D ReadFirst Pr * ExtProc('_Rreadf') • D FilePtr * Value • D BuffPtr * Value • D BufLen 10u 0 Value • D Options 10i 0 Value • D ReadNext Pr * ExtProc('_Rreadn') • D FilePtr * Value • D BuffPtr * Value • D BufLen 10u 0 Value • D Options 10i 0 Value • D RcdWrite Pr * ExtProc('_Rwrite') • D FilePtr * Value • D BuffPtr * Value • D ReadNext Pr * ExtProc('_Rreadn') • D FilePtr * Value • D BuffPtr * Value • D BufLen 10u 0 Value • D Options 10i 0 Value • D RcdWrite Pr * ExtProc('_Rwrite') • D FilePtr * Value • D BuffPtr * Value • D BufLen 10u 0 Value • D Locate Pr * ExtProc('_Rlocate') • D FilePtr * Value • D KeyPtr * Value • D KeyLen 20u 0 Value • D Options 10i 0 Value • D RrnLocate Pr 10i 0 • D FilePtr * Const • D BufLen 10u 0 Value • D Locate Pr * ExtProc('_Rlocate') • D FilePtr * Value • D KeyPtr * Value • D KeyLen 20u 0 Value • D Options 10i 0 Value • D RrnLocate Pr 10i 0 • D FilePtr * Const • D Rrn# 20u 0 Const • D RcdDelete Pr * ExtProc('_Rdelete') • D FilePtr * Value • //************************************************************** • // Sleep API to initiate a program delay • D Sleep Pr 10i 0 ExtProc('sleep') • D Seconds 10u 0 Value • D Rrn# 20u 0 Const • D RcdDelete Pr * ExtProc('_Rdelete') • D FilePtr * Value • //************************************************************** • // Sleep API to initiate a program delay • D Sleep Pr 10i 0 ExtProc('sleep') • D Seconds 10u 0 Value • //************************************************************** • // File API Structures • D Io_Fb_Area Ds Based(Io_Fb_Ptr) • D Io_Key_Ptr * • D Io_Sys_Ptr * • D Io_Rrn 10u 0 • D Io_Bytes_Rtn 10i 0 • D Io_Blocks 5i 0 • D Io_Block_Fill 1a • D Io_Bit_Fld 1a • //************************************************************** • // File API Structures • D Io_Fb_Area Ds Based(Io_Fb_Ptr) • D Io_Key_Ptr * • D Io_Sys_Ptr * • D Io_Rrn 10u 0 • D Io_Bytes_Rtn 10i 0 • D Io_Blocks 5i 0 • D Io_Block_Fill 1a • D Io_Bit_Fld 1a • D Io_Reserved 20a • Drfile ds Based(rfile_ptr) • D reserved1b 16a • D in_buf_Ptr * • D out_buf_Ptr * • D reserved2b 48a • D riofb_T 64a • D reserved3 32a • D buf_length 10u 0 • D Io_Reserved 20a • Drfile ds Based(rfile_ptr) • D reserved1b 16a • D in_buf_Ptr * • D out_buf_Ptr * • D reserved2b 48a • D riofb_T 64a • D reserved3 32a • D buf_length 10u 0 • D reserved4 28a • D In_Null_Ptr * • D Out_Null_Ptr * • D Key_Null_Ptr * • D reserved5 48a • D min_length 10i 0 • D null_map_len 5i 0 • D nkey_map_len 5i 0 • D reserved6 8a • D reserved4 28a • D In_Null_Ptr * • D Out_Null_Ptr * • D Key_Null_Ptr * • D reserved5 48a • D min_length 10i 0 • D null_map_len 5i 0 • D nkey_map_len 5i 0 • D reserved6 8a • //********************************************************************* • // File API Constants / Variables • D Key_Eq C x'0B000100' • D Key_Null C x'00000008' • D Key_Eq_Null C x'0B000108' • D No_Lock C x'00000001' • D Last_Rec C x'02000300' • D Rrn_Eq C x'08000300' • D Loc_Options s 10i 0 • //********************************************************************* • // File API Constants / Variables • D Key_Eq C x'0B000100' • D Key_Null C x'00000008' • D Key_Eq_Null C x'0B000108' • D No_Lock C x'00000001' • D Last_Rec C x'02000300' • D Rrn_Eq C x'08000300' • D Loc_Options s 10i 0 • D In_Null_Map_Ds Ds Based(In_Null_Ptr) • D In_Null_Map 1000 • D Out_Null_Map_D Ds Based(Out_Null_Ptr) • D Out_Null_Map 1000 • D Key_Null_Map_D Ds Based(Key_Null_Ptr) • D Key_Null_Map 1000 • D In_Null_Map_Ds Ds Based(In_Null_Ptr) • D In_Null_Map 1000 • D Out_Null_Map_D Ds Based(Out_Null_Ptr) • D Out_Null_Map 1000 • D Key_Null_Map_D Ds Based(Key_Null_Ptr) • D Key_Null_Map 1000 • //****************************************************************** • // Program Variables • D Errno S 10i 0 Based(Errno_Ptr) NoOpt • D Errno_Ptr S * • D ErrMsg S 60A Based(ErrMsg_Ptr) NoOpt • D ErrMsg_Ptr S * • D Rc S 10i 0 • D Fp S * • D Jrn_Rcv_Dtaara S 21 • D Mbr S 10 • //****************************************************************** • // Program Variables • D Errno S 10i 0 Based(Errno_Ptr) NoOpt • D Errno_Ptr S * • D ErrMsg S 60A Based(ErrMsg_Ptr) NoOpt • D ErrMsg_Ptr S * • D Rc S 10i 0 • D Fp S * • D Jrn_Rcv_Dtaara S 21 • D Mbr S 10 • D Null_Open S 1 • D Buffer S 10240a • D DelBuf S Like(Buffer) Inz(*Blanks) • D Open_Path S 33 • D Record S Like(Buffer) • D BufLen S 10u 0 • D SQL_Text S 512 • D First_Done S 1 • D Idx S 5i 0 • D Type_Out S 2 • D Null_Open S 1 • D Buffer S 10240a • D DelBuf S Like(Buffer) Inz(*Blanks) • D Open_Path S 33 • D Record S Like(Buffer) • D BufLen S 10u 0 • D SQL_Text S 512 • D First_Done S 1 • D Idx S 5i 0 • D Type_Out S 2 • D Count S 5i 0 • D MbrCount S 5i 0 • D Counter S 5i 0 • D Key_Data S 20 • D Member S 10 Inz('*ALL') • D System S 10 Inz('*LOCAL') • D Ds • D Data 4096 • D Rtn_Key_Sys 10 Overlay(Data:1) • D Count S 5i 0 • D MbrCount S 5i 0 • D Counter S 5i 0 • D Key_Data S 20 • D Member S 10 Inz('*ALL') • D System S 10 Inz('*LOCAL') • D Ds • D Data 4096 • D Rtn_Key_Sys 10 Overlay(Data:1) • D Rtn_Key_Lib 10 Overlay(Data:*Next) • D Rtn_Key_Obj 10 Overlay(Data:*Next) • D Operation 10 Overlay(Data:*Next) • D D_Member 10 Overlay(Data:*Next) • D Data_Content 4046 Overlay(Data:*Next) • D D_Cont_Off 5i 0 Overlay(Data_Content:1) • D D_Cont_Len 5i 0 Overlay(Data_Content:*Next) • D D_Null_Off 5i 0 Overlay(Data_Content:*Next) • D D_Null_Len 5i 0 Overlay(Data_Content:*Next) • D Rtn_Key_Lib 10 Overlay(Data:*Next) • D Rtn_Key_Obj 10 Overlay(Data:*Next) • D Operation 10 Overlay(Data:*Next) • D D_Member 10 Overlay(Data:*Next) • D Data_Content 4046 Overlay(Data:*Next) • D D_Cont_Off 5i 0 Overlay(Data_Content:1) • D D_Cont_Len 5i 0 Overlay(Data_Content:*Next) • D D_Null_Off 5i 0 Overlay(Data_Content:*Next) • D D_Null_Len 5i 0 Overlay(Data_Content:*Next) • D Save_Data S Like(Data) • //********************************************************************* • // Error handling API's • D Get_Errno Pr * ExtProc('__errno') • D Str_Error Pr * ExtProc('strerror') • D ErrNo 10i 0 Value • D Error_Ds Ds 264 • D Save_Data S Like(Data) • //********************************************************************* • // Error handling API's • D Get_Errno Pr * ExtProc('__errno') • D Str_Error Pr * ExtProc('strerror') • D ErrNo 10i 0 Value • D Error_Ds Ds 264 • D Error_Size 10i 0 Inz(%Size(Error_Ds)) • D Error_Rtn 10i 0 • D Error_Data 256 • C/Copy QsysInc/QRpgLeSrc,QUseC • /Free • Exec Sql Set Option Commit = *None, CloSqlCsr = *EndMod; • receiveAndWrite(); • D Error_Size 10i 0 Inz(%Size(Error_Ds)) • D Error_Rtn 10i 0 • D Error_Data 256 • C/Copy QsysInc/QRpgLeSrc,QUseC • /Free • Exec Sql Set Option Commit = *None, CloSqlCsr = *EndMod; • receiveAndWrite(); • *InLR = *On; • Return; • /End-Free • //------------------------------------------------------------------------- • // receive And Write file on target • //------------------------------------------------------------------------- • P receiveAndWrite... • P B • D receiveAndWrite... • D Pi • *InLR = *On; • Return; • /End-Free • //------------------------------------------------------------------------- • // receive And Write file on target • //------------------------------------------------------------------------- • P receiveAndWrite... • P B • D receiveAndWrite... • D Pi • /Free • PortParm = Port; • BufLen = getBufLength(File_Name:Lib_Name); • // If deleted records need to be populated (only true for RRN files), an • // insert statement will be used to generate a default record that will • // be deleted. • Fp = *Null; • /Free • PortParm = Port; • BufLen = getBufLength(File_Name:Lib_Name); • // If deleted records need to be populated (only true for RRN files), an • // insert statement will be used to generate a default record that will • // be deleted. • Fp = *Null; • // Retrieve the file description using the appropriate API and test for • // null capability. Use this information to format the Open command • // properly. • Open_Path = %TrimR(Lib_Name) + • '/' + File_Name; • // Establish the communications socket • Sd = Socket(AF_INET:SOCK_STREAM:0); • // Set Socket options • Rc = SetSockOpt(Sd:SOL_SOCKET • // Retrieve the file description using the appropriate API and test for • // null capability. Use this information to format the Open command • // properly. • Open_Path = %TrimR(Lib_Name) + • '/' + File_Name; • // Establish the communications socket • Sd = Socket(AF_INET:SOCK_STREAM:0); • // Set Socket options • Rc = SetSockOpt(Sd:SOL_SOCKET • :SO_REUSADDR • :%Addr(OptVal) • :%Size(OptVal)); • // Initialize the socket address to nulls • SocketAddr = *Allx'00'; • // Set the socket family to internet addressing • SinFamily = AF_INET; • // Assign the port to use • SinPort = portParm; • // set the address to listen on all addresses • :SO_REUSADDR • :%Addr(OptVal) • :%Size(OptVal)); • // Initialize the socket address to nulls • SocketAddr = *Allx'00'; • // Set the socket family to internet addressing • SinFamily = AF_INET; • // Assign the port to use • SinPort = portParm; • // set the address to listen on all addresses • SinAddr = INADDR_ANY; • // Bind the address to the socket • Rc = Bind(Sd:%Addr(SocketAddr) • :%Size(SocketAddr)); • // Begin listening for a connection request • Rc = Listen(Sd:1); • // accept an incoming connection request • Sd2 = Accept (Sd:SockAddr:AddrLen); • SinAddr = INADDR_ANY; • // Bind the address to the socket • Rc = Bind(Sd:%Addr(SocketAddr) • :%Size(SocketAddr)); • // Begin listening for a connection request • Rc = Listen(Sd:1); • // accept an incoming connection request • Sd2 = Accept (Sd:SockAddr:AddrLen); • // Begin processing • DoW Operation <> '*START'; • Bytes_Read = *Zero; • Data_Size = 58; • DoU Timeout < 60; • Timeout = *Zero; • DoU Bytes_Read = Data_Size or Timeout >= 60; • // Use Bytes read to determine if data was available. If bytes read is zero • // sleep for 1 second and increment the timeout counter by 1. Put this in loop • // Begin processing • DoW Operation <> '*START'; • Bytes_Read = *Zero; • Data_Size = 58; • DoU Timeout < 60; • Timeout = *Zero; • DoU Bytes_Read = Data_Size or Timeout >= 60; • // Use Bytes read to determine if data was available. If bytes read is zero • // sleep for 1 second and increment the timeout counter by 1. Put this in loop • // until Bytes read equals Data Size or until timeout is 60. When a good read • // takes place, reset timeout to zero. If timeout reaches 60, then send a • // message. If the response is "I" reset the timeout counter and continue • // and loop. If the response is "C", close the connections and end gracefully • Rc = Read(Sd2:%Addr(Data): • Data_Size-Bytes_Read); • If Rc > *Zero; • %Subst(Save_Data:Bytes_Read+1:Rc) = • %Subst(Data:1:Rc); • Bytes_Read = Bytes_Read + Rc; • // until Bytes read equals Data Size or until timeout is 60. When a good read • // takes place, reset timeout to zero. If timeout reaches 60, then send a • // message. If the response is "I" reset the timeout counter and continue • // and loop. If the response is "C", close the connections and end gracefully • Rc = Read(Sd2:%Addr(Data): • Data_Size-Bytes_Read); • If Rc > *Zero; • %Subst(Save_Data:Bytes_Read+1:Rc) = • %Subst(Data:1:Rc); • Bytes_Read = Bytes_Read + Rc; • EndIf; • If Rc = *Zero; • Sleep(1); • Timeout = Timeout + 1; • Else; • Timeout = *Zero; • EndIf; • EndDo; • If Timeout >= 60; • MsgKey = SndInqMsg('RPL0035'); • EndIf; • If Rc = *Zero; • Sleep(1); • Timeout = Timeout + 1; • Else; • Timeout = *Zero; • EndIf; • EndDo; • If Timeout >= 60; • MsgKey = SndInqMsg('RPL0035'); • If MsgRply(MsgKey) = 'C'; • Cancel(); • return; • EndIf; • EndIf; • EndDo; • If Rc <> Bytes_Read; • Data = Save_Data; • EndIf; • EndDo; • If MsgRply(MsgKey) = 'C'; • Cancel(); • return; • EndIf; • EndIf; • EndDo; • If Rc <> Bytes_Read; • Data = Save_Data; • EndIf; • EndDo; • If Operation = '*START'; • Rc = SysCmd('ADDPFM '+ %Trim(Lib_Name) + • '/'+%Trim(File_Name) + • ' MBR(' + %Trim(D_Member) + ')'); • Rc = SysCmd('CLRPFM '+ %Trim(Lib_Name) + • '/'+%Trim(File_Name) + • ' MBR(' + %Trim(D_Member) + ')'); • If Rc <> *Zero; • If Operation = '*START'; • Rc = SysCmd('ADDPFM '+ %Trim(Lib_Name) + • '/'+%Trim(File_Name) + • ' MBR(' + %Trim(D_Member) + ')'); • Rc = SysCmd('CLRPFM '+ %Trim(Lib_Name) + • '/'+%Trim(File_Name) + • ' MBR(' + %Trim(D_Member) + ')'); • If Rc <> *Zero; • Rc = SysCmd('OVRDBF '+ %Trim(Lib_Name) + • '/'+%Trim(File_Name) + • ' MBR(' + %Trim(D_Member) + • ') SECURE(*YES)'); • SQL_Text = 'DELETE FROM ' + %Trim(Lib_Name) + • '/'+%Trim(File_Name) + ' with NC'; • Exec Sql Prepare S1 from :SQL_Text; • If Sqlcod = *Zero; • Exec Sql Execute S1; • Endif; • Rc = SysCmd('OVRDBF '+ %Trim(Lib_Name) + • '/'+%Trim(File_Name) + • ' MBR(' + %Trim(D_Member) + • ') SECURE(*YES)'); • SQL_Text = 'DELETE FROM ' + %Trim(Lib_Name) + • '/'+%Trim(File_Name) + ' with NC'; • Exec Sql Prepare S1 from :SQL_Text; • If Sqlcod = *Zero; • Exec Sql Execute S1; • Endif; • Endif; • Fp = OpenFile(%TrimR(Open_Path) + • '(' + %Trim(D_Member) + ')': • 'rr+ arrseq=Y secure=Y'); • RFile_Ptr = Fp; • Data_Size = D_Cont_Len + D_Null_Len + 58; • Endif; • Fp = OpenFile(%TrimR(Open_Path) + • '(' + %Trim(D_Member) + ')': • 'rr+ arrseq=Y secure=Y'); • RFile_Ptr = Fp; • Data_Size = D_Cont_Len + D_Null_Len + 58; • Counter = *Zero; • // Process all entries until the *END Directive is received. • DoU Operation = '*END'; • Bytes_Read = *Zero; • DoU Timeout < 60; • Timeout = *Zero; • DoU Bytes_Read = Data_Size or Timeout >= 60; • // Use Bytes read to determine if data was available. If bytes read is zero • Counter = *Zero; • // Process all entries until the *END Directive is received. • DoU Operation = '*END'; • Bytes_Read = *Zero; • DoU Timeout < 60; • Timeout = *Zero; • DoU Bytes_Read = Data_Size or Timeout >= 60; • // Use Bytes read to determine if data was available. If bytes read is zero • // sleep for 1 second and increment the timeout counter by 1. Put this in loop • // until Bytes read equals Data Size or until timeout is 60. When a good read • // takes place, reset timeout to zero. If timeout reaches 60, then send a • // message. If the response is "I" reset the timeout counter and continue to read • // and loop. If the response is "C", close the connections and end gracef • Rc = Read(Sd2:%Addr(Data): • Data_Size-Bytes_Read); • If Rc > *Zero; • %Subst(Save_Data:Bytes_Read+1:Rc) = • %Subst(Data:1:Rc); • // sleep for 1 second and increment the timeout counter by 1. Put this in loop • // until Bytes read equals Data Size or until timeout is 60. When a good read • // takes place, reset timeout to zero. If timeout reaches 60, then send a • // message. If the response is "I" reset the timeout counter and continue to read • // and loop. If the response is "C", close the connections and end gracef • Rc = Read(Sd2:%Addr(Data): • Data_Size-Bytes_Read); • If Rc > *Zero; • %Subst(Save_Data:Bytes_Read+1:Rc) = • %Subst(Data:1:Rc); • Bytes_Read = Bytes_Read + Rc; • EndIf; • If Rc = *Zero; • Sleep(1); • Timeout = Timeout + 1; • Else; • Timeout = *Zero; • EndIf; • EndDo; • If Timeout >= 60; • Bytes_Read = Bytes_Read + Rc; • EndIf; • If Rc = *Zero; • Sleep(1); • Timeout = Timeout + 1; • Else; • Timeout = *Zero; • EndIf; • EndDo; • If Timeout >= 60; • MsgKey = SndInqMsg('RPL0035'); • If MsgRply(MsgKey) = 'C'; • Cancel(); • return; • EndIf; • EndIf; • EndDo; • If Rc <> Bytes_Read; • Data = Save_Data; • EndIf; • MsgKey = SndInqMsg('RPL0035'); • If MsgRply(MsgKey) = 'C'; • Cancel(); • return; • EndIf; • EndIf; • EndDo; • If Rc <> Bytes_Read; • Data = Save_Data; • EndIf; • If Rc = *Zero; • Data = '*NO DATA'; • EndIf; • // If this is the *START directive, clear the member. • Select; • When Operation = '*START'; • If Fp <> *Null; • Rc = CloseFile(Fp); • Fp = *Null; • If Rc = *Zero; • Data = '*NO DATA'; • EndIf; • // If this is the *START directive, clear the member. • Select; • When Operation = '*START'; • If Fp <> *Null; • Rc = CloseFile(Fp); • Fp = *Null; • EndIf; • Rc = SysCmd('ADDPFM '+ %Trim(Lib_Name) + • '/'+%Trim(File_Name) + • ' MBR(' + %Trim(D_Member) + ')'); • Rc = SysCmd('CLRPFM '+ %Trim(Lib_Name) + • '/'+%Trim(File_Name) + • ' MBR(' + %Trim(D_Member) + ')'); • If Rc <> *Zero; • Rc = SysCmd('OVRDBF ' + %Trim(Lib_Name) + • EndIf; • Rc = SysCmd('ADDPFM '+ %Trim(Lib_Name) + • '/'+%Trim(File_Name) + • ' MBR(' + %Trim(D_Member) + ')'); • Rc = SysCmd('CLRPFM '+ %Trim(Lib_Name) + • '/'+%Trim(File_Name) + • ' MBR(' + %Trim(D_Member) + ')'); • If Rc <> *Zero; • Rc = SysCmd('OVRDBF ' + %Trim(Lib_Name) + • '/' + %Trim(File_Name) + • ' MBR(' + %Trim(D_Member) + • ') SECURE(*YES)'); • SQL_Text = 'DELETE FROM ' + %Trim(Lib_Name) + • '/'+%Trim(File_Name) + ' with NC'; • Exec Sql Prepare S1 from :SQL_Text; • If Sqlcod = *Zero; • Exec Sql Execute S1; • Endif; • Endif; • '/' + %Trim(File_Name) + • ' MBR(' + %Trim(D_Member) + • ') SECURE(*YES)'); • SQL_Text = 'DELETE FROM ' + %Trim(Lib_Name) + • '/'+%Trim(File_Name) + ' with NC'; • Exec Sql Prepare S1 from :SQL_Text; • If Sqlcod = *Zero; • Exec Sql Execute S1; • Endif; • Endif; • // Open the file • Fp = OpenFile(%TrimR(Open_Path) + • '(' + %Trim(D_Member) + ')': • 'rr+ secure=Y'); • RFile_Ptr = Fp; • // If this is not the *END directive, post the record image. • When Operation <> '*END' and • %Subst(Data:1:8) <> '*NO DATA' and • // Open the file • Fp = OpenFile(%TrimR(Open_Path) + • '(' + %Trim(D_Member) + ')': • 'rr+ secure=Y'); • RFile_Ptr = Fp; • // If this is not the *END directive, post the record image. • When Operation <> '*END' and • %Subst(Data:1:8) <> '*NO DATA' and • %Subst(Data:1:6) <> 'Error'; • // Use offsets to get record data • Record = %Subst(Data_Content:1+D_Cont_Off: • D_Cont_Len); • // Request to insert deleted records • If Operation = '*INSERTDEL'; • If SqlCod = *Zero; • Io_Fb_Ptr = Locate(Fp: • *NULL: • Io_Rrn: • %Subst(Data:1:6) <> 'Error'; • // Use offsets to get record data • Record = %Subst(Data_Content:1+D_Cont_Off: • D_Cont_Len); • // Request to insert deleted records • If Operation = '*INSERTDEL'; • If SqlCod = *Zero; • Io_Fb_Ptr = Locate(Fp: • *NULL: • Io_Rrn: • Last_Rec); • Io_Rrn += 1; • // need to insert deleted records to use the INZPFM to • // accomplish this. • Rc = SysCmd('INZPFM FILE(' + • %Trim(Lib_Name) + '/' + • %Trim(File_Name) + • ') MBR(' + %Trim(D_Member) + • ') RECORDS(*DLT) TOTRCDS(' + • %Char(Io_Rrn) + ')'); • Last_Rec); • Io_Rrn += 1; • // need to insert deleted records to use the INZPFM to • // accomplish this. • Rc = SysCmd('INZPFM FILE(' + • %Trim(Lib_Name) + '/' + • %Trim(File_Name) + • ') MBR(' + %Trim(D_Member) + • ') RECORDS(*DLT) TOTRCDS(' + • %Char(Io_Rrn) + ')'); • EndIf; • EndIf; • // Normal insert operation • If Operation <> '*INSERTDEL'; • Io_Fb_Ptr = RcdWrite(Fp: • %Addr(Record): • BufLen); • EndIf; • EndIf; • EndIf; • // Normal insert operation • If Operation <> '*INSERTDEL'; • Io_Fb_Ptr = RcdWrite(Fp: • %Addr(Record): • BufLen); • EndIf; • EndSl; • EndDo; • EndIf; • Rc = Close(Sd); • Rc = Close(Sd2); • // Close the file • Rc = CloseFile(Fp); • /End-Free • EndSl; • EndDo; • EndIf; • Rc = Close(Sd); • Rc = Close(Sd2); • // Close the file • Rc = CloseFile(Fp); • /End-Free • P E • //========================================================================= • // Cancel • //========================================================================= • P Cancel B • D Cancel Pi • /Free • CloseFile(Fp); • CallP Close(Sd); • P E • //========================================================================= • // Cancel • //========================================================================= • P Cancel B • D Cancel Pi • /Free • CloseFile(Fp); • CallP Close(Sd); • CallP Close(Sd2); • *InLR = *On; • Return; • /End-Free • P E • //====================================================================== • // Send inquiry message • //====================================================================== • CallP Close(Sd2); • *InLR = *On; • Return; • /End-Free • P E • //====================================================================== • // Send inquiry message • //====================================================================== • PSndInqMsg B • DSndInqMsg Pi 4 • D MsgId 7 Value • D MsgFile s 20 Inz('RPLMSGF RPLLIB') • D MsgData s 20 • D MsgDataLen s 10i 0 Inz(0) • D MsgType s 10 Inz('*INQ') • D MsgQue s 20 Inz('QSYSOPR *LIBL') • PSndInqMsg B • DSndInqMsg Pi 4 • D MsgId 7 Value • D MsgFile s 20 Inz('RPLMSGF RPLLIB') • D MsgData s 20 • D MsgDataLen s 10i 0 Inz(0) • D MsgType s 10 Inz('*INQ') • D MsgQue s 20 Inz('QSYSOPR *LIBL') • D MsgQue# s 10i 0 Inz(1) • D MsgQueRply s 20 Inz('*PGMQ') • D MsgKey s 4 • D ErrData s 50 • C Call 'QMHSNDM' • C Parm MsgId • C Parm MsgFile • C Parm MsgData • C Parm MsgDataLen • D MsgQue# s 10i 0 Inz(1) • D MsgQueRply s 20 Inz('*PGMQ') • D MsgKey s 4 • D ErrData s 50 • C Call 'QMHSNDM' • C Parm MsgId • C Parm MsgFile • C Parm MsgData • C Parm MsgDataLen • C Parm MsgType • C Parm MsgQue • C Parm MsgQue# • C Parm MsgQueRply • C Parm MsgKey • C Parm ErrData • /Free • Return MsgKey; • /End-Free • C Parm MsgType • C Parm MsgQue • C Parm MsgQue# • C Parm MsgQueRply • C Parm MsgKey • C Parm ErrData • /Free • Return MsgKey; • /End-Free • P E • //======================================================================= • // Get Reply to Message • //======================================================================= • PMsgRply B • DMsgRply Pi 1 • D MsgKey 4 • D RplyDs Ds • P E • //======================================================================= • // Get Reply to Message • //======================================================================= • PMsgRply B • DMsgRply Pi 1 • D MsgKey 4 • D RplyDs Ds • D ReplyLen 10i 0 • D ReplyAvl 10i 0 • D ReplySev 10i 0 • D ReplyId 7 • D ReplyType 2 • D ReplyKey 4 • D ReplyResvd 7 • D ReplyCCSIDSts 10i 0 • D ReplyCCSID 10i 0 • D ReplyDtaLen 10i 0 • D ReplyLen 10i 0 • D ReplyAvl 10i 0 • D ReplySev 10i 0 • D ReplyId 7 • D ReplyType 2 • D ReplyKey 4 • D ReplyResvd 7 • D ReplyCCSIDSts 10i 0 • D ReplyCCSID 10i 0 • D ReplyDtaLen 10i 0 • D ReplyDtaAvl 10i 0 • D ReplyData 1 • D RplyLen s 10i 0 Inz(%Len(RplyDs)) • D RplyFmt s 8 Inz('RCVM0100') • D RplyStck s 10 Inz('*') • D RplyCnt s 10i 0 Inz(0) • D RplyTyp s 10 Inz('*RPY') • D Wait s 10i 0 Inz(-1) • D RplyAct s 10 Inz('*REMOVE') • D ReplyDtaAvl 10i 0 • D ReplyData 1 • D RplyLen s 10i 0 Inz(%Len(RplyDs)) • D RplyFmt s 8 Inz('RCVM0100') • D RplyStck s 10 Inz('*') • D RplyCnt s 10i 0 Inz(0) • D RplyTyp s 10 Inz('*RPY') • D Wait s 10i 0 Inz(-1) • D RplyAct s 10 Inz('*REMOVE') • D ErrData s 50 • C Call 'QMHRCVPM' • C Parm RplyDs • C Parm RplyLen • C Parm RplyFmt • C Parm RplyStck • C Parm RplyCnt • C Parm RplyTyp • C Parm MsgKey • D ErrData s 50 • C Call 'QMHRCVPM' • C Parm RplyDs • C Parm RplyLen • C Parm RplyFmt • C Parm RplyStck • C Parm RplyCnt • C Parm RplyTyp • C Parm MsgKey • C Parm Wait • C Parm RplyAct • C Parm ErrData • /Free • Return ReplyData; • /End-Free • P E • //====================================================================== • // Locate file pointer to a specific record in the file (SETLL) • C Parm Wait • C Parm RplyAct • C Parm ErrData • /Free • Return ReplyData; • /End-Free • P E • //====================================================================== • // Locate file pointer to a specific record in the file (SETLL) • //====================================================================== • P RrnLocate B • D RrnLocate Pi 10i 0 • D FilePtr * Const • D Rrn# 20u 0 Const • D Rrn_Eq C x'08000300' • /FREE • //====================================================================== • P RrnLocate B • D RrnLocate Pi 10i 0 • D FilePtr * Const • D Rrn# 20u 0 Const • D Rrn_Eq C x'08000300' • /FREE • Io_Fb_Ptr = Locate(FilePtr: • *NULL: • Rrn#: • Rrn_Eq); • Return Io_Bytes_Rtn; • /END-FREE • P RrnLocate E • *---------------------------------------------------------------- • Io_Fb_Ptr = Locate(FilePtr: • *NULL: • Rrn#: • Rrn_Eq); • Return Io_Bytes_Rtn; • /END-FREE • P RrnLocate E • *---------------------------------------------------------------- • PGetBufLength B • DGetBufLength Pi 10u 0 • D File 10 Value • D Library 10 Value • D BufLen s 10u 0 • D Ds • D Fd_Len 10i 0 Inz(%Len(Fd_Data)) • PGetBufLength B • DGetBufLength Pi 10u 0 • D File 10 Value • D Library 10 Value • D BufLen s 10u 0 • D Ds • D Fd_Len 10i 0 Inz(%Len(Fd_Data)) • D Fd_RtnF 20 • D Fd_RtnFile 10 Overlay(Fd_RtnF:1) • D Fd_RtnLib 10 Overlay(Fd_RtnF:11) • D Fd_Fmt 8 Inz('FILD0100') • D Fd_File 20 • D Fd_File_Name 10 Overlay(Fd_File:1) • D Fd_File_Lib 10 Overlay(Fd_File:11) • D Fd_RFmt 10 Inz('*FIRST') • D Fd_Ovr 1 Inz('1') • D Fd_Sys 10 Inz('*LCL') • D Fd_RtnF 20 • D Fd_RtnFile 10 Overlay(Fd_RtnF:1) • D Fd_RtnLib 10 Overlay(Fd_RtnF:11) • D Fd_Fmt 8 Inz('FILD0100') • D Fd_File 20 • D Fd_File_Name 10 Overlay(Fd_File:1) • D Fd_File_Lib 10 Overlay(Fd_File:11) • D Fd_RFmt 10 Inz('*FIRST') • D Fd_Ovr 1 Inz('1') • D Fd_Sys 10 Inz('*LCL') • D Fd_FmtT 10 Inz('*INT') • DFile_Ds Ds • D Fd_Data 32767 • D Rtn_Len 10i 0 Overlay(Fd_Data:1) • D Prv_Len 10i 0 Overlay(Fd_Data:*Next) • D Fd_Attr1 1 Overlay(Fd_Data:*Next) • D Fd_Attr2 1 Overlay(Fd_Data:*Next) • D Reserved_1 4 Overlay(Fd_Data:*Next) • D Fd_Dta_Mbrs 5i 0 Overlay(Fd_Data:*Next) • D Fd_Acc_Path 13 Overlay(Fd_Data:*Next) • D Fd_FmtT 10 Inz('*INT') • DFile_Ds Ds • D Fd_Data 32767 • D Rtn_Len 10i 0 Overlay(Fd_Data:1) • D Prv_Len 10i 0 Overlay(Fd_Data:*Next) • D Fd_Attr1 1 Overlay(Fd_Data:*Next) • D Fd_Attr2 1 Overlay(Fd_Data:*Next) • D Reserved_1 4 Overlay(Fd_Data:*Next) • D Fd_Dta_Mbrs 5i 0 Overlay(Fd_Data:*Next) • D Fd_Acc_Path 13 Overlay(Fd_Data:*Next) • D Fd_Key_Flds 5i 0 Overlay(Fd_Acc_Path:1) • D Fd_Key_Len 5i 0 Overlay(Fd_Acc_Path:3) • D Fd_KAttr_1 1 Overlay(Fd_Acc_Path:5) • D Fd_Maint 1 Overlay(Fd_Acc_Path:6) • D Reserved_2 7 Overlay(Fd_Acc_Path:7) • D Reserved_2b 1 Overlay(Fd_Data:*Next) • D Fd_Auth 10 Overlay(Fd_Data:*Next) • D Fd_Stg_Unit 1 Overlay(Fd_Data:*Next) • D Fd_Max_Mbrs 5i 0 Overlay(Fd_Data:*Next) • D Fd_Max_FWt 5i 0 Overlay(Fd_Data:*Next) • D Fd_Key_Flds 5i 0 Overlay(Fd_Acc_Path:1) • D Fd_Key_Len 5i 0 Overlay(Fd_Acc_Path:3) • D Fd_KAttr_1 1 Overlay(Fd_Acc_Path:5) • D Fd_Maint 1 Overlay(Fd_Acc_Path:6) • D Reserved_2 7 Overlay(Fd_Acc_Path:7) • D Reserved_2b 1 Overlay(Fd_Data:*Next) • D Fd_Auth 10 Overlay(Fd_Data:*Next) • D Fd_Stg_Unit 1 Overlay(Fd_Data:*Next) • D Fd_Max_Mbrs 5i 0 Overlay(Fd_Data:*Next) • D Fd_Max_FWt 5i 0 Overlay(Fd_Data:*Next) • D Fd_Frc_Rtio 5i 0 Overlay(Fd_Data:*Next) • D Fd_Mbr_Cnt 5i 0 Overlay(Fd_Data:*Next) • D Reserved_3 9 Overlay(Fd_Data:*Next) • D Fd_Max_RWt 5i 0 Overlay(Fd_Data:*Next) • D Fd_Add_Attr1 1 Overlay(Fd_Data:*Next) • D Fd_Rcd_Fmts 5i 0 Overlay(Fd_Data:*Next) • D Fd_Add_Attr2a 1 Overlay(Fd_Data:*Next) • D Fd_Add_Attr2b 1 Overlay(Fd_Data:*Next) • D Fd_Version 5i 0 Overlay(Fd_Data:*Next) • D Fd_Add_Attr3a 1 Overlay(Fd_Data:*Next) • D Fd_Add_Attr3b 1 Overlay(Fd_Data:*Next) • D Fd_File_Lvl 13 Overlay(Fd_Data:*Next) • D Fd_File_Txt 52 Overlay(Fd_Data:*Next) • D Reserved_4 2 Overlay(Fd_File_Txt:1) • D Fd_Text_Dsc 50 Overlay(Fd_File_Txt:3) • D Reserved_5 13 Overlay(Fd_Data:*Next) • D Fd_Src_File 10 Overlay(Fd_Data:*Next) • D Fd_Src_Mbr 10 Overlay(Fd_Data:*Next) • D Fd_Src_Lib 10 Overlay(Fd_Data:*Next) • D Fd_Acc_Rcv 1 Overlay(Fd_Data:*Next) • D Reserved_6 23 Overlay(Fd_Data:*Next) • D Fd_CCSID 5i 0 Overlay(Fd_Data:*Next) • D Fd_ASP 2 Overlay(Fd_Data:*Next) • D Fd_Comp_Obj 1 Overlay(Fd_Data:*Next) • D Fd_Fields 5i 0 Overlay(Fd_Data:*Next) • D Reserved_7 76 Overlay(Fd_Data:*Next) • D Fd_DD_Off 10i 0 Overlay(Fd_Data:*Next) • D Reserved_8 14 Overlay(Fd_Data:*Next) • D Fd_Gen_KeyL 5i 0 Overlay(Fd_Data:*Next) • D Fd_Rcd_Len 5i 0 Overlay(Fd_Data:*Next) • D Reserved_6 23 Overlay(Fd_Data:*Next) • D Fd_CCSID 5i 0 Overlay(Fd_Data:*Next) • D Fd_ASP 2 Overlay(Fd_Data:*Next) • D Fd_Comp_Obj 1 Overlay(Fd_Data:*Next) • D Fd_Fields 5i 0 Overlay(Fd_Data:*Next) • D Reserved_7 76 Overlay(Fd_Data:*Next) • D Fd_DD_Off 10i 0 Overlay(Fd_Data:*Next) • D Reserved_8 14 Overlay(Fd_Data:*Next) • D Fd_Gen_KeyL 5i 0 Overlay(Fd_Data:*Next) • D Fd_Rcd_Len 5i 0 Overlay(Fd_Data:*Next) • D Reserved_9 8 Overlay(Fd_Data:*Next) • D Fd_Gen_KeyC 5i 0 Overlay(Fd_Data:*Next) • D Fd_Scp_Off 10i 0 Overlay(Fd_Data:*Next) • D Reserved_10 8 Overlay(Fd_Data:*Next) • D Fd_Seq_Off 10i 0 Overlay(Fd_Data:*Next) • D Reserved_11 4 Overlay(Fd_Data:*Next) • D Fd_Key_Typ 2 Overlay(Fd_Data:*Next) • D Fd_Crt_Vrs 6 Overlay(Fd_Data:*Next) • D Reserved_12 20 Overlay(Fd_Data:*Next) • D Fd_Phy_Off 10i 0 Overlay(Fd_Data:*Next) • D Reserved_9 8 Overlay(Fd_Data:*Next) • D Fd_Gen_KeyC 5i 0 Overlay(Fd_Data:*Next) • D Fd_Scp_Off 10i 0 Overlay(Fd_Data:*Next) • D Reserved_10 8 Overlay(Fd_Data:*Next) • D Fd_Seq_Off 10i 0 Overlay(Fd_Data:*Next) • D Reserved_11 4 Overlay(Fd_Data:*Next) • D Fd_Key_Typ 2 Overlay(Fd_Data:*Next) • D Fd_Crt_Vrs 6 Overlay(Fd_Data:*Next) • D Reserved_12 20 Overlay(Fd_Data:*Next) • D Fd_Phy_Off 10i 0 Overlay(Fd_Data:*Next) • D Fd_Lgl_Off 10i 0 Overlay(Fd_Data:*Next) • D Fd_Srt_Seq 6 Overlay(Fd_Data:*Next) • D Fd_Srt_Flgs 1 Overlay(Fd_Data:*Next) • D Fd_Lang_Id 3 Overlay(Fd_Data:*Next) • D Fd_CntryId 2 Overlay(Fd_Data:*Next) • D Fd_Jrn_Off 10i 0 Overlay(Fd_Data:*Next) • D Fd_Vct_Cnt 10i 0 Overlay(Fd_Data:*Next) • D Reserved_13 14 Overlay(Fd_Data:*Next) • /Free • Fd_File_Name = File; • D Fd_Lgl_Off 10i 0 Overlay(Fd_Data:*Next) • D Fd_Srt_Seq 6 Overlay(Fd_Data:*Next) • D Fd_Srt_Flgs 1 Overlay(Fd_Data:*Next) • D Fd_Lang_Id 3 Overlay(Fd_Data:*Next) • D Fd_CntryId 2 Overlay(Fd_Data:*Next) • D Fd_Jrn_Off 10i 0 Overlay(Fd_Data:*Next) • D Fd_Vct_Cnt 10i 0 Overlay(Fd_Data:*Next) • D Reserved_13 14 Overlay(Fd_Data:*Next) • /Free • Fd_File_Name = File; • Fd_File_Lib = Library; • QUsBPrv = 15; • /End-Free • C Call 'QDBRTVFD' • C Parm Fd_Data • C Parm Fd_Len • C Parm Fd_RtnF • C Parm Fd_Fmt • C Parm Fd_File • Fd_File_Lib = Library; • QUsBPrv = 15; • /End-Free • C Call 'QDBRTVFD' • C Parm Fd_Data • C Parm Fd_Len • C Parm Fd_RtnF • C Parm Fd_Fmt • C Parm Fd_File • C Parm Fd_RFmt • C Parm Fd_Ovr • C Parm Fd_Sys • C Parm Fd_FmtT • C Parm QUseC • /Free • BufLen = Fd_Rcd_Len; • Return BufLen; • /End-Free • P E • C Parm Fd_RFmt • C Parm Fd_Ovr • C Parm Fd_Sys • C Parm Fd_FmtT • C Parm QUseC • /Free • BufLen = Fd_Rcd_Len; • Return BufLen; • /End-Free • P E • ****************** End of data ************************************** Modern RPG – Unrealized Capabilities George L. Slater

  50. MODERNRPG/QRPGLESRC Appendix R_SOURCE • . . . : 6 100 Browse MODERNRPG/QRPGLESRC • R_SOURCE • ... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 ...+... 9 ...+... 0 • *************** Beginning of data *************************************************************************************** • //============================================================= • // Modifications * • //===============* • // • // 11/28/2006 Monitor for Locks on Data Areas and Retry up to • // 10 times until a good read is achieved. • // • //============================================================= • H Option(*SrcStmt:*Nodebugio) DftActGrp(*No) ActGrp(*New) • H Debug(*Yes) DatFmt(*ISO) AlwNull(*UsrCtl) BndDir('QC2LE') • D R_Source Pr • D Lib_Name 10 • D File_Name 10 • D R_Source Pi • D Lib_Name 10 • D File_Name 10 • //************************************************************************* • H Debug(*Yes) DatFmt(*ISO) AlwNull(*UsrCtl) BndDir('QC2LE') • D R_Source Pr • D Lib_Name 10 • D File_Name 10 • D R_Source Pi • D Lib_Name 10 • D File_Name 10 • //************************************************************************* • // Sockets API's • D Socket Pr 10i 0 Extproc('socket') • D 10i 0 Value • D 10i 0 Value • D 10i 0 Value • D SetSockOpt Pr 10i 0 Extproc('setsockopt') • D 10i 0 Value • D 10i 0 Value • D 10i 0 Value • // Sockets API's • D Socket Pr 10i 0 Extproc('socket') • D 10i 0 Value • D 10i 0 Value • D 10i 0 Value • D SetSockOpt Pr 10i 0 Extproc('setsockopt') • D 10i 0 Value • D 10i 0 Value • D 10i 0 Value • D * Value • D 10i 0 Value • D Bind Pr 10i 0 Extproc('bind') • D 10i 0 Value • D * Value • D 10i 0 Value • D Listen Pr 10i 0 Extproc('listen') • D 10i 0 Value • D * Value • D 10i 0 Value • D Bind Pr 10i 0 Extproc('bind') • D 10i 0 Value • D * Value • D 10i 0 Value • D Listen Pr 10i 0 Extproc('listen') • D 10i 0 Value • D 10i 0 Value • D Accept Pr 10i 0 Extproc('accept') • D 10i 0 Value • D * Value • D * Value • D Connect Pr 10i 0 Extproc('connect') • D 10i 0 Value • D * Value • D 10i 0 Value • D Accept Pr 10i 0 Extproc('accept') • D 10i 0 Value • D * Value • D * Value • D Connect Pr 10i 0 Extproc('connect') • D 10i 0 Value • D * Value • D 10i 0 Value • D GetHostByName Pr * Extproc('gethostbyname') • D * Value • D GetHostByAddr Pr * Extproc('gethostbyaddr') • D * Value • D 5i 0 Value • D 5i 0 Value • D 10i 0 Value • D GetHostByName Pr * Extproc('gethostbyname') • D * Value • D GetHostByAddr Pr * Extproc('gethostbyaddr') • D * Value • D 5i 0 Value • D 5i 0 Value • D InetAddr Pr 10u 0 Extproc('inet_addr') • D * Value • D Read Pr 10i 0 Extproc('read') • D 10i 0 Value • D * Value • D 10u 0 Value • D Write Pr 10i 0 Extproc('write') • D 10i 0 Value • D InetAddr Pr 10u 0 Extproc('inet_addr') • D * Value • D Read Pr 10i 0 Extproc('read') • D 10i 0 Value • D * Value • D 10u 0 Value • D Write Pr 10i 0 Extproc('write') • D 10i 0 Value • D * Value • D 10u 0 Value • D Close Pr 10i 0 Extproc('close') • D 10i 0 Value • D Cancel Pr • //******************************************************************* • // Sockets Structures • D HostEnt Ds Align Based(Host@) • D * Value • D 10u 0 Value • D Close Pr 10i 0 Extproc('close') • D 10i 0 Value • D Cancel Pr • //******************************************************************* • // Sockets Structures • D HostEnt Ds Align Based(Host@) • D HName@ * • D HAliases * • D HAddrType 10i 0 • D HLength 10i 0 • D HAddrList@ * • D HostEntData Ds Align Based(HostEntData@) • D HName 256a • D HAliasesArr@ * Dim(65) • D HAliasesArr 256a Dim(64) • D HName@ * • D HAliases * • D HAddrType 10i 0 • D HLength 10i 0 • D HAddrList@ * • D HostEntData Ds Align Based(HostEntData@) • D HName 256a • D HAliasesArr@ * Dim(65) • D HAliasesArr 256a Dim(64) • D HAddrArr@ * Dim(101) • D HAddrArr 10u 0 Dim(100) • D OpenFlag 10i 0 • D F0@ * • D FileP0 260a • D HReserved0 150a • D F1@ * • D FileP1 260a • D HReserved1 150a • D F2@ * • D HAddrArr@ * Dim(101) • D HAddrArr 10u 0 Dim(100) • D OpenFlag 10i 0 • D F0@ * • D FileP0 260a • D HReserved0 150a • D F1@ * • D FileP1 260a • D HReserved1 150a • D F2@ * • D FileP2 260a • D HReserved2 150a • D SocketAddr Ds • D SinFamily 5i 0 • D SinPort 5u 0 • D SinAddr 10u 0 • D SinZero 8a Inz(x'00') • //******************************************************************* • D FileP2 260a • D HReserved2 150a • D SocketAddr Ds • D SinFamily 5i 0 • D SinPort 5u 0 • D SinAddr 10u 0 • D SinZero 8a Inz(x'00') • //******************************************************************* • // Sockets Constants / Variables • D AF_INET S 10i 0 Inz(2) • D AF_NS S 10i 0 Inz(6) • D AF_UNIX S 10i 0 Inz(1) • D AF_TELEPHONY S 10i 0 Inz(99) • D SOCK_STREAM S 10i 0 Inz(1) • D SOCK_DGRAM S 10i 0 Inz(2) • D SOCK_SEQPACKET S 10i 0 Inz(5) • D SOCK_RAW S 10i 0 Inz(3) • D INADDR_ANY S 10i 0 Inz(0) • // Sockets Constants / Variables • D AF_INET S 10i 0 Inz(2) • D AF_NS S 10i 0 Inz(6) • D AF_UNIX S 10i 0 Inz(1) • D AF_TELEPHONY S 10i 0 Inz(99) • D SOCK_STREAM S 10i 0 Inz(1) • D SOCK_DGRAM S 10i 0 Inz(2) • D SOCK_SEQPACKET S 10i 0 Inz(5) • D SOCK_RAW S 10i 0 Inz(3) • D INADDR_ANY S 10i 0 Inz(0) • D SOL_SOCKET S 10i 0 Inz(-1) • D SO_REUSADDR S 10i 0 Inz(55) • D Bytes_Read S 10i 0 Inz(*Zero) • D Data_Size S 10i 0 Inz(*Zero) • D StartSize S 10i 0 Inz(*Zero) • D Port S 5s 0 Inz(22022) • D Sd S 10i 0 • D Sd2 S 10i 0 • D OptVal S 10u 0 Inz(1) • D SOL_SOCKET S 10i 0 Inz(-1) • D SO_REUSADDR S 10i 0 Inz(55) • D Bytes_Read S 10i 0 Inz(*Zero) • D Data_Size S 10i 0 Inz(*Zero) • D StartSize S 10i 0 Inz(*Zero) • D Port S 5s 0 Inz(22022) • D Sd S 10i 0 • D Sd2 S 10i 0 • D OptVal S 10u 0 Inz(1) • //ServerName S 255 Inz('FrankieIII.FrankenSeries.com') • D ServerName S 255 Inz('LOOPBACK') • D Local_Addr S 15 Inz('127.0.0.1') • D SockAddr S * Inz(%Addr(SocketAddr)) • D AddressLength S 10i 0 • D AddrLen S * Inz(%Addr(AddressLength)) • D RrnCounter S 20i 0 • D RcdLength S 10i 0 • D SIdx s 10i 0 • D CIdx s 10i 0 • //ServerName S 255 Inz('FrankieIII.FrankenSeries.com') • D ServerName S 255 Inz('LOOPBACK') • D Local_Addr S 15 Inz('127.0.0.1') • D SockAddr S * Inz(%Addr(SocketAddr)) • D AddressLength S 10i 0 • D AddrLen S * Inz(%Addr(AddressLength)) • D RrnCounter S 20i 0 • D RcdLength S 10i 0 • D SIdx s 10i 0 • D CIdx s 10i 0 • D Sql_Stmt s 8192 • D DftDate s d Inz(*LoVal) • D DftTime s t Inz(*LoVal) • D DftStamp s z Inz(*LoVal) • D File_Type s 10 Inz('*FILE') • D StatusIdSeq s 10u 0 • //******************************************************************* • // Messaging API's • D SndInqMsg Pr 4 • D Sql_Stmt s 8192 • D DftDate s d Inz(*LoVal) • D DftTime s t Inz(*LoVal) • D DftStamp s z Inz(*LoVal) • D File_Type s 10 Inz('*FILE') • D StatusIdSeq s 10u 0 • //******************************************************************* • // Messaging API's • D SndInqMsg Pr 4 • D MsgId 7 Value • D MsgRply Pr 1 • D MsgKey 4 • //****************************************************************** • // Port Number conversion • D Ds • D PortParm 15s 5 • D PortNum 5s 0 Overlay(PortParm:6) • D MsgId 7 Value • D MsgRply Pr 1 • D MsgKey 4 • //****************************************************************** • // Port Number conversion • D Ds • D PortParm 15s 5 • D PortNum 5s 0 Overlay(PortParm:6) • //****************************************************************** • // Error Handling / Messaging variables • D MsgKey S 4 • D Timeout S 5i 0 • //******************************************************************** • // System Command API • D SysCmd Pr 10i 0 ExtProc('system') • D Command * Value Options(*String) • //****************************************************************** • // Error Handling / Messaging variables • D MsgKey S 4 • D Timeout S 5i 0 • //******************************************************************** • // System Command API • D SysCmd Pr 10i 0 ExtProc('system') • D Command * Value Options(*String) • D CPFMsgId s 7a import('_EXCP_MSGID') • //******************************************************************** • // File API's • D OpenFile Pr * ExtProc('_Ropen') • D FileName * Options(*String) Value • D Mode * Options(*String) Value • D CloseFile Pr 10i 0 ExtProc('_Rclose') • D FilePtr * Value • D CPFMsgId s 7a import('_EXCP_MSGID') • //******************************************************************** • // File API's • D OpenFile Pr * ExtProc('_Ropen') • D FileName * Options(*String) Value • D Mode * Options(*String) Value • D CloseFile Pr 10i 0 ExtProc('_Rclose') • D FilePtr * Value • D ReadFirst Pr * ExtProc('_Rreadf') • D FilePtr * Value • D BuffPtr * Value • D BufLen 10u 0 Value • D Options 10i 0 Value • D ReadNext Pr * ExtProc('_Rreadn') • D FilePtr * Value • D BuffPtr * Value • D ReadFirst Pr * ExtProc('_Rreadf') • D FilePtr * Value • D BuffPtr * Value • D BufLen 10u 0 Value • D Options 10i 0 Value • D ReadNext Pr * ExtProc('_Rreadn') • D FilePtr * Value • D BuffPtr * Value • D BufLen 10u 0 Value • D Options 10i 0 Value • D RcdWrite Pr * ExtProc('_Rwrite') • D FilePtr * Value • D BuffPtr * Value • D BufLen 10u 0 Value • D Locate Pr * ExtProc('_Rlocate') • D FilePtr * Value • D BufLen 10u 0 Value • D Options 10i 0 Value • D RcdWrite Pr * ExtProc('_Rwrite') • D FilePtr * Value • D BuffPtr * Value • D BufLen 10u 0 Value • D Locate Pr * ExtProc('_Rlocate') • D FilePtr * Value • D KeyPtr * Value • D KeyLen 20u 0 Value • D Options 10i 0 Value • D RrnLocate Pr 10i 0 • D FilePtr * Const • D Rrn# 20u 0 Const • D RcdDelete Pr * ExtProc('_Rdelete') • D FilePtr * Value • D KeyPtr * Value • D KeyLen 20u 0 Value • D Options 10i 0 Value • D RrnLocate Pr 10i 0 • D FilePtr * Const • D Rrn# 20u 0 Const • D RcdDelete Pr * ExtProc('_Rdelete') • D FilePtr * Value • //************************************************************** • // Sleep API to initiate a program delay • D Sleep Pr 10i 0 ExtProc('sleep') • D Seconds 10u 0 Value • DListMbrs Pr ExtPgm('QUSLMBR') • D Space 20 • D Format 8 • D DB_Name 20 • //************************************************************** • // Sleep API to initiate a program delay • D Sleep Pr 10i 0 ExtProc('sleep') • D Seconds 10u 0 Value • DListMbrs Pr ExtPgm('QUSLMBR') • D Space 20 • D Format 8 • D DB_Name 20 • D Mbr 10 • D Ovr 1 • DRtvList Pr ExtPgm('QUSRTVUS') • D Space 20 • D Start 10i 0 • D Length 10i 0 • D Data 16 • DGetMbrList Pr • D Mbr 10 • D Ovr 1 • DRtvList Pr ExtPgm('QUSRTVUS') • D Space 20 • D Start 10i 0 • D Length 10i 0 • D Data 16 • DGetMbrList Pr • D File 10 • D Library 10 • D Member 10 • D UserSpace s 20 Inz('MBRLSPC QTEMP ') • //************************************************************** • // File API Structures • D Io_Fb_Area Ds Based(Io_Fb_Ptr) • D Io_Key_Ptr * • D File 10 • D Library 10 • D Member 10 • D UserSpace s 20 Inz('MBRLSPC QTEMP ') • //************************************************************** • // File API Structures • D Io_Fb_Area Ds Based(Io_Fb_Ptr) • D Io_Key_Ptr * • D Io_Sys_Ptr * • D Io_Rrn 10u 0 • D Io_Bytes_Rtn 10i 0 • D Io_Blocks 5i 0 • D Io_Block_Fill 1a • D Io_Bit_Fld 1a • D Io_Reserved 20a • Drfile ds Based(rfile_ptr) • D reserved1b 16a • D Io_Sys_Ptr * • D Io_Rrn 10u 0 • D Io_Bytes_Rtn 10i 0 • D Io_Blocks 5i 0 • D Io_Block_Fill 1a • D Io_Bit_Fld 1a • D Io_Reserved 20a • Drfile ds Based(rfile_ptr) • D reserved1b 16a • D in_buf_Ptr * • D out_buf_Ptr * • D reserved2b 48a • D riofb_T 64a • D reserved3 32a • D buf_length 10u 0 • D reserved4 28a • D In_Null_Ptr * • D Out_Null_Ptr * • D Key_Null_Ptr * • D in_buf_Ptr * • D out_buf_Ptr * • D reserved2b 48a • D riofb_T 64a • D reserved3 32a • D buf_length 10u 0 • D reserved4 28a • D In_Null_Ptr * • D Out_Null_Ptr * • D Key_Null_Ptr * • D reserved5 48a • D min_length 10i 0 • D null_map_len 5i 0 • D nkey_map_len 5i 0 • D reserved6 8a • D Ds • D ListData 16 • D ListOffset 10i 0 Overlay(ListData:1) • D ListSize 10i 0 Overlay(ListData:5) • D reserved5 48a • D min_length 10i 0 • D null_map_len 5i 0 • D nkey_map_len 5i 0 • D reserved6 8a • D Ds • D ListData 16 • D ListOffset 10i 0 Overlay(ListData:1) • D ListSize 10i 0 Overlay(ListData:5) • D ListCount 10i 0 Overlay(ListData:9) • D ListItmSz 10i 0 Overlay(ListData:13) • D Start s 10i 0 Inz(125) • D Length s 10i 0 Inz(16) • D Ds • D MbrDtaLong 16 • D Mbrname 10 Overlay(MbrDtaLong:1) • D ListCount 10i 0 Overlay(ListData:9) • D ListItmSz 10i 0 Overlay(ListData:13) • D Start s 10i 0 Inz(125) • D Length s 10i 0 Inz(16) • D Ds • D MbrDtaLong 16 • D Mbrname 10 Overlay(MbrDtaLong:1) • //********************************************************************* • // File API Constants / Variables • D Key_Eq C x'0B000100' • D Key_Null C x'00000008' • D Key_Eq_Null C x'0B000108' • D No_Lock C x'00000001' • D Last_Rec C x'02000300' • D Rrn_Eq C x'08000300' • //********************************************************************* • // File API Constants / Variables • D Key_Eq C x'0B000100' • D Key_Null C x'00000008' • D Key_Eq_Null C x'0B000108' • D No_Lock C x'00000001' • D Last_Rec C x'02000300' • D Rrn_Eq C x'08000300' • D Loc_Options s 10i 0 • D In_Null_Map_Ds Ds Based(In_Null_Ptr) • D In_Null_Map 1000 • D Out_Null_Map_D Ds Based(Out_Null_Ptr) • D Out_Null_Map 1000 • D Key_Null_Map_D Ds Based(Key_Null_Ptr) • D Key_Null_Map 1000 • D Loc_Options s 10i 0 • D In_Null_Map_Ds Ds Based(In_Null_Ptr) • D In_Null_Map 1000 • D Out_Null_Map_D Ds Based(Out_Null_Ptr) • D Out_Null_Map 1000 • D Key_Null_Map_D Ds Based(Key_Null_Ptr) • D Key_Null_Map 1000 • //****************************************************************** • // Program Variables • D Errno S 10i 0 Based(Errno_Ptr) NoOpt • D Errno_Ptr S * • D ErrMsg S 60A Based(ErrMsg_Ptr) NoOpt • D ErrMsg_Ptr S * • D Rc S 10i 0 • D Fp S * • D Jrn_Rcv_Dtaara S 21 • //****************************************************************** • // Program Variables • D Errno S 10i 0 Based(Errno_Ptr) NoOpt • D Errno_Ptr S * • D ErrMsg S 60A Based(ErrMsg_Ptr) NoOpt • D ErrMsg_Ptr S * • D Rc S 10i 0 • D Fp S * • D Jrn_Rcv_Dtaara S 21 • D Mbr S 10 • D Null_Open S 1 • D Buffer S 10240a • D DelBuf S Like(Buffer) Inz(*Blanks) • D Open_Path S 33 • D Record S Like(Buffer) • D BufLen S 10u 0 • D SQL_Text S 512 • D First_Done S 1 • D Idx S 5i 0 • D Mbr S 10 • D Null_Open S 1 • D Buffer S 10240a • D DelBuf S Like(Buffer) Inz(*Blanks) • D Open_Path S 33 • D Record S Like(Buffer) • D BufLen S 10u 0 • D SQL_Text S 512 • D First_Done S 1 • D Idx S 5i 0 • D Type_Out S 2 • D Count S 5i 0 • D MbrCount S 5i 0 • D Counter S 5i 0 • D Key_Data S 20 • D System S 10 Inz('*LOCAL') • D Member S 10 Inz('*ALL') • D Ds • D Type_Out S 2 • D Count S 5i 0 • D MbrCount S 5i 0 • D Counter S 5i 0 • D Key_Data S 20 • D System S 10 Inz('*LOCAL') • D Member S 10 Inz('*ALL') • D Ds • D Data 4096 • D Rtn_Key_Sys 10 Overlay(Data:1) • D Rtn_Key_Lib 10 Overlay(Data:*Next) • D Rtn_Key_Obj 10 Overlay(Data:*Next) • D Operation 10 Overlay(Data:*Next) • D D_Member 10 Overlay(Data:*Next) • D Data_Content 4046 Overlay(Data:*Next) • D D_Cont_Off 5i 0 Overlay(Data_Content:1) • D D_Cont_Len 5i 0 Overlay(Data_Content:*Next) • D D_Null_Off 5i 0 Overlay(Data_Content:*Next) • D D_Null_Len 5i 0 Overlay(Data_Content:*Next) • D Rtn_Key_Sys 10 Overlay(Data:1) • D Rtn_Key_Lib 10 Overlay(Data:*Next) • D Rtn_Key_Obj 10 Overlay(Data:*Next) • D Operation 10 Overlay(Data:*Next) • D D_Member 10 Overlay(Data:*Next) • D Data_Content 4046 Overlay(Data:*Next) • D D_Cont_Off 5i 0 Overlay(Data_Content:1) • D D_Cont_Len 5i 0 Overlay(Data_Content:*Next) • D D_Null_Off 5i 0 Overlay(Data_Content:*Next) • D D_Null_Len 5i 0 Overlay(Data_Content:*Next) • D Save_Data S Like(Data) • //********************************************************************* • // Error handling API's • D Get_Errno Pr * ExtProc('__errno') • D Str_Error Pr * ExtProc('strerror') • D ErrNo 10i 0 Value • D Save_Data S Like(Data) • //********************************************************************* • // Error handling API's • D Get_Errno Pr * ExtProc('__errno') • D Str_Error Pr * ExtProc('strerror') • D ErrNo 10i 0 Value • D Error_Ds Ds 264 • D Error_Size 10i 0 Inz(%Size(Error_Ds)) • D Error_Rtn 10i 0 • D Error_Data 256 • C/Copy QsysInc/QRpgLeSrc,QUseC • /Free • Exec Sql Set Option Commit = *None, CloSqlCsr = *EndMod; • D Error_Ds Ds 264 • D Error_Size 10i 0 Inz(%Size(Error_Ds)) • D Error_Rtn 10i 0 • D Error_Data 256 • C/Copy QsysInc/QRpgLeSrc,QUseC • /Free • Exec Sql Set Option Commit = *None, CloSqlCsr = *EndMod; • PortParm = Port; • Counter = *Zero; • Open_Path = %TrimR(Lib_Name) + • '/' + File_Name; • GetMbrList(File_Name:Lib_Name:Member); • // Send a start of refresh. This will signal the target to clear the file • // subsequent reloading. • PortParm = Port; • Counter = *Zero; • Open_Path = %TrimR(Lib_Name) + • '/' + File_Name; • GetMbrList(File_Name:Lib_Name:Member); • // Send a start of refresh. This will signal the target to clear the file • // subsequent reloading. • // Establish a socket • Sd = Socket(AF_INET:SOCK_STREAM:0); • // Initialize the socket address to null • SocketAddr = *ALLx'00'; • // Set the socket family to internet addressing • SinFamily = AF_INET; • // Set the port number to use • Eval(h) SinPort = PortNum; • // Convert the address to an internal format • SinAddr = InetAddr(%Addr(Local_Addr)); • // Establish a socket • Sd = Socket(AF_INET:SOCK_STREAM:0); • // Initialize the socket address to null • SocketAddr = *ALLx'00'; • // Set the socket family to internet addressing • SinFamily = AF_INET; • // Set the port number to use • Eval(h) SinPort = PortNum; • // Convert the address to an internal format • SinAddr = InetAddr(%Addr(Local_Addr)); • // Connect to the socket • Rc = Connect(Sd:%Addr(SocketAddr) • :%Size(SocketAddr)); • StartSize = 58; • // process all memebers in the retrieved member list • For MbrCount = 1 to ListCount; • Start = ListOffset + 1 + (ListItmSz * (MbrCount - 1)); • CallP RtvList(UserSpace:Start:ListItmSz:MbrDtaLong); • D_Member = MbrDtaLong; • // Connect to the socket • Rc = Connect(Sd:%Addr(SocketAddr) • :%Size(SocketAddr)); • StartSize = 58; • // process all memebers in the retrieved member list • For MbrCount = 1 to ListCount; • Start = ListOffset + 1 + (ListItmSz * (MbrCount - 1)); • CallP RtvList(UserSpace:Start:ListItmSz:MbrDtaLong); • D_Member = MbrDtaLong; • Fp = OpenFile(%TrimR(Open_Path) + • '(' + %Trim(D_Member) + ')': • 'rr+ arrseq=Y secure=Y'); • Null_Open = 'N'; • RrnCounter = 1; • rFile_Ptr = Fp; • Io_Fb_Ptr = ReadFirst(Fp: • %Addr(Buffer): • Fp = OpenFile(%TrimR(Open_Path) + • '(' + %Trim(D_Member) + ')': • 'rr+ arrseq=Y secure=Y'); • Null_Open = 'N'; • RrnCounter = 1; • rFile_Ptr = Fp; • Io_Fb_Ptr = ReadFirst(Fp: • %Addr(Buffer): • %Size(Buffer): • No_Lock); • RcdLength = Io_Bytes_Rtn; • // Establish lengths and offsets for data contents and null map • D_Null_Len = *Zero; • D_Null_Off = *Zero; • D_Cont_Len = Io_Bytes_Rtn; • D_Cont_Off = 8; • Data_Size = D_Cont_Len + D_Null_Len + 58; • %Size(Buffer): • No_Lock); • RcdLength = Io_Bytes_Rtn; • // Establish lengths and offsets for data contents and null map • D_Null_Len = *Zero; • D_Null_Off = *Zero; • D_Cont_Len = Io_Bytes_Rtn; • D_Cont_Off = 8; • Data_Size = D_Cont_Len + D_Null_Len + 58; • Data = System+Lib_Name+File_Name+ • '*START ' + D_Member + • %Subst(Data_Content:1:8); • // Check RC. If RC = -1 then sleep(1) and increment Timeout counter by 1. • // perorm a DOU Loop that loops until Timeout is 60 or RC = *Zero. If • // timeout is > 60 then send an inquiry messsage. If response is "I" • // continue to wait and loop. If the response is a "C" then close the • // connectoins and end gracefully. • DoU Timeout < 60; • Data = System+Lib_Name+File_Name+ • '*START ' + D_Member + • %Subst(Data_Content:1:8); • // Check RC. If RC = -1 then sleep(1) and increment Timeout counter by 1. • // perorm a DOU Loop that loops until Timeout is 60 or RC = *Zero. If • // timeout is > 60 then send an inquiry messsage. If response is "I" • // continue to wait and loop. If the response is a "C" then close the • // connectoins and end gracefully. • DoU Timeout < 60; • Timeout = *Zero; • DoU Rc > *Zero or Timeout >= 60; • Rc = Write(Sd:%Addr(Data):StartSize); • If Rc < *Zero; • Sleep(1); • Timeout = Timeout + 1; • Else; • Timeout = *Zero; • EndIf; • EndDo; • Timeout = *Zero; • DoU Rc > *Zero or Timeout >= 60; • Rc = Write(Sd:%Addr(Data):StartSize); • If Rc < *Zero; • Sleep(1); • Timeout = Timeout + 1; • Else; • Timeout = *Zero; • EndIf; • EndDo; • EndDo; • DoW Io_Bytes_Rtn > *Zero; • StartSize = Data_Size; • // Establish lengths and offsets for data contents and null map • D_Null_Len = *Zero; • D_Null_Off = *Zero; • D_Cont_Len = Io_Bytes_Rtn; • D_Cont_Off = 8; • Count = Count + 1; • EndDo; • DoW Io_Bytes_Rtn > *Zero; • StartSize = Data_Size; • // Establish lengths and offsets for data contents and null map • D_Null_Len = *Zero; • D_Null_Off = *Zero; • D_Cont_Len = Io_Bytes_Rtn; • D_Cont_Off = 8; • Count = Count + 1; • If Count = 100; • Type_Out = 'PT'; • Count = *Zero; • Else; • Type_Out = 'RF'; • EndIf; • //---- • // Records are retrieved in arrival sequence and a counter • // is incremented to keep track of the record count read. • // If the record count read is less than the RRN being processed • If Count = 100; • Type_Out = 'PT'; • Count = *Zero; • Else; • Type_Out = 'RF'; • EndIf; • //---- • // Records are retrieved in arrival sequence and a counter • // is incremented to keep track of the record count read. • // If the record count read is less than the RRN being processed • // then deleted records were present between the last record and • // this one. Send a request for the refresh target processor to • // insert a deleted record for each missing record. This will • // insure that the target file image looks like the source file • // image. • DoW RrnCounter < Io_Rrn; • DoU Timeout < 60; • Timeout = *Zero; • DoU Rc > *Zero or Timeout >= 60; • // Send the entry without a null map included • // then deleted records were present between the last record and • // this one. Send a request for the refresh target processor to • // insert a deleted record for each missing record. This will • // insure that the target file image looks like the source file • // image. • DoW RrnCounter < Io_Rrn; • DoU Timeout < 60; • Timeout = *Zero; • DoU Rc > *Zero or Timeout >= 60; • // Send the entry without a null map included • Data = System+Lib_Name+File_Name+ • '*INSERTDEL' + D_Member + • %Subst(Data_Content:1:8) + • %Subst(DelBuf:1:Io_Bytes_Rtn); • Rc = Write(Sd:%Addr(Data):Data_Size); • RrnCounter += 1; • If Rc < *Zero; • Sleep(1); • Timeout = Timeout + 1; • Else; • Data = System+Lib_Name+File_Name+ • '*INSERTDEL' + D_Member + • %Subst(Data_Content:1:8) + • %Subst(DelBuf:1:Io_Bytes_Rtn); • Rc = Write(Sd:%Addr(Data):Data_Size); • RrnCounter += 1; • If Rc < *Zero; • Sleep(1); • Timeout = Timeout + 1; • Else; • Timeout = *Zero; • EndIf; • EndDo; • If Timeout >= 60; • Cancel(); • Return; • EndIf; • EndDo; • EndDo; • Timeout = *Zero; • EndIf; • EndDo; • If Timeout >= 60; • Cancel(); • Return; • EndIf; • EndDo; • EndDo; • DoU Timeout < 60; • Timeout = *Zero; • DoU Rc > *Zero or Timeout >= 60; • Data = System+Lib_Name+File_Name+ • '*REFRESH ' + D_Member + • %Subst(Data_Content:1:8) + • %Subst(Buffer:1:Io_Bytes_Rtn); • Rc = Write(Sd:%Addr(Data):Data_Size); • If Rc < *Zero; • Sleep(1); • DoU Timeout < 60; • Timeout = *Zero; • DoU Rc > *Zero or Timeout >= 60; • Data = System+Lib_Name+File_Name+ • '*REFRESH ' + D_Member + • %Subst(Data_Content:1:8) + • %Subst(Buffer:1:Io_Bytes_Rtn); • Rc = Write(Sd:%Addr(Data):Data_Size); • If Rc < *Zero; • Sleep(1); • Timeout = Timeout + 1; • Else; • Timeout = *Zero; • EndIf; • EndDo; • If Timeout >= 60; • Cancel(); • return; • EndIf; • EndDo; • Timeout = Timeout + 1; • Else; • Timeout = *Zero; • EndIf; • EndDo; • If Timeout >= 60; • Cancel(); • return; • EndIf; • EndDo; • RrnCounter += 1; • Io_Fb_Ptr = ReadNext(Fp: • %Addr(Buffer): • %Size(Buffer): • No_Lock); • EndDo; • // RrnCounter is set to whatever the next expected RRN is so that it • // can be compared to the next record retrieved. All current records • // have already been processed and so the RrnCounter will be set one • RrnCounter += 1; • Io_Fb_Ptr = ReadNext(Fp: • %Addr(Buffer): • %Size(Buffer): • No_Lock); • EndDo; • // RrnCounter is set to whatever the next expected RRN is so that it • // can be compared to the next record retrieved. All current records • // have already been processed and so the RrnCounter will be set one • // higher than the actual last RRN that was written. It will be • // necessary, then, to set the RrnCounter back to the last record • // written. • RrnCounter -= 1; • // Check for and send any deleted records that exist at the end of the • // file. Io_Rrn will contain the last record in the file even if it is • // deleted. • Loc_Options = %Int(Last_Rec) + %Int(No_Lock); • Io_Fb_Ptr = Locate(Fp: • *NULL: • // higher than the actual last RRN that was written. It will be • // necessary, then, to set the RrnCounter back to the last record • // written. • RrnCounter -= 1; • // Check for and send any deleted records that exist at the end of the • // file. Io_Rrn will contain the last record in the file even if it is • // deleted. • Loc_Options = %Int(Last_Rec) + %Int(No_Lock); • Io_Fb_Ptr = Locate(Fp: • *NULL: • Io_Rrn: • Loc_Options); • // If the Io_Rrn is greater than the last Rrn written, then add • // deleted records until the file is at the correct length. • DoW RrnCounter < Io_Rrn; • DoU Timeout < 60; • Timeout = *Zero; • DoU Rc > *Zero or Timeout >= 60; • Data = System+Lib_Name+File_Name+ • '*INSERTDEL' + D_Member + • Io_Rrn: • Loc_Options); • // If the Io_Rrn is greater than the last Rrn written, then add • // deleted records until the file is at the correct length. • DoW RrnCounter < Io_Rrn; • DoU Timeout < 60; • Timeout = *Zero; • DoU Rc > *Zero or Timeout >= 60; • Data = System+Lib_Name+File_Name+ • '*INSERTDEL' + D_Member + • %Subst(Data_Content:1:8) + • %Subst(DelBuf:1:RcdLength); • Rc = Write(Sd:%Addr(Data):Data_Size); • RrnCounter += 1; • If Rc < *Zero; • Cancel(); • return; • EndIf; • EndDo; • EndDo; • %Subst(Data_Content:1:8) + • %Subst(DelBuf:1:RcdLength); • Rc = Write(Sd:%Addr(Data):Data_Size); • RrnCounter += 1; • If Rc < *Zero; • Cancel(); • return; • EndIf; • EndDo; • EndDo; • EndDo; • // Send an end of refresh. This will confirm to the target that no additio • // data will be sent since all file data has been sent. • EndFor; • Data = System+Lib_Name+File_Name+ • '*END '; • EndDo; • // Send an end of refresh. This will confirm to the target that no additio • // data will be sent since all file data has been sent. • EndFor; • Data = System+Lib_Name+File_Name+ • '*END '; • DoU Timeout < 60; • Timeout = *Zero; • DoU Rc > *Zero or Timeout >= 60; • Rc = Write(Sd:%Addr(Data):Data_Size); • If Rc < *Zero; • Sleep(1); • Timeout = Timeout + 1; • Else; • Timeout = *Zero; • EndIf; • DoU Timeout < 60; • Timeout = *Zero; • DoU Rc > *Zero or Timeout >= 60; • Rc = Write(Sd:%Addr(Data):Data_Size); • If Rc < *Zero; • Sleep(1); • Timeout = Timeout + 1; • Else; • Timeout = *Zero; • EndIf; • EndDo; • EndDo; • CloseFile(Fp); • CallP Close(Sd); • *InLR = *On; • Return; • /End-Free • //========================================================================= • EndDo; • EndDo; • CloseFile(Fp); • CallP Close(Sd); • *InLR = *On; • Return; • /End-Free • //========================================================================= • // Cancel • //========================================================================= • P Cancel B • D Cancel Pi • /Free • CloseFile(Fp); • CallP Close(Sd); • CallP Close(Sd2); • // Cancel • //========================================================================= • P Cancel B • D Cancel Pi • /Free • CloseFile(Fp); • CallP Close(Sd); • CallP Close(Sd2); • *InLR = *On; • Return; • /End-Free • P E • //====================================================================== • // Send inquiry message • //====================================================================== • PSndInqMsg B • *InLR = *On; • Return; • /End-Free • P E • //====================================================================== • // Send inquiry message • //====================================================================== • PSndInqMsg B • DSndInqMsg Pi 4 • D MsgId 7 Value • D MsgFile s 20 Inz('RPLMSGF RPLLIB') • D MsgData s 20 • D MsgDataLen s 10i 0 Inz(0) • D MsgType s 10 Inz('*INQ') • D MsgQue s 20 Inz('QSYSOPR *LIBL') • D MsgQue# s 10i 0 Inz(1) • D MsgQueRply s 20 Inz('*PGMQ') • DSndInqMsg Pi 4 • D MsgId 7 Value • D MsgFile s 20 Inz('RPLMSGF RPLLIB') • D MsgData s 20 • D MsgDataLen s 10i 0 Inz(0) • D MsgType s 10 Inz('*INQ') • D MsgQue s 20 Inz('QSYSOPR *LIBL') • D MsgQue# s 10i 0 Inz(1) • D MsgQueRply s 20 Inz('*PGMQ') • D MsgKey s 4 • D ErrData s 50 • C Call 'QMHSNDM' • C Parm MsgId • C Parm MsgFile • C Parm MsgData • C Parm MsgDataLen • C Parm MsgType • C Parm MsgQue • D MsgKey s 4 • D ErrData s 50 • C Call 'QMHSNDM' • C Parm MsgId • C Parm MsgFile • C Parm MsgData • C Parm MsgDataLen • C Parm MsgType • C Parm MsgQue • C Parm MsgQue# • C Parm MsgQueRply • C Parm MsgKey • C Parm ErrData • /Free • Return MsgKey; • /End-Free • P E • //======================================================================= • C Parm MsgQue# • C Parm MsgQueRply • C Parm MsgKey • C Parm ErrData • /Free • Return MsgKey; • /End-Free • P E • //======================================================================= • // Get Reply to Message • //======================================================================= • PMsgRply B • DMsgRply Pi 1 • D MsgKey 4 • D RplyDs Ds • D ReplyLen 10i 0 • D ReplyAvl 10i 0 • // Get Reply to Message • //======================================================================= • PMsgRply B • DMsgRply Pi 1 • D MsgKey 4 • D RplyDs Ds • D ReplyLen 10i 0 • D ReplyAvl 10i 0 • D ReplySev 10i 0 • D ReplyId 7 • D ReplyType 2 • D ReplyKey 4 • D ReplyResvd 7 • D ReplyCCSIDSts 10i 0 • D ReplyCCSID 10i 0 • D ReplyDtaLen 10i 0 • D ReplyDtaAvl 10i 0 • D ReplyData 1 • D ReplySev 10i 0 • D ReplyId 7 • D ReplyType 2 • D ReplyKey 4 • D ReplyResvd 7 • D ReplyCCSIDSts 10i 0 • D ReplyCCSID 10i 0 • D ReplyDtaLen 10i 0 • D ReplyDtaAvl 10i 0 • D ReplyData 1 • D RplyLen s 10i 0 Inz(%Len(RplyDs)) • D RplyFmt s 8 Inz('RCVM0100') • D RplyStck s 10 Inz('*') • D RplyCnt s 10i 0 Inz(0) • D RplyTyp s 10 Inz('*RPY') • D Wait s 10i 0 Inz(-1) • D RplyAct s 10 Inz('*REMOVE') • D ErrData s 50 • D RplyLen s 10i 0 Inz(%Len(RplyDs)) • D RplyFmt s 8 Inz('RCVM0100') • D RplyStck s 10 Inz('*') • D RplyCnt s 10i 0 Inz(0) • D RplyTyp s 10 Inz('*RPY') • D Wait s 10i 0 Inz(-1) • D RplyAct s 10 Inz('*REMOVE') • D ErrData s 50 • C Call 'QMHRCVPM' • C Parm RplyDs • C Parm RplyLen • C Parm RplyFmt • C Parm RplyStck • C Parm RplyCnt • C Parm RplyTyp • C Parm MsgKey • C Parm Wait • C Parm RplyAct • C Call 'QMHRCVPM' • C Parm RplyDs • C Parm RplyLen • C Parm RplyFmt • C Parm RplyStck • C Parm RplyCnt • C Parm RplyTyp • C Parm MsgKey • C Parm Wait • C Parm RplyAct • C Parm ErrData • /Free • Return ReplyData; • /End-Free • P E • //====================================================================== • // Locate file pointer to a specific record in the file (SETLL) • //====================================================================== • P RrnLocate B • C Parm ErrData • /Free • Return ReplyData; • /End-Free • P E • //====================================================================== • // Locate file pointer to a specific record in the file (SETLL) • //====================================================================== • P RrnLocate B • D RrnLocate Pi 10i 0 • D FilePtr * Const • D Rrn# 20u 0 Const • D Rrn_Eq C x'08000300' • /FREE • Io_Fb_Ptr = Locate(FilePtr: • *NULL: • D RrnLocate Pi 10i 0 • D FilePtr * Const • D Rrn# 20u 0 Const • D Rrn_Eq C x'08000300' • /FREE • Io_Fb_Ptr = Locate(FilePtr: • *NULL: • Rrn#: • Rrn_Eq); • Return Io_Bytes_Rtn; • /END-FREE • P RrnLocate E • //====================================================================== • // Get Member List • //====================================================================== • Rrn#: • Rrn_Eq); • Return Io_Bytes_Rtn; • /END-FREE • P RrnLocate E • //====================================================================== • // Get Member List • //====================================================================== • P GetMbrList B • D GetMbrList Pi • D File 10 • D Library 10 • D Member 10 • D Format s 8 Inz('MBRL0100') • D Override s 1 Inz('0') • P GetMbrList B • D GetMbrList Pi • D File 10 • D Library 10 • D Member 10 • D Format s 8 Inz('MBRL0100') • D Override s 1 Inz('0') • D DbFile s 20 • /Free • DbFile = File + Library; • SysCmd('CRTUSRSPC QTEMP/MBRLSPC'); • ListMbrs(UserSpace:Format:DbFile:Member:Override); • D DbFile s 20 • /Free • DbFile = File + Library; • SysCmd('CRTUSRSPC QTEMP/MBRLSPC'); • ListMbrs(UserSpace:Format:DbFile:Member:Override); • CallP RtvList(UserSpace:Start:Length:ListData); • Return; • /End-Free • P E • ****************** End of data ***************************** Modern RPG – Unrealized Capabilities George L. Slater

More Related