home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / REGISTTP.ZIP / REGCONP.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-05-08  |  21.9 KB  |  730 lines
  1. Procedure Regconp;
  2. {$I-}
  3. CONST  REGISTERName    = 'REGISTER';
  4. Const  REGISTERMSGLN   = 25;
  5.    REGISTERMsgPos  = 1;
  6.     REGISTERFldln : Array[1..34] OF Integer =
  7. (1,1,2,2,3,4,4,5,6,6,7,7,8,8,9,10,11,11,11,12,13,13,13,13,14
  8. ,15,16,17,18,19,20,21,22,23);
  9.        REGISTERFldpos : Array[1..34] OF Integer =
  10. (1,69,10,21,3,21,59,59,21,59,3,59,3,59,3,3,12,46,58,12,12,37,46,65,3
  11. ,3,3,3,3,3,3,3,3,3);
  12.        REGISTERFldlen : Array[1..34] OF Integer =
  13. (10,11,2,57,75,10,20,20,21,20,39,20,39,20,39,76,25,11,21,25,20,2,11,14,75
  14. ,75,75,75,75,75,75,75,75,75);
  15.        REGISTERFldtyp : Array[1..34] OF Char =
  16. ('X','X','X','X','X','X','X','X','X','X','X','X','X','X','X','X','X','X','X','X','X','X','X','X','X'
  17. ,'X','X','X','X','X','X','X','X','X');
  18.        REGISTERFldInts : Array[1..34] OF Char =
  19. (' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' '
  20. ,' ',' ',' ',' ',' ',' ',' ',' ',' ');
  21.        REGISTERFlddecN : Array[1..34] OF BYTE =
  22. (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  23. ,0,0,0,0,0,0,0,0,0);
  24.        REGISTERFldcolr : Array[1..34] OF Char =
  25. ('Y','Y','G','W','W','R','W','W','W','W','W','W','W','W','W','W','W','W','W','W','W','W','W','W','W'
  26. ,'W','W','W','W','W','W','W','W','W');
  27.        REGISTERFldattr : Array[1..34] OF Char =
  28. ('P','P',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' '
  29. ,' ',' ',' ',' ',' ',' ',' ',' ','P');
  30.        REGISTERFldKey  : Array[1..34] OF Char =
  31. (' ',' ','K','K',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' '
  32. ,' ',' ',' ',' ',' ',' ',' ',' ',' ');
  33. {$I REGISTER.TYP}
  34.   REGISTERArray  = Array[1..2792] OF Char;
  35.    Spaces = String[100];
  36. Var
  37.  REGISTERSpaces : Spaces;
  38.  REGISTERCodestr : Codestr;
  39.  REGISTERMaxrec : Integer;
  40.  Scrnptr : ScreenPointer;
  41.  REGISTERTxfile :  Text;
  42.  REGISTERLdfile :  File;
  43.  REGISTERDbfile :  DataFile;
  44.  REGISTERI3        : IndexFile;
  45.  REGISTERI4        : IndexFile;
  46.  REGISTERFilename  : String;
  47.  REGISTERDbrec     : REGISTERData;
  48.  REGISTERDbstr     : Array[1..2792] OF Char ABSOLUTE  REGISTERDbrec;
  49.  REGISTERTmDbrec : REGISTERTmData;
  50.  REGISTERTmDbstr   : Array[1..2792] OF Char ABSOLUTE  REGISTERTmDbrec;
  51.  REGISTERMsgStr    : String[79];
  52. Procedure GetDateTime;
  53. Begin
  54.   GetTime(Hour, Minute, Second, Sec100);
  55.   Str(Hour:2, Tchr);
  56.   Str(Minute:2, Tchr1);
  57.   Tchr := Tchr + ':' + tchr1;
  58.   Str(Second:2,Tchr1);
  59.   Tchr := Tchr + ':' + tchr1;
  60.   Str(Sec100:2, Tchr1);
  61.   Tchr := Tchr + ':' + Tchr1;
  62.   ScreenTime := Tchr;
  63.   GetDate(Year, Month, Day, DayofWeek);
  64.   Str(Year:2, Tchr);
  65.   Str(Month:2, Tchr1);
  66.   If Tchr[1] = ' ' Then Tchr[1] := '0';
  67.   Tchr := Tchr + '/' + Tchr1;
  68.   Str(Day, Tchr1);
  69.   If Tchr1[1] = ' ' Then Tchr[1] := '0';
  70.   Tchr := Tchr + '/' + Tchr1;
  71.   ScreenDate := Tchr;
  72. End;
  73. Procedure REGISTER_Init;
  74. Begin
  75.   HldFldseq   := 1;
  76.   Frstdatafld := 1;
  77.   Lastdatafld := 34;
  78.   Continue    := True;
  79.  
  80.  
  81.   Datalen := 0;
  82.   For Fldseq := 1 TO Lastdatafld DO
  83.   Begin
  84.     Datalen := Datalen + REGISTERFldlen[Fldseq] + 1;
  85.     Mapln[Fldseq]   := REGISTERFldln[Fldseq];
  86.     Mappos[Fldseq]  := REGISTERFldpos[Fldseq];
  87.     Maplen[Fldseq]  := REGISTERFldlen[Fldseq];
  88.     Maptyp[Fldseq]  := REGISTERFldtyp[Fldseq];
  89.     Mapdecn[Fldseq] := REGISTERFlddecN[Fldseq];
  90.     Mapints[Fldseq] := REGISTERFLDINTS[Fldseq];
  91.     Mapcolr[Fldseq] := REGISTERFldcolr[Fldseq];
  92.     Mapattr[Fldseq] := REGISTERFldattr[Fldseq];
  93.     MapKey[Fldseq]  := REGISTERFldKey[Fldseq];
  94.   End;
  95.   Datalen := Datalen + 4;
  96.  
  97.   For Posndx := 1 TO Datalen DO
  98.   Begin
  99.    REGISTERDbstr[Posndx] := ' ';
  100.   End;
  101.   For Ypos := 1 TO 25 DO 
  102.   Begin 
  103.     For Xpos := 1 TO 80 DO 
  104.     Begin
  105.       Scrnln[Ypos, Xpos] := ' ';
  106.     End;
  107.   End;
  108.   TextBackGround(Black);
  109.   TextColor(Blue);
  110.   If ClearScrn Then ClrScr;
  111.  
  112.   For Xpos := 1 To 79 Do ScrnLn[1, Xpos] := ' ';
  113.   REGISTERMsgStr := 
  114. '                              REGISTER   FORM                                   ';
  115.   Lnndx := 1;
  116.   For Posndx := 1 to 79 Do Scrnln[Lnndx, Posndx] := REGISTERMsgStr[Posndx];
  117.   Gotoxy(1,1);
  118.   Write(
  119. '                              REGISTER   FORM                                   ');
  120.   REGISTERMsgStr :=
  121. '  ENTRY:    TITLE:                                                              ';
  122.   Lnndx := 2;
  123.   For Posndx := 1 to 79 Do Scrnln[Lnndx, Posndx] := REGISTERMsgStr[Posndx];
  124.   Gotoxy(1,2);
  125.   Write(
  126. '  ENTRY:    TITLE:                                                              ');
  127.   REGISTERMsgStr := 
  128. '  REGISTRATION FEE:                          REGISTER TO:                       ';
  129.   Lnndx := 4;
  130.   For Posndx := 1 to 79 Do Scrnln[Lnndx, Posndx] := REGISTERMsgStr[Posndx];
  131.   Gotoxy(1,4);
  132.   Write(
  133. '  REGISTRATION FEE:                          REGISTER TO:                       ');
  134.   REGISTERMsgStr :=
  135. '  DESCRIPTION:                                                                  ';
  136.   Lnndx := 6;
  137.   For Posndx := 1 to 79 Do Scrnln[Lnndx, Posndx] := REGISTERMsgStr[Posndx];
  138.   Gotoxy(1,6);
  139.   Write(
  140. '  DESCRIPTION:                                                                  ');
  141.   REGISTERMsgStr :=
  142. '  NAME:                                 SSN:                                    ';
  143.   Lnndx := 11;
  144.   For Posndx := 1 to 79 Do Scrnln[Lnndx, Posndx] := REGISTERMsgStr[Posndx];
  145.   Gotoxy(1,11);
  146.   Write(
  147. '  NAME:                                 SSN:                                    ');
  148.   REGISTERMsgStr := 
  149. '  ADDRESS:                                                                      ';
  150.   Lnndx := 12;
  151.   For Posndx := 1 to 79 Do Scrnln[Lnndx, Posndx] := REGISTERMsgStr[Posndx];
  152.   Gotoxy(1,12);
  153.   Write(
  154. '  ADDRESS:                                                                      ');
  155.   REGISTERMsgStr :=
  156. '  CITY:                         ST:     ZIP:             PHONE:                 ';
  157.   Lnndx := 13;
  158.   For Posndx := 1 to 79 Do Scrnln[Lnndx, Posndx] := REGISTERMsgStr[Posndx];
  159.   Gotoxy(1,13);
  160.   Write(
  161. '  CITY:                         ST:     ZIP:             PHONE:                 ');
  162.   TextColor(Blue);
  163.   REGISTERMsgStr := 
  164. ' Ent-Get  F2-Next  F3-Prev  F4-Find  F5-List  F6-Add  F7-Updt  F8-Del F10-Util  ';
  165.   Lnndx := 24;
  166.   For Posndx := 1 to 79 Do Scrnln[Lnndx, Posndx] := REGISTERMsgStr[Posndx];
  167.   Gotoxy(1,24);
  168.   Write(
  169. ' Ent-Get  F2-Next  F3-Prev  F4-Find  F5-List  F6-Add  F7-Updt  F8-Del F10-Util  ');
  170.   X1 := 1; X2 := 79; Y1 := 1; Y2 := 25;
  171.   TextColor(Red);
  172.   GotoXY(X1, Y1);
  173.   Write(UpLeft);
  174.   for x := succ(X1) to pred(X2) do
  175.     Write(HWall);
  176.   GotoXY(X2, Y1);
  177.   Write(UpRight);
  178.   for Y := succ(Y1) to pred(Y2) do
  179.   begin
  180.     GotoXY(X2, y);
  181.     Write(VWall);
  182.   end;
  183.   GotoXY(X1, Y2);
  184.   Write(LoLeft);
  185.   for x := succ(X1) to pred(X2) do
  186.     Write(HWall);
  187.   Write(LoRight);
  188.   for Y := pred(Y2) downto succ(Y1) do
  189.   begin
  190.     GotoXY(X1, y);
  191.     Write(VWall);
  192.   end;
  193.  
  194.   GotoXY(1,1);
  195.   X2 := 79; X1 := 1;
  196.   While (Scrnln[1,X2] = ' ') and (X2 > 1) Do
  197.     X2 := X2 - 1;
  198.   While (Scrnln[1,X1] = ' ') and (X1 < 80) Do
  199.     X1 := X1 + 1;
  200.   For Xpos := X1 To X2 Do
  201.   Begin
  202.   GoTOXY(Xpos,1);
  203.     Write(Scrnln[1,Xpos]);
  204.   End;
  205. End;
  206. Procedure REGISTER_FmtRecBuf;
  207. Begin
  208.   Posndx  := 5;
  209.  
  210.   For Fldseq := 1 TO Lastdatafld Do
  211.   Begin
  212.     Posndx := Posndx + 1;
  213.     Xpos    := REGISTERFldpos[Fldseq];
  214.     Ypos    := REGISTERFldln[Fldseq];
  215.     For Xpos := Xpos TO Xpos + REGISTERFldlen[Fldseq] - 1 DO
  216.     Begin
  217.       REGISTERDbstr[Posndx] := Scrnln[Ypos,Xpos];
  218.      Posndx := Posndx + 1;
  219.     End;
  220.   End;
  221. End;
  222.  
  223. Procedure REGISTER_FmtScrnBuf;
  224. Begin
  225.  
  226.  REGISTERTmDbrec.datafld1 := REGISTERDbrec.Datafld1;
  227.  REGISTERTmDbrec.datafld2 := REGISTERDbrec.Datafld2;
  228.  REGISTERTmDbrec.datafld3 := REGISTERDbrec.Datafld3;
  229.  REGISTERTmDbrec.datafld4 := REGISTERDbrec.Datafld4;
  230.  REGISTERTmDbrec.datafld5 := REGISTERDbrec.Datafld5;
  231.  REGISTERTmDbrec.datafld6 := REGISTERDbrec.Datafld6;
  232.  REGISTERTmDbrec.datafld7 := REGISTERDbrec.Datafld7;
  233.  REGISTERTmDbrec.datafld8 := REGISTERDbrec.Datafld8;
  234.  REGISTERTmDbrec.datafld9 := REGISTERDbrec.Datafld9;
  235.  REGISTERTmDbrec.datafld10 := REGISTERDbrec.Datafld10;
  236.  REGISTERTmDbrec.datafld11 := REGISTERDbrec.Datafld11;
  237.  REGISTERTmDbrec.datafld12 := REGISTERDbrec.Datafld12;
  238.  REGISTERTmDbrec.datafld13 := REGISTERDbrec.Datafld13;
  239.  REGISTERTmDbrec.datafld14 := REGISTERDbrec.Datafld14;
  240.  REGISTERTmDbrec.datafld15 := REGISTERDbrec.Datafld15;
  241.  REGISTERTmDbrec.datafld16 := REGISTERDbrec.Datafld16;
  242.  REGISTERTmDbrec.datafld17 := REGISTERDbrec.Datafld17;
  243.  REGISTERTmDbrec.datafld18 := REGISTERDbrec.Datafld18;
  244.  REGISTERTmDbrec.datafld19 := REGISTERDbrec.Datafld19;
  245.  REGISTERTmDbrec.datafld20 := REGISTERDbrec.Datafld20;
  246.  REGISTERTmDbrec.datafld21 := REGISTERDbrec.Datafld21;
  247.  REGISTERTmDbrec.datafld22 := REGISTERDbrec.Datafld22;
  248.  REGISTERTmDbrec.datafld23 := REGISTERDbrec.Datafld23;
  249.  REGISTERTmDbrec.datafld24 := REGISTERDbrec.Datafld24;
  250.  REGISTERTmDbrec.datafld25 := REGISTERDbrec.Datafld25;
  251.  REGISTERTmDbrec.datafld26 := REGISTERDbrec.Datafld26;
  252.  REGISTERTmDbrec.datafld27 := REGISTERDbrec.Datafld27;
  253.  REGISTERTmDbrec.datafld28 := REGISTERDbrec.Datafld28;
  254.  REGISTERTmDbrec.datafld29 := REGISTERDbrec.Datafld29;
  255.  REGISTERTmDbrec.datafld30 := REGISTERDbrec.Datafld30;
  256.  REGISTERTmDbrec.datafld31 := REGISTERDbrec.Datafld31;
  257.  REGISTERTmDbrec.datafld32 := REGISTERDbrec.Datafld32;
  258.  REGISTERTmDbrec.datafld33 := REGISTERDbrec.Datafld33;
  259.  REGISTERTmDbrec.datafld34 := REGISTERDbrec.Datafld34;
  260.   Posndx  := 5;
  261.   For Fldseq := 1 TO Lastdatafld DO
  262.   Begin
  263.     Posndx := Posndx + 1;
  264.     Xpos    := REGISTERFldpos[Fldseq];
  265.     Ypos    := REGISTERFldln[Fldseq];
  266.     Case MapColr[Fldseq] Of
  267.       'R' : TextColor(Red);
  268.       'G' : TextColor(Green);
  269.       'B' : TextColor(Blue);
  270.       'Y' : TextColor(Yellow);
  271.       'W' : TextColor(White);
  272.       'C' : TextColor(Cyan);
  273.       Else TextColor(White);
  274.     End;
  275.     For Xpos := Xpos TO Xpos + REGISTERFldlen[Fldseq] - 1 DO
  276.     Begin
  277.       Scrnln[Ypos, XPos] := REGISTERDbStr[Posndx];
  278.       GotoXY(Xpos,Ypos);
  279.       Write(REGISTERDbstr[Posndx]);
  280.      REGISTERTmDbstr[Posndx] := REGISTERDbstr[Posndx];
  281.       Posndx := Posndx + 1
  282.     End;
  283.   End;
  284. End;
  285. Procedure FlushRecord;
  286. Begin
  287.     FlushFile(REGISTERDbFile);
  288.     FlushIndex(REGISTERI3);
  289.     FlushIndex(REGISTERI4);
  290. End;
  291. Procedure Select_Rcd;
  292. Begin
  293.   IF OK Then 
  294.   Begin
  295.     GETREC(REGISTERDbfile,RecordNumber,REGISTERDbrec);
  296.   REGISTERMsgStr := 'Record Found';
  297.   End
  298.   Else
  299.   REGISTERMsgStr := 'Record Not Found';
  300. End;
  301. Procedure Next_Rcd;
  302. Begin
  303.   If OK Then
  304.   Begin
  305.     GetRec(REGISTERDbfile,RecordNumber,REGISTERDbrec);
  306.   REGISTERMsgStr := 'Next Record Found';
  307. End
  308. Else
  309.   REGISTERMsgStr := 'The End of the Database Has Been Reached';
  310. End;
  311. Procedure Prev_Rcd;
  312. Begin
  313.   If OK Then
  314.   Begin
  315.     GetRec(REGISTERDbfile,RecordNumber,REGISTERDbrec);
  316.   REGISTERMsgStr := 'Prev Record Found';
  317.   End
  318.   Else
  319.    REGISTERMsgStr := 'The Begining of the Database Has Been reached';
  320. End;
  321. Procedure Find_Rcd;
  322. Begin
  323.   If OK Then
  324.   Begin
  325.     GetRec(REGISTERDbfile,RecordNumber,REGISTERDbrec);
  326.   REGISTERMsgStr := 'Search Record Found';
  327.   End
  328.   Else
  329.   REGISTERMsgStr := 'Search Record Not Found';
  330. End;
  331. Procedure List_Rcd;
  332. Begin
  333.   For Ypos := 1 To 25 Do
  334.   Begin
  335.     For Xpos := 1 To 79 Do
  336.     Begin
  337.       Tchr[Xpos] := Scrnln[Ypos,Xpos];
  338.     End;
  339.     Tchr[0] := #79;
  340.     Writeln(LST,Tchr);
  341.     If IoResult <> 0 Then
  342.     Begin
  343.      RegisterMsgStr :=
  344.      'Printer Error - Depress Enter to Try Again or Depress ESC To Exit';
  345.      Exit;
  346.     End;
  347.   End;
  348.   If IoResult <> 0 Then
  349.   Begin
  350.    RegisterMsgStr :=
  351.    'Printer Error - Depress Enter to Try Again or Depress ESC To Exit';
  352.     Gotoxy(2,REGISTERMsgln);
  353.     Write(REGISTERMsgStr);
  354.    Keychar := Readkey;
  355.    Exit;
  356.   End;
  357.   Writeln(LST);
  358.   Keychar := ' ';
  359.   Function_Key := ' ';
  360.   Function_ID := ' ';
  361.   Tchr1 := 'R';
  362.   Global_Register_Val := 'Y';
  363. End;
  364. Procedure Insert_Rcd;
  365. Begin
  366.    Addrec(REGISTERDbfile,RecordNumber,REGISTERDbrec);
  367.    Move(REGISTERSpaces,REGISTERCodeStr,Sizeof(REGISTERCodeStr));
  368.    REGISTERCodeStr := REGISTERDbRec.Datafld3;
  369.     Addkey(REGISTERI3,RecordNumber,REGISTERDbrec.Datafld3);
  370.    Move(REGISTERSpaces,REGISTERCodeStr,Sizeof(REGISTERCodeStr));
  371.    REGISTERCodeStr := REGISTERDbRec.Datafld4;
  372.     Addkey(REGISTERI4,RecordNumber,REGISTERDbrec.Datafld4);
  373.   REGISTERMsgStr := 'Record Has Been Added';
  374.   FlushRecord;
  375. End;
  376. Procedure Update_Rcd;
  377. Begin
  378.   If OK Then
  379.   Begin
  380.     GetRec(REGISTERDbfile,RecordNumber,REGISTERDbrec);
  381.    REGISTER_FmtRecBuf;
  382.     Putrec(REGISTERDbfile,RecordNumber,REGISTERDbrec);
  383.   If REGISTERTmDbRec.Datafld3 <> REGISTERDbrec.DataFld3 Then
  384.   Begin
  385.     Move(REGISTERSpaces,REGISTERCodeStr,Sizeof(REGISTERCodeStr));
  386.    REGISTERCodeStr := REGISTERTmDbRec.Datafld3;
  387.     DeleteKey(REGISTERI3,RecordNumber,REGISTERTmDbrec.datafld3);
  388.     Move(REGISTERSpaces,REGISTERCodeStr,Sizeof(REGISTERCodeStr));
  389.    REGISTERCodeStr := REGISTERDbRec.Datafld3;
  390.     AddKey(REGISTERI3,RecordNumber,REGISTERDbrec.datafld3);
  391.   End;
  392.   If REGISTERTmDbRec.Datafld4 <> REGISTERDbrec.DataFld4 Then
  393.   Begin
  394.     Move(REGISTERSpaces,REGISTERCodeStr,Sizeof(REGISTERCodeStr));
  395.    REGISTERCodeStr := REGISTERTmDbRec.Datafld4;
  396.     DeleteKey(REGISTERI4,RecordNumber,REGISTERTmDbrec.datafld4);
  397.     Move(REGISTERSpaces,REGISTERCodeStr,Sizeof(REGISTERCodeStr));
  398.    REGISTERCodeStr := REGISTERDbRec.Datafld4;
  399.     AddKey(REGISTERI4,RecordNumber,REGISTERDbrec.datafld4);
  400.   End;
  401.   REGISTERMsgStr := 'Record Has Been Updated';
  402.   End
  403.   Else
  404.   REGISTERMsgStr := 'Update Record Not Found';
  405.   FlushRecord;
  406. End;
  407. Procedure Delete_Rcd;
  408. Begin
  409.   If OK Then
  410.   Begin
  411.     Move(REGISTERSpaces,REGISTERCodeStr,Sizeof(REGISTERCodeStr));
  412.    REGISTERCodeStr :=REGISTERDbrec.Datafld3;
  413.     DeleteKey(REGISTERI3,RecordNumber,REGISTERDbrec.Datafld3);
  414.     Move(REGISTERSpaces,REGISTERCodeStr,Sizeof(REGISTERCodeStr));
  415.    REGISTERCodeStr :=REGISTERDbrec.Datafld4;
  416.     DeleteKey(REGISTERI4,RecordNumber,REGISTERDbrec.Datafld4);
  417.     DeleteRec(REGISTERDbfile,RecordNumber);
  418.   REGISTERMsgStr := 'Record Has Been Deleted';
  419.     For Xpos := 1 to Datalen Do
  420.     Begin
  421.     REGISTERDbStr[Xpos] := ' ';
  422.     End;
  423.   End
  424.   Else
  425.   REGISTERMsgStr := 'Delete Record Not Found';
  426.   FlushRecord;
  427. End;
  428. Procedure Rebuild_Index;
  429. Begin
  430.   Dups := False;
  431.   Case Fldseq Of
  432.    3 : Begin
  433.         Size := Sizeof(REGISTERDbRec.Datafld3) - 1;
  434.         REGISTERFilename := 'REGISTER.I3';
  435.         MakeIndex(REGISTERI3,REGISTERFilename,Size,Duplicates);
  436.         For RecordNumber := 1 To Filelen(REGISTERDbfile) - 1 Do
  437.         Begin
  438.           GetRec(REGISTERDbfile,RecordNumber,REGISTERDbrec);
  439.          REGISTERCodeStr := REGISTERDbrec.Datafld3;
  440.           AddKey(REGISTERI3,RecordNumber,REGISTERDbRec.Datafld3);
  441.         End;
  442.       End;
  443.    4 : Begin
  444.         Size := Sizeof(REGISTERDbRec.Datafld4) - 1;
  445.         REGISTERFilename := 'REGISTER.I4';
  446.         MakeIndex(REGISTERI4,REGISTERFilename,Size,Duplicates);
  447.         For RecordNumber := 1 To Filelen(REGISTERDbfile) - 1 Do
  448.         Begin
  449.           GetRec(REGISTERDbfile,RecordNumber,REGISTERDbrec);
  450.          REGISTERCodeStr := REGISTERDbrec.Datafld4;
  451.           AddKey(REGISTERI4,RecordNumber,REGISTERDbRec.Datafld4);
  452.         End;
  453.       End;
  454.       Else REGISTERMsgStr := 'Cursor not on Index Field';
  455.   End;
  456.   FlushRecord;
  457. End;
  458. Procedure Open_DataBase;
  459. Begin
  460.   REGISTERFilename := 'REGISTER.DAT';
  461.   Size := Sizeof(REGISTERDbrec);
  462.   Openfile(REGISTERDbfile,REGISTERFilename,Size);
  463.   If Not OK Then
  464.   Begin
  465.     Makefile(REGISTERDbfile,REGISTERFileName,Size);
  466.   End;
  467.   If Not OK Then
  468.   REGISTERMsgStr := 'Database Could Not Be opened/Created';
  469. End;
  470. Procedure Open_Index;
  471. Begin
  472.   Size := Sizeof(REGISTERDbrec.Datafld3) - 1;
  473.  REGISTERFilename := 'REGISTER.I3';
  474.  OpenIndex(REGISTERI3,REGISTERFileName,Size,Duplicates);
  475.  If Not OK Then
  476.  Begin
  477.    Size := Sizeof(REGISTERDbrec.Datafld3) - 1;
  478.    MakeIndex(REGISTERI3,REGISTERFileName,Size,Duplicates);
  479.  End;
  480.  If Not OK Then
  481.    REGISTERMsgStr := 'Index Could Not Be opened/Created';
  482.   Size := Sizeof(REGISTERDbrec.Datafld4) - 1;
  483.  REGISTERFilename := 'REGISTER.I4';
  484.  OpenIndex(REGISTERI4,REGISTERFileName,Size,Duplicates);
  485.  If Not OK Then
  486.  Begin
  487.    Size := Sizeof(REGISTERDbrec.Datafld4) - 1;
  488.    MakeIndex(REGISTERI4,REGISTERFileName,Size,Duplicates);
  489.  End;
  490.  If Not OK Then
  491.    REGISTERMsgStr := 'Index Could Not Be opened/Created';
  492. End;
  493. Procedure Close_Index;
  494. Begin
  495.     CloseIndex(REGISTERI3);
  496.     CloseIndex(REGISTERI4);
  497. End;
  498. Procedure Close_File;
  499. Begin
  500.   CloseFile(REGISTERDbfile);
  501. End;
  502. Procedure Load_Data;
  503. Var Count, Result : word;
  504. Begin
  505.   Close_Index;
  506.   Closefile(REGISTERDbfile);
  507.   Size   := Sizeof(REGISTERDbrec);
  508.   Openfile(REGISTERDbfile,'REGISTER.dat',Size);
  509.   Assign(REGISTERLdFile,'REGISTER.Lod');
  510.   Size   := Sizeof(REGISTERDbRec);
  511.   Reset(REGISTERLdFile,Size);
  512.   Size   := Sizeof(REGISTERDbRec);
  513.   Count  := 1;
  514.   Result := 1;
  515.   While Count = Result Do
  516.   Begin
  517.     BlockRead(REGISTERLdFile,REGISTERDbRec,Count,Result);
  518.     AddRec(REGISTERDbFile,RecordNumber,REGISTERDbRec);
  519.     If Not Ok Then
  520.     Begin
  521.       REGISTERMsgStr := 'Error Loading File';
  522.       Exit;
  523.     End;
  524.     If Count <> Result Then Exit;
  525.   End;
  526.   Close(REGISTERLdFile);
  527.   Open_Index;
  528.   For Fldseq := 1 to LastDataFld Do
  529.   Begin
  530.     ReBuild_index;
  531.   End;
  532. End;
  533. Procedure Dump_Data;
  534. Var Count, Result : word;
  535. Begin
  536.   Count := 1;
  537.   Close_Index;
  538.   Assign(REGISTERLdFile,'REGISTER.Lod');
  539.   Size := Sizeof(REGISTERDbRec);
  540.   ReWrite(REGISTERLdFile,Size);
  541.   Size := Sizeof(REGISTERDbRec);
  542.   For RecordNumber := 1 To Filelen(REGISTERDbFile) - 1 Do
  543.   Begin
  544.     GetRec(REGISTERDbFile,RecordNumber,REGISTERDbRec);
  545.     If Not Ok Then
  546.     Begin
  547.       REGISTERMsgStr := 'Error Dumping File';
  548.       Exit;
  549.     End;
  550.     BlockWrite(REGISTERLdFile,REGISTERDbRec,Count,Result);
  551.   End;
  552.   Close(REGISTERLdFile);
  553.   Open_Index;
  554. End;
  555. Procedure Build_Index;
  556. Begin
  557.   Size := Maxkeylen;
  558. End;
  559. Procedure Utility;
  560. Begin;
  561.   REGISTERMsgStr := ' F1-Rebuild Index F2-Load Data  F3-Dump Data';
  562.   GotoXy(1,24);
  563.   Write(REGISTERMsgStr);
  564.   REGISTERMsgStr := 'Enter option and depress Enter key';
  565.   Gotoxy(1,25);
  566.   Write(REGISTERMsgStr);
  567.   Enterdata;
  568.   Case Function_Key Of
  569.     #59  : Rebuild_Index;
  570.     #60  : Load_Data;
  571.     #61  : Dump_Data;
  572.   Else
  573.     REGISTERMsgStr := ' Invalid Option';
  574.   End;
  575.   GotoXY(1,24);
  576.   For Xpos := 1 to 79 Do
  577.     Write(Scrnln[24,Xpos]);
  578. End;
  579. Procedure FunctionIO;
  580. Begin
  581.  
  582.   Case Function_Key OF 
  583.     #13      : Function_Id := 'S';
  584.     #60, #81 : Function_Id := 'N';
  585.     #61, #73 : Function_Id := 'P';
  586.     #62 : Function_Id := 'F';
  587.     #63 : Function_Id := 'L';
  588.     #64 : Function_Id := 'A';
  589.     #65 : Function_Id := 'U';
  590.     #66 : Function_Id := 'D';
  591.     #68 :                Begin
  592.                            Utility;
  593.                            Exit;
  594.                          End;
  595.   End;
  596.  
  597.   Case HldFldseq Of
  598.   3  : Begin
  599.            REGISTERCodeStr := REGISTERDbrec.Datafld3;
  600.             Case Function_Id Of
  601.            'S','A','U','D' : FindKey(REGISTERI3,RecordNumber,REGISTERCodestr);
  602.            'N' : NextKey(REGISTERI3,RecordNumber,REGISTERCodestr);
  603.            'P' : PrevKey(REGISTERI3,RecordNumber,REGISTERCodestr);
  604.            'F' : SearchKey(REGISTERI3,RecordNumber,REGISTERCodestr);
  605.           End;
  606.         End;
  607.   4  : Begin
  608.            REGISTERCodeStr := REGISTERDbrec.Datafld4;
  609.             Case Function_Id Of
  610.            'S','A','U','D' : FindKey(REGISTERI4,RecordNumber,REGISTERCodestr);
  611.            'N' : NextKey(REGISTERI4,RecordNumber,REGISTERCodestr);
  612.            'P' : PrevKey(REGISTERI4,RecordNumber,REGISTERCodestr);
  613.            'F' : SearchKey(REGISTERI4,RecordNumber,REGISTERCodestr);
  614.           End;
  615.         End;
  616.   Else
  617.     REGISTERCodeStr := REGISTERDbrec.Datafld3;
  618.       Case Function_Id Of
  619.       'S','A','U','D' : FindKey(REGISTERI3,RecordNumber,REGISTERCodestr);
  620.      'N' : NextKey(REGISTERI3,RecordNumber,REGISTERCodestr);
  621.      'P' : PrevKey(REGISTERI3,RecordNumber,REGISTERCodestr);
  622.      'F' : FindKey(REGISTERI3,RecordNumber,REGISTERCodestr);
  623.       End;
  624.   End;
  625.  
  626.   Case Function_Id Of
  627.     'S' : Select_Rcd;
  628.     'N' : Next_Rcd;
  629.     'P' : Prev_Rcd;
  630.     'F' : Find_Rcd;
  631.  
  632.     'L' : Begin
  633.             List_Rcd;
  634.             While (Ioresult <> 0) And (KeyChar <> #27) Do
  635.               List_Rcd;
  636.           End;
  637.     'A' : Insert_Rcd;
  638.     'U' : Update_Rcd;
  639.     'D' : Delete_Rcd;
  640.     'R' : Rebuild_Index;
  641.   End;
  642. End;
  643. Begin
  644.  
  645.   ClearScrn := True;
  646.   Dups := False;
  647.  
  648.   Size := Sizeof(REGISTERDbrec);
  649.   Open_DataBase;
  650.  
  651.   Size := Sizeof(REGISTERCodestr) - 1;
  652.   Open_Index;
  653.  
  654.   RecordNumber := 1;
  655.  
  656.   REGISTER_Init;
  657.  
  658. {  Init_File; }
  659.  
  660.   REGISTERMsgStr := '                                                                               ';
  661.  
  662.   RecordNumber := 1;
  663.  
  664.   RegisterCodeStr := '01';
  665.   RegisterCodeStr[0] := #2;
  666.   FindKey(REGISTERI3,RecordNumber,REGISTERCodestr);
  667.  If Ok Then
  668.     GetRec(RegisterDbFile,RecordNumber,RegisterDbRec);
  669.  
  670.   Register_FmtScrnBUF;
  671.  
  672.  
  673.   While Continue Do
  674.   Begin
  675.     REGISTERDbRec.DataFld34 :=
  676. 'Depress F5 to Print when Filled out - ESC To Exit - F2 For Other titles';
  677.  
  678.     GetDateTime;
  679.     REGISTERDbRec.Datafld1 := ScreenDate;
  680.     REGISTERDbRec.Datafld2 := ScreenTime;
  681.  
  682.     REGISTER_FmtScrnBuf;
  683.  
  684.     EnterData;
  685.  
  686.   REGISTER_FmtRecBuf;
  687.  
  688.   REGISTERMsgStr := '                                                                               ';
  689.     Gotoxy(1,REGISTERMsgln);
  690.     Write('                                                                               ');
  691.  
  692.     { USER CODE }
  693.  
  694.     FunctionIo;
  695.  
  696.     If Tchr1 = 'R' Then
  697.     Begin
  698.       RegisterCodeStr := '01';
  699.       RegisterCodeStr[0] := #2;
  700.       FindKey(REGISTERI3,RecordNumber,REGISTERCodestr);
  701.       RegisterTmDbRec.Datafld3 := 'RR';
  702.       RegisterDbRec.Datafld3 := 'RR';
  703.       Register_FmtScrnBuf;
  704.       If Ok Then
  705.       Begin
  706.         Update_rcd;
  707.         ClrScr;
  708.         Exit;
  709.      End;
  710.    End;
  711.     TextColor(Red);
  712.  
  713.     Gotoxy(1,REGISTERMsgln);
  714.  
  715.     Write(REGISTERMsgStr);
  716.  
  717.     GotoXY(Mappos[Fldseq],Mapln[Fldseq]);
  718.  
  719.     If Function_Key <> #27 Then Continue := True; 
  720.   End;
  721.  
  722.   TextColor(White);
  723.   Clrscr;
  724.   FlushRecord;
  725.   Close_Index;
  726.   Close_File;
  727.   RestoreCRTMode;
  728. End;
  729.  
  730.