home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / PASCAL / TPDB32 / PACK.PAS < prev    next >
Pascal/Delphi Source File  |  1991-10-28  |  2KB  |  63 lines
  1. {$A+,B-,D+,E-,F-,I-,L-,N-,O-,R-,S-,V-}
  2. {$M 16384,0,655360}
  3.  
  4. program PackFile;
  5.  
  6.                            (***********************************)
  7.                            (*               TPDB              *)
  8.                            (***********************************)
  9.                            (*         Object -Oriented        *)
  10.                            (*     Turbo Pascal 6.0 Units      *)
  11.                            (*    for Accessing dBASE III      *)
  12.                            (*             files.              *)
  13.                            (*        Copyright 1991           *)
  14.                            (*          Brian Corll            *)
  15.                            (*       All Rights Reserved       *)
  16.                            (*     dBASE is a registered       *)
  17.                            (* trademark of Ashton-Tate, Inc.  *)
  18.                            (*   Version 3.20  October, 1991   *)
  19.                            (***********************************)
  20.                            (*   Portions Copyright 1984,1991  *)
  21.                            (*    Borland International Corp.  *)
  22.                            (***********************************)
  23.  
  24.  
  25. uses
  26.     Crt, TPDB, TPDBScrn, TPDBStr;
  27.  
  28. var
  29.     Message: string [80];
  30.     RecCount: string;
  31.     Packer: DataObject;
  32.  
  33. begin
  34.     CursorOff;
  35.     if ParamCount = 0 then begin
  36.         Beep;
  37.         ClrScr;
  38.         Flash(1, 1, LightGreen + BlackBG, 'PACK filename.dbf');
  39.         CursorOn;
  40.         Halt(1);
  41.     end;
  42.     New(Packer, Init(ParamStr(1)));
  43.     if Packer^.TotalRecs = 0 then begin
  44.         ClrScr;
  45.         Beep;
  46.         Message := 'Record count in file ' + Upper(ParamStr(1)) + ' is ZERO.';
  47.         Flash(1, 1, LightGreen + BlackBG, Message);
  48.         CursorOn;
  49.         Halt(1);
  50.     end;
  51.     ClrScr;
  52.     Message := 'PACKing file ' + Upper(ParamStr(1));
  53.     FlashC(11, Yellow + BlackBG, Message);
  54.     Packer^.Pack;
  55.     Str(Packer^.TotalRecs: 10, RecCount);
  56.     FlashC(12, LightGreen + BlackBG, 'File has been packed.');
  57.     Message := 'Current record count in file ' + Upper(ParamStr(1)) + ' is ' + LTrim(RecCount);
  58.     FlashC(13, LightCyan + BlackBG, Message);
  59.     FlashC(14, White + BlackBG, 'Copyright 1991 Brian Corll');
  60.     Dispose(Packer, Done);
  61.     CursorOn;
  62. end.
  63.