home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / FILER.ZIP / SORTER1.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-11-18  |  7.6 KB  |  223 lines
  1. {================================================================}
  2. {                  INITIALIZE FILER FILE                         }
  3. {================================================================}
  4. PROCEDURE INITIALIZE;
  5.  
  6. BEGIN
  7.   REPEAT
  8.     CLRSCR;
  9.     TEXTMODE(BW40);
  10.     GOTOXY(1,22);
  11.     WRITE('SORTER A LA PASCAL');
  12.     GOTOXY(1,23);
  13.     WRITE('ENTER SOURCE FILE NAME : ');
  14.     READLN(SOURCENAME);
  15.     X := POS('.',SOURCENAME);
  16.     IF X <> 0 THEN SOURCENAME := COPY(SOURCENAME,1,X-1);
  17.     SOURCENAMEDAT := SOURCENAME + '.DAT';
  18.     SOURCENAMEBAK := SOURCENAME + '.BAK';
  19.     FILEEXISTS := EXIST(SOURCENAMEDAT);
  20.   UNTIL FILEEXISTS = TRUE;
  21.  
  22.   {========================================}
  23.   {   ERASE ANY BACKUP FILE OF SAME NAME   }
  24.   {========================================}
  25.   IF (EXIST(SOURCENAMEBAK)) THEN
  26.     BEGIN
  27.       ASSIGN(SOURCE,SOURCENAMEBAK);
  28.       ERASE(SOURCE);
  29.       WRITELN;
  30.       WRITELN(SOURCENAMEBAK,' HAS BEEN DELETED.');
  31.     END;
  32.  
  33.   {========================================}
  34.   {       RENAME FILE TO FILENAME.BAK      }
  35.   {========================================}
  36.   ASSIGN(SOURCE,SOURCENAMEDAT);
  37.   RENAME(SOURCE,SOURCENAMEBAK);
  38.   RESET(SOURCE);
  39.   WRITELN('FILE ',SOURCENAMEDAT,' RENAMED ',SOURCENAMEBAK);
  40.  
  41.   {=======================================}
  42.   {    CREATE DESTINATION FILENAME.DAT    }
  43.   {=======================================}
  44.   ASSIGN(DESTINATION, SOURCENAMEDAT);
  45.   REWRITE ( DESTINATION );
  46.  
  47.   {=======================================}
  48.   {      BUILD HEADER FOR NEW FILE        }
  49.   {=======================================}
  50.   SEEK(SOURCE,0);
  51.   BLOCKREAD( SOURCE,GETDATA,1 );          { BASIC/Z BLOCK 0 }
  52.   BLOCKWRITE(DESTINATION,GETDATA,1);
  53.  
  54.   BLOCKREAD( SOURCE,GETDATA,1 );          { FILE PARAMETERS }
  55.   BLOCKWRITE(DESTINATION,GETDATA,1);
  56.  
  57.   BLOCKREAD( SOURCE,LBL,3 );                 { FILER LABELS }
  58.   BLOCKWRITE(DESTINATION,LBL,3);
  59.  
  60.  
  61.   {=================================================}
  62.   {      READ IN HEADER DATA FOR FILER FILE         }
  63.   {=================================================}
  64.   FILENAME := 'XXXXXX';
  65.   FOR X := 1 TO 6 DO
  66.     FILENAME[X] := GETDATA[X];
  67.   MAXNBRREC := CHTOIN(GETDATA,7,4);
  68.   NBRRECUSED := CHTOIN(GETDATA,11,4);
  69.   RCDLEN := CHTOIN(GETDATA,15,3);
  70.   BLOCKINGFACTOR := CHTOIN(GETDATA,18,2);
  71.   FIELDPERRECORD := CHTOIN(GETDATA,20,2);
  72.   FILEDATE := '  /  /  ';
  73.   MOVE(GETDATA[22],FILEDATE[1],8);
  74.  
  75. {================================================================}
  76. {  GET LABEL LENGTH, DATA LENGTH & DATA FORM INFO                }
  77. {================================================================}
  78.  
  79. LABELPOSN[1] := 1;
  80. DATAPOSN[1] := 1;
  81.  
  82. FOR X := 1 TO FIELDPERRECORD DO
  83.   BEGIN
  84.     LABELLENGTH[X] :=  BCDTOIN(GETDATA[32+X]);
  85.     DATALEN[X]     :=  BCDTOIN(GETDATA[64+X]);
  86.     DATAFORM[X]    :=  ORD(GETDATA[96+X])-48;
  87.     LABELPOSN[X+1] :=  LABELPOSN[X] + LABELLENGTH[X];
  88.     DATAPOSN[X+1]  :=  DATAPOSN[X] + DATALEN[X];
  89.   END;
  90.  
  91. {================================================================}
  92. {           TRANSLATE REPORT STRUCTURE                           }
  93. {================================================================}
  94.  
  95.   BLOCKREAD(SOURCE,GETDATA,1);  { SCREEN INFORMATION }
  96.   BLOCKWRITE(DESTINATION,GETDATA,1);
  97.       { ESTABLISH VALUE OF DATAFORM[Z] FOR ASCII INFORMATION }
  98.       IF GETDATA[1] = 'S' THEN ASCII := 9 ELSE ASCII := 15;
  99.   FOR X := 1 TO FIELDPERRECORD DO
  100.     BEGIN
  101.       W := X*4+1;
  102.       ROW[X]       := BCDTOIN(GETDATA[W]);
  103.       COLUMN[X] := BCDTOIN(GETDATA[W+1])*10+TRUNC(BCDTOIN(GETDATA[W+2])/10);
  104.       {FIELDNBR[X]  := BCDTOIN(GETDATA[W+3]);} { NOT IMPLEMENTED }
  105.     END;
  106.   BLOCKREAD(SOURCE,GETDATA,2);  { REPORT FORMAT INFORMATION (NOT USED) }
  107.   BLOCKWRITE(DESTINATION,GETDATA,1);
  108.   BLOCKWRITE(DESTINATION,GETDATA,1);    { FIRST RECORD GOES HERE }
  109.   BLOCKWRITE(DESTINATION,GETDATA,1);
  110.  
  111. {================================================================}
  112. {          INITIALIZE VARIABLES FOR ENTRY INTO FILER             }
  113. {================================================================}
  114.   DATARECORD := NBRRECUSED;                 { SOURCE FILE SET UP }
  115.   CALCULATE;
  116.   DISKRECNOWINMEM := DISKRECORD -1; { ENSURE DISK READ FIRST TIME}
  117.   FILERECCHGD := FALSE;      { ENSURE NO WRITE BEFORE FIRST READ }
  118.   LASTRECUSED := 0;               { SET LAST RECORD USED TO ZERO }
  119.   NBRDISKRECUSED := DISKRECORD;     { ESTABLISH MAX DISK REC NBR }
  120.   RECADDEDTOFILE := FALSE; { FLAG TO INDICATE CHANGE IN FILE SIZE}
  121.  
  122.   NBRRECUSED2 := 0;                    { DESTINATION FILE SET UP }
  123.   DATARECORD2 := NBRRECUSED2;
  124.   CALCULATE2;
  125.   DISKRECNOWINMEM2 := DISKRECORD2 -1; { ENSURE DISK READ FIRST TIME}
  126.   FILERECCHGD2 := FALSE;       { ENSURE NO WRITE BEFORE FIRST READ }
  127.   LASTRECUSED2 := 0;                { SET LAST RECORD USED TO ZERO }
  128.   NBRDISKRECUSED2 := DISKRECORD2;     { ESTABLISH MAX DISK REC NBR }
  129.   RECADDEDTOFILE2 := FALSE;  { FLAG TO INDICATE CHANGE IN FILE SIZE}
  130.  
  131. END;  { INTIIALIZE PROCEDURE }
  132.  
  133.  
  134. {================================================================}
  135. {                         SORT PROGRAM                           }
  136. {================================================================}
  137.  
  138. BEGIN
  139.   INITIALIZE;                   { ID AND READ IN FILE PARAMETERS }
  140.   TEXTMODE(BW80);
  141.  
  142.   {======================================}
  143.   {           ENTER KEY FIELDS           }
  144.   {======================================}
  145.   REPEAT
  146.     DISPLAYREC;
  147.     GOTOXY(1,21);
  148.     WRITE('IN ORDER OF IMPORTANCE :');
  149.     X := 1;
  150.     KEYLENGTH := 0;
  151.     REPEAT
  152.       CLREOL;
  153.       IF X = 1 THEN
  154.         BEGIN
  155.           GOTOXY(1,23);
  156.           WRITE('ENTER KEY FIELD NUMBER : ')
  157.         END
  158.       ELSE
  159.         BEGIN
  160.           GOTOXY(1,24);
  161.           WRITE('ENTER RETURN ONLY TO END KEY DEFINITION');
  162.           GOTOXY(1,23);
  163.           WRITE('ENTER NEXT KEY FIELD : ');
  164.           CLREOL;
  165.         END;
  166.       ANS := '';
  167.       READ(ANS);
  168.       STRINGTOREAL(ANS,NUMVALUE,CODE);
  169.       KEYFIELD[X] := TRUNC(NUMVALUE);
  170.       IF NUMVALUE <> 0 THEN KEYLENGTH := KEYLENGTH + DATALEN[KEYFIELD[X]];
  171.       X := X + 1;
  172.     UNTIL NUMVALUE = 0;
  173.     KEYFIELD[0] := X-2;
  174.     IF KEYLENGTH > 55 THEN KEYLENGTH := 55;
  175.     KEYLENGTH := KEYLENGTH + 6;  { 5 for field nbr + 1 for string 0 byte }
  176.  
  177.     {=======================================}
  178.     {      DISPLAY KEYS SELECTED            }
  179.     {=======================================}
  180.     CLRSCR;
  181.     GOTOXY(1,23);
  182.     WRITELN('KEY FIELDS SELECTED ARE :');
  183.     WRITELN('=========================');
  184.     WRITELN;
  185.     FOR X := 1 TO KEYFIELD[0] DO
  186.       BEGIN
  187.         PRINTLABEL(KEYFIELD[X]);
  188.       END;
  189.     WRITELN;
  190.     WRITELN('=========================');
  191.     WRITELN('KEYLENGTH = ',KEYLENGTH);
  192.     WRITE('IS THIS OK (Y/N) : ');
  193.     READLN(CH);
  194.   UNTIL (UPCASE(CH) = 'Y') OR (EOLN);
  195.   WRITELN;
  196.  
  197.   {===============================================}
  198.   {  BUILD KEY FIELDS AND PASS TO TURBO SORT      }
  199.   {===============================================}
  200.  
  201.   WRITELN(TURBOSORT(KEYLENGTH)); { CALL TURBO SORT PROGRAM }
  202.                                  { SEE INP, LESS & OUTP    }
  203.                                  { PROCEDURES              }
  204.  
  205. {================================================================}
  206. {                    END PROGRAM                                 }
  207. {================================================================}
  208.  
  209. SEEK(DESTINATION,1);
  210. BLOCKREAD(DESTINATION,GETDATA,1);
  211. STR(NBRRECUSED:4,ANS);
  212. MOVE(ANS[1],GETDATA[11],4);  { UPDATE NBR OF RECORDS }
  213. SEEK(DESTINATION,1);
  214. BLOCKWRITE(DESTINATION,GETDATA,1);
  215. CLOSE(SOURCE);
  216. CLOSE(DESTINATION);
  217. GOTOXY(5,24);
  218. WRITELN('[  0 INDICATES SUCCESSFUL SORT  ]');
  219. WRITELN;
  220. WRITELN;
  221. WRITELN('..oO[   HAVE A GREAT DAY!   ]Oo..');
  222. END.
  223.