* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * Physical File Source * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * A R CP1020 A TEXT('Generic File Comparison -+ A Driver File ') A AFRECTYP 10 A AFFLDNAM 10 A K AFRECTYP A K AFFLDNAM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * Control Language Program Source * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* Table Driven Generic File Merge */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ PGM PARM( &LIBRARY1 + &FILE1 + &MBR1 + &LIBRARY2 + &FILE2 + &MBR2 ) DCL VAR(&FILE1 ) TYPE(*CHAR) LEN( 10) DCL VAR(&FILE2 ) TYPE(*CHAR) LEN( 10) DCL VAR(&LIBRARY1 ) TYPE(*CHAR) LEN( 10) DCL VAR(&LIBRARY2 ) TYPE(*CHAR) LEN( 10) DCL VAR(&MBR1 ) TYPE(*CHAR) LEN( 10) DCL VAR(&MBR2 ) TYPE(*CHAR) LEN( 10) DCL VAR(&ERRFLG ) TYPE(*LGL ) LEN( 1) VALUE('0') DCL VAR(&MSGDTA ) TYPE(*CHAR) LEN( 512) DCL VAR(&MSGID ) TYPE(*CHAR) LEN( 7) DCL VAR(&MSGF ) TYPE(*CHAR) LEN( 10) DCL VAR(&MSGFLIB ) TYPE(*CHAR) LEN( 10) MONMSG MSGID(CPF0000) EXEC(GOTO ERROR) /* */ /* Load key fields */ /* */ DSPFD FILE(&LIBRARY1/&FILE1) TYPE(*ACCPTH) + OUTPUT(*OUTFILE) OUTFILE(QTEMP/DSPFD) /* */ /* Load file field description */ /* */ DSPFFD FILE(&LIBRARY1/&FILE1) OUTPUT(*OUTFILE) + OUTFILE(QTEMP/DSPFFD) /* */ /* Call the program */ /* */ OVRDBF FILE(INPUT1) TOFILE(&LIBRARY1/&FILE1) MBR(&MBR1) SHARE(*YES) OVRDBF FILE(INPUT2) TOFILE(&LIBRARY2/&FILE2) MBR(&MBR2) SHARE(*YES) OPNQRYF FILE((INPUT1)) KEYFLD(*FILE) OPTION(*ALL) OPNQRYF FILE((INPUT2)) KEYFLD(*FILE) CALL PGM(CP1020R) PARM(&FILE1) CLOF OPNID(INPUT1) CLOF OPNID(INPUT2) DLTOVR FILE(INPUT1) DLTOVR FILE(INPUT2) /* */ /* */ /* */ RETURN /* */ /* Error Handling */ /* */ ERROR: IF COND(¬ &ERRFLG) THEN(DO) CHGVAR VAR(&ERRFLG) VALUE('1') RCLRSC ETAG: RCVMSG PGMQ(*SAME) MSGTYPE(*EXCP) MSGDTA(&MSGDTA) + MSGID(&MSGID) MSGF(&MSGF) MSGFLIB(&MSGFLIB) IF COND(&MSGID *NE ' ') THEN(DO) SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) + MSGDTA(&MSGDTA) TOPGMQ(*PRV) MSGTYPE(*ESCAPE) GOTO CMDLBL(ETAG) ENDDO ENDDO RETURN ENDPGM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ILE/RPG Program Source * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * "If it's squinky, then you know it's BrilligWare!" * * * * * * * * Source available at http://www.brilligware.com * * * * Brillig Enterprises (aka Chris Pando) (C)2006 * * * * * * * * This work is licensed under a Creative Commons * * * * Attribution-NonCommercial-ShareAlike License: * * * * http://creativecommons.org/licenses/by-nc-sa/2.0/legalcode * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * This program is for DEMONSTRATION PURPOSES ONLY! * * * * Absolutely no warranties, explicit or implied, exist. * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * Generic File Merge * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * h dftActGrp(*No) actGrp(*Caller) bndDir('QC2LE') * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ... files ... * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * fcp1020f if e k disk finput1 uf a f 600 disk finput2 if f 600 disk * * ... dspffd must exist at compile time. It has the same format * as the outfile from the DSPFFD command ... * fdspffd if e disk * * ... dspfd must exist at compile time. It has the same format * as the outfile from the DSPFD *ACCPTH command ... * fdspfd if e disk * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ... procedure interfaces ... * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * d cp1020r pr d pmRecTyp 10a d cp1020r pi d pmRecTyp 10a * * internal procedures * d comp pr 10i 0 d 5p 0 Value d 5p 0 Value d compDta pr Like(comp) d compKey pr Like(comp) d init pr d keyHI pr d * Value d loadFlds pr d * Value d read1 pr d read2 pr * * external procedures (from the C run-time library) * d memcmp pr 10i 0 ExtProc('memcmp') d * Value d * Value d 10i 0 Value d memset pr ExtProc('memset') d * Value d 10i 0 Value d 10i 0 Value * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ... data structures ... * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * dbuffer1ds ds 600 d buffer1 1a dim(600) dbuffer2ds ds 600 d buffer2 1a dim(600) /EJECT * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ... standalone variables ... * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * d fldNam s 10a dim(256) Field Name d fldOff s 5p 0 dim(256) Field Offset d fldLen s 5p 0 dim(256) Field Length d fldKSq s 1a dim(256) Ascending/Descending d refNam s dim(256) Like(fldNam) d refOff s dim(256) Like(fldOff) d refLen s dim(256) Like(fldLen) d refKSq s dim(256) Like(fldKSq) d @bfr1@ s * dim(256) d @bfr2@ s * dim(256) d testVar s 10i 0 hold comp results d $I s 5p 0 Inz(0) Utility Variable d $J s Like($I) Utility Variable d keyCnt s Like($I) Inz(0) KeylFieldaCounte d dtaCnt s Like($I) Inz(0) DataiFieldrCount * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ... constants ... * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * d EQUAL c 0 d ASCENDING c 'A' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * Mainline * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * /free init(); read1(); read2(); DoW (Not %Eof(input1) Or Not %Eof(input2)); testVar = compKey(); Select; When (testVar < EQUAL ); // key 1 < key 2 Delete input1; read1(); When (testVar > EQUAL ); // key 1 > key 2 Write input1 buffer2ds; read2(); Other; If (compDta() <> EQUAL); // key 1 = key 2 update input1 buffer2ds; EndIf; read1(); read2(); EndSl; EndDo; Return; /end-free c KeyList KList c Kfld pmRecTyp c Kfld afFLDNAM /EJECT * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * Procedures * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * load arrays with field offsets and lengths (both key and data) * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * p init b d pi d fldCnt s Like($I) /free // // first load information from DSPFFD into temporary arrays // Read dspffd; DoW ( Not %Eof(dspffd) ); fldCnt = fldCnt + 1; refNam(fldCnt) = whFLDI; refOff(fldCnt) = whFOBO; refLen(fldCnt) = whFLDB; Read dspffd; EndDo; // // now load key fields // Read dspfd; DoW (Not %Eof(dspfd)); $J = %Lookup( apKEYF : refNam : 1 : fldCnt ); // not testing for failure loadFlds( %Addr(keyCnt) ); fldKSq($I) = apKSEQ; // ascending or descending Read dspfd; EndDo; // // and, finally, load all data fields *not* in cp1020f // For $J = 1 to fldCnt; If ( 0 = %Lookup( refNam($J) : fldNam : 1 : keyCnt ) ); // If 0 then *not* a key field afFLDNAM = refNam($J); SetLL keyList cp1020f; If ( Not %Equal(cp1020f) ); loadFlds( %Addr(dtaCnt) ); EndIf; EndIf; EndFor; *InLR = *On; Return; /end-free p init e * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * read from first file * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * p read1 b d pi /free Read input1 buffer1ds; If (%Eof(input1)); keyHI( %Addr(@bfr1@) ); EndIf; Return; /end-free p read1 e * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * read from second file * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * p read2 b d pi /free Read input2 buffer2ds; If (%Eof(input2)); keyHI( %Addr(@bfr2@) ); EndIf; Return; /end-free p read2 e /EJECT * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * compare keys * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * p compKey b d pi 10i 0 D memcmpstr s 10i 0 /free memcmpstr = comp( 1 // compare all : keyCnt // keyfields ); If ( fldKSq($I) = ASCENDING ); Return memcmpstr; Else; Return (memcmpstr * -1); // flip for descending key fields EndIf; /end-free p compKey e * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * compare data * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * p compDta b d pi 10i 0 /free Return comp( keyCnt + 1 // compare all : keyCnt + dtaCnt // data fields ); /end-free p compDta e * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * compare buffers by field number * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * p comp b d pi 10i 0 d $start 5p 0 Value d $finis 5p 0 Value d memcmpstr s Like(testVar) /free $I = $start - 1; DoU ($I = $finis Or memcmpstr <> 0); $I = $I + 1; memcmpstr = memcmp( @bfr1@($I) // %Addr(buffer1(fldOff($I))) : @bfr2@($I) // %Addr(buffer2(fldOff($I))) : fldLen($I) ); EndDo; Return memcmpstr; /end-free p comp e * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * load key fields with x'FF' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * p keyHI b d pi d @bfr@@ * Value d @bfr@ s Like(@bfr1@) Dim(%Elem(@bfr1@)) d Based(@bfr@@) /free For $I = 1 to keyCnt; memset( @bfr@($I) : x'FF' : fldLen($I) ); EndFor; /end-free p keyHI e * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * move fields from reference array to working array * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * p loadFlds b d pi d cnt@ * Value d cnt s Like($I) Based(cnt@) /free $I = $I + 1; cnt = cnt + 1; fldNam($I) = refNam($J); fldOff($I) = refOff($J); fldLen($I) = refLen($J); @bfr1@($I) = %Addr(buffer1(fldOff($I))); // cached for performance @bfr2@($I) = %Addr(buffer2(fldOff($I))); // cached for performance /end-free p loadFlds e