home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / BTP20.ZIP / CRUNCH1.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-06-10  |  6.4 KB  |  216 lines
  1. PROGRAM Crunch1;               { (c) 1993 John C. Leon   last updated 6/9/93 }
  2.  
  3. {
  4.  Will take any standard, fixed-length or variable length, Btrieve file and
  5.  produce a clone with the same file structure, then transfer records from
  6.  the source to the target file.
  7.  
  8.  There is a limit on variable length files of a total of 32767 bytes (the
  9.  value of CONST MaxDBufferLength) for the entire (fixed and variable portions)
  10.  data buffer/record.
  11.  
  12.  The purpose of the program is to remove dead space in the source file left
  13.  over from deletions in the source.
  14.  
  15.  Supplemental indexes are retained as supplemental indexes in the target.
  16.  
  17.  If the source file has an owner name, it must be supplied as the third
  18.  command-line parameter, in order to read the source file, but the target
  19.  file will NOT have an owner name.
  20.  
  21.  This program uses only standard Btrieve 5.10 calls.  In CRUNCH2.PAS, we
  22.  use "step next extended" and "insert extended" calls to accomplish the same
  23.  thing as this program.
  24.  
  25.  This program illustrates the use of the BSized object, and has the
  26.  interesting twist of using the source file's data buffer as the data buffer
  27.  for the target file's BSized object.
  28. }
  29.  
  30.  
  31. {$IFDEF production} {$D-,R-,L-,S-} {$ENDIF}
  32.  
  33. USES
  34.    Crt, DOS, BTP;
  35.  
  36. CONST
  37.    BufferLength : word = MaxFixedRecLength;
  38.    NOTICE1 = 'Crunch1                   (C) 1993 John C. Leon.  All Rights Reserved.';
  39.    NOTICE2 = '----------------------------------------------------------------------';
  40.  
  41. VAR
  42.    OrgName, CopyName : string[79];
  43.    OrgFile, CopyFile : PBSized;
  44.    OwnerName         : string;
  45.    Counter, x, y     : longint;
  46.  
  47. procedure PrintNotices;
  48. begin
  49.    writeln(NOTICE1);
  50.    writeln(NOTICE2);
  51.    writeln;
  52. end;
  53.  
  54. procedure VerifyTargetOverWrite;
  55. var
  56.    Response: string;
  57.    DirInfo : SearchRec;
  58. begin
  59. findfirst(CopyName, archive, DirInfo);
  60. if doserror = 0 then
  61.    begin
  62.    writeln;
  63.    write('Target file ', CopyName, ' exists.  Overwrite? (Y/N): ');
  64.    readln(Response);
  65.    Response[1] := upcase(Response[1]);
  66.    if Response[1] = 'N' then
  67.       begin
  68.       dispose(OrgFile, Done);
  69.       halt(5);
  70.       end;
  71.    if Response[1] <> 'Y' then
  72.       begin
  73.       writeln;
  74.       writeln('Invalid response ... program aborted.');
  75.       dispose(OrgFile, Done);
  76.       halt(6);
  77.       end;
  78.    end;
  79. end;
  80.  
  81.  
  82. (* Begin MAIN program code *)
  83. (* ------------------------------------------------------------------------ *)
  84. BEGIN
  85.  
  86. if not IsBtrieveLoaded then
  87.    begin
  88.    writeln;
  89.    writeln('Please load Btrieve before running this program.');
  90.    writeln;
  91.    halt(1);
  92.    end;
  93.  
  94. clrscr;
  95. PrintNotices;
  96.  
  97. {If user asked for help, or didn't pass two filenames, give help and exit.}
  98. if (paramstr(1) = '?') or (paramstr(1) = '/?') or (paramstr(1) = '-?') or
  99.    (paramcount < 2) then
  100.    begin
  101.    writeln;
  102.    writeln('USAGE: CRUNCH1 sourcefile targetfile [owner]');
  103.    writeln;
  104.    writeln('This program will create the target file, duplicating the original');
  105.    writeln('file''s structure exactly.  Supplemental indexes, if any, and');
  106.    writeln('an alternate collating sequence, if any, will be duplicated in');
  107.    writeln('the target file.');
  108.    writeln;
  109.    writeln('If the source file has an owner name, specify the owner name as');
  110.    writeln('the third command line parameter.  In no event will the target');
  111.    writeln('file be created with an owner name.');
  112.    writeln;
  113.    writeln('After creating the target file, all records will be copied from');
  114.    writeln('the source file to the target.');
  115.    writeln;
  116.    writeln('Variable length files with record lengths to 32,767 are supported');
  117.    halt(2);
  118.    end;
  119.  
  120. OrgName := paramstr(1); CopyName := paramstr(2);
  121. for Counter := 1 to length(OrgName) do
  122.    OrgName[Counter] := upcase(OrgName[Counter]);
  123. for Counter := 1 to length(CopyName) do
  124.    CopyName[Counter] := upcase(CopyName[Counter]);
  125. OwnerName := '';
  126. if paramcount >= 3 then
  127.    OwnerName := paramstr(3);
  128.  
  129. { Open original file in read only mode }
  130. OrgFile := new(PBSized, Init(OrgName, ReadOnly, OwnerName, BufferLength));
  131.  
  132. if BStatus <> Zero then
  133.    begin
  134.    writeln('Error opening ', OrgName, '.  Program aborted.');
  135.    dispose(OrgFile, Done);
  136.    halt(3);
  137.    end;
  138.  
  139. if OrgFile^.NumRecs = 0 then            {don't proceed if empty file}
  140.    begin
  141.    writeln('No records in ', OrgName, '.  Program aborted.');
  142.    OrgFile^.Close;
  143.    dispose(OrgFile, Done);
  144.    halt(4);
  145.    end;
  146.  
  147. {If target file exists, get confirmation before overwriting. Program will be
  148.  aborted if target exists and user elects to abort.}
  149.  
  150. VerifyTargetOverWrite;
  151.  
  152. if (OrgFile^.Specs.FileFlags and VarLength) = VarLength then
  153.    begin
  154.    BufferLength := MaxDBufferLength;
  155.    OrgFile^.Close;
  156.    dispose(OrgFile, Done);
  157.    OrgFile := new(PBSized, Init(OrgName, ReadOnly, OwnerName, BufferLength));
  158.    end;
  159.  
  160. {Create copy of original, using precisely the same specs, but do not use
  161.  any owner name the source file may have used.}
  162.  
  163. BStatus := CloneFile(OrgName, CopyName, Retain, '');
  164. if BStatus = Zero then
  165.    writeln(CopyName, ' created successfully.')
  166.    else
  167.    begin
  168.    writeln;
  169.    writeln('Error creating ', CopyName, '.  Status = ', BStatus, '.');
  170.    writeln('Program aborted.');
  171.    writeln;
  172.    dispose(OrgFile, Done);
  173.    halt(7);
  174.    end;
  175.  
  176. {Open new copy of file in accelerated mode.}
  177. CopyFile := new(PBSized, Init(CopyName, Accel, '', BufferLength));
  178.  
  179. writeln;
  180. writeln('Number of records in ', OrgName, ': ', OrgFile^.NumRecs);
  181. write('Number of records inserted: ');
  182. x := wherex;
  183. y := wherey;
  184.  
  185. freemem(CopyFile^.DBuffer, CopyFile^.DBufferSize);
  186. CopyFile^.DBuffer := OrgFile^.DBuffer;
  187.  
  188. {Main loop...read a record, write a record.}
  189. for Counter:= 1 to OrgFile^.NumRecs do
  190.    begin
  191.    OrgFile^.BT(BStepNext, Zero);
  192.    CopyFile^.BT(BInsert, Zero);
  193.    if (Counter MOD 5) = 0 then
  194.       begin
  195.       gotoxy(x, y);
  196.       write(Counter);
  197.       end;
  198.    end;
  199. if (Counter MOD 5) <> 0 then
  200.    write(Counter);
  201. writeln;
  202. writeln('DONE...');
  203.  
  204. BStatus := OrgFile^.Close;
  205. BStatus := CopyFile^.Close;
  206.  
  207. dispose(OrgFile, Done);
  208. CopyFile^.DBuffer := nil; {As we're using OrgFile's pointer, which became
  209.                            undefined when OrgFile was disposed, this pointer
  210.                            is now undefined.  If we don't set the undefined
  211.                            pointer to nil, CopyFile's destructor will try to
  212.                            free it's memory and kill prog w/runtime error.}
  213. dispose(CopyFile, Done);
  214.  
  215. END.
  216.