home *** CD-ROM | disk | FTP | other *** search
/ RBBS in a Box Volume 1 #2 / RBBS_vol1_no2.iso / 014r / movewipe.zip / MOVEWIPE.PAS < prev   
Pascal/Delphi Source File  |  1986-11-29  |  21KB  |  1,037 lines
  1. {╔════════════════════════════════════════════════════════════════════════╗
  2.  ║    MOVE.COM   by   Lawrence Spiwak       08/19/86                      ║
  3.  ║                                                                        ║
  4.  ╚════════════════════════════════════════════════════════════════════════╝}
  5.  
  6. program Move_File_Across_Subdirs;
  7.  
  8. const
  9.    BufSize     = 20000;
  10.  
  11. type
  12.    String2     = string[2];
  13.    String4     = string[4];
  14.    String255   = string[255];
  15.    RegType     = record ax,bx,cx,dx,bp,si,di,ds,es,flags : integer end;
  16.  
  17. var
  18.    NextFile      : boolean;
  19.    InputFile     : string[12];
  20.    OutputFile    : string[12];
  21.    InPath        : string[243];
  22.    OutPath       : string[243];
  23.    File1         : string[255];
  24.    File2         : string[255];
  25.    FileIn        : file;
  26.    FileOut       : file;
  27.    Handle1       : integer;
  28.    Handle2       : integer;
  29.    Attribute     : integer;
  30.    Names         : array[1..600] of string[12];
  31.    DataBlock     : array [1..BufSize] of byte;
  32.    CompBlock     : array [1..BufSize] of byte;
  33.    ErrorA        : byte;
  34.    I,J,K         : integer;
  35.    BlocksRead    : integer;
  36.    PutUp         : string[37];
  37.    Address1      : string[37];
  38.    Address2      : string[19];
  39.    OKToProceed   : boolean;
  40.    Regs          : RegType;
  41.    Bytes1        : integer;
  42.    Bytes2        : byte;
  43.    Bytes3        : integer;
  44.    Bytes4        : byte;
  45.    Buffer        : string[127];
  46.    CmdLine       : string[127] absolute cseg:$80;
  47.    Sort          : boolean;
  48.    Retry         : boolean;
  49.  
  50.  
  51.  
  52.  
  53.  
  54. procedure Convert_Cases(var InputString : String255);
  55.  
  56. var
  57.    Temp   : char;
  58.    A,B    : integer;
  59.  
  60. begin
  61.  
  62. B:=length(InputString);
  63. for A:=1 to B do begin
  64.    Temp:=InputString[A];
  65.    InputString[A]:=UpCase(Temp);
  66.    end;
  67.  
  68. end;
  69.  
  70.  
  71.  
  72.  
  73.  
  74. procedure Translate;
  75.  
  76. var
  77.    Index  : integer;
  78.  
  79. begin
  80.  
  81. PutUp:='NNWDXHQD/BPL!azM`xqfmdd!Rqhx`lw0/01';
  82. Address1:='311FVmjufqthux!Amue$03/4';
  83. Address2:='Ndmaptsmf+!EM41:/2';
  84.  
  85. for Index:=1 to Length(PutUp) do
  86.    if Odd(Index) then
  87.       PutUp[Index]:=chr(ord(PutUp[Index])-1)
  88.    else
  89.       PutUp[Index]:=chr(ord(PutUp[Index])+1);
  90.  
  91. for Index:=1 to Length(Address1) do
  92.    if Odd(Index) then
  93.       Address1[Index]:=chr(ord(Address1[Index])-1)
  94.    else
  95.       Address1[Index]:=chr(ord(Address1[Index])+1);
  96.  
  97. for Index:=1 to Length(Address2) do
  98.    if Odd(Index) then
  99.       Address2[Index]:=chr(ord(Address2[Index])-1)
  100.    else
  101.       Address2[Index]:=chr(ord(Address2[Index])+1);
  102.  
  103. Writeln(PutUp);
  104. Writeln;
  105.  
  106. end;
  107.  
  108.  
  109.  
  110.  
  111.  
  112. function LegalFile(FileName : String255) : Boolean;
  113.  
  114. var
  115.    Legal : boolean;
  116.    A     : integer;
  117.  
  118. begin
  119.  
  120. Legal:=True;
  121. for A:=1 to length(Filename) do
  122.    if not(FileName[A] in ['A'..'Z','\','*','?','-','_','$','.',':','1'..'9']) then
  123.       Legal:=False;
  124. LegalFile:=Legal;
  125.  
  126. end;
  127.  
  128.  
  129.  
  130.  
  131.  
  132. procedure Get_Command_Line;
  133.  
  134. var
  135.    Temp        : char;
  136.    TempFile    : string[255];
  137.    A,B,C       : integer;
  138.  
  139. begin
  140.  
  141. Buffer:=CmdLine;
  142. {$V-} Convert_Cases(Buffer) {$V+};
  143.  
  144. A:=1;
  145. while (Buffer[1]=' ') and (A<(Length(Buffer)+1)) do begin
  146.    Buffer:=Copy(Buffer,2,Length(Buffer)-1);
  147.    A:=A+1;
  148.    end;
  149.  
  150. A:=1; B:=0;
  151. while (A<Length(Buffer)+1) and (B=0) do
  152.    if not (Buffer[A] in ['!'..'_']) then
  153.       B:=A
  154.    else
  155.       A:=A+1;
  156.  
  157. TempFile:=Copy(Buffer,1,B-1);
  158. if Length(TempFile)<1 then begin
  159.    Writeln;
  160.    Write('Specify: ');
  161.    TextColor(White);
  162.    Writeln('MOVEWIPE   source_file   destination_file   /S');
  163.    TextColor(Yellow);
  164.    Writeln;
  165.    Writeln('To move multiple files using wildcards, you must specify the destination path');
  166.    Writeln('only (or another wildcard).  For example:');
  167.    Writeln;
  168.    Writeln('       MOVEWIPE d1:dir1\dir2\filename.*  d2:dir3\dir4\*.*');
  169.    Writeln;
  170.    Writeln('Files selected with the wildcard cannot be moved to a single file.');
  171.    Writeln('Single files cannot be copied to wildcard files.  Files selected with');
  172.    Writeln('the wildcard cannot be renamed in the copying process.  However, single');
  173.    Writeln('files may be renamed by simply specifying a different destination name.');
  174.    Writeln('If the destination name is not found the current filename will be used.');
  175.    Writeln;
  176.    Writeln('An optional switch  "/S"  allows the user to sort the directory by filename.');
  177.    Writeln;
  178.    Writeln('If you find this program of use, please send $10 in contributions to:');
  179.    Writeln;
  180.    Writeln('                                ',copy(PutUp,17,15));
  181.    Writeln('                          ',Address1);
  182.    Writeln('                              ',Address2);
  183.    Halt;
  184.    end;
  185. C:=Length(Buffer)-B+1;
  186. Buffer:=Copy(Buffer,B,C);
  187. if not (Buffer[1]=' ') then begin
  188.    Writeln('Specify a Destination File');
  189.    Halt;
  190.    end
  191. else
  192.    Buffer:=Copy(Buffer,2,Length(Buffer)-1);
  193.  
  194. if not (LegalFile(TempFile)) then begin
  195.    Writeln('Illegal source filename');
  196.    Halt;
  197.    end;
  198.  
  199. B:=0;
  200. for A:=length(TempFile) downto 1 do
  201.    if (((TempFile[A]='\') or (TempFile[A]=':')) and (B=0)) then
  202.       B:=A;
  203.  
  204. if (B>0) then begin
  205.    A:=Length(TempFile);
  206.    InputFile:=Copy(TempFile,B+1,(A-B));
  207.    InPath:=Copy(TempFile,1,B);
  208.    if InputFile='' then begin
  209.       Writeln('Specify an Input File');
  210.       Halt;
  211.       end;
  212.    end
  213. else begin
  214.    InputFile:=TempFile;
  215.    InPath:=''
  216.    end;
  217.  
  218. if (Length(InPath)=2) and (InPath[2]=':') then begin
  219.    GetDir(Ord(InPath[1])-64,InPath);
  220.    if InPath[Length(InPath)]<>'\' then
  221.       InPath:=InPath+'\';
  222.       end
  223. else if InPath='' then begin
  224.    GetDir(0,InPath);
  225.    if InPath[Length(InPath)]<>'\' then
  226.       InPath:=InPath+'\';
  227.    end;
  228.  
  229. A:=1;
  230. while (Buffer[1]=' ') and (A<Length(Buffer)) do begin
  231.    Buffer:=Copy(Buffer,2,Length(Buffer)-1);
  232.    A:=A+1;
  233.    end;
  234.  
  235. A:=1; B:=0;
  236. while (A<128) and (B=0) do
  237.    if not (Buffer[A] in ['!'..'_']) then
  238.       B:=A
  239.    else
  240.       A:=A+1;
  241.  
  242. TempFile:=Copy(Buffer,1,B-1);
  243. Buffer:=Copy(Buffer,B,Length(Buffer)-Length(TempFile));
  244.  
  245. B:=Length(TempFile);
  246. if not (LegalFile(TempFile)) then begin
  247.    Writeln('Illegal destination filename');
  248.    Halt;
  249.    end;
  250.  
  251. B:=0;
  252. for A:=length(TempFile) downto 1 do
  253. if (((TempFile[A]='\') or (TempFile[A]=':')) and (B=0)) then B:=A;
  254. if (B>0) then begin
  255.    A:=Length(TempFile);
  256.    OutputFile:=Copy(TempFile,B+1,(A-B));
  257.    OutPath:=Copy(TempFile,1,B);
  258.    end
  259. else begin
  260.    OutputFile:=TempFile;
  261.    OutPath:='';
  262.    end;
  263.  
  264. if (Length(OutPath)=2) and (OutPath[2]=':') then begin
  265.    GetDir(Ord(OutPath[1])-64,OutPath);
  266.    if OutPath[Length(OutPath)]<>'\' then
  267.       OutPath:=OutPath+'\';
  268.       end
  269. else if OutPath='' then begin
  270.    GetDir(0,OutPath);
  271.    if OutPath[Length(OutPath)]<>'\' then
  272.       OutPath:=OutPath+'\';
  273.       end;
  274.  
  275. A:=1;
  276. while (Buffer[1]=' ') and (A<(Length(Buffer)+1)) do begin
  277.    Buffer:=Copy(Buffer,2,Length(Buffer)-1);
  278.    A:=A+1;
  279.    end;
  280.  
  281. end;
  282.  
  283.  
  284.  
  285.  
  286.  
  287. procedure Check_Input_File;
  288.  
  289. var
  290.    FileThere : boolean;
  291.    Index     : integer;
  292.    Temp      : integer;
  293.  
  294. begin
  295. with Regs do begin
  296.  
  297. File1:=InPath+InputFile+chr(0);
  298.  
  299. Index:=0;
  300. Attribute:=0;
  301. Temp:=1;
  302.  
  303. while (Attribute<>Temp) and (Index<5) do begin
  304.    ax:=$4300;  {Get attribute}
  305.    ds:=seg(File1);
  306.    dx:=ofs(File1)+1;
  307.    Intr($21,Regs);
  308.    Attribute:=cx;
  309.  
  310.    ax:=$4300;  {Get attribute again for safecheck.  Check up to 5 times}
  311.    ds:=seg(File1);
  312.    dx:=ofs(File1)+1;
  313.    Intr($21,Regs);
  314.    Temp:=cx;
  315.  
  316.    Index:=Index+1;
  317.    end;
  318.  
  319. if Attribute<>Temp then begin
  320.    TextColor(LightRed);
  321.    Writeln;
  322.    Writeln('Error reading attributes : Transient values returned.  Program aborted.');
  323.    Halt;
  324.    end;
  325.  
  326. ax:=$4301;   {Set attribute to null}
  327. cx:=$0000;
  328. ds:=seg(File1);
  329. dx:=ofs(File1)+1;
  330. Intr($21,Regs);
  331.  
  332. Assign(FileIn,InPath+InputFile);
  333. {$I-} Reset(FileIn) {I$+};
  334. FileThere:=(IOresult=0);
  335.  
  336. if FileThere then
  337.    Close(FileIn);
  338.  
  339. if not FileThere then begin
  340.    Writeln('File ',InPath,InputFile,' not found.');
  341.    Halt;
  342.    end;
  343.  
  344. end;
  345. end;
  346.  
  347.  
  348.  
  349.  
  350.  
  351. procedure Check_Output_File;
  352.  
  353. var
  354.    Temp      : char;
  355.    FileThere : boolean;
  356.    CheckFile : string[255];
  357.  
  358. begin
  359.  
  360. Temp:='Y';
  361. File2:=OutPath+OutputFile+chr(0);
  362.  
  363. Assign(FileIn,OutPath+OutputFile);
  364. {$I-} Reset(FileIn) {I$+};
  365. FileThere:=(IOresult=0);
  366.  
  367. if FileThere then
  368.    Close(FileIn);
  369.  
  370. if FileThere then begin
  371.    ClrEOL;
  372.    Write('File ',OutPath+OutputFile,' found.  Do you wish to overwrite? (Y/N)');
  373.    repeat
  374.    Read(kbd,Temp);
  375.    until (Upcase(Temp) in ['Y','N']);
  376.    end;
  377.  
  378. NextFile:=True;
  379.  
  380. if Upcase(Temp)='N' then begin
  381.    write(' N');
  382.    NextFile:=False;
  383.    end
  384. else
  385.    with Regs do begin
  386.    ax:=$4301;  {Get/Set Attribute}
  387.    cx:=0;
  388.    ds:=seg(File2);
  389.    dx:=ofs(File2)+1;
  390.    Intr($21,Regs);
  391.    if (flags and 1)>1 then
  392.       NextFile:=False;
  393.    end;
  394.  
  395. Write(chr(13));
  396. ClrEOL;
  397.  
  398. if not(NextFile) then begin
  399.    Write(InPath,InputFile,' to ',OutPath,OutputFile,'  ');
  400.    TextColor(LightRed+Blink);
  401.    if ((Regs.flags and 1)>1) and (Regs.ax = 5) then
  402.       Writeln('Access Denied.')
  403.    else
  404.       Writeln('Not Moved.');
  405.    TextColor(Yellow);
  406.    end;
  407.  
  408. end;
  409.  
  410.  
  411.  
  412.  
  413.  
  414. procedure Read_And_Write;
  415.  
  416. var
  417.    Error1 : integer;
  418.    Error2 : integer;
  419.  
  420. begin
  421.  
  422. File1:=InPath+InputFile+chr(0);
  423. File2:=OutPath+OutputFile+chr(0);
  424.  
  425. Error1:=0;
  426. Error2:=0;
  427.  
  428. with Regs do begin
  429.  
  430. ax:=$3D02;        { Open Input File }
  431. ds:=seg(File1);
  432. dx:=ofs(File1)+1;
  433. Intr($21,Regs);
  434.  
  435. if (flags and 1)>0 then begin
  436.    TextColor(LightRed);
  437.    Write('Error opening Source : ');
  438.  
  439.    Case ax of
  440.    3: begin
  441.       Writeln('No such path.  Program aborted.');
  442.       TextColor(Yellow);
  443.       Halt;
  444.       end;
  445.    4: begin
  446.       Writeln('No handle available.  Close all files before attempting');
  447.       Writeln('MOVEWIPE.  Program aborted.');
  448.       Halt;
  449.       end;
  450.    end;
  451.    end;
  452.  
  453. Handle1:=ax;      { Store File Handle }
  454. Error1:=flags and 1;
  455.  
  456.  
  457. If Error1=0 then begin
  458.  
  459. ax:=$3C00;        { Open/Create Output File }
  460. ds:=seg(File2);
  461. dx:=ofs(File2)+1;
  462. cx:=$0000;
  463. Intr($21,Regs);
  464.  
  465. if ((flags and 1)>0) and (ax=5) then begin
  466.    OutPath:=OutPath+OutputFile+'\';
  467.    OutputFile:=InputFile;
  468.    File2:=OutPath+OutputFile+chr(0);
  469.    ax:=$3C00;     {Open/Create Again Assuming Directory}
  470.    ds:=seg(File2);
  471.    dx:=ofs(File2)+1;
  472.    cx:=$0000;
  473.    Intr($21,Regs);
  474.    end;
  475.  
  476. if (flags and 1)>0 then begin
  477.    TextColor(LightRed);
  478.    Writeln;
  479.    Write('Error creating Destination : ');
  480.  
  481.    Case ax of
  482.    3: Writeln('No such path as ',Outpath);
  483.    4: begin
  484.       Writeln;
  485.       Writeln('No handle available.  Close all files before attempting MOVEWIPE.');
  486.       end;
  487.    5: begin
  488.       Writeln('Access denied to file.');
  489.       Writeln('You may be trying to copy a file to a directory name.');
  490.       Writeln('Please check before continuing.  Program aborted.');
  491.       end;
  492.    end;
  493.    TextColor(White);
  494.    Halt;
  495.    end;
  496.  
  497. Handle2:=ax;
  498.  
  499. Writeln(File1,'to ',File2); ClrEOL;
  500. Write('Copying,');
  501.  
  502. Bytes1:=0;
  503. Bytes2:=0;
  504. Bytes3:=0;
  505. Bytes4:=0;
  506.  
  507. repeat
  508.  
  509. ax:=$3F00;        { Read bytes from Input File }
  510. bx:=Handle1;
  511. cx:=BufSize;
  512. ds:=seg(DataBlock);
  513. dx:=ofs(DataBlock);
  514. Intr($21,Regs);
  515. BlocksRead:=ax;   { Number of bytes actually read }
  516. Error1:=flags and 1;
  517.  
  518. if (BlocksRead=BufSize) then
  519.    Bytes2:=Bytes2+1
  520. else
  521.    Bytes1:=BlocksRead;
  522.  
  523. if BlocksRead>0 then begin
  524.    ax:=$4000;        { Write block to Output File }
  525.    bx:=Handle2;
  526.    cx:=BlocksRead;
  527.    ds:=seg(DataBlock);
  528.    dx:=ofs(DataBlock);
  529.    Intr($21,Regs);
  530.    end;
  531. Error2:=flags and 1;
  532.  
  533. if (ax=BufSize) then
  534.    Bytes4:=Bytes4+1
  535. else
  536.    Bytes3:=ax;
  537.  
  538.  
  539. until (BlocksRead<>BufSize) or (ax<>BlocksRead) or (Error1=1) or (Error2=1);
  540.  
  541. end;
  542.  
  543. if (BlocksRead<>ax) or (Error1=1) or (Error2=1) then begin
  544.    if Error1=1 then
  545.       Write('error reading source file,')
  546.    else
  547.       Write('error writing destination file,');
  548.  
  549.    OKToProceed:=False;
  550.    end
  551. else
  552.    OKToProceed:=True;
  553.  
  554. end;
  555. end;
  556.  
  557.  
  558.  
  559.  
  560.  
  561. procedure Verify_File;
  562.  
  563. var
  564.    I : integer;
  565.  
  566. begin
  567.  
  568. write(' verifying,');
  569.  
  570. with Regs do begin
  571.  
  572. ax:=$4200;        {Goto beginning of file}
  573. bx:=Handle1;
  574. cx:=$0000;
  575. dx:=$0000;
  576. Intr($21,Regs);
  577.  
  578. ax:=$4200;        {Goto beginning of file}
  579. bx:=Handle2;
  580. cx:=$0000;
  581. dx:=$0000;
  582. Intr($21,Regs);
  583.  
  584. {InLine($51/$56/$57/$50);
  585. InLine($06/$1E/$07/$BE/DataBlock/$BF/CompBlock/$B9/$4E20/$8A/$24);
  586. InLine($88/$25/$46/$47/$E2/$F8/$07);
  587. InLine($58/$5F/$5E/$59);}
  588.  
  589. repeat
  590.  
  591. FillChar(DataBlock,SizeOf(DataBlock),0);
  592. FillChar(CompBlock,SizeOf(CompBlock),0);
  593.  
  594. ax:=$3F00;
  595. bx:=Handle1;
  596. cx:=BufSize;
  597. ds:=seg(DataBlock);
  598. dx:=ofs(DataBlock);
  599. Intr($21,Regs);
  600.  
  601. if ax>0 then begin
  602.    cx:=ax;
  603.    ax:=$3F00;
  604.    bx:=Handle2;
  605.    ds:=seg(CompBlock);
  606.    dx:=ofs(CompBlock);
  607.    Intr($21,Regs);
  608.    end;
  609.  
  610. ErrorA:=0;
  611. I:=1;
  612. While (I<=BufSize) and (ErrorA=0) do begin
  613.    if CompBlock[I]<>DataBlock[I] then
  614.       ErrorA:=1;
  615.    I:=I+1;
  616.    end;
  617.  
  618. {InLine($51/$56/$57/$50);
  619. InLine($53/$06/$1E/$07/$BE/CompBlock/$BF/DataBlock/$B9/$4E20/$8A/$24);
  620. InLine($8A/$FC/$8A/$25/$3A/$E7/$75/$06/$46/$47/$E2/$F2/$7A/$05);
  621. InLine($C6/$06/ErrorA/$01/$407/$5B);
  622. InLine($58/$5F/$5E/$59);}
  623.  
  624. if (ErrorA=1) then
  625.    OKToProceed:=False
  626. else
  627.    OKToProceed:=True;
  628.  
  629. until (not OKToProceed) or (ax<>BufSize);
  630.  
  631. if OKToProceed then
  632.    Write(' pass,')
  633. else
  634.    Write(' fail,');
  635.  
  636. end;
  637. end;
  638.  
  639.  
  640.  
  641.  
  642.  
  643. procedure Close_Files;
  644.  
  645. begin
  646.  
  647. with regs do begin
  648.  
  649. ax:=$3E00;        {Close Files}
  650. bx:=Handle2;
  651. Intr($21,Regs);
  652.  
  653. ax:=$3E00;
  654. bx:=Handle1;
  655. Intr($21,Regs);
  656.  
  657. ax:=$4301;
  658. cx:=Attribute;
  659. if not (OKToProceed) then begin
  660.    ds:=seg(File1);
  661.    dx:=ofs(File1)+1;
  662.    end
  663. else begin
  664.    ds:=seg(File2);
  665.    dx:=ofs(File2)+1;
  666.    end;
  667.  
  668. Intr($21,Regs);
  669.  
  670. Write(' done.');
  671. GotoXY(1,WhereY-1);
  672. Write(File1,'to ',File2);
  673.  
  674. if (OKToProceed) then begin
  675.    TextColor(LightGreen);
  676.    Writeln('  Moved.');
  677.    TextColor(Yellow);
  678.    end
  679. else begin
  680.    TextColor(LightRed+Blink);
  681.    Writeln('  Not moved.');
  682.    TextColor(Yellow);
  683.    end;
  684.  
  685. end;
  686. end;
  687.  
  688.  
  689.  
  690.  
  691.  
  692. procedure Delete_Input;
  693.  
  694. var
  695.    Count : integer;
  696.  
  697. begin
  698.  
  699. Write(' wiping and deleting input,');
  700.  
  701. with Regs do begin
  702.  
  703. ax:=$4200;        {Goto beginning of file}
  704. bx:=Handle1;
  705. cx:=$0000;
  706. dx:=$0000;
  707. Intr($21,Regs);
  708.  
  709. FillChar(DataBlock,SizeOf(DataBlock),0);
  710.  
  711. if (Bytes2<>0) then begin
  712.    for Count:=1 to Bytes2 do begin
  713.       ax:=$4000;
  714.       bx:=Handle1;
  715.       cx:=BufSize;
  716.       ds:=seg(DataBlock);
  717.       dx:=ofs(DataBlock);
  718.       Intr($21,Regs);
  719.    end;
  720.    end;
  721.  
  722. if (Bytes1<>0) then begin
  723.    ax:=$4000;
  724.    bx:=Handle1;
  725.    cx:=Bytes1;
  726.    ds:=seg(DataBlock);
  727.    dx:=ofs(DataBlock);
  728.    Intr($21,Regs);
  729.    end;
  730.  
  731. Close_Files;
  732. ax:=$4100;           {Delete file}
  733. ds:=seg(File1);
  734. dx:=ofs(File1)+1;
  735. Intr($21,Regs);
  736. K:=K+1;
  737.  
  738. end;
  739. end;
  740.  
  741.  
  742.  
  743.  
  744.  
  745. procedure Delete_Output;
  746.  
  747. var
  748.    count : integer;
  749.    Temp  : char;
  750.  
  751. begin
  752.  
  753. Write(' wiping and deleting output,');
  754.  
  755. with Regs do begin
  756.  
  757. ax:=$4200;   {Goto beginning of file}
  758. bx:=Handle2;
  759. cx:=$0000;
  760. dx:=$0000;
  761. Intr($21,Regs);
  762.  
  763. FillChar(DataBlock,SizeOf(DataBlock),0);
  764.  
  765. if (Bytes4<>0) then begin
  766.    for Count:=1 to Bytes4 do begin
  767.       ax:=$4000;
  768.       bx:=Handle2;
  769.       cx:=BufSize;
  770.       ds:=seg(DataBlock);
  771.       dx:=ofs(DataBlock);
  772.       Intr($21,Regs);
  773.    end;
  774.    end;
  775.  
  776. if (Bytes3<>0) then begin
  777.    ax:=$4000;
  778.    bx:=Handle2;
  779.    cx:=Bytes3;
  780.    ds:=seg(DataBlock);
  781.    dx:=ofs(DataBlock);
  782.    Intr($21,Regs);
  783.    end;
  784.  
  785. Close_Files;
  786. ax:=$4100;           {Delete file}
  787. ds:=seg(File2);
  788. dx:=ofs(File2)+1;
  789. Intr($21,Regs);
  790. ClrEOL;
  791. TextColor(LightRed);
  792. if (J-K)>0 then
  793.    Write((J-K),' files left. ');
  794. Write('Do you wish to Abort, Continue, or Retry (A/C/R)?');
  795. Temp:=' ';
  796. repeat
  797. repeat
  798. Sound(440);
  799. Delay(100);
  800. Sound(880);
  801. Delay(100);
  802. Until (KeyPressed);
  803. Read(kbd,Temp);
  804. Until (UpCase(Temp) in ['A','C','R']);
  805. NoSound;
  806. Write(chr(13));
  807. ClrEOL;
  808. TextColor(Yellow);
  809. if (UpCase(Temp)='A') then
  810.    Halt;
  811. if (UpCase(Temp)='R') then begin
  812.    Retry:=True;
  813.    GotoXY(1,WhereY-1);
  814.    ClrEOL;
  815.    end
  816. else
  817.    Retry:=False;
  818.  
  819. end;
  820. end;
  821.  
  822.  
  823.  
  824.  
  825.  
  826. procedure Sort_Dir(Num:integer);
  827.  
  828. var
  829.    I     : integer;
  830.    Done  : boolean;
  831.    Temp  : string[20];
  832.  
  833. begin
  834.  
  835. if Num>1 then begin
  836.    repeat
  837.  
  838.    Done:=True;
  839.  
  840.    for I:=2 to Num do
  841.       if Names[I-1] > Names[I] then begin
  842.          Temp:=Names[I];
  843.          Names[I]:=Names[I-1];
  844.          Names[I-1]:=Temp;
  845.          Done:=False;
  846.          end;
  847.  
  848.    until (Done);
  849.    end;
  850.  
  851. end;
  852.  
  853.  
  854.  
  855.  
  856.  
  857. procedure Dir_List;
  858.  
  859. var
  860.    DTA       : array [1..53] of byte;
  861.    Mask      : string [127];
  862.    NamR      : string [20];
  863.    Error,I   : integer;
  864.    Wild      : boolean;
  865.  
  866. begin
  867.  
  868. J:=2;
  869. FillChar(DTA,SizeOf(DTA),0);
  870. FillChar(Mask,SizeOf(Mask),0);
  871. FillChar(NamR,SizeOf(NamR),0);
  872.  
  873. with Regs do begin
  874.  
  875. ax:=$1A00;
  876. ds:=seg(DTA);
  877. dx:=ofs(DTA);
  878. Intr($21,Regs);
  879.  
  880. Error:=0;
  881. Mask:=InPath+InputFile+chr(0);
  882.  
  883. ax:=$4E00;
  884. ds:=seg(Mask);
  885. dx:=ofs(Mask)+1;
  886. cx:=$0003;
  887. Intr($21,Regs);
  888. Error:=ax and $FF;
  889.  
  890. I:=1;
  891. if (Error = 0) then repeat
  892.    NamR[I]:=chr(mem[seg(DTA):ofs(DTA)+29+I]);
  893.    I:=I+1;
  894.    until not (NamR[I-1] in [' '..'~']) or (I>20);
  895.  
  896. NamR[0]:=chr(I-1);
  897. Names[1]:=NamR;
  898.  
  899. while (Error=0) and (J<601) do begin
  900.    Error:=0;
  901.    ax:=$4F00;
  902.    cx:=$0003;
  903.    Intr($21,Regs);
  904.    Error:=ax and $FF;
  905.    I:=1;
  906.    repeat
  907.       NamR[I]:=chr(mem[seg(DTA):ofs(DTA)+29+I]);
  908.       I:=I+1;
  909.       Until not (NamR[I-1] in [' '..'~']) or (I>20);
  910.       NamR[0]:=chr(I-1);
  911.       if (Error=0) then begin
  912.          Names[J]:=NamR;
  913.          J:=J+1;
  914.          end;
  915.    end;
  916.  
  917. Wild:=False;
  918. K:=1;
  919. for I:=1 to Length(InputFile) do
  920.     if (InputFile[I]='?') or (InputFile[I]='*') then
  921.        Wild:=True;
  922.  
  923. if Wild then begin
  924.    if Length(Buffer)<>0 then begin
  925.       if not (UpCase(Buffer[2])='S') then begin
  926.          Writeln('Switch not recognized.  Directory will not be sorted.')
  927.          end
  928.       else
  929.          begin
  930.          Sort_Dir(J-1);
  931.          Writeln('Directory sort:');
  932.          end;
  933.          end;
  934.    Wild:=False;
  935.    if (OutputFile='') or (OutputFile='*.*') or (OutputFile='*') then begin
  936.       I:=1;
  937.       While (I<J) do begin
  938.          if Names[I]<>'' then begin
  939.             InputFile:=Names[I];
  940.             OutputFile:=Names[I];
  941.             if (InPath+InputFile)=(OutPath+OutputFile) then begin
  942.                Writeln('A file cannot be copied onto itself.  Specify another directory or drive.');
  943.                Halt;
  944.                end;
  945.             Check_Input_File;
  946.             Check_Output_File;
  947.             Retry:=False;
  948.             repeat
  949.             if NextFile then begin
  950.                Read_And_Write;
  951.                if (OKToProceed) then
  952.                   Verify_File;
  953.                if (OKToProceed) then
  954.                   Delete_Input
  955.                else
  956.                   Delete_Output;
  957.                end;
  958.             until (Retry=False);
  959.             end;
  960.          I:=I+1;
  961.          end;
  962.       end
  963.    else begin
  964.       OutPath:=Outpath+OutputFile+'\';
  965.       I:=1;
  966.       While (I<J) do begin
  967.          if Names[I]<>'' then begin
  968.             InputFile:=Names[I];
  969.             OutputFile:=Names[I];
  970.             if (InPath+InputFile)=(OutPath+OutputFile) then begin
  971.                Writeln('A file cannot be copied onto itself.  Specify another directory or drive.');
  972.                Halt;
  973.                end;
  974.             Check_Input_File;
  975.             Check_Output_File;
  976.             Retry:=False;
  977.             repeat
  978.             if NextFile then begin
  979.                Read_And_Write;
  980.                if (OKToProceed) then
  981.                   Verify_File;
  982.                if (OKToProceed) then
  983.                   Delete_Input
  984.                else
  985.                   Delete_Output;
  986.                end;
  987.             until (Retry=False);
  988.             end;
  989.          I:=I+1;
  990.          end;
  991.       end;
  992.       end
  993. else begin
  994.    Wild:=False;
  995.    for I:=1 to Length(OutputFile) do
  996.       if (OutputFile[I]='?') or (OutputFile[I]='*') then
  997.          Wild:=True;
  998.    if Wild then begin
  999.       Writeln('Single files cannot be copied to a wildcard.  Use a specific destination name.');
  1000.       Halt;
  1001.       end
  1002.    else begin
  1003.       if OutputFile='' then
  1004.          OutputFile:=InputFile;
  1005.  
  1006.       if (InPath+InputFile)=(OutPath+OutputFile) then begin
  1007.          Writeln('A file cannot be copied onto itself.  Specify another directory or drive.');
  1008.          Halt;
  1009.          end;
  1010.  
  1011.       Check_Input_File;
  1012.       Check_Output_File;
  1013.       If NextFile then begin
  1014.          Read_And_Write;
  1015.          if (OKToProceed) then
  1016.             Verify_File;
  1017.          if (OKToProceed) then
  1018.             Delete_Input
  1019.          else
  1020.             Delete_Output;
  1021.             end;
  1022.       end;
  1023.    end;
  1024. end;
  1025. end;
  1026.  
  1027.  
  1028.  
  1029.  
  1030.  
  1031. BEGIN                {Main program}
  1032. Translate;
  1033. OKToProceed:=True;
  1034. Get_Command_Line;
  1035. Dir_List;
  1036. ClrEOL;
  1037. END.              {Main program}