home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / COPYWC6.ZIP / COPYWC6.PAS
Encoding:
Pascal/Delphi Source File  |  1985-12-29  |  9.0 KB  |  374 lines
  1. { Wild card file copier for back-up of selected files from
  2.   hard disk systems. Pauses as each floppy is filled to allow
  3.   the next formatted floppy to be inserted. }
  4.  
  5. { Command line entries are in the form: <copy mask> <dest drive> </c>
  6.   where copy mask is <d:filename.typ> and wildcards are permitted;
  7.         dest drive is <d:>; and
  8.         /c is the optional confirm parameter (Y/N for each copy). }
  9.  
  10. { Turbo 3.0 required. Thus DOS 2.0 or later is also required. }
  11.  
  12. {This program accesses files using wild-cards. This method works with
  13.  MS-DOS (or PC-DOS) versions 1 and later, though the program requires
  14.  DOS 2.0 because of Turbo Pascal 3.0 . }
  15.  
  16. {Copyright 1985 by David W. Carroll
  17.                     P.O Box 699
  18.                     Pine Grove, CA  95665 }
  19. {All commercial rights reserved.}
  20.  
  21. { This program and over 600 more Turbo Pascal programs are
  22.   available on the High Sierra RBBS-PC at 209-296-3534 }
  23.  
  24. program copywc6;
  25.  
  26. type
  27.   regpack = record
  28.               case integer of
  29.                 1: (ax,bx,cx,dx,bp,si,di,ds,es,flags: integer);
  30.                 2: (al,ah,bl,bh,cl,ch,dl,dh         : byte)
  31.             end;
  32.  
  33.   fcbarray =    array[0..36] of char;
  34.   strtype  =    string [14];
  35.   comstr   =    string[127];
  36.   datstr   =    string[2];
  37.  
  38. const
  39.    getdta =       $1a;
  40.    get1stdir =    $11;
  41.    getnextdir =   $12;
  42.    parsename =    $29;
  43.  
  44. var
  45.   buffer  : comstr;
  46.   conf    : string[10];
  47.   inch    : char;
  48.   filestr,
  49.   filename: strtype;
  50.   indrive : string[2];
  51.   outdrive : string[2];
  52.   dfcb,
  53.   dta,
  54.   dta2    : fcbarray;
  55.   disp    : string[10];
  56.   user_input,
  57.   display,
  58.   quit,
  59.   confirm      : boolean;
  60.  
  61. function Uppercase(var Str : datstr) :datstr;
  62. var
  63.  indx,len    : Integer;
  64.  
  65. begin
  66.   Len := length(Str);
  67.   for Indx := 1 to len do
  68.    Str[Indx] := UpCase(Str[Indx]);
  69.   uppercase := str
  70. end;
  71.  
  72.  
  73. function copyproc(fname:strtype) : byte;
  74. const
  75.   recsize = 128;
  76.   bufsize = 200;
  77.  
  78. var
  79.   source, dest : file;
  80.   sourcename, destname : string[14];
  81.   buffer : array[1..recsize,1..bufsize] of byte;
  82.   recsread : integer;
  83.   bufx, buff1: integer;
  84.   docopy,
  85.   writeerr : boolean;
  86.   ch : char;
  87.  
  88. begin
  89.   if confirm then
  90.   begin
  91.     write('Copy ',indrive + fname,' ':(13-length(fname)),
  92.           'to ',outdrive,' (Y/N) ? ');
  93.     repeat
  94.       read(kbd,inch);
  95.     until upcase(inch) in ['Y','N'];
  96.     writeln(upcase(inch));
  97.     docopy := upcase(inch) = 'Y';
  98.   end
  99.   else
  100.   begin
  101.     docopy := true;
  102.     writeln('Copying ',indrive + fname,' ':(13-length(fname)),
  103.             'to ',outdrive);
  104.   end;
  105.   if docopy then
  106.     repeat
  107.       sourcename := indrive + fname;
  108.       assign(source, sourcename);
  109.       reset(source);
  110.       destname :=  outdrive + fname;
  111.       assign(dest,destname);
  112.       rewrite(dest);
  113.       writeerr := false;
  114.       repeat
  115.         blockread(source,buffer,bufsize,recsread);
  116.         {$I-}
  117.         blockwrite(dest,buffer,recsread);
  118.         {$I+}
  119.         writeerr := IOResult <> 0;
  120.       until (recsread = 0) or writeerr;
  121.       close(source);
  122.       close(dest);
  123.       if writeerr then
  124.       begin
  125.         erase(dest);
  126.         writeln(^G'Insert next formatted diskette in B:');
  127.         writeln('Then hit any key to continue copy.');
  128.         read(kbd,ch);
  129.       end;
  130.     until not writeerr;
  131.   copyproc := 0;
  132. end;
  133.  
  134.  
  135. procedure setDTA(num:byte);      {set Disk Transfer Address}
  136. var
  137.   regs:       regpack;
  138.  
  139. begin
  140.   with regs do begin
  141.     ah := getdta;
  142.     case num of
  143.     1:  begin
  144.          ds := seg(dta);
  145.          dx := ofs(dta);
  146.         end;
  147.     2:  begin
  148.          ds := seg(dta2);
  149.          dx := ofs(dta2);
  150.         end;
  151.     end;
  152.     MSDOS(regs)
  153.   end
  154. end; {setDTA}
  155.  
  156. procedure calldir(calltype : byte; var errflag : byte);
  157. var
  158.   regs:       regpack;
  159.  
  160. begin
  161.   with regs do begin
  162.     ah := calltype;
  163.     cx := 0;
  164.     ds := seg(dfcb);
  165.     dx := ofs(dfcb);
  166.     MSDOS(regs);
  167.     errflag:= al
  168.   end
  169. end; {calldir}
  170.  
  171. procedure parse(var errflag:byte);
  172. var
  173.   regs : regpack;
  174. begin
  175.   with regs do begin
  176.     ah := parsename;
  177.     ds := seg(buffer[1]);
  178.     si := ofs(buffer[1]);
  179.     es := seg(dfcb);
  180.     di := ofs(dfcb);
  181.     al := $0F;
  182.     MSDOS(regs);
  183.     errflag := al;
  184.   end;
  185. end;  {parse}
  186.  
  187. procedure find;
  188. const
  189.   space  = ' ';
  190.   period = '.';
  191. var
  192.    i,
  193.    err:    byte;
  194.  
  195. begin
  196.   for i := 0 to 36 do dfcb[i] := chr(0);
  197. {  if not user_input then
  198.  }   writeln('Search mask: ',buffer:15);
  199.   writeln;
  200.   parse(err);
  201.   setDTA(1);                          { set 1st DTA for get func.}
  202.   calldir(get1stdir, err);            { get first entry matching mask }
  203.   if err > 0 then
  204.     writeln('No files found');
  205.   while err = 0 do
  206.   begin
  207.     filename:= '';
  208.     for i:= 1 to 11 do
  209.     begin
  210.       if dta[i] <> space then
  211.         filename := filename + dta[i];
  212.       if i = 8 then filename := filename + period;
  213.     end;
  214.    { writeln(filename);}
  215.     setDTA(2);                        { set 2nd DTA for file processing }
  216.     err := copyproc(filename);        { process file }
  217.     if err = 0 then
  218.     begin
  219.       setDTA(1);
  220.       calldir(getnextdir, err);          { get next entry }
  221.     end;
  222.   end;
  223.   writeln;
  224. end; {find}
  225.  
  226. begin  {copywc6}
  227.   user_input := false;
  228.   clrscr;
  229.   writeln('Wild card file copy');
  230.   writeln('by David W. Carroll');
  231.   writeln;
  232.   writeln('For transferring files from HD to floppies');
  233.   writeln('Continues from last file as each floppy is filled');
  234.   writeln;
  235.   writeln('Command line arguments supported in the form:');
  236.   writeln('A> copywc6 d:filename.typ d: /c ');
  237.   writeln('where <d:filename.typ> is the copy mask with wildcards; ');
  238.   writeln('      <d:> is the destination drive; and');
  239.   writeln('      </c> is the optional "confirm each copy" flag.');
  240.   writeln;
  241.   writeln;
  242.  
  243.  
  244.   if paramcount < 1 then
  245.   begin
  246.     write('Enter copy mask, <ENTER> to quit: ');
  247.     readln(buffer);
  248.     user_input := true;
  249.  
  250.     if length(buffer) > 0 then
  251.     begin
  252.       write('Confirm each file? (Y/N) ');
  253.       repeat
  254.         read(kbd,inch);
  255.       until upcase(inch) in ['Y','N'];
  256.       writeln(upcase(inch));
  257.       confirm := upcase(inch) = 'Y';
  258.  
  259.       repeat
  260.         write('Copy to drive: ');
  261.         readln(outdrive);
  262.         if (pos(':',outdrive)=0) and (length(outdrive)=1) then
  263.           outdrive := outdrive + ':';
  264.       until (length(outdrive)=2) and (upcase(outdrive[1]) in ['A'..'D']) and
  265.         (outdrive[2] = ':');
  266.       outdrive := uppercase(outdrive);
  267.     end
  268.   end;
  269.  
  270.  
  271.   if paramcount > 0 then
  272.   begin
  273.     buffer := paramstr(1);
  274.     if pos(':',copy(buffer,1,2)) > 0 then
  275.       indrive := copy(buffer,1,2)
  276.     else
  277.       indrive := '';
  278.     indrive := uppercase(indrive);
  279.  
  280.     if paramcount > 1 then
  281.     begin
  282.       outdrive := paramstr(2);
  283.       if (pos(':',outdrive)=0) and (length(outdrive)=1) then
  284.         outdrive := outdrive + ':';
  285.       if not ( (length(outdrive)=2) and (upcase(outdrive[1]) in ['A'..'D']) and
  286.         (outdrive[2] = ':')) then
  287.       repeat
  288.         write('Copy to drive: ');
  289.         readln(outdrive);
  290.         if (pos(':',outdrive)=0) and (length(outdrive)=1) then
  291.           outdrive := outdrive + ':';
  292.       until (length(outdrive)=2) and (upcase(outdrive[1]) in ['A'..'D']) and
  293.         (outdrive[2] = ':');
  294.     end
  295.     else
  296.     begin
  297.       repeat
  298.         write('Copy to drive: ');
  299.         readln(outdrive);
  300.         if (pos(':',outdrive)=0) and (length(outdrive)=1) then
  301.           outdrive := outdrive + ':';
  302.       until (length(outdrive)=2) and (upcase(outdrive[1]) in ['A'..'D']) and
  303.         (outdrive[2] = ':');
  304.     end;
  305.     outdrive := uppercase(outdrive);
  306.  
  307.     confirm := false;
  308.     if paramcount > 2 then
  309.     begin
  310.       conf := paramstr(3);
  311.       if (conf[1] = '/') and (upcase(conf[2]) = 'C') then
  312.         confirm := true
  313.       else
  314.       begin
  315.         write('Confirm each file? (Y/N) ');
  316.         repeat
  317.           read(kbd,inch);
  318.         until upcase(inch) in ['Y','N'];
  319.         writeln(upcase(inch));
  320.         confirm := upcase(inch) = 'Y';
  321.  
  322.       end
  323.     end
  324.     else
  325.     begin
  326.         write('Confirm each file? (Y/N) ');
  327.         repeat
  328.           read(kbd,inch);
  329.         until upcase(inch) in ['Y','N'];
  330.         writeln(upcase(inch));
  331.         confirm := upcase(inch) = 'Y';
  332.     end;
  333.  
  334.     find;
  335.  
  336.     repeat
  337.       quit := false;
  338.       buffer := '';
  339.       write('Enter next copy mask, <ENTER> to quit: ');
  340.       readln(buffer);
  341.       if pos(':',buffer)>0 then
  342.         indrive := copy(buffer,1,2)
  343.       else
  344.         indrive := '';
  345.       indrive := uppercase(indrive);
  346.       if length(buffer) > 0 then
  347.       begin
  348.  
  349.         write('Confirm each file? (Y/N) ');
  350.         repeat
  351.           read(kbd,inch);
  352.         until upcase(inch) in ['Y','N'];
  353.         writeln(upcase(inch));
  354.         confirm := upcase(inch) = 'Y';
  355.  
  356.         find;
  357.  
  358.       end
  359.       else
  360.       begin
  361.         write('Quit? (Y/N) ');
  362.         repeat
  363.           read(kbd,inch);
  364.         until upcase(inch) in ['Y','N'];
  365.         writeln(upcase(inch));
  366.         quit := upcase(inch) = 'Y';
  367.       end
  368.     until quit;
  369.   end
  370.   else
  371.     writeln('Program Terminated');
  372. end.   {copywc6}
  373.  
  374.