home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 7 / 07.iso / c / c017 / 14.ddi / PDEMD.ZIP / VIDLIB.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-03-28  |  25.8 KB  |  1,040 lines
  1. {$N+,F+}
  2.  
  3. PROGRAM VIDLIb;
  4.  
  5. USES
  6.     Crt,Pxengine,Vidutil,Vlib;
  7.  
  8. TYPE
  9.     FExecute = Function:Integer;
  10.     PROCESS= Record
  11.         Item : String[2];
  12.         Message : String;
  13.         FPtr: FExecute;
  14.     End;
  15.  
  16.  
  17. CONST
  18.     NumKeys : Integer = 0;
  19.     FieldNum : Integer = 0;
  20.     GotSrchKFirst : Boolean = FALSE;
  21.     GotSrchFFirst : Boolean = FALSE;
  22. VAR
  23.     SearchRecord : VLIBTABLEENTRY;
  24.     Choice : String;
  25.     Key : Char;
  26.  
  27.  
  28.  
  29. FUNCTION VLIBError1(ErrCode : Integer) : Integer;
  30.  
  31. Var
  32.     Key : Char;
  33.     ClrString : String;
  34. BEGIN
  35.     Fillchar(ClrString,sizeof(ClrString),' ');
  36.     ClrString[0] := #70;
  37.     if (ErrCode > 0) then    
  38.         Begin
  39.             GoToRc(24,6);
  40.             Write('[Err:',ErrCode,'] ',PXErrMsg(ErrCode),' (Hit any Key)');
  41.             VLIBError1 := ErrCode;
  42.             Key := ReadKey;
  43.             PrintText(24,6,ClrString);
  44.         End
  45.     else
  46.         VLIBError1 := PXSUCCESS;
  47. END;
  48.  
  49. PROCEDURE DisplayFields;
  50.  
  51. Begin
  52.     PrintText(4,3, '1-Title...:');
  53.     PrintText(4,62,'2-Rating..:');
  54.     PrintText(5,3, '3-Star(s).:');
  55.     PrintText(6,3, '4-Cast....:');
  56.     PrintText(6,48,'5-Director:');
  57.     PrintText(7,3, '6-Company.:');
  58.     PrintText(7,33,'7-Category:');
  59.     PrintText(7,59,'8-Date.:');
  60.     PrintText(9,3, '9-Price:$');
  61.     PrintText(9,23,'10-Tape #:');
  62.     PrintText(9,40,'11-Run Time:');
  63.     PrintText(9,60,'12-Format:');
  64.     PrintText(10,3,'13-Start:');
  65.     PrintText(10,23,'14-Stop.:');
  66.     PrintText(10,40,'15-Rec Speed:');
  67.  
  68.     PrintText(13,5, 'AR-Add Record');
  69.     PrintText(14,5, 'CT-Close Table');
  70.     PrintText(15,5, 'DT-Decrypt Table');
  71.     PrintText(16,5, 'DR-Delete Record');
  72.     PrintText(17,5, 'ET-Delete Table');
  73.     PrintText(18,5, 'ER-Edit Record');
  74.  
  75.     PrintText(13,23,'FR-First Record');
  76.     PrintText(14,23,'GR-Goto Record');
  77.     PrintText(15,23,'KF-Srch Key 1st');
  78.     PrintText(16,23,'KN-Srch Key Next');
  79.     PrintText(17,23,'LR-Last Record');
  80.     PrintText(18,23,'MT-Merge Table');
  81.  
  82.     PrintText(13,41,'NT-Encrypt Table');
  83.     PrintText(14,41,'NR-Next Record');
  84.     PrintText(15,41,'OT-Open Table');
  85.     PrintText(16,41,'PF-Copy Table');
  86.     PrintText(17,41,'PR-Prev Record');
  87.     PrintText(18,41,'QU-Quit');
  88.  
  89.     PrintText(13,59,'RT-Rename Table');
  90.     PrintText(14,59,'SF-Srch Field 1st');
  91.     PrintText(15,59,'SN-Srch Field Next');
  92.     PrintText(16,59,'TT-Create Table');
  93.     PrintText(17,59,'YT-Empty Table');
  94.  
  95.     PrintText(18,58, '[Choice:      ]');
  96.  
  97.     PrintText(21,2,'File: None');
  98.     PrintText(21,20,'Records: 0');
  99.     PrintText(21,35,'Fields: 0');
  100.     PrintText(21,49,'Key Fields: 0');
  101.     PrintText(21,66,'Rec No: 0');
  102.  
  103. End;
  104.  
  105. FUNCTION OpeningScreen: Boolean;
  106.  
  107. Begin
  108.  
  109.     OpeningScreen := TRUE;
  110.     ClearArea(1,1,25,80);
  111.  
  112.     CenterText(1,1,80,'PARAGen-Video Library Demo..[Pascal Ver 1.4]');
  113.     CenterText(2,1,80,'(C) 90,91 Innovative Data Solutions, Inc.');
  114.     DrawBox(3,1,13,80,'╡Video Data╞');
  115.     DrawBox(12,4,8,74,'╡Options╞');
  116.     DrawBox(20,1,3,80,'╡Paradox Information');
  117.     DrawBox(22,4,4,74,'╡Error and Input Information╞');
  118.     DisplayFields;
  119.     VLIBRet := PXinit;
  120.     if (VLIBRet <> PXSUCCESS) then
  121.         Begin
  122.           VlibRet := VLIBError1(VlibRet);
  123.             OPeningScreen := FALSE;
  124.         End;
  125. End;
  126.  
  127. Procedure ClearRecord;
  128.  
  129. Type
  130.     IType = Array[0..14] of Byte;
  131.  
  132. Const
  133.     CRow:IType = (4,4,5,6,6,7,7,7,9,9,9,9,10,10,10);
  134.     CCol:IType = (15,74,15,15,60,15,45,68,15,32,53,70,14,33,53);
  135.     Len:IType = (40,5,55,30,15,15,10,10,7,5,7,8,7,7,10);
  136.     Number:Byte = 14;
  137. Var
  138.     Index : Byte;
  139.     Spaces,TempString : String;
  140.  
  141. Begin
  142.     FillChar(Spaces,sizeof(Spaces),' ');
  143.     FillChar(TempString,sizeof(TempString),#0);
  144.     Spaces[0] := #80;
  145.     TempString[0] := #0;
  146.     For Index := 0 to Number do
  147.         Begin
  148.             TempString := Copy(Spaces,1,Len[Index]);
  149.             PrintText(CRow[Index],CCol[Index],TempString);
  150.         End;
  151. End;
  152.  
  153.  
  154. Procedure DisplayRecord(RecordEntry:VLIBTABLEENTRY);
  155.  
  156. Type
  157.     IType = Array[0..14] of Byte;
  158.  
  159. Const    
  160.     DRow:IType = (4,4,5,6,6,7,7,7,9,9,9,9,10,10,10);
  161.     DCol:IType = (15,74,15,15,60,15,45,68,15,32,53,70,14,33,53);
  162.  
  163. Begin
  164.  
  165.     ClearRecord;
  166.     PrintText(DRow[0],DCol[0],RecordEntry.Title);
  167.     PrintText(DRow[1],DCol[1],RecordEntry.Rating);
  168.     PrintText(DRow[2],DCol[2],RecordEntry.Stars);
  169.     PrintText(DRow[3],DCol[3],RecordEntry.Cast);
  170.     PrintText(DRow[4],DCol[4],RecordEntry.Director);
  171.     PrintText(DRow[5],DCol[5],RecordEntry.Company);
  172.     PrintText(DRow[6],DCol[6],RecordEntry.Category);
  173.     GoToRC(DRow[7],DCol[7]);
  174.     Write(RecordEntry.DateMonth:2,'/',RecordEntry.DateDay:2,'/',(RecordEntry.DateYear):2);
  175.     GoToRC(DRow[8],DCol[8]);
  176.     Write(RecordEntry.Price:3:2);
  177.     GoToRC(DRow[9],DCol[9]);
  178.     Write(RecordEntry.Tape);
  179.     GoToRC(DRow[10],DCol[10]);
  180.     Write(RecordEntry.RunTime:2:2);
  181.     PrintText(DRow[11],DCol[11],RecordEntry.Format);
  182.     GoToRC(DRow[12],DCol[12]);
  183.     Write(RecordEntry.Start);
  184.     GoToRC(DRow[13],DCol[13]);
  185.     Write(RecordEntry.Stop);
  186.     GoToRC(DRow[14],DCol[14]);
  187.     Write(RecordEntry.RunSpeed);
  188.  
  189. End;
  190.  
  191.  
  192. Procedure UpdateParadoxInfo(UseInfo:Boolean);
  193. Type
  194.     IType = Array[0..4] of Byte;
  195. Const
  196.     PRow:Byte = 21;
  197.     PCol:IType = (8,29,43,61,74);
  198. Var
  199.     NumRecs,CurrRec : RecordNumber;
  200.     NumFields,NKeys : Integer;
  201.     TableName : String;
  202.  
  203. Begin
  204.     NumRecs := 0;
  205.     CurrRec := 0;
  206.     NumFields := 0;
  207.     NKeys := 0;
  208.     TableName := 'None';
  209.     if (UseInfo) then
  210.         Begin
  211.             TableName := VLIBName+'.DB';
  212.             VLIBRet := VLIBTblNRecs(NumRecs);
  213.             VLIBRet := VLIBRecNFlds(NumFields);
  214.             VLIBRet := VLIBKeyNFlds(NKeys);
  215.             VLIBRet := VLIBRecNum(CurrRec);
  216.         End;
  217.     PrintText(PRow,PCol[0],'            ');
  218.     PrintText(PRow,PCol[1],'    ');
  219.     PrintText(PRow,PCol[2],'    ');
  220.     PrintText(PRow,PCol[3],'    ');
  221.     PrintText(PRow,PCol[4],'    ');
  222.  
  223.     PrintText(PRow,PCol[0],TableName);
  224.     GoToRC(PRow,PCol[1]);
  225.     Write(NumRecs);
  226.     GoToRC(PRow,PCol[2]);
  227.     Write(NumFields);
  228.     GoToRC(PRow,PCol[3]);
  229.     Write(NKeys);
  230.     GoToRC(PRow,PCol[4]);
  231.     Write(CurrRec);
  232.  
  233. End;
  234.  
  235. Function EditRec(var RecordEntry:VLIBTABLEENTRY; EditOnly:Boolean):Boolean;
  236. Type
  237.     IType = Array[0..14] of Byte;
  238. Const
  239.     ERow:IType = (4,4,5,6,6,7,7,7,9,9,9,9,10,10,10);
  240.     ECol:IType = (15,74,15,15,60,15,45,68,15,32,53,70,14,33,53);
  241.     ELen:IType = (40,5,55,30,15,15,10,10,7,5,7,8,7,7,10);
  242. Var
  243.     Choice : String;
  244.     Code   : Integer;
  245.  
  246. Begin
  247.     FillChar(RecordEntry,sizeof(RecordEntry),#0);
  248.     if (EditOnly) then
  249.         Begin
  250.             if (VLIBRecGet(RecordEntry) <> PXSUCCESS) then
  251.                 Begin
  252.                     EditRec := FALSE;
  253.                     Exit;        
  254.                 End;
  255.         End
  256.     else
  257.         ClearRecord;
  258.     RecordEntry.Title := GetString(ERow[0],ECol[0],ELen[0],RecordEntry.Title,FALSE);
  259.     RecordEntry.Rating := GetString(ERow[1],ECol[1],ELen[1],RecordEntry.Rating,FALSE);
  260.     RecordEntry.Stars := GetString(ERow[2],ECol[2],ELen[2],RecordEntry.Stars,FALSE);
  261.     RecordEntry.Cast := GetString(ERow[3],ECol[3],ELen[3],RecordEntry.Cast,FALSE);
  262.     RecordEntry.Director := GetString(ERow[4],ECol[4],ELen[4],RecordEntry.Director,FALSE);
  263.     RecordEntry.Company := GetString(ERow[5],ECol[5],ELen[5],RecordEntry.Company,FALSE);
  264.     RecordEntry.Category := GetString(ERow[6],ECol[6],ELen[6],RecordEntry.Category,FALSE);
  265.     if (not EditOnly) then
  266.         PrintText(ERow[7],ECol[7],'  /  /');
  267.  
  268.     if (EditOnly) then
  269.         Begin
  270.             Str(RecordEntry.DateMonth,Choice);
  271.             Choice := GetString(ERow[7],ECol[7],2,Choice,FALSE);
  272.             Val(Choice,RecordEntry.DateMonth,Code);
  273.             Str(RecordEntry.DateDay,Choice);
  274.             Choice := GetString(ERow[7],ECol[7]+3,2,Choice,FALSE);
  275.             Val(Choice,RecordEntry.DateDay,Code);
  276.             Str(RecordEntry.DateYear,Choice);
  277.             Choice := GetString(ERow[7],ECol[7]+6,4,Choice,FALSE);
  278.             Val(Choice,RecordEntry.DateYear,Code);
  279.  
  280.             Str(RecordEntry.Price:3:2,Choice);
  281.             Choice := GetString(ERow[8],ECol[8],ELen[8],Choice,FALSE);
  282.             Val(Choice,RecordEntry.Price,Code);
  283.  
  284.             Str(RecordEntry.Tape,Choice);
  285.             Choice := GetString(ERow[9],ECol[9],ELen[9],Choice,FALSE);
  286.             Val(Choice,RecordEntry.Tape,Code);
  287.  
  288.             Str(RecordEntry.RunTime:3:2,Choice);
  289.             Choice := GetString(ERow[10],ECol[10],ELen[10],Choice,FALSE);
  290.             Val(Choice,RecordEntry.RunTime,Code);
  291.         End
  292.     else
  293.         Begin
  294.             Choice := GetString(ERow[7],ECol[7],2,Choice,FALSE);
  295.             Val(Choice,RecordEntry.DateMonth,Code);
  296.             Choice := GetString(ERow[7],ECol[7]+3,2,Choice,FALSE);
  297.             Val(Choice,RecordEntry.DateDay,Code);
  298.             Choice := GetString(ERow[7],ECol[7]+6,2,Choice,FALSE);
  299.             Val(Choice,RecordEntry.DateYear,Code);
  300.             Choice := GetString(ERow[8],ECol[8],ELen[8],Choice,FALSE);
  301.             Val(Choice,RecordEntry.Price,Code);
  302.             Choice := GetString(ERow[9],ECol[9],ELen[9],Choice,FALSE);
  303.             Val(Choice,RecordEntry.Tape,Code);
  304.             Choice := GetString(ERow[10],ECol[10],ELen[10],Choice,FALSE);
  305.             Val(Choice,RecordEntry.RunTime,Code);
  306.         End;
  307.     RecordEntry.Format := GetString(ERow[11],ECol[11],ELen[11],RecordEntry.Format,FALSE);
  308.     if (EditOnly) then
  309.         Begin
  310.               Str(RecordEntry.Start,Choice);
  311.             Choice := GetString(ERow[12],ECol[12],ELen[12],Choice,FALSE);
  312.             Val(Choice,RecordEntry.Start,Code);
  313.             Str(RecordEntry.Stop,Choice);
  314.             Choice := GetString(ERow[13],ECol[13],ELen[13],Choice,FALSE);
  315.             Val(Choice,RecordEntry.Stop,Code);
  316.         End
  317.     else 
  318.         Begin
  319.             Choice := GetString(ERow[12],ECol[12],ELen[12],Choice,FALSE);
  320.             Val(Choice,RecordEntry.Start,Code);
  321.             Choice := GetString(ERow[13],ECol[13],ELen[13],Choice,FALSE);
  322.             Val(Choice,RecordEntry.Stop,COde);
  323.         End;
  324.     RecordEntry.RunSpeed := GetString(ERow[14],ECol[14],ELen[14],RecordEntry.RunSpeed,FALSE);
  325.     EditRec := TRUE;
  326.  
  327. End;
  328.  
  329.  
  330. FUNCTION SrchRec(var RecordEntry:VLIBTABLEENTRY;KeyOrFld:Boolean):Boolean;
  331.  
  332. Type
  333.     IType = Array[0..14] of Byte;
  334.     SType = Array[0..14] of String;
  335.  
  336. Const
  337.     SRow:IType = (4,4,5,6,6,7,7,7,9,9,9,9,10,10,10);
  338.     SCol:IType = (15,74,15,15,60,15,45,68,15,32,53,70,14,33,53);
  339.     SLen:IType = (40,5,55,30,15,15,10,10,7,5,7,8,7,7,10);
  340.     FieldArray:Stype = (
  341.                                 'Title',
  342.                                 'Rating',
  343.                                 'Stars',
  344.                                 'Cast',
  345.                                 'Director',
  346.                                 'Company',
  347.                                 'Category',
  348.                                 'Date',
  349.                                 'Price',
  350.                                 'Tape',
  351.                                 'RunTime',
  352.                                 'Format',
  353.                                 'Start',
  354.                                 'Stop',
  355.                                 'RunSpeed'
  356.                                 );
  357. Var
  358.     Field,NumFields,NKeys,Mode,Code:Integer;
  359.     Choice,ClrString : String;
  360.     Ret : Boolean;
  361.     
  362. Begin
  363.     Mode := SEARCHFIRST;
  364.     Ret := TRUE;
  365.     Fillchar(ClrString,sizeof(ClrString),' ');
  366.     ClrString[0] := #70;
  367.     ClearRecord;
  368.     if (VLIBRecNFlds(NumFields) <> PXSUCCESS) then
  369.         Begin
  370.             SrchRec := FALSE;
  371.         End;
  372.     if (VLIBKeyNFlds(NKeys) <> PXSUCCESS) then
  373.         Begin
  374.             SrchRec := FALSE;
  375.         End;
  376.     if (KeyOrFld) then
  377.         Begin
  378.             PrintText(24,6,'Number of keys to search on (1 or ');
  379.             GoToRC(24,40);
  380.             Write(NKeys,'):');
  381.             Choice := GetString(24,44,1,Choice,TRUE);
  382.             ClearMessageArea;
  383.             Val(Choice,Field,Code);
  384.             if ((Field < 1) or (Field > NKeys)) then
  385.                 Begin
  386.                     PrintText(24,6,'Invalid number of keys - Hit any Key');
  387.                     Key := ReadKey;
  388.                     PrintText(24,6,ClrString);
  389.                     SrchRec := FALSE;
  390.                     Exit;
  391.                 End;
  392.             NumKeys := Field;
  393.             case Field of 
  394.                 2:
  395.                     RecordEntry.Title := GetString(SRow[0],SCol[0],SLen[0],RecordEntry.Title,FALSE);
  396.             End;
  397.             RecordEntry.Category := GetString(SRow[6],SCol[6],SLen[6],RecordEntry.Category,FALSE);
  398.         End
  399.     else
  400.         Begin
  401.             if (not GotSrchFFirst) then
  402.                 Begin
  403.                     PrintText(24,6,'Field to search on (1 - ');
  404.                     GoToRC(24,30);
  405.                     Write(NumFields,'):');
  406.                     Choice := GetString(24,34,2,Choice,TRUE);
  407.                     ClearMessageArea;
  408.                     Val(Choice,Field,Code);
  409.                     if ((Field < 1) or (Field > NumFields)) then
  410.                         Begin
  411.                             GoToRC(24,6);
  412.                             Write(Field);
  413.                             PrintText(24,9,' is an invalid Field Number  - Hit any Key');
  414.                             Key := ReadKey;
  415.                             PrintText(24,6,ClrString);
  416.                             SrchRec := FALSE;
  417.                             Exit;
  418.                         End;
  419.                     FieldNum:=Field;
  420.                 End
  421.             else 
  422.                 Begin
  423.                     Mode := SEARCHNEXT;
  424.                     Field := FieldNum;
  425.                 End;
  426.             {start main switch loop }
  427.             case Field of
  428.                 1: Begin
  429.                         if (not GotSrchFFirst) then
  430.                             RecordEntry.Title := GetString(SRow[0],SCol[0],SLen[0],RecordEntry.Title,FALSE);
  431.                     End;
  432.                 2: Begin
  433.                         if (not GotSrchFFirst) then
  434.                             RecordEntry.Rating := GetString(SRow[1],SCol[1],SLen[1],RecordEntry.Rating,FALSE);
  435.                     End;
  436.                 3: Begin
  437.                     if (not GotSrchFFirst) then
  438.                         RecordEntry.Stars := GetString(SRow[2],SCol[2],SLen[2],RecordEntry.Stars,FALSE);
  439.                     End;
  440.                 4: Begin
  441.                         if (not GotSrchFFirst) then
  442.                             RecordEntry.Cast := GetString(SRow[3],SCol[3],SLen[3],RecordEntry.Cast,FALSE);
  443.                     End;
  444.                 5: Begin
  445.                         if (not GotSrchFFirst) then
  446.                             RecordEntry.Director := GetString(SRow[4],SCol[4],SLen[4],RecordEntry.Director,FALSE);
  447.                     End;
  448.                 6: Begin
  449.                         if (not GotSrchFFirst) then
  450.                             RecordEntry.Company := GetString(SRow[5],SCol[5],SLen[5],RecordEntry.Company,FALSE);
  451.                     End;
  452.                 7: Begin
  453.                         if (not GotSrchFFirst) then
  454.                             RecordEntry.Category := GetString(SRow[6],SCol[6],SLen[6],RecordEntry.Category,FALSE);
  455.                     End;
  456.                 8: Begin
  457.                         if (not GotSrchFFirst) then
  458.                             Begin
  459.                                 Choice := GetString(SRow[7],SCol[7],2,Choice,FALSE);
  460.                                 Val(Choice,RecordEntry.DateMonth,Code);
  461.                                 Choice := GetString(SRow[7],SCol[7]+3,2,Choice,FALSE);
  462.                                 Val(Choice,RecordEntry.DateDay,COde);
  463.                                 Choice := GetString(SRow[7],SCol[7]+6,2,Choice,FALSE);
  464.                                 Val(Choice,RecordEntry.DateYear,Code);
  465.                             End;
  466.                     End;
  467.                 9: Begin
  468.                         if (not GotSrchFFirst) then
  469.                             Begin
  470.                                 Choice := GetString(SRow[8],SCol[8],SLen[8],Choice,FALSE);
  471.                                 Val(Choice,RecordEntry.Price,Code);
  472.                             End;
  473.                     End;
  474.               10: Begin
  475.                     if (not GotSrchFFirst) then
  476.                         Begin
  477.                             Choice := GetString(SRow[9],SCol[9],SLen[9],Choice,FALSE);
  478.                             Val(Choice,RecordEntry.Tape,Code);
  479.                         End;
  480.                     End;
  481.               11: Begin
  482.                         if (not GotSrchFFirst) then
  483.                             Begin
  484.                                 Choice := GetString(SRow[10],SCol[10],SLen[10],Choice,FALSE);
  485.                                 Val(Choice,RecordEntry.RunTime,COde);
  486.                             End;
  487.                     End;
  488.               12: Begin
  489.                         if (not GotSrchFFirst) then
  490.                               RecordEntry.Format := GetString(SRow[11],SCol[11],SLen[11],RecordEntry.Format,FALSE);
  491.                     End;
  492.               13: Begin
  493.                         if (not GotSrchFFirst) then
  494.                             Begin
  495.                                 Choice := GetString(SRow[12],SCol[12],SLen[12],Choice,FALSE);
  496.                                 Val(Choice,RecordEntry.Start,Code);
  497.                             End;
  498.                     End;
  499.               14: Begin
  500.                         if (not GotSrchFFirst) then
  501.                             Begin
  502.                                 Choice := GetString(SRow[13],SCol[13],SLen[13],Choice,FALSE);
  503.                                 Val(Choice,RecordEntry.Stop,Code);
  504.                             End;
  505.                     End;
  506.               15: Begin
  507.                         if (not GotSrchFFirst) then
  508.                             RecordEntry.RunSpeed := GetString(SRow[14],SCol[14],SLen[14],RecordEntry.RunSpeed,FALSE);
  509.                     End;
  510.             End; {case}
  511.             if (VLIBSrchFld(Mode,FieldArray[Field-1],RecordEntry) <> PXSUCCESS) then
  512.                 Ret:=FALSE;
  513.         End;
  514.     SrchRec := Ret;
  515. End;
  516.  
  517. FUNCTION AddRecord:INTEGER;
  518. Var
  519.     RecordEntry:VLIBTABLEENTRY;
  520.  
  521. Begin
  522.     if (EditRec(RecordEntry,FALSE)) then
  523.         Begin
  524.             VLIBRet := VLIBRecInsert(RecordEntry);
  525.             if (VLIBRet = PXSUCCESS) then
  526.                 Begin
  527.                     DisplayRecord(RecordEntry);
  528.                     UpdateParadoxInfo(TRUE);
  529.                 End;
  530.         End;
  531.     AddRecord := VLIBRet;
  532. End;
  533.  
  534. FUNCTION CloseFile:INTEGER;
  535.  
  536. Begin
  537.     UpdateParadoxInfo(FALSE);
  538.     ClearRecord;
  539.     CloseFile := VLIBTblClose;
  540. End;
  541.  
  542. FUNCTION DecryptFile:INTEGER;
  543. Var
  544.     Choice : String;
  545.     IsProtected : Boolean;
  546.  
  547. Begin
  548.     VLIBRet := VLIBTblProtected(IsProtected);
  549.     if (VLIBRet = PXSUCCESS) then
  550.         Begin
  551.             if (IsProtected) then
  552.                 Begin
  553.                     PrintText(24,6,'Enter Password:');
  554.                     Choice := GetString(24,23,15,Choice,FALSE);
  555.                     ClearMessageArea;
  556.                     VLIBRet := VLIBTblDecrypt(Choice);
  557.                             DecryptFile := VLIBRet;
  558.                             Exit;
  559.                 End
  560.             else
  561.                 VLIBRet := -1; 
  562.                 PrintText(24,6,'Table is not encrypted');
  563.         End;
  564.     DecryptFile := VLIBRet;
  565. End;
  566.  
  567. FUNCTION DeleteRecord:INTEGER;
  568. Var
  569.     RecordEntry:VLIBTABLEENTRY;
  570.     Choice : String;
  571.     Ret : Integer;
  572.  
  573. Begin
  574.      PrintText(24,6,'Delete Current Record (Y or N):');
  575.     Choice := GetString(24,38,1,Choice,TRUE);
  576.     ClearMessageArea;
  577.     VLIBRet := -1;
  578.     if (Choice[1] = 'Y') then
  579.         Begin
  580.             VLIBRet := VLIBRecDelete;
  581.             if (VLIBRet = PXSUCCESS) then
  582.                 Begin
  583.                     VLIBRet := VLIBRecGet(RecordEntry);
  584.                     if (VLIBRet = PXSUCCESS) then
  585.                         Begin
  586.                             DisplayRecord(RecordEntry);
  587.                             UpdateParadoxInfo(TRUE);
  588.                         End
  589.                     else 
  590.                         Begin
  591.                             if (VLIBRet = PXERR_TABLEEMPTY) then
  592.                                 Begin
  593.                                     ClearRecord;
  594.                                     UpdateParadoxInfo(TRUE);
  595.                                 End
  596.                         End;
  597.                 End;
  598.         End;
  599.     DeleteRecord := VLIBRet;
  600.             
  601. End;
  602.  
  603. FUNCTION DeleteFile:INTEGER;
  604. Begin
  605.     UpdateParadoxInfo(FALSE);
  606.     ClearRecord;
  607.     DeleteFile := VLIBTblDelete;
  608. End;
  609.  
  610. FUNCTION EditRecord:INTEGER;
  611. Var
  612.     RecordEntry:VLIBTABLEENTRY;
  613.  
  614. Begin
  615.     VLIBRet := -1;
  616.     if (EditRec(RecordEntry,TRUE)) then
  617.         Begin
  618.             VLIBRet := VLIBRecUpdate(RecordEntry);
  619.             if (VLIBRet = PXSUCCESS) then
  620.                     DisplayRecord(RecordEntry);
  621.         End;
  622.     EditRecord := VLIBRet;
  623. End;
  624.  
  625. FUNCTION FirstRecord:INTEGER;
  626. Var
  627.     RecordEntry:VLIBTABLEENTRY;
  628.  
  629. Begin
  630.     VLIBRet := VLIBRecFirst(RecordEntry);
  631.     if (VLIBRet = PXSUCCESS) then
  632.         Begin
  633.             DisplayRecord(RecordEntry);
  634.             UpdateParadoxInfo(TRUE);
  635.         End;
  636.     FirstRecord:=VLIBRet;
  637. End;
  638.  
  639. FUNCTION GotoRecord:INTEGER;
  640.  
  641. Var
  642.     RecordEntry:VLIBTABLEENTRY;
  643.     Choice : String;
  644.     Value : RecordNumber;
  645.     Code : Integer;
  646.  
  647. Begin
  648.     PrintText(24,6,'Goto record No:');
  649.     Choice := GetString(24,22,6,Choice,FALSE);
  650.     Val(Choice,Value,Code);
  651.     ClearMessageArea;
  652.     VLIBRet := VLIBRecGoto(Value);
  653.     if (VLIBRet = PXSUCCESS) then
  654.         Begin
  655.             VLIBRet := VLIBRecGet(RecordEntry);
  656.             if (VLIBRet = PXSUCCESS) then
  657.                 Begin
  658.                     DisplayRecord(RecordEntry);
  659.                     UpdateParadoxInfo(TRUE);
  660.                 End;
  661.         End;
  662.     GotoRecord := VLIBRet;
  663. End;
  664.  
  665. FUNCTION SearchKFirst:INTEGER;
  666.  
  667. Var
  668.     RecordEntry:VLIBTABLEENTRY;
  669.  
  670. Begin
  671.     FillChar(SearchRecord,sizeof(SearchRecord),#0);
  672.     GotSrchKFirst := FALSE;
  673.  
  674.     VLIBRet := -1;
  675.     if (SrchRec(SearchRecord,TRUE)) then
  676.         begin
  677.             ClearMessageArea;
  678.             VLIBRet := VLIBSrchKey(SEARCHFIRST,NumKeys,SearchRecord);
  679.             if (VLIBRet = PXSUCCESS) then
  680.                 Begin
  681.                     VLIBRet := VLIBRecGet(RecordEntry);
  682.                     if (VLIBRet = PXSUCCESS) then
  683.                         begin
  684.                             DisplayRecord(RecordEntry);
  685.                             UpdateParadoxInfo(TRUE);
  686.                             GotSrchKFirst := TRUE;
  687.                         End;
  688.                 End;
  689.         End;
  690.     SearchKFirst := VLIBRet;
  691.             
  692. End;
  693.  
  694. FUNCTION SearchKNext:INTEGER;
  695. Var
  696.     RecordEntry:VLIBTABLEENTRY;
  697.  
  698. Begin
  699.  
  700.     VLIBRet := -1;
  701.     if (GotSrchKFirst) then
  702.         Begin
  703.             VLIBRet := VLIBSrchKey(SEARCHNEXT,NumKeys,SearchRecord);
  704.             if (VLIBRet = PXSUCCESS) then
  705.                 Begin
  706.                     VLIBRet := VLIBRecGet(RecordEntry);
  707.                     if (VLIBRet = PXSUCCESS) then
  708.                         Begin
  709.                             DisplayRecord(RecordEntry);
  710.                             UpdateParadoxInfo(TRUE);
  711.                         End;
  712.                 End;
  713.         End
  714.     else
  715.         PrintText(24,6,'No search key is set up, call Srch Key 1st');
  716.     SearchKNext := VLIBRet;
  717.  
  718. End;
  719.  
  720. FUNCTION LastRecord:INTEGER;
  721. Var
  722.     RecordEntry : VLIBTABLEENTRY; 
  723.  
  724. Begin
  725.     VLIBRet := VLIBRecLast(RecordEntry);
  726.     if (VLIBRet = PXSUCCESS) then
  727.         Begin
  728.             DisplayRecord(RecordEntry);
  729.             UpdateParadoxInfo(TRUE);
  730.         End;
  731.     LastRecord := VLIBRet;
  732. End;
  733.  
  734. FUNCTION MergeFile:INTEGER;
  735. Var
  736.     Choice : String;
  737.  
  738. Begin
  739.  
  740.     PrintText(24,6,'File to merge into ');
  741.     GoToRC(24,26);
  742.     Write(VLIBName,'.DB (No Extension):');
  743.     Choice := GetString(24,49,8,Choice,TRUE);
  744.     ClearMessageArea;
  745.  
  746.     MergeFIle := VLIBTblAdd(Choice,DESTINATION);
  747. End;
  748.  
  749. FUNCTION EncryptFile:INTEGER;
  750. Var
  751.     Choice : String;
  752. Begin
  753.     PrintText(24,6,'Enter Password:');
  754.     Choice := GetString(24,23,15,Choice,FALSE);
  755.     ClearMessageArea;
  756.     EncryptFile := VLIBTblEncrypt(Choice);
  757. End;
  758.  
  759. FUNCTION NextRecord:INTEGER;
  760. Var
  761.     RecordEntry : VLIBTABLEENTRY; 
  762.  
  763. Begin
  764.     VLIBRet := VLIBRecNext(RecordEntry);
  765.     if (VLIBRet = PXSUCCESS) then
  766.         Begin
  767.             DisplayRecord(RecordEntry);
  768.             UpdateParadoxInfo(TRUE);
  769.         End;
  770.     NextRecord:=VLIBRet;
  771. End;
  772.  
  773. FUNCTION OpenFile:INTEGER;
  774. Var
  775.     Choice,Value:String;
  776.     IsProtected:Boolean;
  777.  
  778. Begin
  779.     Value := NoPassword;
  780.     VLIBRet := VLIBTblProtected(IsProtected);
  781.     if (VLIBRet = PXSUCCESS) then
  782.         Begin
  783.             if (IsProtected) then
  784.                 Begin
  785.                     PrintText(24,6,'Enter Password:');
  786.                     Choice := GetString(24,23,15,Choice,FALSE);
  787.                     ClearMessageArea;
  788.                     Value := Choice;  
  789.                 End
  790.         End
  791.       else
  792.         Begin
  793.             OpenFile := VLIBRet;
  794.             Exit;
  795.         End;
  796.     VLIBRet := VLIBTblOpen(Value);
  797.     if (VLIBRet = PXSUCCESS) then
  798.         OpenFile := FirstRecord;
  799.     OpenFile:=VLIBRet;
  800. End;
  801.  
  802.     
  803. FUNCTION CopyFile:INTEGER;
  804. Var
  805.     Choice:String;
  806.  
  807. Begin
  808.     PrintText(24,6,'File to copy from (No extension):');
  809.     Choice := GetString(24,40,8,Choice,TRUE);
  810.     ClearMessageArea;
  811.     CopyFile := VLIBTblCopy(Choice,DESTINATION);
  812. End;
  813.  
  814. FUNCTION PreviousRecord:INTEGER;
  815. Var
  816.     RecordEntry : VLIBTABLEENTRY; 
  817.  
  818. Begin
  819.     VLIBRet := VLIBRecPrev(RecordEntry);
  820.     if (VLIBRet = PXSUCCESS) then
  821.         Begin
  822.             DisplayRecord(RecordEntry);
  823.             UpdateParadoxInfo(TRUE);
  824.         End;
  825.     PreviousRecord := VLIBRet;
  826.  
  827. End;
  828.  
  829.  
  830. FUNCTION RenameFile:INTEGER;
  831. Var
  832.     Choice:String;
  833.  
  834. Begin
  835.     PrintText(24,6,'Rename ');
  836.     GoToRc(24,13);
  837.     Write(VLIBName,'.DB to (No extension):');
  838.     Choice := GetString(24,40,8,Choice,TRUE);
  839.     ClearMessageArea;
  840.     RenameFile := VLIBTblRename(Choice);
  841. End;
  842.  
  843. FUNCTION SearchFFirst:INTEGER;
  844. Var
  845.     RecordEntry:VLIBTABLEENTRY;
  846.  
  847. Begin
  848.     GotSrchFFirst := FALSE;
  849.     VLIbRet := -1;
  850.     FillChar(SearchRecord,sizeof(SearchRecord),#0);
  851.     if (SrchRec(SearchRecord,FALSE)) then
  852.         Begin
  853.             ClearMessageArea;
  854.             VLIBRet := VLIBRecGet(RecordEntry);
  855.             if (VLIBRet = PXSUCCESS) then
  856.                 Begin
  857.                     DisplayRecord(RecordEntry);
  858.                     UpdateParadoxInfo(TRUE);
  859.                     GotSrchFFirst := TRUE;
  860.                 End;
  861.         End;
  862.     SearchFFirst := VLIBRet;
  863.         
  864. End;
  865.  
  866. FUNCTION SearchFNext:INTEGER;
  867. Var
  868.     RecordEntry:VLIBTABLEENTRY;
  869.  
  870. Begin
  871.  
  872.     VLIBRet := -1;
  873.     if (GotSrchFFirst) then
  874.         Begin
  875.             if (SrchRec(SearchRecord,FALSE)) then
  876.                 Begin
  877.                     ClearMessageArea;
  878.                     VLIBRet := VLIBRecGet(RecordEntry);
  879.                     if (VLIBRet = PXSUCCESS) then
  880.                         Begin
  881.                             DisplayRecord(RecordEntry);
  882.                             UpdateParadoxInfo(TRUE);
  883.                             GotSrchFFirst := TRUE;
  884.                         End;
  885.                 End;
  886.         End
  887.     else
  888.         PrintText(24,6,'No search field is set up, call Srch Field 1st');
  889.     SearchFNext := VLIBRet;
  890.  
  891. End;
  892.  
  893. FUNCTION CreateFile:INTEGER;
  894. Var
  895.     Choice : String;
  896.  
  897. Begin
  898.     VLIBRet := -1;
  899.     PrintText(24,6,'Over Write ');
  900.     GoToRC(24,17);
  901.     Write(VLIBName,'.DB (Y or N):');
  902.     Choice := GetString(24,35,1,Choice,TRUE);
  903.     ClearMessageArea;
  904.     if (Choice[1] = 'Y') then
  905.             CreateFile := VLIBTblCreate(64);
  906.     CreateFile := VLIBRet;
  907. End;
  908.  
  909. FUNCTION EmptyFil:INTEGER;
  910. Begin
  911.     ClearRecord;
  912.     EmptyFil := VLIBTblEmpty;
  913. End;
  914.  
  915. FUNCTION ValidEvent(Choice: String):Boolean;
  916.  
  917.     CONST
  918.         NumFunctions = 21;
  919.         EventArray : Array[0..NumFunctions] of Process = (
  920.             (ITem : 'AR';Message : 'Record Add Successful'),
  921.             (Item : 'CT';Message : 'Table Close Successful'),
  922.             (Item : 'DT';Message : 'Table Decrypt Successful'),
  923.             (Item : 'DR';Message : 'Record Delete Successful'),
  924.             (Item : 'ET';Message : 'Table Delete Successful'),
  925.             (Item : 'ER';Message : 'Record Update Successful'),
  926.             (Item : 'FR';Message : 'First Record Successful'),
  927.             (Item : 'GR';Message : 'Goto Record Successful'),
  928.             (Item : 'KF';Message : 'Search Key 1st Successful'),
  929.             (Item : 'KN';Message : 'Search Key Next Successful'),
  930.             (Item : 'LR';Message : 'Last Record Successful'),
  931.             (Item : 'MT';Message : 'Table Merge Successful'),
  932.             (Item : 'NT';Message : 'Table Encrypt Successful'),
  933.             (Item : 'NR';Message : 'Next Record Successful'),
  934.             (Item : 'OT';Message : 'Table Open Successful'),
  935.             (Item : 'PT';Message : 'Table Copy Successful'),
  936.             (Item : 'PR';Message : 'Prev Record Successful'),
  937.             (Item : 'RT';Message : 'Table Rename Successful'),
  938.             (Item : 'SF';Message : 'Search Field 1st Successful'),
  939.             (Item : 'SN';Message : 'Search Field Next Successful'),
  940.             (Item : 'TT';Message : 'Table Create Successful'),
  941.             (Item : 'YT';Message : 'Table Empty Successful')
  942.         );
  943.  
  944. VAR
  945.     DoProcess,Finished : Boolean;
  946.     Index,Ret : Integer;
  947.     Key : Char;
  948.     Spaces : String;
  949.  
  950. Begin
  951.     FillChar(SPaces,sizeof(String),' ');
  952.     Spaces[0] := #70;
  953.     DoProcess := FALSE;
  954.     Ret := 1;
  955.     Finished := FALSE;
  956.     Index := 0;
  957.  
  958.     (* Set up PASCAL Function pointers - these function references can
  959.           not be added to CONST declaration above because they are not
  960.         allowed, the compiler will object with an error.  Please notice
  961.         the {$F+} directive before the DisplayFields procedure.  This
  962.         enables FAR calls and enables this program to use the Function
  963.         pointers declared below...................................... *)
  964.  
  965.     EventArray[0].Fptr  := AddRecord;
  966.     EventArray[1].Fptr  := CloseFile;
  967.     EventArray[2].Fptr  := DecryptFile;
  968.     EventArray[3].Fptr  := DeleteRecord;
  969.     EventArray[4].Fptr  := DeleteFile;
  970.     EventArray[5].Fptr  := EditRecord;
  971.     EventArray[6].Fptr  := FirstRecord;
  972.     EventArray[7].Fptr  := GotoRecord;
  973.     EventArray[8].Fptr  := SearchKFirst;
  974.     EventArray[9].Fptr  := SearchKNext;
  975.     EventArray[10].Fptr := LastRecord;
  976.     EventArray[11].Fptr := MergeFile;
  977.     EventArray[12].Fptr := EncryptFile;
  978.     EventArray[13].Fptr := NextRecord;
  979.     EventArray[14].Fptr := OpenFile;
  980.     EventArray[15].Fptr := CopyFile;
  981.     EventArray[16].Fptr := PreviousRecord;
  982.     EventArray[17].Fptr := RenameFile;
  983.     EventArray[18].Fptr := SearchFFirst;
  984.     EventArray[19].Fptr := SearchFNext;
  985.     EventArray[20].Fptr := CreateFile;
  986.     EventArray[21].Fptr := EmptyFil;
  987.  
  988.     if (Choice = 'QU') then
  989.         ValidEvent := FALSE
  990.     else
  991.         Begin
  992.             Repeat
  993.                 begin
  994.                     if (Choice = EventArray[Index].Item) then
  995.                         begin
  996.                             DoProcess := TRUE;
  997.                             Finished := TRUE;
  998.                         end
  999.                     else
  1000.                         Index := Index +1;
  1001.                 end;
  1002.             Until ((Index > NumFunctions) or Finished);    
  1003.  
  1004.             if (DoProcess) then
  1005.                 Begin
  1006.                     Ret := EventArray[Index].Fptr;
  1007.                         if (Ret = 0) then
  1008.                             PrintText(24,6,EventArray[Index].Message)
  1009.                         else
  1010.                             Ret := VLIBError1(Ret);
  1011.                 End
  1012.             else
  1013.                 Begin
  1014.                     GoToRc(24,6);
  1015.                     Write(Choice,' is an invalid option - Hit any Key');
  1016.                     Key := ReadKey;
  1017.                     PrintText(24,6,Spaces);
  1018.                 End;
  1019.         End;
  1020. End;
  1021.  
  1022. (*----------------------------------------------------------------
  1023.                           MAIN PROGRAM                  
  1024. -----------------------------------------------------------------*)
  1025.  
  1026. Begin
  1027.     if (OpeningScreen) then
  1028.         Begin
  1029.             Repeat
  1030.                 Choice := GetString(18,68,2,Choice,TRUE);
  1031.                 ClearMessageArea;
  1032.             Until not (ValidEvent(Choice));
  1033.             VLIBRet := PXExit;
  1034.             if (VLIBRet <> PXSUCCESS) then
  1035.                 VlibRet := VLIBError1(VlibRet);
  1036.         End;
  1037.         ClearArea(1,1,25,80);    
  1038. End.
  1039. 
  1040.