home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / FILER.ZIP / TRANSFR1.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1985-11-18  |  11.9 KB  |  346 lines
  1.  
  2.  
  3. {================================================================}
  4. {            STORE DATA IN ARRAY GETDATA PROCEDURE               }
  5. {================================================================}
  6. PROCEDURE STOREDATAINARRAY2 (Z : INTEGER);
  7. BEGIN
  8.   FIRST := 1;
  9.   IF DATAFORM2[Z] <> ASCII THEN
  10.     BEGIN
  11.       STRINGTOREAL(ANS,NUMVALUE,CODE);
  12.       STR(NUMVALUE:20:8,ANS);
  13.       ANS := ANS + '                                            ';
  14.       FIRST := POS('.',ANS) - DATALEN2[Z];
  15.       IF DATAFORM2[Z] <> 0 THEN FIRST := FIRST + DATAFORM2[Z] + 1;
  16.       IF DATAFORM2[Z] = ASCII THEN FIRST := 1;
  17.     END;
  18.   FILLCHAR(GETDATA2[PRECBYTE2+DATAPOSN2[Z]],DATALEN2[Z],' ');
  19.   MOVE(ANS[FIRST],GETDATA2[PRECBYTE2+DATAPOSN2[Z]],DATALEN2[Z]);
  20. END;
  21. {================================================================}
  22. {                  INITIALIZE FILER FILE                         }
  23. {================================================================}
  24. PROCEDURE INITIALIZE;
  25.  
  26. BEGIN
  27.   REPEAT
  28.     CLRSCR;
  29.     TEXTMODE(BW40);
  30.     GOTOXY(1,22);
  31.     WRITE('TRANSFER A LA PASCAL');
  32.     GOTOXY(1,23);
  33.     WRITE('ENTER SOURCE FILE NAME : ');
  34.     READLN(SOURCENAME);
  35.     X := POS('.',SOURCENAME);
  36.     IF X <> 0 THEN SOURCENAME := COPY(SOURCENAME,1,X-1);
  37.     SOURCENAMEDAT := SOURCENAME + '.DAT';
  38.     FILEEXISTS := EXIST(SOURCENAMEDAT);
  39.   UNTIL FILEEXISTS = TRUE;
  40.   WRITELN;
  41.   WRITELN;
  42.  
  43.   REPEAT
  44.     GOTOXY(1,23);
  45.     WRITE('ENTER DESTINATION FILE NAME : ');
  46.     READLN(DESTINATIONNAME);
  47.     X := POS('.',DESTINATIONNAME);
  48.     IF X <> 0 THEN DESTINATIONNAME := COPY(DESTINATIONNAME,1,X-1);
  49.     DESTINATIONNAMEDAT := DESTINATIONNAME + '.DAT';
  50.     FILEEXISTS := EXIST(DESTINATIONNAMEDAT);
  51.   UNTIL FILEEXISTS = TRUE;
  52.  
  53.  
  54.   {=======================================}
  55.   {   CREATE SOURCE & DESTINATION FILE    }
  56.   {=======================================}
  57.   ASSIGN(SOURCE,SOURCENAMEDAT);
  58.   RESET(SOURCE);
  59.  
  60.   ASSIGN(DESTINATION, DESTINATIONNAMEDAT);
  61.   RESET ( DESTINATION );
  62.  
  63.   {=======================================}
  64.   {        BUILD HEADER FOR SOURCE        }
  65.   {=======================================}
  66.   SEEK(SOURCE,0);
  67.   BLOCKREAD( SOURCE,GETDATA,1 );          { BASIC/Z BLOCK 0 }
  68.   BLOCKREAD( SOURCE,GETDATA,1 );          { FILE PARAMETERS }
  69.   BLOCKREAD( SOURCE,LBL,3 );                 { FILER LABELS }
  70.  
  71.  
  72.   {=================================================}
  73.   {      READ IN HEADER DATA FOR FILER FILE         }
  74.   {=================================================}
  75.   FILENAME := 'XXXXXX';
  76.   FOR X := 1 TO 6 DO
  77.     FILENAME[X] := GETDATA[X];
  78.   MAXNBRREC := CHTOIN(GETDATA,7,4);
  79.   NBRRECUSED := CHTOIN(GETDATA,11,4);
  80.   RCDLEN := CHTOIN(GETDATA,15,3);
  81.   BLOCKINGFACTOR := CHTOIN(GETDATA,18,2);
  82.   FIELDPERRECORD := CHTOIN(GETDATA,20,2);
  83.   FILEDATE := '  /  /  ';
  84.   MOVE(GETDATA[22],FILEDATE[1],8);
  85.  
  86. {================================================================}
  87. {  GET LABEL LENGTH, DATA LENGTH & DATA FORM INFO                }
  88. {================================================================}
  89.  
  90. LABELPOSN[1] := 1;
  91. DATAPOSN[1] := 1;
  92.  
  93. FOR X := 1 TO FIELDPERRECORD DO
  94.   BEGIN
  95.     LABELLENGTH[X] :=  BCDTOIN(GETDATA[32+X]);
  96.     DATALEN[X]     :=  BCDTOIN(GETDATA[64+X]);
  97.     DATAFORM[X]    :=  ORD(GETDATA[96+X])-48;
  98.     LABELPOSN[X+1] :=  LABELPOSN[X] + LABELLENGTH[X];
  99.     DATAPOSN[X+1]  :=  DATAPOSN[X] + DATALEN[X];
  100.   END;
  101.  
  102. {================================================================}
  103. {           TRANSLATE REPORT STRUCTURE                           }
  104. {================================================================}
  105.  
  106.   BLOCKREAD(SOURCE,GETDATA,1);  { SCREEN INFORMATION }
  107.       { ESTABLISH VALUE OF DATAFORM[Z] FOR ASCII INFORMATION }
  108.       IF GETDATA[1] = 'S' THEN ASCII := 9 ELSE ASCII := 15;
  109.   FOR X := 1 TO FIELDPERRECORD DO
  110.     BEGIN
  111.       W := X*4+1;
  112.       ROW[X]       := BCDTOIN(GETDATA[W]);
  113.       COLUMN[X] := BCDTOIN(GETDATA[W+1])*10+TRUNC(BCDTOIN(GETDATA[W+2])/10);
  114.       {FIELDNBR[X]  := BCDTOIN(GETDATA[W+3]);} { NOT IMPLEMENTED }
  115.     END;
  116.   BLOCKREAD(SOURCE,GETDATA,2);  { REPORT FORMAT INFORMATION (NOT USED) }
  117.  
  118.  
  119.   {============================================}
  120.   {        BUILD HEADER FOR DESTINATION        }
  121.   {============================================}
  122.   SEEK(DESTINATION,0);
  123.   BLOCKREAD( DESTINATION,GETDATA2,1 );          { BASIC/Z BLOCK 0 }
  124.   BLOCKREAD( DESTINATION,GETDATA2,1 );          { FILE PARAMETERS }
  125.   BLOCKREAD( DESTINATION,LBL2,3 );                 { FILER LABELS }
  126.  
  127.  
  128.   {=================================================}
  129.   {      READ IN HEADER DATA FOR FILER FILE         }
  130.   {=================================================}
  131.   FILENAME := 'XXXXXX';
  132.   FOR X := 1 TO 6 DO
  133.     FILENAME2[X] := GETDATA2[X];
  134.   MAXNBRREC2 := CHTOIN(GETDATA2,7,4);
  135.   NBRRECUSED2 := CHTOIN(GETDATA2,11,4);
  136.   RCDLEN2 := CHTOIN(GETDATA2,15,3);
  137.   BLOCKINGFACTOR2 := CHTOIN(GETDATA2,18,2);
  138.   FIELDPERRECORD2 := CHTOIN(GETDATA2,20,2);
  139.   FILEDATE2 := '  /  /  ';
  140.   MOVE(GETDATA2[22],FILEDATE2[1],8);
  141.  
  142. {================================================================}
  143. {  GET LABEL LENGTH, DATA LENGTH & DATA FORM INFO                }
  144. {================================================================}
  145.  
  146. LABELPOSN2[1] := 1;
  147. DATAPOSN2[1] := 1;
  148.  
  149. FOR X := 1 TO FIELDPERRECORD2 DO
  150.   BEGIN
  151.     LABELLENGTH2[X] :=  BCDTOIN(GETDATA2[32+X]);
  152.     DATALEN2[X]     :=  BCDTOIN(GETDATA2[64+X]);
  153.     DATAFORM2[X]    :=  ORD(GETDATA2[96+X])-48;
  154.     LABELPOSN2[X+1] :=  LABELPOSN2[X] + LABELLENGTH2[X];
  155.     DATAPOSN2[X+1]  :=  DATAPOSN2[X] + DATALEN2[X];
  156.   END;
  157.  
  158. {================================================================}
  159. {           TRANSLATE REPORT STRUCTURE                           }
  160. {================================================================}
  161.  
  162.   BLOCKREAD(DESTINATION,GETDATA2,1);  { SCREEN INFORMATION }
  163.       { ESTABLISH VALUE OF DATAFORM[Z] FOR ASCII INFORMATION }
  164.       IF GETDATA2[1] = 'S' THEN ASCII := 9 ELSE ASCII := 15;
  165.   FOR X := 1 TO FIELDPERRECORD2 DO
  166.     BEGIN
  167.       W := X*4+1;
  168.       ROW2[X]       := BCDTOIN(GETDATA2[W]);
  169.       COLUMN2[X] := BCDTOIN(GETDATA2[W+1])*10+TRUNC(BCDTOIN(GETDATA2[W+2])/10);
  170.       {FIELDNBR2[X]  := BCDTOIN(GETDATA2[W+3]);} { NOT IMPLEMENTED }
  171.     END;
  172.   BLOCKREAD(DESTINATION,GETDATA2,2);  { REPORT FORMAT INFORMATION (NOT USED) }
  173.  
  174. {================================================================}
  175. {          INITIALIZE VARIABLES FOR ENTRY INTO FILER             }
  176. {================================================================}
  177.   DATARECORD := NBRRECUSED;                 { SOURCE FILE SET UP }
  178.   CALCULATE;
  179.   DISKRECNOWINMEM := DISKRECORD -1; { ENSURE DISK READ FIRST TIME}
  180.   FILERECCHGD := FALSE;      { ENSURE NO WRITE BEFORE FIRST READ }
  181.   LASTRECUSED := 0;               { SET LAST RECORD USED TO ZERO }
  182.   NBRDISKRECUSED := DISKRECORD;     { ESTABLISH MAX DISK REC NBR }
  183.   RECADDEDTOFILE := FALSE; { FLAG TO INDICATE CHANGE IN FILE SIZE}
  184. {================================================================}
  185. {        INITIALIZE VARIABLES FOR ENTRY INTO DESTINATION         }
  186. {================================================================}
  187.   DATARECORD2 := NBRRECUSED2;          { DESTINATION FILE SET UP }
  188.   CALCULATE2;
  189.   DISKRECNOWINMEM2 := DISKRECORD2 -1; { ENSURE DISK READ FIRST TIME}
  190.   FILERECCHGD2 := FALSE;       { ENSURE NO WRITE BEFORE FIRST READ }
  191.   LASTRECUSED2 := 0;                { SET LAST RECORD USED TO ZERO }
  192.   NBRDISKRECUSED2 := DISKRECORD2;     { ESTABLISH MAX DISK REC NBR }
  193.   RECADDEDTOFILE2 := FALSE;  { FLAG TO INDICATE CHANGE IN FILE SIZE}
  194.  
  195. END;  { INTIIALIZE PROCEDURE }
  196.  
  197. {================================================================}
  198. {                     TRANSFER PROGRAM                           }
  199. {================================================================}
  200.  
  201. BEGIN
  202.   INITIALIZE;                   { ID AND READ IN FILE PARAMETERS }
  203.   TEXTMODE(BW80);
  204.  
  205.   {======================================}
  206.   {        BUILD TRANSLATE ARRAY         }
  207.   {======================================}
  208.   REPEAT
  209.     DISPLAYREC2;   { DISPLAY DESTINATION FILER FILE }
  210.     FOR X := 1 TO 31 DO
  211.       TRANSARRAY[X] := 0;
  212.     X := 1;
  213.     REPEAT
  214.       GOTOXY(1,22);
  215.       WRITE('NAME OF SOURCE FIELD TO BE TRANSLATED  : ');
  216.       CLREOL;
  217.       TEXTCOLOR(YELLOW);
  218.       TEXTBACKGROUND(BLUE);
  219.       FOR W := LABELPOSN[X] TO LABELPOSN[X+1]-1 DO { WRITE LABEL }
  220.         WRITE(LBL[W]);
  221.       TEXTCOLOR(WHITE);
  222.       TEXTBACKGROUND(BLACK);
  223.       GOTOXY(1,23);
  224.       WRITE('ENTER DESTINATION FIELD NUMBER (ABOVE) : ');
  225.       CLREOL;
  226.       ANS := '';
  227.       READ(ANS);
  228.       IF LENGTH(ANS) = 0 THEN
  229.         BEGIN
  230.           ANS := '0';
  231.         END;
  232.       IF (ANS = '-') AND (X>1) THEN X := PRED(X)
  233.       ELSE
  234.         BEGIN
  235.           VAL(ANS,DESTFIELDNBR,CODE);
  236.           IF CODE = 0 THEN
  237.             BEGIN
  238.               TRANSARRAY[X] := DESTFIELDNBR;
  239.               X := SUCC(X);
  240.             END
  241.           ELSE TRANSARRAY[X] := 0;
  242.         END;
  243.     UNTIL X > FIELDPERRECORD;
  244.  
  245.     CLRSCR;
  246.     FOR X := 1 TO FIELDPERRECORD DO
  247.       BEGIN
  248.         WRITE(X:3,'  ===>',TRANSARRAY[X]:3,'   |  ');
  249.         FOR W := LABELPOSN[X] TO LABELPOSN[X+1]-1 DO
  250.               WRITE (LBL[W]);
  251.         WRITE(' ===> ');
  252.         IF TRANSARRAY[X] <> 0 THEN
  253.           BEGIN
  254.             FOR W := LABELPOSN2[TRANSARRAY[X]] TO LABELPOSN2[TRANSARRAY[X]+1]-1 DO
  255.               WRITE(LBL2[W]);
  256.           END;
  257.         WRITELN;
  258.       END;
  259.     WRITELN;
  260.     WRITE('IS TRANSFER TABLE OK (Y/N) : ');
  261.     READLN(CH);
  262.     CH := UPCASE(CH);
  263.     IF CH <> 'N' THEN CH := 'Y';
  264.   UNTIL CH = 'Y';
  265.   WRITELN;
  266.   WRITE('PRINT HARD COPY OF TRANSFER TABLE (Y/N) ? : ');
  267.   READLN(CH);
  268.   CH := UPCASE(CH);
  269.   IF CH = 'Y' THEN
  270.   BEGIN
  271.     WRITELN('ENERGIZE AND SELECT PRINTER FOR HARD COPY');
  272.     WRITELN('DEPRESS ANY KEY WHEN READY.');
  273.     READ(KBD,CH);
  274.     WRITELN;
  275.     WRITELN('..... PRINTING......');
  276.  
  277.     WRITELN(LST,'             TRANSLATION TABLE');
  278.     WRITELN(LST);
  279.     WRITELN(LST,'OLD      NEW      OLD LABEL ==> NEW LABEL');
  280.     WRITELN(LST,'FLD #    FLD #');
  281.     WRITELN(LST);
  282.     FOR X := 1 TO FIELDPERRECORD DO
  283.       BEGIN
  284.         WRITE(LST,X:3,'  ===>',TRANSARRAY[X]:3,'   |  ');
  285.         FOR W := LABELPOSN[X] TO LABELPOSN[X+1]-1 DO
  286.               WRITE(LST,LBL[W]);
  287.         WRITE(LST,' ===> ');
  288.         IF TRANSARRAY[X] <> 0 THEN
  289.           BEGIN
  290.             FOR W := LABELPOSN2[TRANSARRAY[X]] TO LABELPOSN2[TRANSARRAY[X]+1]-1 DO
  291.               WRITE(LST,LBL2[W]);
  292.           END;
  293.         WRITELN(LST);
  294.       END;
  295.     WRITELN(LST,^L);
  296.   END;
  297.  
  298.   CLRSCR;
  299.   GOTOXY(1,20);
  300.   WRITELN('TRANSFER A LA PASCAL');               { TRANSFER DATA }
  301.   WRITE('====================');
  302.   FOR DATARECORD := 1 TO NBRRECUSED DO
  303.     BEGIN
  304.       GETDATAREC;    { GET SOURCE DATA RECORD }
  305.       DATARECORD2 := DATARECORD;
  306.       GETDATAREC2;   { GET DESTINATION DATA RECORD }
  307.       FOR DESTNBR := 1 TO FIELDPERRECORD DO
  308.         BEGIN
  309.           W := TRANSARRAY[DESTNBR];
  310.           IF W <> 0 THEN
  311.             BEGIN
  312.               GETDATAFROMARRAY(ANS,DESTNBR);
  313.               ANS := ANS + '                                     ';
  314.               STOREDATAINARRAY2(W);
  315.             END;
  316.           FILERECCHGD2 := TRUE;
  317.         END;
  318.         GOTOXY(1,23);
  319.         WRITE(DATARECORD,' OF ',NBRRECUSED,' RECORDS TRANSFERED.');
  320.     END;
  321.  
  322. {================================================================}
  323. {                    END PROGRAM                                 }
  324. {================================================================}
  325. IF FILERECCHGD2 = TRUE THEN  { ENSURE LAST RECORD IS WRITTEN TO DISK }
  326.   BEGIN
  327.     SEEK(DESTINATION,DISKRECNOWINMEM2);
  328.     BLOCKWRITE(DESTINATION,GETDATA2,2);
  329.   END;
  330.  
  331. SEEK(DESTINATION,1);                 { UPDATE NUMBER OF RECORDS }
  332. BLOCKREAD(DESTINATION,GETDATA2,1);
  333.  
  334. WRITELN;
  335. WRITELN;
  336. WRITELN('HAVE A GREAT DAY!');
  337.  
  338. STR(NBRRECUSED:4,ANS);                {  ENTER NUMBER OF RECORDS  }
  339. MOVE(ANS[1],GETDATA2[11],4);          { IN FILER FILE HEADER INFO }
  340. SEEK(DESTINATION,1);
  341. BLOCKWRITE(DESTINATION,GETDATA2,1);
  342.  
  343. CLOSE(SOURCE);
  344. CLOSE(DESTINATION);
  345. END.
  346.