home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / FILER.ZIP / FILER4.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-11-18  |  10.0 KB  |  305 lines
  1. {===============================================================}
  2. {                       FUNCTION EXIST                          }
  3. {===============================================================}
  4. FUNCTION EXIST(FILENAME : NAMESTR) : BOOLEAN;
  5. VAR
  6.   FIL :  FILE;
  7. BEGIN
  8.   ASSIGN(FIL,FILENAME);
  9.   {$I-}
  10.   RESET(FIL);
  11.   {$I+}
  12.   EXIST := (IORESULT = 0)
  13. END;
  14. {================================================================}
  15. {               IDENTIFY DATA RECORD PROCEDURE                   }
  16. {================================================================}
  17. PROCEDURE IDRECORD;
  18. BEGIN
  19.   GOTOXY(1,24);
  20.   WRITE('ENTER RECORD NUMBER : ');
  21.   READ(DATARECORD);
  22.   IF DATARECORD> NBRRECUSED THEN DATARECORD := NBRRECUSED;
  23.   IF DATARECORD< 1 THEN DATARECORD := 1;
  24.   LASTRECUSED := DATARECORD+1;        { FORCE DISPLAY AFTER MENU }
  25.   TEXTMODE(C80);
  26.   REGVIDEO;
  27.   CLRSCR;
  28. END;
  29. {================================================================}
  30. {               ADD / ENTER RECORDS PROCEDURE                    }
  31. {================================================================}
  32. PROCEDURE ADDNEWRECORD;
  33. BEGIN
  34.   TEXTMODE(C80);
  35.   REGVIDEO;
  36.   REPEAT
  37.     NBRRECUSED := NBRRECUSED + 1;
  38.     DATARECORD := NBRRECUSED;
  39.     GETDATAREC;
  40.     DISPLAYREC;
  41.     GOTOXY(1,24);
  42.     WRITE('ADD/ENTER RECORD MODE     [ USE WORDSTAR EDIT ');
  43.     WRITE('COMMANDS ]         F1 KEY TO END');
  44.       REPEAT
  45.         ENTERFIELD;
  46.         GOTOXY(1,24);
  47.         CLREOL;
  48.         WRITE('DATA RECORD OK? (Y/N/<F1>) ');
  49.         WRITE('    ');
  50.         TEXTCOLOR(WHITE+BLINK);
  51.         TEXTBACKGROUND(RED);
  52.         WRITE('<F1> KEY FOR MENU');
  53.         REGVIDEO;
  54.         GOTOXY(28,24);
  55.         READ(KBD,CH);
  56.         IF CH = #27 THEN READ(KBD,CH1) ELSE CH1 := #0;
  57.       UNTIL CH <> 'N';
  58.   UNTIL CH1 = #59;
  59.   FILERECCHGD := TRUE;
  60.   RECADDEDTOFILE := TRUE;
  61.   LASTRECUSED := DATARECORD;
  62.   DATARECORD := 0;                   { A READ OF DATA RECORD 0 }
  63.   GETDATAREC;                        { WILL WRITE LAST RECORD  }
  64.  END;
  65. {================================================================}
  66. {             DISPLAY RECORDS TO END PROCEDURE                   }
  67. {================================================================}
  68. PROCEDURE DISPLAYRECORDS;
  69. BEGIN
  70.   IDRECORD;
  71.   REPEAT
  72.     CALCULATE;
  73.     GETDATAREC;
  74.     IF LASTRECUSED <> DATARECORD THEN
  75.       BEGIN
  76.         LASTRECUSED := DATARECORD;
  77.         DISPLAYREC;
  78.       END;
  79.     GOTOXY(1,24);
  80.     WRITE('RETURN TO CONTINUE :         [ F2 TO ENTER DATA ]    ');
  81.     WRITE('      F1 = RETURN TO MENU');
  82.     GOTOXY(22,24);
  83.     READ(KBD,CH);
  84.     IF CH <> #27 THEN
  85.       BEGIN
  86.         CASE CH OF
  87.           ^D,^F,^M  :  IF DATARECORD <NBRRECUSED+1 THEN { RETURN KEY }
  88.                DATARECORD := DATARECORD +1;
  89.  
  90.           ^H  :  DELETEREC;                             { DELETE KEY }
  91.  
  92.           ^A,^S  :  IF DATARECORD > 1 THEN         { F9 = LEFT ARROW }
  93.              DATARECORD := DATARECORD -1;
  94.  
  95.           ^E,^C,^R,^X  :               { WORDSTAR'S UP FIELD COMMAND }
  96.              BEGIN
  97.                FIELDDATAMSG;
  98.                ENTERFIELD;
  99.              END;
  100.  
  101.         END; { CASE CH OF }
  102.       END
  103.     ELSE
  104.       BEGIN
  105.         READ(KBD,CH1);
  106.         CASE CH1 OF
  107.  
  108.            #68  :  IF DATARECORD < NBRRECUSED+1 THEN  { F10 = RIGHT ARROW }
  109.              DATARECORD := DATARECORD +1;
  110.  
  111.            #59  :  DATARECORD := NBRRECUSED +1   ;    { F1 = HOME KEY  }
  112.  
  113.            #67  :  IF DATARECORD > 1 THEN            { F9 = LEFT ARROW }
  114.              DATARECORD := DATARECORD -1;
  115.  
  116.            #60,#65,#66  :
  117.              BEGIN                             { LINE FEED }
  118.                FIELDDATAMSG;
  119.                ENTERFIELD;
  120.              END;
  121.         END; { CASE CH OF }
  122.       END;  { ELSE BEGIN  }
  123.   UNTIL DATARECORD > NBRRECUSED;
  124. END;
  125. {================================================================}
  126. {                  CORRECT RECORD PROCEDURE                      }
  127. {================================================================}
  128. PROCEDURE CORRECTRECORD;
  129. BEGIN
  130.   IDRECORD;
  131.   CALCULATE;
  132.   GETDATAREC;
  133.   DISPLAYREC;
  134.   FIELDDATAMSG;
  135.   REPEAT
  136.     ENTERFIELD;
  137.     GOTOXY(1,24);
  138.     WRITE('DATA RECORD OK? (Y/N) ');
  139.     CLREOL;
  140.     READ(KBD,CH);
  141.     FIELDDATAMSG;
  142.   UNTIL CH <> 'N';
  143. END;
  144.  
  145. {################################################################}
  146. {                                                                }
  147. {                         MAIN PROGRAM                           }
  148. {                         ============                           }
  149. {################################################################}
  150.  
  151.  
  152. BEGIN
  153. FILERSTART:
  154.   REPEAT
  155.     TEXTMODE(C40);
  156.     REGVIDEO;
  157.     CLRSCR;
  158.     GOTOXY(1,22);
  159.     WRITE('FILER A LA PASCAL');
  160.     GOTOXY(1,23);
  161.     WRITE('ENTER SOURCE FILE NAME : ');
  162.     READLN(SOURCENAME);
  163.     X := POS('.',SOURCENAME);
  164.     IF X <> 0 THEN SOURCENAME := COPY(SOURCENAME,1,X-1);
  165.     SOURCENAME := SOURCENAME + '.DAT';
  166.     FILEEXISTS := EXIST(SOURCENAME);
  167.   UNTIL FILEEXISTS = TRUE;
  168.   WRITE('ENTER CURRENT DATE (MM/DD/YY) : ');
  169.   READLN( CURRDATE );
  170.   IF LENGTH(CURRDATE) = 0 THEN CURRDATE := '  /  /  ';
  171.   ASSIGN( SOURCE, SOURCENAME );
  172.   RESET( SOURCE );
  173.   SEEK(SOURCE,1);
  174.   BLOCKREAD( SOURCE,GETDATA,1 );
  175.   BLOCKREAD( SOURCE,LBL,3 );
  176.   FILENAME := 'XXXXXX';
  177.   FOR X := 1 TO 6 DO
  178.     FILENAME[X] := GETDATA[X];
  179.   MAXNBRREC := CHTOIN(GETDATA,7,4);
  180.   NBRRECUSED := CHTOIN(GETDATA,11,4);
  181.   RCDLEN := CHTOIN(GETDATA,15,3);
  182.   BLOCKINGFACTOR := CHTOIN(GETDATA,18,2);
  183.   FIELDPERRECORD := CHTOIN(GETDATA,20,2);
  184.   FILEDATE := '  /  /  ';
  185.   MOVE(GETDATA[22],FILEDATE[1],8);
  186.  
  187. {================================================================}
  188. {  GET LABEL LENGTH, DATA LENGTH & DATA FORM INFO                }
  189. {================================================================}
  190.  
  191. LABELPOSN[1] := 1;
  192. DATAPOSN[1] := 1;
  193.  
  194. FOR X := 1 TO FIELDPERRECORD DO
  195.   BEGIN
  196.     LABELLENGTH[X] :=  BCDTOIN(GETDATA[32+X]);
  197.     DATALEN[X]     :=  BCDTOIN(GETDATA[64+X]);
  198.     DATAFORM[X]    :=  ORD(GETDATA[96+X])-48;
  199.     LABELPOSN[X+1] :=  LABELPOSN[X] + LABELLENGTH[X];
  200.     DATAPOSN[X+1]  :=  DATAPOSN[X] + DATALEN[X];
  201.   END;
  202.  
  203. {================================================================}
  204. {           TRANSLATE REPORT STRUCTURE                           }
  205. {================================================================}
  206.  
  207.   BLOCKREAD(SOURCE,GETDATA,1);  { SCREEN INFORMATION }
  208.       { ESTABLISH VALUE OF DATAFORM[Z] FOR ASCII INFORMATION }
  209.       IF GETDATA[1] = 'S' THEN ASCII := 9 ELSE ASCII := 15;
  210.   FOR X := 1 TO FIELDPERRECORD DO
  211.     BEGIN
  212.       W := X*4+1;
  213.       ROW[X]       := BCDTOIN(GETDATA[W]);
  214.       COLUMN[X] := BCDTOIN(GETDATA[W+1])*10+TRUNC(BCDTOIN(GETDATA[W+2])/10);
  215.       {FIELDNBR[X]  := BCDTOIN(GETDATA[W+3]);} { NOT IMPLEMENTED }
  216.     END;
  217. {================================================================}
  218. {          INITIALIZE VARIABLES FOR ENTRY INTO FILER             }
  219. {================================================================}
  220.   DATARECORD := NBRRECUSED;
  221.   CALCULATE;
  222.   ABORTCHAR := FALSE;         { FLAG TO INDICATE ABORT OF SEARCH }
  223.   CHANGEDATE := FALSE;  { FLAG TO INDICATE THAT DATA HAS CHANGED }
  224.   DISKRECNOWINMEM := DISKRECORD -1; { ENSURE DISK READ FIRST TIME}
  225.   FILERECCHGD := FALSE;      { ENSURE NO WRITE BEFORE FIRST READ }
  226.   LASTRECUSED := 0;               { SET LAST RECORD USED TO ZERO }
  227.   LASTTARGET := '';     { ENSURE THERE IS A TARGET TO SEARCH FOR }
  228.   NBRDISKRECUSED := DISKRECORD;     { ESTABLISH MAX DISK REC NBR }
  229.   RECADDEDTOFILE := FALSE; { FLAG TO INDICATE CHANGE IN FILE SIZE}
  230. {================================================================}
  231. {               MASTER MENU                                      }
  232. {================================================================}
  233.  
  234.   REPEAT
  235.     TEXTMODE(C40);
  236.     REGVIDEO;
  237.     CLRSCR;
  238.     GOTOXY(1,10);
  239.     WRITELN ('FILER MASTER MENU');
  240.     WRITELN ('=================');
  241.     WRITELN ('FILE : ',FILENAME);
  242.     WRITELN ('LAST CHANGE : ',FILEDATE);
  243.     WRITELN('ACTIVE RECORDS : ',NBRRECUSED);
  244.     WRITELN('LAST RECORD : ',LASTRECUSED);
  245.     WRITELN;
  246.     WRITELN ('1. ADD/ENTER RECORDS');
  247.     WRITELN ('2. DISPLAY RECORDS');
  248.     WRITELN ('3. CORRECT RECORDS');
  249.     WRITELN ('4. DELETE RECORD');
  250.     WRITELN ('5. END FILER PROGRAM');
  251.     WRITELN;
  252.     WRITE ('ENTER OPTION : ');
  253.     READ(OPTION);
  254.         CASE OPTION OF
  255.           '1'  :   ADDNEWRECORD;
  256.           '2'  :   IF NBRRECUSED > 0 THEN DISPLAYRECORDS;
  257.           '3'  :   IF NBRRECUSED > 0 THEN CORRECTRECORD;
  258.           '4'  :   IF NBRRECUSED > 0 THEN
  259.                      BEGIN
  260.                        IDRECORD;
  261.                        GETDATAREC;
  262.                        DISPLAYREC;
  263.                        DELETEREC;
  264.                      END;
  265.         END;
  266.   UNTIL OPTION IN  ['5','9'];
  267. {================================================================}
  268. {                    END PROGRAM                                 }
  269. {================================================================}
  270.   IF FILERECCHGD = TRUE THEN
  271.     BEGIN                            { WRITE LAST CHANGED RECORD }
  272.       SEEK(SOURCE,DISKRECNOWINMEM);
  273.       BLOCKWRITE(SOURCE,GETDATA,2);
  274.       CHANGEDATE := TRUE;
  275.     END;
  276.  
  277.   IF RECADDEDTOFILE = TRUE THEN
  278.     BEGIN
  279.       SEEK(SOURCE,0);                   { UPDATE BASIC/Z BLOCK 0 }
  280.       BLOCKREAD(SOURCE,GETDATA,1);
  281.       X := (NBRRECUSED+BLOCKINGFACTOR-1) DIV BLOCKINGFACTOR +3;
  282.       GETDATA[3] := CHR(X-((X DIV 256)*256));
  283.       GETDATA[4] := CHR(X DIV 256);
  284.       SEEK(SOURCE,0);
  285.       BLOCKWRITE(SOURCE,GETDATA,1);
  286.     END;
  287.  
  288.   SEEK(SOURCE,1);                   { UPDATE FILER HEADER RECORD }
  289.   BLOCKREAD(SOURCE,GETDATA,1);
  290.   STR(NBRRECUSED:4,ANS);
  291.   MOVE(ANS[1],GETDATA[11],4);
  292.   IF CHANGEDATE = TRUE THEN MOVE(CURRDATE[1],GETDATA[22],8);
  293.   FILEDATE := CURRDATE;
  294.   SEEK(SOURCE,1);
  295.   BLOCKWRITE(SOURCE,GETDATA,1);
  296.   CLOSE(SOURCE);
  297.   TEXTMODE(C80);
  298.   IF OPTION = '9' THEN GOTO FILERSTART;
  299.   GOTOXY(1,22);
  300.   WRITELN;
  301.   WRITELN('THANK YOU FOR USING FILER');
  302.   WRITELN;
  303.   WRITELN('HAVE A GREAT DAY!');
  304.   
  305. {================================================================}