home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol291 / delete.pqs / delete.pas
Encoding:
Pascal/Delphi Source File  |  1986-12-17  |  1.6 KB  |  70 lines
  1. program delete_file;
  2. {
  3.  Delete files in CP/M-80 while in Turbo envionment.
  4.  Use by block reading to top of Turbo program, running, and then block erase.
  5.  
  6.  Drive specification and wildcards may be used (B:*.BAK, TEST.*, etc.).
  7.  
  8.                    ....Richard J. Hunter [70227,137]
  9.                        June13, 985
  10. }
  11. const
  12.   delete =  19; {bdos delete file function}
  13. var
  14.   fcb    :  array[0..11] of char;
  15.   mask   :  string[14];
  16.   result,
  17.   i,j    :  integer;
  18.  
  19. procedure fill_fcb; {fils fcb wil file ame, expands wildcards}
  20.   begin
  21.     if pos('.',mask)=0 then
  22.       begin
  23.         writeln('ERROR : Must include file extension');
  24.         halt;
  25.       end;
  26.     fillchar(fcb[1],11,'?'); {start with fcb full of '?'s}
  27.     if pos(':',mask)>0 then
  28.       begin
  29.         fcb[0]:=char(ord(copy(mask,1,1))-64);{assign drive no.}
  30.         delete(mask,1,2);
  31.       end
  32.     else
  33.       fcb[0]:=char(0); {default drive}
  34.  
  35.     {now fill fie name}
  36.     i:=1;
  37.     while (mask[i]<>'.') and (i<9) do
  38.       begin
  39.         if mask[i]='*' then
  40.           i:=8
  41.         else
  42.           fcb[i]:=mask[i];
  43.         i:=i+1;
  44.       end;
  45.  
  46.     {now fill file extension}
  47.     i:=9;
  48.     j:=pos('.',mask)+1;
  49.     while j<=length(mask) do
  50.       begin
  51.         if mask[j]='*' then
  52.           j:=length(mask)
  53.         else
  54.           fcb[i]:=mask[j];
  55.         i:=i+1;j:=j+1;
  56.       end;
  57.  
  58.   end;
  59.  
  60. begin {main}
  61.   clrscr;
  62.   write('DELETE FILES--enter [drive:]filename.ext : ');
  63.   readln(mask);
  64.   fill_fcb;
  65.   result:=bdos(delete,addr(fc[0]));
  66.   if result=255 then writeln('No files found!');
  67. end. {main}
  68. eadln(mask);
  69.   fill_fcb;
  70.   result:=bdos(delete,addr(