home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-387-Vol-3of3.iso / m / msh_ut11.zip / CPMV.INC < prev    next >
Text File  |  1992-05-10  |  38KB  |  1,058 lines
  1. {-----------------------------------------------------}
  2. { Jens Pirnay <pirnay@rphs1.physik.uni-regensburg.de> }
  3. { This file is subject to the copyleft-regulations    }
  4. { of the Free Software Foundation (the guys from GNU) }
  5. {-----------------------------------------------------}
  6. {
  7.   This is a common include-file for cp.pas and mv.pas,
  8.   there are only slight differences, that can be easily
  9.   overcome by conditional compilation
  10. }
  11.  
  12. {
  13.   Mark a special case: if there is only one file
  14.   to copy or move, we will treat the destination path as
  15.   the destination file (if this name isn't a directory)
  16. }
  17. {$V-,I-} { No fuzzy string-check, no io-errors }
  18.   CONST
  19.     BuffSize   = $8000;
  20.     DAttr      = Dos.Directory OR Dos.Hidden   OR Dos.ReadOnly;
  21.     WAttr : BYTE = Dos.ReadOnly;
  22.     FAttr : BYTE = Dos.Archive OR Dos.ReadOnly OR Dos.Directory;
  23.   TYPE
  24.     Bfr  = ARRAY [1..BuffSize] OF BYTE;
  25.     pBuf = ^Buffer;
  26.     Buffer = RECORD
  27.       Buf  : Bfr;
  28.       next : pBuf
  29.     END;
  30.     FP = ^FL;
  31.     FL = RECORD
  32.       sRec     : Dos.SearchRec;
  33. {$IFDEF MV}
  34.       SourceDir  : Dos.DirStr;
  35. {$ENDIF}
  36.       numRecrd,           { Num of read-Record }
  37.       numByte  : WORD;    { Num ov read-Byte }
  38.       WCount   : LONGINT; { total written-byte }
  39.       sAdrBuf  : POINTER; { start address of the Buffer }
  40.       eoFF,               { input is EOF }
  41.       skip     : BOOLEAN; { this file should be skipped }
  42.       nextP    : FP
  43.     END;
  44.     dDisk    = (source, dest);
  45.  
  46.   CONST Bsize = SIZEOF (Buffer) + SIZEOF (FL);
  47.  
  48.   VAR
  49.     progName : Dos.NameStr;
  50.     st : STRING [2];
  51.  
  52.   CONST
  53.     psp : INTEGER = 1;
  54. {$IFDEF CP}
  55.     tStamp     : BOOLEAN = FALSE;  { By default copy even newer files }
  56. {$ENDIF}
  57. {$IFDEF FORMAT}
  58.     FormatDrv  : BOOLEAN = FALSE;  { By default don't ask for format  }
  59. {$ENDIF}
  60.     recursion  : BOOLEAN = FALSE;  { No recursion by default          }
  61.     force      : BOOLEAN = FALSE;  { By default don't overwrite       }
  62.  
  63. { ---------------------- general procedure/Functions ---------------------- }
  64.  
  65.    PROCEDURE abort;
  66.    BEGIN
  67.      EndInfo;
  68.      HALT;
  69.    END;
  70.  
  71. {$IFDEF Format}
  72. const
  73.   disksides = 2;
  74.   {Anzahl der zu formatierenden Seiten}
  75.   bootsek  : array[1..108] of byte =
  76.   ($eb,$34,$90,$56,$42,32,$2d,32,$63,$27,$54,
  77.    0,2,0,1,0,2,0,0,0,0,0,0,0,0,0,disksides,
  78.    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  79.    0,0,0,0,0,0,$fa,$b8,$30,0,$8e,$d0,$bc,$fc,
  80.    0,$fb,$e,$1f,$bb,7,0,$be,$6c,$7c,$90,$8a,
  81.    4,$46,$3c,0,$74,8,$b4,$e,$56,$cd,$10,$5e,
  82.    $eb,$f1,$b4,1,$cd,$16,$74,6,$b4,0,$cd,$16,
  83.    $eb,$f4,$b4,0,$cd,$16,$33,$d2,$cd,$19);
  84. {$IFDEF German}
  85.    boottext1 : array[1..39] of char =
  86.      #13#10'Diskette hat keine Systemdateien !'#13#10#10;
  87.    boottext2 : array[1..83] of char =
  88.      'Um die Systemdateien zu übertragen muß die Diskette mit SYS A: behandelt werden.'#13#10#10;
  89.    boottext3 : array[1..59] of char =
  90.      'Bitte Diskette wechseln und weiter mit beliebiger Taste.'#13#10#10;
  91. {$ELSE}
  92.    boottext1 : array[1..39] of char =
  93.      #13#10'This disk contains no systemfiles!'#13#10#10;
  94.    boottext2 : array[1..83] of char =
  95.      'To make disk bootable, you have transfer system-files with the command "SYS A:".'#13#10#10;
  96.    boottext3 : array[1..59] of char =
  97.      'Please change disks and continue by pressing any key... '#13#10#10;
  98. {$ENDIF}
  99.  
  100. type
  101.   sector = array[1..512] of byte;
  102.   track  = array[1..18,1..512] of byte;
  103.   secptr = ^track;
  104.  
  105. var
  106.   fmttyp            : shortint;  {Formatauswahl}
  107.   art               : byte;      {Art des Laufwerks (s. Formunit)}
  108.   verifyflag        : boolean;   {Verifizieren ?}
  109.   puffer            : secptr;    {Platz für max. 18 Sektoren}
  110.  
  111. {***********************Unterprogramme***********************}
  112.  
  113. procedure ExitFmt;
  114. begin
  115.   laufwerkstabalt;
  116.   freemem(puffer, SizeOf(track));
  117. end;
  118.  
  119. {************************************************************}
  120.  
  121. procedure diskprep(drive: byte; sekzahl : byte; anzsek : word);
  122. var               {Bootsektor, ROOT und FAT schreiben}
  123.   zaehler : byte;
  124.   anzahl  : byte;
  125.   i       : integer;
  126.   kopie   : integer;
  127.   fehler  : byte;
  128.  
  129. begin
  130.   anzahl:=formtab^[4]*2+round(formtab^[3]*32/512);
  131.   {Sektoren FAT und ROOT}
  132.   fillchar(puffer^, SizeOf(track), 0); {Puffer löschen}
  133.   for i:=1 to 108 do puffer^[1,i]:=bootsek[i];
  134.   puffer^[1,14]:=formtab^[2]; {Sektoren pro Cluster}
  135.   puffer^[1,18]:=formtab^[3];
  136.   puffer^[1,19]:=0; {Anzahl der Einträge im Hauptverzeichnis}
  137.   puffer^[1,20]:=lo(anzsek);
  138.   puffer^[1,21]:=hi(anzsek);  {Anzahl der Sektoren total}
  139.   puffer^[1,22]:=formtab^[1]; {Mediabyte}
  140.   puffer^[1,23]:=formtab^[4];
  141.   puffer^[1,24]:=0;         {Sektoren pro FAT}
  142.   puffer^[1,25]:=sekzahl;   {Sektoren pro Seite einer Spur}
  143.   for i:=1 to 39 do puffer^[1,i+108]:=ord(boottext1[i]);
  144.   for i:=1 to 83 do puffer^[1,i+147]:=ord(boottext2[i]);
  145.   for i:=1 to 59 do puffer^[1,i+230]:=ord(boottext3[i]);
  146.   puffer^[1,511]:=$55;
  147.   puffer^[1,512]:=$aa;    {Ende des Bootsektors}
  148.   fehler:=readwriteverify(3, 0, 0, 1, 1, drive, puffer^);
  149.   for i:=1 to 512 do puffer^[1,i]:=0;
  150.   {Bootsektor in Puffer löschen}
  151.   puffer^[1,1]:=formtab^[1]; {Mediabyte}
  152.   puffer^[1,2]:=$ff;
  153.   puffer^[1,3]:=$ff;
  154.   kopie:=formtab^[4]+1;
  155.   puffer^[kopie,1]:=formtab^[1];
  156.   puffer^[kopie,2]:=$ff;
  157.   puffer^[kopie,3]:=$ff;
  158.   fehler:=readwriteverify(3, 0, 0, 2, sekzahl-1, drive,
  159.                           puffer^);
  160.   dec(anzahl,sekzahl-1);
  161.   fillchar(puffer^, SizeOf(track), 0); {Puffer löschen}
  162.   fehler:=readwriteverify(3, 0, 1, 1, anzahl, drive,
  163.                           puffer^);
  164. end;
  165.  
  166. {************************************************************}
  167.  
  168. procedure diskformat(drive, fmttyp, spurzahl, sekzahl : byte);
  169.                     {Diskette formatieren}
  170. var
  171.   spur      : byte;    {Aktuelle Spur}
  172.   sek       : byte;    {Aktueller Sektorpuffer}
  173.   seite     : byte;    {Aktuelle Seite}
  174.   anzsektor : word;    {Sektoren auf Disk}
  175.   fehler    : byte;    {Fehler bei Diskoperationen}
  176.  
  177. begin
  178.   getmem(puffer, SizeOf(track));
  179.   schreibrate(art, fmttyp, drive);
  180.   {Schreibrate für Format setzen}
  181.   laufwerkstabneu;        {DPB für Format setzen}
  182.   anzsektor:=spurzahl*sekzahl*disksides;
  183.   spur:=0;
  184.   repeat
  185.     if einzelschritt then einzelstep;
  186.     for seite:=0 to (disksides-1) do
  187.     begin
  188.     {$IFDEF German}
  189.       UpdateInfo (2, 'Formatiere...', spur*disksides+seite,
  190.                   spurzahl*disksides);
  191.     {$ELSE}
  192.       UpdateInfo (2, 'Formatting...', spur*disksides+seite,
  193.                   spurzahl*disksides);
  194.     {$ENDIF}
  195.       fehler:=spurformat(spur, seite, 1, sekzahl, drive);
  196.       if fehler=3 then
  197.       begin
  198.       {$IFDEF German}
  199.         fehler := Alert('Diskette ist schreibgeschützt !', 'Abbruch');
  200.       {$ELSE}
  201.         fehler := Alert('Disk is write protected !', 'Cancel');
  202.       {$ENDIF}
  203.         ExitFmt;
  204.         exit;
  205.       end;
  206.       if verifyflag then
  207.         fehler:=readwriteverify(4, spur, seite, 1,
  208.                                 sekzahl, drive, puffer^);
  209.       if fehler<>0 then
  210.       begin
  211.  
  212.       {$IFDEF German}
  213.         fehler := Alert('Diskette für dieses Format unbrauchbar !', 'Abbruch');
  214.       {$ELSE}
  215.         fehler := Alert('Improper format for this disk!', 'Cancel');
  216.       {$ENDIF}
  217.         ExitFmt;
  218.         exit;
  219.       end;
  220.     end;
  221.     inc(spur);   {Nächste Spur}
  222.   until (spur>=spurzahl);
  223.   diskprep(drive, sekzahl, anzsektor);
  224.   ExitFmt;
  225. end;
  226.  
  227. PROCEDURE FormatDrive (drive : BYTE);
  228. BEGIN
  229.   verifyflag:=true; {Verify : ON}
  230.   art:=laufwerka;  {Art des Laufwerkes s. Unit Formunit}
  231.   if drive=0 then art:=laufwerka else art:=laufwerkb;
  232. {$IFDEF German}
  233.   fmttyp := Alert('Disketten-Kapazität in kB', '360|720|1200|1440');
  234. {$ELSE}
  235.   fmttyp := Alert('Disk-capacity in kB', '360|720|1200|1440');
  236. {$ENDIF}
  237.   case fmttyp of
  238.     1 : diskformat(drive, fmttyp, 40, 9);  {360 KB}
  239.     2 : diskformat(drive, fmttyp, 80, 9);  {720 KB}
  240.     3 : diskformat(drive, fmttyp, 80, 15); {1,2 MB}
  241.     4 : diskformat(drive, fmttyp, 80, 18); {1,44 MB}
  242.    ELSE
  243.   end;
  244. end;
  245. {$ENDIF}
  246.  
  247.   PROCEDURE CheckDrive(dst : STRING);
  248.   var regs             : Registers;
  249.       drive, ans, stat : BYTE;
  250.       problem, options : STRING;
  251.  
  252.   begin
  253.     IF Copy(dst, 2, 1) = ':' THEN
  254.     BEGIN
  255.       drive := ORD(Upcase(dst[1])) - ORD('A');
  256.       IF drive<2 THEN
  257.       BEGIN
  258.         REPEAT
  259.           with regs do
  260.             begin
  261.               ah := $00;
  262.               intr($13,regs);
  263.               ah := $03;
  264.               al := $01;
  265.               dh := $00;
  266.               dl := drive;
  267.               ch := $00;
  268.               cl := $FF;
  269.               intr($13,regs);
  270.             end;
  271.             case mem[$40:$41] of
  272.               $02,$04 : stat := 0;   { OK }
  273.               $03     : stat := 1    { WriteProt }
  274.              else       stat := 2;   { Not ready }
  275.            end;
  276.            IF stat<>0 THEN
  277.            BEGIN
  278.            {$IFDEF German}
  279.              if stat=1 THEN problem := 'Diskette ist schreibgeschützt!'
  280.                        ELSE problem := 'Laufwerk ist nicht bereit!';
  281.              if stat=1 THEN options := 'Nochmal|Abbruch'
  282.              {$IFDEF Format}
  283.                        ELSE options := 'Nochmal|Abbruch|Format';
  284.              {$ELSE}
  285.                        ELSE options := 'Nochmal|Abbruch';
  286.              {$ENDIF}
  287.             {$ELSE}
  288.              if stat=1 THEN problem := 'Disk is write-protected!'
  289.                        ELSE problem := 'Drive is not ready!';
  290.              if stat=1 THEN options := 'Again|Cancel'
  291.              {$IFDEF Format}
  292.                        ELSE options := 'Again|Cancel|Format';
  293.              {$ELSE}
  294.                        ELSE options := 'Again|Cancel';
  295.              {$ENDIF}
  296.            {$ENDIF}
  297.              ans := Alert(problem, options);
  298.              IF ans = 2 THEN
  299.                abort;
  300.             {$IFDEF Format}
  301.              IF ans = 3 THEN
  302.                FormatDrive(drive); { drive = 0/1 }
  303.             {$ENDIF}
  304.            END;
  305.         UNTIL stat=0;
  306.       END;
  307.     END;
  308.   end;
  309.  
  310.   PROCEDURE getCSize ( Drvnum : WORD; VAR CSize : WORD );
  311.     VAR reg : Dos.REGISTERS;
  312.   BEGIN
  313.     reg.AH := $1c; reg.DL := BYTE (Drvnum); MSDOS (reg);
  314.     CSize := reg.AL * reg.CX
  315.   END;
  316.  
  317.   FUNCTION CLusterSIZE ( Size : LONGINT; CSize : WORD ) : WORD;
  318.   BEGIN
  319.     IF Size MOD Csize = 0 THEN ClusterSIZE := Size DIV Csize
  320.                           ELSE ClusterSIZE := Size DIV Csize + 1
  321.   END;
  322.  
  323.   PROCEDURE get_next (VAR sRec   : Dos.SearchRec;
  324.                       VAR dError : INTEGER;
  325.                       VAR src_Fn : DOS.DirStr;
  326.                       VAR param  : WORD;
  327.                       LastParam  : WORD);
  328.   VAR st : STRING[1]; answer : WORD;
  329.   BEGIN
  330.     Dos.FINDNEXT (sRec);   dError := DosError;
  331.     if dError<>0 THEN { Current pattern is finished }
  332.     BEGIN
  333.       REPEAT
  334.         INC(param);
  335.         IF (param<=LastParam) THEN
  336.         BEGIN
  337.           src_Fn := MSHParamStr (param);
  338.           src_fn := Dos.FExpand (src_Fn);
  339.           st := COPY (src_Fn, LENGTH (src_Fn), 1);
  340.           IF (st = '\') OR (st = ':') THEN src_Fn := src_Fn + '*.*';
  341.           system.FileMode := 0;                           { read only }
  342. (*
  343.           answer := Alert ('FindFirst:'+ src_fn, 'OK');
  344. *)
  345.           Dos.FINDFIRST ( src_Fn, FAttr, sRec );
  346.           dError := DosError;
  347.           WHILE (dError = 0) AND
  348.                 ( (sRec.attr AND Dos.Directory) <> 0) AND     { skip ./.. }
  349.                ( (sRec.name = '.') OR (sRec.Name = '..') ) DO
  350.             get_next (sRec, dError, src_fn, param, LastParam);
  351.           IF recursion = FALSE THEN
  352.             WHILE (dError = 0) AND ( (sRec.attr AND Dos.Directory) <> 0)
  353.               DO get_next (sRec, dError, src_fn, param, LastParam);
  354.         END;
  355.       UNTIL (dError=0) OR (param>LastParam);
  356.       { Continue even if pattern not found }
  357.     END;
  358.   END;
  359.  
  360.   PROCEDURE make_directory ( Dir : Dos.DirStr; dRec : Dos.SearchRec );
  361.  
  362.     PROCEDURE cut_sub ( inDir : Dos.DirStr;  VAR outDir : Dos.DirStr );
  363.       VAR po : WORD;
  364.     BEGIN
  365.       po := LENGTH (inDir);
  366.       WHILE (po > 0) AND (inDir [po] <> '\') DO DEC (po);
  367.       outDir := COPY (inDir, 1, po - 1)
  368.     END;
  369.  
  370.     VAR dd : Dos.DirStr;  i : INTEGER;
  371.   BEGIN
  372.     dd := Dir;
  373.     Dos.FINDFIRST ( dd, DAttr, dRec );                   { check Dir exists? }
  374.     IF DosError <> 0 THEN BEGIN
  375.       MKDIR (dd);
  376.       IF IORESULT <> 0 THEN BEGIN
  377.         cut_sub ( dd, dd);
  378.         make_directory ( dd, dRec );
  379.       END;
  380.     END;
  381.     MKDIR (Dir);  i := IORESULT;        { reSet ioResult for later use of File }
  382.   END;
  383.  
  384. { ---------------------- general procedure/Functions ---------------------- }
  385.  
  386.   PROCEDURE Get_Param ( VAR Dst_path     : STRING;
  387.                         VAR First_src_Fn : WORD);
  388.     VAR
  389.       Dir : Dos.DirStr;  Nam : Dos.NameStr;  Ext : Dos.ExtStr;
  390.       pc : INTEGER;
  391.  
  392.     PROCEDURE help;
  393.     BEGIN
  394.       WRITELN (progName, ' by nemossan/pirnay  V.1.0');
  395. {$IFDEF German}
  396. {$IFDEF CP}
  397.       WRITELN ('Ex: ', progName, ' [/ifrt] [Dr:[Dir\]]*.pas [Dr:[Dir\]]');
  398.       WRITELN ('    ', progName, ' [-ifrt] [Dr:[Dir\]]*.*   [Dr:][Dir\]');
  399.       WRITELN ('    ', progName, ' [-t /r ] [Dr:[Dir\]]s*.*  [Dr:[Dir\]]');
  400.       WRITELN ('1.Parameter: Optionen Parameter.');
  401.       WRITELN ('   Manuelles Verändern des Zielpfads,   mit "i".');
  402.       WRITELN ('   überschreiben existierender Dateien, mit "f".');
  403.       WRITELN ('   REKURSIVES Kopieren,                 mit "r".');
  404.       WRITELN ('   Kopieren nur von NEUEREN Dateien,    mit "t".');
  405.       WRITELN ('   (setzt automatisch "f")');
  406.       WRITELN ('   erzwinge Formatieren von A:/B:       mit "z".');
  407.       WRITELN ('Weitere Parameter: Quell-Datei(en)/Verzeichnis, Wildcards erlaubt.');
  408.       WRITELN ('   Kopiert rekursiv Verzeichnisse mit Option "-r".');
  409.       WRITELN ('Letzter Parameter: Ziel-Verzeichnis');
  410.       WRITELN ('Spezialfall: Ist nur 1 Datei zu kopieren, und der letzte Parameter');
  411.       WRITELN ('kein Verzeichnis, so wird dies der Name der zu erzeugenden Kopie');
  412. {$ELSE} {CP=MV}
  413.       WRITELN ('Ex: ', progName, ' [/ifr] [Dr:[Dir\]]*.pas [Dr:[Dir\]]');
  414.       WRITELN ('    ', progName, ' [-ifr] [Dr:[Dir\]]*.*   [Dr:][Dir\]');
  415.       WRITELN ('    ', progName, ' [-t /r ] [Dr:[Dir\]]s*.*  [Dr:[Dir\]]');
  416.       WRITELN ('1.Parameter: Optionen Parameter.');
  417.       WRITELN ('   Manuelles Verändern des Zielpfads,   mit "i".');
  418.       WRITELN ('   überschreiben existierender Dateien, mit "f".');
  419.       WRITELN ('   REKURSIVES Verschieben,              mit "r".');
  420.       WRITELN ('   erzwinge Formatieren von A:/B:       mit "z".');
  421.       WRITELN ('Weitere Parameter: Quell-Datei(en)/Verzeichnis, Wildcards erlaubt.');
  422.       WRITELN ('   Verschiebt rekursiv Verzeichnisse mit Option "-r".');
  423.       WRITELN ('Letzter Parameter: Ziel-Verzeichnis');
  424.       WRITELN ('Spezialfall: Ist nur 1 Datei zu verschieben, und der letzte Parameter');
  425.       WRITELN ('kein Verzeichnis, so wird dies der neue Name der Datei');
  426. {$ENDIF} {CP}
  427. {$ELSE}  {German}
  428. {$IFDEF CP}
  429.       WRITELN ('Ex: ', progName, ' [/iftr] [Dr:[Dir\]]*.pas [Dr:[Dir\]]');
  430.       WRITELN ('    ', progName, ' [-iftr] [Dr:[Dir\]]*.*   [Dr:][Dir\]');
  431.       WRITELN ('    ', progName, ' [-t /r ] [Dr:[Dir\]]s*.*  [Dr:[Dir\]]');
  432.       WRITELN ('1st-param(s): option parameters.');
  433.       WRITELN ('   manual correction of dest.-path,  when "i".');
  434.       WRITELN ('   overwrites existing files,        when "f".');
  435.       WRITELN ('   RECURSIVEly copies,               when "r".');
  436.       WRITELN ('   copies only NEWER File(s)         when "t".');
  437.       WRITELN ('   (implicitly sets "f")');
  438.       WRITELN ('   force formatting of drive a:/b:   when "z".');
  439.       WRITELN ('next-param(s): input File(s)/Dir(s), wild-card allowed.');
  440.       WRITELN ('   recursively copies if Dir-name matched and "-r".');
  441.       WRITELN ('last-param: Destination-path');
  442.       WRITELN ('N.B.: If there is just 1 file to copy, and the last param is no');
  443.       WRITELN ('directory, then this last param becomes the name of the copy');
  444. {$ELSE} {CP=MV}
  445.       WRITELN ('Ex: ', progName, ' [/ifr] [Dr:[Dir\]]*.pas [Dr:[Dir\]]');
  446.       WRITELN ('    ', progName, ' [-ifr] [Dr:[Dir\]]*.*   [Dr:][Dir\]');
  447.       WRITELN ('    ', progName, ' [-t /r ] [Dr:[Dir\]]s*.*  [Dr:[Dir\]]');
  448.       WRITELN ('1st-param(s): option parameters.');
  449.       WRITELN ('   manual correction of dest.-path,  when "i".');
  450.       WRITELN ('   overwrites existing files,        when "f".');
  451.       WRITELN ('   RECURSIVEly moves,                when "r".');
  452.       WRITELN ('   force formatting of drive a:/b:   when "z".');
  453.       WRITELN ('next-param(s): input File(s)/Dir(s), wild-card allowed.');
  454.       WRITELN ('   recursively moves if Dir-name matched and "-r".');
  455.       WRITELN ('last-param: Destination-path');
  456.       WRITELN ('N.B.: If there is just 1 file to move, and the last param is no');
  457.       WRITELN ('directory, then this last param becomes the new name of the file');
  458. {$ENDIF} {CP}
  459. {$ENDIF} {GERMAN}
  460.       HALT;
  461.     END;
  462.  
  463.     PROCEDURE select ( ch : CHAR; st : STRING; VAR action : BOOLEAN );
  464.     BEGIN
  465.       IF (POS (ch, st) > 1) OR (POS (UPCASE (ch), st) > 1)
  466.         THEN action := TRUE;
  467.     END;
  468.  
  469.     CONST psp         : INTEGER = 1;
  470.           interactive : BOOLEAN = FALSE;
  471.  
  472.   BEGIN {Get_Param}
  473.     Dos.FSplit (Dos.FExpand (MSHPARAMSTR (0) ), Dir, Nam, Ext);
  474.     progName := Nam;
  475.     pc := MSHParamCount;
  476.     IF pc = 0 THEN help
  477.     ELSE BEGIN
  478.       st := COPY (MSHParamStr (psp), 1, 1);
  479.       WHILE (st [1] = '/') OR (st [1] = '-') DO BEGIN
  480.         select ('i', MSHParamStr (psp), interactive);
  481. {$IFDEF CP}
  482.         select ('t', MSHParamStr (psp), tStamp);
  483. {$ENDIF}
  484.         select ('r', MSHParamStr (psp), recursion);
  485.         select ('f', MSHParamStr (psp), force);
  486.       {$IFDEF Format}
  487.         select ('z', MSHParamStr (psp), FormatDrv);
  488.       {$ENDIF}
  489.         INC (psp);
  490.         IF pc < psp THEN help;
  491.         st := COPY (MSHParamStr (psp), 1, 1);
  492.       END;
  493. {$IFDEF CP}
  494.       IF tStamp = TRUE THEN
  495.         force := TRUE;
  496. {$ENDIF}
  497.       First_src_Fn := psp;
  498.     END;
  499.     FAttr := FAttr OR Dos.Hidden;   WAttr := WAttr OR Dos.Hidden;
  500.     FAttr := FAttr OR Dos.SysFile;  WAttr := WAttr OR Dos.Sysfile;
  501.     Dst_path := MSHParamStr (MSHParamCount);
  502.     IF (COPY (Dst_path, LENGTH (Dst_path), 1) <> ':') AND
  503.        (COPY (Dst_path, LENGTH (Dst_path), 1) <> '\') THEN
  504.       dst_Path := dst_Path + '\';
  505.     dst_Path := Dos.FExpand (dst_Path);
  506.     IF interactive THEN
  507.     BEGIN
  508.     {$IFDEF German}
  509.       InputStr ('Geben Sie das Zielverzeichnis an:', FALSE, dst_Path);
  510.     {$ELSE}
  511.       InputStr ('Confirm the destination path:', FALSE, dst_Path);
  512.     {$ENDIF}
  513.       IF dst_path = '' THEN
  514.         Halt
  515.       ELSE
  516.       BEGIN
  517.         IF (COPY (Dst_path, LENGTH (Dst_path), 1) <> ':') AND
  518.            (COPY (Dst_path, LENGTH (Dst_path), 1) <> '\') THEN
  519.           dst_Path := dst_Path + '\';
  520.         dst_Path := Dos.FExpand (dst_Path);
  521.       END;
  522.     END;
  523.     IF (POS ('*', Dst_path) <> 0) OR (POS ('?', Dst_path) <> 0) THEN
  524.       help; { Destination has to be without wildcards! }
  525.   END; {Get_Param}
  526.  
  527.   PROCEDURE readWrite ( VAR src_Fn : DOS.PathStr;
  528.                         Dst_path   : Dos.PathStr;
  529.                     VAR Tnum, LCount      : WORD;
  530.                         SpecialCase       : BOOLEAN;
  531.                         FirstParam,
  532.                         LastParam         : WORD);
  533.     VAR
  534.       StorePath     : DOS.PathStr;
  535.       sFn, dFn, oFn : Dos.PathStr;
  536.       sRc           : Dos.SearchRec;
  537.       inF, otF      : FILE;
  538.       sB, cB, oB    : pBuf;
  539.       Finfo, Cinfo,
  540.       Oinfo         : FP;           { First/Current/Old File-info's }
  541.       iError,
  542.       dError        : INTEGER;
  543.       param         : WORD;
  544.       skipping      : BOOLEAN;
  545.  
  546.     {$IFDEF MV}
  547.     PROCEDURE TestRenaming ( src_fn, dst_fn : STRING;
  548.                              VAR info       : FP );
  549.  
  550.     VAR possible, done : BOOLEAN;
  551.         F : FILE;  rec : SearchRec;
  552.         i : INTEGER;
  553.         Dir : Dos.DirStr;  Nam : Dos.NameStr;  Ext : Dos.ExtStr;
  554.         dRec : Dos.SearchRec;
  555.         answer : BYTE;
  556.     BEGIN
  557.       done := FALSE;
  558.       possible := (Upcase(src_fn[1]) = Upcase(dst_fn[1])) AND
  559.                   (src_fn[2]=':') AND (dst_fn[2]=':');
  560.       If possible THEN
  561.       BEGIN
  562.         { Does file already exist ?   }
  563.         answer := doserror; { reset doserror }
  564.         FindFirst(dst_fn, AnyFile, rec);
  565.         IF doserror = 0 THEN { found }
  566.         BEGIN
  567.           possible := FALSE;
  568.           IF rec.Attr AND DOS.Directory = 0 THEN { Normal file }
  569.           BEGIN
  570.             IF force = FALSE THEN { Ask first }
  571.             BEGIN
  572. {$IFDEF German}
  573.               answer := Alert ('Warnung! Die Datei "' + info^.srec.name +
  574.                                '" existiert schon im Zielverzeichnis!',
  575.                                'Überschr.|Nächste|Alle|Abbruch');
  576. {$ELSE}
  577.               answer := Alert ('Warning! File "' + info^.srec.name +
  578.                                '" does already exist!',
  579.                                'Write|Skip|All|Abort');
  580. {$ENDIF}
  581.               IF (answer = 255) OR (answer = 4) THEN abort;
  582.               IF answer = 3 THEN force := TRUE;
  583.               possible := (answer=1) OR (answer=3);
  584.             END
  585.             ELSE
  586.              possible := TRUE;
  587.             IF possible THEN
  588.             BEGIN
  589.               ASSIGN(F, dst_fn);
  590.               Dos.SETFATTR ( F, DOS.Archive );
  591.               rewrite(F);
  592.               iError := IORESULT;
  593.               ERASE (F);
  594.               iError := ioresult;
  595.               possible := iError=0;
  596.               answer := doserror;
  597.             END;
  598.           END;
  599.         END
  600.         ELSE
  601.          possible := TRUE;
  602.         IF possible THEN
  603.         BEGIN
  604.           { Rename file }
  605. {$IFDEF German}
  606.             UpdateInfo (2, 'Verschiebe ' + info^.Srec.Name, 1, 1);
  607. {$ELSE}
  608.             UpdateInfo (1, 'Moving ' + info^.Srec.Name, 1, 1);
  609. {$ENDIF}
  610.           Dos.FSplit (dst_fn,  Dir, Nam, Ext);
  611.           IF (LENGTH (Dir) > 3) AND (Dir [LENGTH (Dir) ] = '\') THEN
  612.           BEGIN
  613.             Dir := COPY (Dir, 1, LENGTH (Dir) - 1);
  614.             make_directory ( Dir, dRec );
  615.           END;
  616.           ASSIGN(F, src_fn);
  617.           RENAME(F, dst_fn);
  618.           iError := ioresult;
  619.           done := iError = 0;
  620.         END;
  621.       END;
  622.       info^.skip := done;
  623.       info^.eoff := done;
  624.     END;
  625. {$ENDIF}
  626.  
  627.     PROCEDURE READing (VAR dError : INTEGER; VAR Rnum : WORD);
  628.  
  629.       PROCEDURE readF;
  630.       VAR s : LONGINT;
  631.       BEGIN
  632.         WHILE (NOT EOF (inF) ) AND (MAXAVAIL > Bsize) DO BEGIN
  633.           system.FileMode := 0;                                   { read only }
  634.           BLOCKREAD ( inF, cB^.Buf, BuffSize, Cinfo^.numByte );
  635.           s := BuffSize;
  636.           s := s * Cinfo^.numRecrd;
  637.           s := s + Cinfo^.numbyte + Cinfo^.WCount;
  638. {$IFDEF German}
  639.           UpdateInfo (1, 'Lese ' + Cinfo^.Srec.Name,
  640.                      s, Cinfo^.Srec.Size);
  641. {$ELSE}
  642.           UpdateInfo (1, 'Reading ' + Cinfo^.Srec.Name,
  643.                      s, Cinfo^.Srec.Size);
  644. {$ENDIF}
  645.           INC (Cinfo^.numRecrd);
  646.           oB := cB;  NEW (cB);  oB^.next := cB;  cB^.next := NIL
  647.         END;
  648.         Cinfo^.eoFF := EOF (inF);
  649.         CLOSE (inF);
  650.         IF KeyPressed AND (ReadKey=#27) THEN abort;
  651.       END;
  652.  
  653.       VAR Dir : Dos.DirStr;  Nam : Dos.NameStr;  Ext : Dos.ExtStr;
  654.           tmp : STRING;
  655.  
  656.     BEGIN {READing}
  657.       NEW (sB);  cB := sB;  sB^.next := NIL;  Cinfo^.numRecrd := 0;
  658.       Cinfo^.skip := FALSE;  Cinfo^.eoFF := FALSE;
  659.       WHILE (dError = 0) AND (MAXAVAIL > Bsize) AND
  660.            ( (sRc.Attr AND Directory) = 0) DO BEGIN
  661.         IF Cinfo^.WCount = 0 THEN BEGIN               { read this File, first }
  662.           Cinfo^.sRec := sRc;
  663.           Dos.FSplit (Dos.FExpand (src_Fn),  Dir, Nam, Ext);
  664.           sFn := Dir + Cinfo^.sRec.Name;
  665.           INC (Rnum);
  666. {$IFDEF MV}
  667.           Cinfo^.SourceDir := Dir;
  668.           IF SpecialCase THEN
  669.             tmp := Dst_Path
  670.            ELSE
  671.             tmp := Dst_Path + Cinfo^.sRec.Name;
  672.           TestRenaming(sFn, tmp, CInfo);
  673. {$ENDIF}
  674.         END;
  675.         IF NOT Cinfo^.skip THEN
  676.         BEGIN
  677.           ASSIGN (inF, sFn);  RESET (inF, 1);  SEEK (inF, Cinfo^.WCount);
  678.           iError := ioresult;
  679.           Cinfo^.sAdrBuf := cB;
  680.           readF;                                   { read until EOF/memory-full }
  681.         END;
  682.         IF Cinfo^.eoFF THEN get_next (sRc, dError, src_Fn, param, LastParam);
  683.         Oinfo := Cinfo;                          { increase Current File info }
  684.         NEW (Cinfo);
  685.         Oinfo^.nextP := Cinfo;
  686.         Cinfo^.nextP := NIL;   Cinfo^.numRecrd := 0;    Cinfo^.eoFF := FALSE;
  687.         Cinfo^.skip := FALSE;  Cinfo^.WCount := 0;
  688.       END;
  689.     END; { READing }
  690.  
  691.     PROCEDURE WRITing (VAR Wnum : WORD);
  692.  
  693.       VAR
  694.         Dir : Dos.DirStr;  Nam : Dos.NameStr;  Ext : Dos.ExtStr;
  695.         dRec : Dos.SearchRec;  DNum : WORD;    CSize : WORD;
  696.         answer : BYTE; DiskFull : BOOLEAN;
  697.         {$IFDEF MV} F : FILE; {$ENDIF}
  698.  
  699.       PROCEDURE write1Block (VAR otF : FILE;   Cinfo : FP;  VAR cB : pBuf;
  700.                              VAR DiskFull : BOOLEAN);
  701.         VAR size, written : WORD;
  702.       BEGIN
  703.         DiskFull := FALSE;
  704.         IF Cinfo^.numRecrd > 1 THEN size := Buffsize
  705.                                ELSE size := Cinfo^.numByte;
  706.         written := size;
  707.         IF NOT Cinfo^.skip THEN
  708.           BLOCKWRITE (otF, cB^.Buf, size, written);
  709.         DiskFull := (written < size);
  710.         IF DiskFull THEN
  711.         BEGIN
  712.           WriteLn(written, '<', size); ReadLn;
  713.         END;
  714.         Cinfo^.WCount := Cinfo^.WCount + size;
  715.     {$IFDEF German}
  716.         UpdateInfo (2, 'Schreibe ' + Nam + ext,
  717.                     Cinfo^.Wcount, Cinfo^.Srec.Size);
  718.     {$ELSE}
  719.         UpdateInfo (2, 'Writing ' + Nam + ext,
  720.                     Cinfo^.Wcount, Cinfo^.Srec.Size);
  721.     {$ENDIF}
  722.         DEC (Cinfo^.numRecrd);
  723.         cB := cB^.next;
  724.         IF KeyPressed AND (ReadKey=#27) THEN
  725.         BEGIN
  726.           Close(otF);
  727.           abort;
  728.         END;
  729.       END;
  730.  
  731.     VAR tmpSize : LONGINT;
  732.  
  733.     BEGIN {WRITing}
  734.       Cinfo := Finfo;  cB := sB;  skipping := FALSE;
  735.       WHILE (Cinfo^.nextP <> NIL) DO BEGIN
  736.         oFn := dFn;
  737.         IF SpecialCase THEN
  738.           dFn := Dst_Path
  739.          ELSE
  740.           dFn := Dst_Path + Cinfo^.sRec.Name;
  741.         Dos.FSplit (Dos.FExpand (dFn),  Dir, Nam, Ext);
  742.         IF (Cinfo^.WCount = 0) OR (oFn <> dFn) THEN
  743.         BEGIN      { write first-time }
  744.           skipping := CInfo^.skip;
  745.           IF NOT skipping THEN
  746.           BEGIN
  747.             IF (LENGTH (Dir) > 3) AND (Dir [LENGTH (Dir) ] = '\') THEN
  748.             BEGIN
  749.               Dir := COPY (Dir, 1, LENGTH (Dir) - 1);
  750.               make_directory ( Dir, dRec );
  751.             END;
  752.             Dos.FINDFIRST ( dFn, FAttr, dRec );
  753.             tmpSize := -1;
  754.             IF DosError = 0 THEN BEGIN         { same Fn Found in destination }
  755.               tmpSize := dRec.size; { Keep size of existing file in mind }
  756. {$IFDEF CP}
  757.               IF force = FALSE THEN { Ask first }
  758.               BEGIN
  759. {$IFDEF German}
  760.                 answer := Alert ('Warnung! Die Datei "' + nam + ext +
  761.                                  '"| existiert schon im Zielverzeichnis!',
  762.                                  'Überschr.|Nächste|Alle|Alle neueren|Abbruch');
  763. {$ELSE}
  764.                 answer := Alert ('Warning! File "' + nam + ext +
  765.                                  '" does already exist!',
  766.                                  'Write|Skip|All|All Newer|Abort');
  767. {$ENDIF} {German}
  768.                 IF (answer = 255) OR (answer = 5) THEN abort;
  769.                 IF answer = 4 THEN
  770.                 BEGIN
  771.                   force  := TRUE;
  772.                   tStamp := TRUE;
  773.                   IF (Cinfo^.sRec.time <= dRec.time) THEN
  774.                     skipping := TRUE;
  775.                 END;
  776.                 IF answer = 2 THEN skipping := TRUE;
  777.                 IF answer = 3 THEN force := TRUE;
  778.               END
  779.               ELSE
  780.               BEGIN
  781.                 { Time-Check for newer files }
  782.                 IF tStamp AND (Cinfo^.sRec.time <= dRec.time) THEN
  783.                   skipping := TRUE;
  784.               END;
  785. {$ELSE} {MV}
  786.               IF force = FALSE THEN { Ask first }
  787.               BEGIN
  788. {$IFDEF German}
  789.                 answer := Alert ('Warnung! Die Datei "' + nam + ext +
  790.                                  '" existiert schon im Zielverzeichnis!',
  791.                                  'Überschr.|Nächste|Alle|Abbruch');
  792. {$ELSE}
  793.                 answer := Alert ('Warning! File "' + nam + ext +
  794.                                  '" does already exist!',
  795.                                  'Write|Skip|All|Abort');
  796. {$ENDIF}
  797.                 IF (answer = 255) OR (answer = 4) THEN abort;
  798.                 IF answer = 2 THEN skipping := TRUE;
  799.                 IF answer = 3 THEN force := TRUE;
  800.               END;
  801. {$ENDIF}
  802.             END;
  803.           END;
  804. {$IFDEF SizeCheck}
  805.           IF NOT skipping THEN
  806.           BEGIN
  807.             st := COPY (Dir, 1, 2);
  808.             DNum := ORD (st [1]) - ORD ('@');
  809.             getCSize (Dnum, CSize);
  810.             IF tmpSize>=0 THEN
  811.               tmpSize := ClusterSIZE (tmpSize, Csize)
  812.              ELSE
  813.               tmpSize := 0;
  814.             REPEAT
  815.               answer := 0;
  816.               IF ClusterSIZE (Dos.DISKFREE (DNum), Csize) + { check Free-area }
  817.                  tmpSize                             { add existing file-size }
  818.                 < ClusterSIZE (Cinfo^.sRec.size,  Csize) THEN
  819.               BEGIN
  820.   {$IFDEF German}
  821.                 answer := Alert ('Datei "' + Cinfo^.sRec.Name + '" paßt nicht|' +
  822.                                 'mehr in "' + st + '".', 'Nächste Datei|Abbruch|Nochmal');
  823.   {$ELSE}
  824.                 answer := Alert ('Size of "' + Cinfo^.sRec.Name + '" exceeds|' +
  825.                                 'free-area of "' + st + '".', 'Skip|Abort|Again');
  826.   {$ENDIF}
  827.                 IF (answer = 255) OR (answer = 2) THEN
  828.                   abort;
  829.                 IF answer = 1 THEN
  830.                 BEGIN
  831.                   skipping := TRUE;
  832.                   answer   := 0;
  833.                 END;
  834.               END;
  835.             UNTIL answer = 0;
  836.           END;
  837. {$ENDIF} {SizeCheck}
  838.           ASSIGN (otF, dFn);
  839.           Cinfo^.skip := skipping;
  840.           IF NOT skipping THEN BEGIN
  841.             Dos.SETFATTR (otF, Dos.Archive);
  842.             REWRITE (otF, 1);
  843.             iError := ioresult;
  844.             INC (Tnum);  INC (Wnum)
  845.           END
  846.         END ELSE IF NOT Cinfo^.skip THEN BEGIN            { already writing }
  847.           ASSIGN (otF, dFn); RESET (otF, 1);  SEEK (otF, Cinfo^.WCount);
  848.           iError := ioresult;
  849.         END;
  850.         IF NOT Cinfo^.skip THEN BEGIN
  851.           cB := Cinfo^.sAdrBuf;
  852.           DiskFull := FALSE;
  853.           WHILE (Cinfo^.numRecrd > 0) AND NOT DiskFull DO
  854.             write1Block (otF, Cinfo, cB, DiskFull);
  855.           Dos.SETFTIME (otF, Cinfo^.sRec.Time);
  856.           CLOSE (otF);
  857.           IF DiskFull THEN
  858.           BEGIN
  859.             ERASE (otF);
  860.             Cinfo^.Skip := TRUE;
  861. {$IFDEF German}
  862.             answer := Alert ('Warnung! Die Datei "' + Cinfo^.sRec.Name +
  863.                              '"|passt nicht mehr ins Zielverzeichnis!',
  864.                               'Nächste Datei|Abbruch');
  865. {$ELSE}
  866.             answer := Alert ('Warning! No space left for file "' +
  867.                              Cinfo^.sRec.Name + '"!',
  868.                              'Skip|Abort');
  869. {$ENDIF}
  870.             IF (answer = 255) OR (answer = 2) THEN abort;
  871.           END
  872.           ELSE
  873.           BEGIN
  874.             IF Cinfo^.eoFF THEN
  875.             BEGIN
  876.               Dos.SETFATTR ( otF, Cinfo^.sRec.Attr );
  877. {$IFDEF MV}
  878.               IF NOT Cinfo^.Skip THEN
  879.               BEGIN
  880.                {$IFDEF German}
  881.                 UpdateInfo (2, 'Verschiebe: ' + CInfo^.SRec.Name, 1, 1);
  882.                {$ELSE}
  883.                 UpdateInfo (2, 'Moving file: ' + CInfo^.SRec.Name, 1, 1);
  884.                {$ENDIF}
  885.                 ASSIGN (F, Cinfo^.SourceDir + Cinfo^.sRec.Name);
  886.                 Dos.SETFATTR ( F, DOS.Archive );
  887.                 CLOSE (F);
  888.                 IF IORESULT <> 0 THEN ;
  889.                 ERASE (F);
  890.                 IF IORESULT <> 0 THEN ;
  891.               END;
  892. {$ENDIF}
  893.             END;
  894.           END;
  895.         END;
  896.         Cinfo := Cinfo^.nextP;
  897.       END;
  898.     END;
  899.  
  900.     VAR
  901.       pp : POINTER;
  902.       Wnum, Rnum : WORD;
  903.       Dir : Dos.DirStr;  Nam : Dos.NameStr;  Ext : Dos.ExtStr;
  904.       {$IFDEF MV}
  905.       same : BOOLEAN; tmp : STRING; F : FILE; i : INTEGER;
  906.       ans : BYTE;
  907.       {$ENDIF}
  908.  
  909.   BEGIN {ReadWrite}
  910.     NEW (Finfo);
  911.     Finfo^.WCount := 0;   Finfo^.numRecrd := 0;
  912.     Finfo^.skip := FALSE; Finfo^.eoFF := FALSE;
  913.     Oinfo := Finfo;
  914.     param := FirstParam;
  915.     st := COPY (src_Fn, LENGTH (src_Fn), 1);
  916.     IF (st [1] = '\') OR (st [1] = ':') THEN src_Fn := src_Fn + '*.*';
  917.     system.FileMode := 0;                                         { read only }
  918.     Dos.FINDFIRST ( src_Fn, FAttr, sRc );
  919.     dError := DosError;
  920.     WHILE (dError = 0) AND
  921.          ( (sRc.attr AND Dos.Directory) <> 0) AND     { skip ./.. }
  922.          ( (sRc.name = '.') OR (sRc.Name = '..') ) DO
  923.       get_next (sRc, dError, src_Fn, param, LastParam);
  924.     IF recursion = FALSE THEN
  925.       WHILE (dError = 0) AND ( (sRc.attr AND Dos.Directory) <> 0)
  926.         DO get_next (sRc, dError, src_fn, param, LastParam);
  927.     Wnum := 0;  Rnum := 0;  dFn := '';  INC (LCount);
  928.     WHILE dError = 0 DO BEGIN
  929.       MARK (pp);
  930.       Cinfo := Finfo;  Cinfo^.nextP := NIL;
  931.       IF (dError = 0) AND ( (sRc.Attr AND Directory) <> 0 ) AND
  932.          (recursion = TRUE)
  933.       THEN BEGIN { Dir name }
  934. {$IFDEF MV}
  935.         Dos.FSplit (src_Fn,  Dir, Nam, Ext);
  936.         Finfo^.WCount := 0;
  937.         StorePath := Dir + sRc.name + '\';
  938.         readWrite ( StorePath, Dos.FExpand (Dst_path) +
  939.                     sRc.Name + '\',
  940.                     Tnum, LCount, SpecialCase, 1, 1);
  941.                     { recursive call for sub-dir }
  942.         RMDIR (Dir + sRc.name);
  943.         IF IORESULT <> 0 THEN ;
  944. {$ELSE} {CP}
  945.         Finfo^.WCount := 0;
  946.         Dos.FSplit (src_Fn,  Dir, Nam, Ext);
  947.         StorePath := Dir + sRc.name + '\';
  948.         readWrite ( StorePath, Dos.FExpand (Dst_path) +
  949.                     sRc.Name + '\',
  950.                     Tnum, LCount, SpecialCase, 1, 1);
  951.                     { recursive call for sub-dir }
  952. {$ENDIF}
  953.         get_next (sRc, dError, src_Fn, param, LastParam)
  954.       END;
  955.       system.FileMode := 0;                                       { read only }
  956.       IF NOT Cinfo^.skip THEN
  957.         READing (dError, Rnum);
  958.       IF (Rnum > 0) THEN BEGIN
  959.         system.FileMode := 2;                                    { read/write }
  960.         WRITing (Wnum);
  961.       END;
  962.       IF Oinfo^.skip AND (NOT Oinfo^.eoFF) THEN
  963.         get_next (sRc, dError, src_Fn, param, LastParam);
  964.       IF (Oinfo^.eoFF) OR (Oinfo^.skip) THEN BEGIN
  965.         Finfo^.WCount := 0; Finfo^.skip := FALSE;        { this file is ENDed }
  966.       END ELSE Finfo^ := Oinfo^;  { continue next READ/WRITE on the same File }
  967.       RELEASE (pp);
  968.     END;
  969.   END; { readWrite }
  970.  
  971.  
  972. PROCEDURE DoIt;
  973.   VAR
  974.     src_Fn, Dst_path : DOS.PathStr;
  975.     dummy            : BYTE;
  976.     Tnum, LCount     : WORD;
  977.     Param, Pcount    : WORD;
  978.     special, nodir   : BOOLEAN;
  979.     Test             : DOS.SearchRec;
  980.  
  981. BEGIN {doit}
  982. {
  983.   WriteLn('Minimum-Heap-Size: ', sizeof(Buffer)+sizeof(FL)*2+sizeof(FL));
  984. }
  985.   Get_Param ( Dst_path, Param );
  986. {$IFDEF German}
  987.   StartInfo ('Lese ', 'Schreibe ');
  988. {$ELSE}
  989.   StartInfo ('Reading ', 'Writing ');
  990. {$ENDIF}
  991.  
  992. {$IFDEF Format}
  993.   IF (Copy(dst_path, 2, 1) = ':') AND FormatDrv THEN
  994.   BEGIN
  995.     dummy := ORD(Upcase(dst_path[1])) - ORD('A');
  996.     IF (dummy=0) OR (dummy=1) THEN
  997.       FormatDrive(dummy);
  998.   END;
  999. {$ENDIF}
  1000.  
  1001.   CheckDrive(Dst_path);
  1002.  
  1003.   {
  1004.     Now we check a special case: if there is only one file
  1005.     to copy or move, we will treat the destination path as
  1006.     the destination file (if this name isn't a directory)
  1007.   }
  1008.   special := FALSE;
  1009.   nodir   := Dst_path [LENGTH (Dst_path) ] <> ':';  { No simple drive }
  1010.   IF nodir THEN
  1011.   BEGIN
  1012.     src_fn := Dst_path;
  1013.     IF src_fn [LENGTH (src_fn) ] = '\' THEN
  1014.       DELETE (src_fn, LENGTH (src_fn), 1);      { remove trailing '\'}
  1015.     nodir := src_fn [LENGTH (src_fn) ] <> ':';  { Still no simple drive }
  1016.     IF nodir THEN
  1017.     BEGIN
  1018.       FINDFIRST (src_fn, DOS.AnyFile, test);
  1019.       IF doserror = 0 THEN
  1020.         nodir := (test.Attr AND DOS.Directory = 0)
  1021.        ELSE
  1022.         nodir := TRUE; { Not found }
  1023.     END;
  1024.   END;
  1025.   src_Fn := MSHParamStr (Param);
  1026.   src_fn := Dos.FExpand (src_Fn);
  1027.   IF nodir AND                                           { Dst_path=filename }
  1028.      (MSHParamCount - 1 - Param = 0) AND                 { Just 1 Sourcefile }
  1029.      (POS ('*', src_Fn) = 0) AND (POS ('*', src_Fn) = 0) THEN  { No wildcards      }
  1030.   BEGIN
  1031.   {$IFDEF CP}
  1032.     FINDFIRST (src_fn, DOS.AnyFile, test);                { Make sure that we }
  1033.     IF doserror = 0 THEN                                  { won't have a dir  }
  1034.       nodir := (test.Attr AND DOS.Directory = 0)
  1035.      ELSE
  1036.       nodir := TRUE; { Not found }
  1037.   {$ELSE}
  1038.       nodir := TRUE; { Not found }
  1039.   {$ENDIF}
  1040.     IF nodir THEN
  1041.     BEGIN
  1042.       IF COPY (Dst_path, LENGTH (Dst_path), 1) = '\' THEN
  1043.         DELETE (Dst_path, LENGTH (Dst_path), 1);
  1044.       Special := TRUE;
  1045.     END;
  1046.   END;
  1047. (*
  1048.   STR(MSHParamCount, src_Fn);
  1049.   TNum := Alert ('Parameter:'+ src_fn, 'OK');
  1050. *)
  1051.   src_Fn := MSHParamStr (Param);
  1052.   src_fn := Dos.FExpand (src_Fn);
  1053.   Tnum := 0;  LCount := 0;
  1054.   readWrite (src_Fn, Dst_path,
  1055.              TNum, LCount, special, Param, MSHParamCount - 1);
  1056.   Abort;
  1057. END;
  1058.