home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / BTP20.ZIP / CLONE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-06-10  |  4.2 KB  |  130 lines
  1. PROGRAM Clone;                 { (C) 1993 John C. Leon   last updated 6/8/93 }
  2.  
  3. {$IFDEF production} {$D-,R-,L-,S-} {$ENDIF}
  4. {$X+}
  5.  
  6. USES
  7.    Dos, BTP;
  8.  
  9. CONST
  10.    NOTICE = 'CLONE 2.0  (C) 1993 John C. Leon.  All Rights Reserved.';
  11.  
  12. VAR
  13.    OrgName, CopyName : string[79];
  14.    OwnerName         : TOwnerName;
  15.    Supplementals     : string;
  16.    Counter, Option   : integer;
  17.    OrgFile           : PBFile;
  18.    CopyFile          : File;
  19.    Response          : string;
  20.    DirInfo           : SearchRec;
  21.  
  22. BEGIN
  23.    if not IsBtrieveLoaded then
  24.       begin
  25.       writeln('Please load Btrieve before running this program.');
  26.       halt(1);
  27.       end;
  28.  
  29.    writeln;
  30.    writeln(NOTICE);
  31.    writeln;
  32.  
  33.    if (paramstr(1) = '?') or (paramstr(1) = '/?') or (paramstr(1) = '-?') or
  34.       (paramcount < 2) then
  35.       begin
  36.       writeln('USAGE: CLONE source_file target_file [drop|retain|none] [owner]');
  37.       writeln;
  38.       writeln('CLONE will duplicate the structure of an existing Btrieve file.');
  39.       writeln('The target table will hold no records.  If the source file has');
  40.       writeln('supplemental indexes, you can choose to RETAIN them as');
  41.       writeln('supplemental indexes (the default), DROP them, or make them');
  42.       writeln('permanent indexes.  Specifying NONE will retain existing');
  43.       writeln('supplemental indexes as PERMANENT indexes in the clone.');
  44.       writeln('If an owner name exists for the source file, specify that name');
  45.       writeln('as the fourth command line parameter.  The target file will then');
  46.       writeln('be created (without an owner name).');
  47.       halt(2);
  48.       end;
  49.  
  50.    OrgName := paramstr(1); CopyName := paramstr(2);
  51.    for Counter := 1 to length(OrgName) do
  52.       OrgName[Counter] := upcase(OrgName[Counter]);
  53.    for Counter := 1 to length(CopyName) do
  54.       CopyName[Counter] := upcase(CopyName[Counter]);
  55.    if paramcount >= 3 then
  56.       begin
  57.       Supplementals := paramstr(3);
  58.       for Counter := 1 to length(Supplementals) do
  59.          Supplementals[Counter] := upcase(Supplementals[Counter]);
  60.       if ((Supplementals <> 'DROP') and (Supplementals <> 'RETAIN') and
  61.          (Supplementals <> 'NONE')) then
  62.          Supplementals := 'RETAIN';
  63.       end
  64.       else
  65.       Supplementals := 'RETAIN';      {note default is to retain supp indexes}
  66.    if paramcount >= 4 then
  67.       OwnerName := paramstr(4)
  68.       else
  69.       OwnerName := '';
  70.  
  71.    if Supplementals = 'DROP'       then Option := Drop   else
  72.       if Supplementals = 'RETAIN'  then Option := Retain else
  73.          if Supplementals = 'NONE' then Option := None;
  74.  
  75.    {Verify that source file exists and is a Btrieve file before continuing. }
  76.    {While the CloneFile function would return a proper status error code if }
  77.    {the source file was not found, it would be something not entirely       }
  78.    {indicative of the type of i/o error.  The following is much more exact. }
  79.  
  80.    OrgFile := new(PBFile, Init(OrgName, ReadOnly, OwnerName));
  81.    if BStatus = FileNotFound then
  82.       begin
  83.       writeln;
  84.       writeln('Source file ', OrgName, ' not found.');
  85.       writeln;
  86.       dispose(OrgFile, Done);
  87.       halt(3);
  88.       end;
  89.    if BStatus = 0 then
  90.       begin
  91.       OrgFile^.Close;
  92.       dispose(OrgFile, Done);
  93.       end
  94.       else
  95.       begin
  96.       writeln;
  97.       writeln('Btrieve cannot open ', OrgName, '.  Status = ', BStatus);
  98.       dispose(OrgFile, Done);
  99.       halt(4);
  100.       end;
  101.  
  102.    {If target file exists, whether as a Btrieve file or not, }
  103.    {get confirmation before overwriting.                     }
  104.    
  105.    FindFirst(CopyName, Archive, DirInfo);
  106.    if doserror = 0 then
  107.       begin
  108.       writeln;
  109.       write('Target file ', CopyName, ' exists.  Overwrite? (Y/N): ');
  110.       readln(Response);
  111.       Response := upcase(Response[1]);
  112.       if Response = 'N' then
  113.          halt(5);
  114.       if Response <> 'Y' then
  115.          begin
  116.          writeln;
  117.          writeln('Improper response...CLONE aborted.');
  118.          halt(6);
  119.          end;
  120.       end;
  121.  
  122.    if CloneFile(OrgName, CopyName, Option, OwnerName) = 0 then
  123.       writeln(OrgName, ' successfully cloned as ', CopyName)
  124.       else
  125.       begin
  126.       writeln('Clone operation failed.  Status = ', BStatus);
  127.       halt(7);
  128.       end;
  129. END.
  130.