home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 04 / tricks / 1dcopy.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-01-12  |  4.8 KB  |  173 lines
  1. (* ------------------------------------------------------ *)
  2. (*                     1DCOPY.PAS                         *)
  3. (*        (c) 1990 Bernd Heukendorf  & TOOLBOX            *)
  4. (* ------------------------------------------------------ *)
  5. PROGRAM One_Drive_Copy_120;
  6. {$I-}
  7. {$V-}
  8. USES Crt, Dos;
  9.  
  10. TYPE
  11.   DirPtr    = ^DateiPtr;
  12.   PufferPtr = ^POINTER;
  13.   Str6      = STRING [6];
  14.   DateiPtr  = RECORD
  15.                 Size : LONGINT;
  16.                 Name : STRING [12]
  17.               END;
  18.  
  19. VAR
  20.   FehlerStr     : ARRAY [1..5] OF STRING[31];
  21.   Puffer        : ARRAY [1..255, 1..10] OF PufferPtr;
  22.   Datei         : ARRAY [1..255] OF DirPtr;
  23.   BlockSize     : ARRAY [1..255,1..10] OF LONGINT;
  24.   Kopiert       : ARRAY [1..255] OF BYTE;
  25.   F             : SearchRec;
  26.   Regs          : Registers;
  27.   FileIO        : FILE;
  28.   Ch            : CHAR;
  29.   Rest, MaxMem  : LONGINT;
  30.   Result        : WORD;
  31.   YPos, I, K,
  32.   DateiAnzahl,
  33.   Geladen,
  34.   Gespeichert   : BYTE;
  35.  
  36.   PROCEDURE Fehler(FehlerCode : BYTE);
  37.   BEGIN
  38.     GotoXY(1, YPos + 4);
  39.     WriteLn('Fehler - ', FehlerStr[FehlerCode]);
  40.     IF FehlerCode = 4 THEN BEGIN
  41.       Close(FileIO);
  42.       Erase(FileIO)
  43.     END;
  44.     Halt(FehlerCode);
  45.   END;
  46.  
  47.   PROCEDURE Init;
  48.   BEGIN
  49.     WriteLn;
  50.     WriteLn('1DriveCopy 1.2');
  51.     WriteLn;
  52.     WriteLn('File(s) gefunden :');
  53.     WriteLn('File(s) geladen  :');
  54.     WriteLn('File(s) kopiert  :');
  55.     WriteLn;
  56.     FehlerStr [1] := 'kein Dateiname angegeben';
  57.     FehlerStr [2] := 'Datei(en) nicht gefunden';
  58.     FehlerStr [3] := 'Datenträger nicht auswechselbar';
  59.     FehlerStr [4] := 'Disk voll';
  60.     FehlerStr [5] := 'nicht genug Speicher';
  61.     DateiAnzahl   := 0;
  62.     MaxMem        := MemAvail;
  63.     YPos          := WhereY - 4;
  64.     If ParamCount  = 0 Then Fehler(1);
  65.     Regs.AH       := $44;
  66.     Regs.AL       := 8;
  67.     Regs.BL       := 0;
  68.     MSDos(Regs);
  69.     IF Regs.AX = 1 THEN Fehler(3);
  70.   END;
  71.  
  72.   PROCEDURE Wechsel(Txt : Str6);
  73.   BEGIN
  74.     WHILE KeyPressed DO Ch := ReadKey;
  75.     GotoXY(30, YPos);
  76.     Write('╔══════════════════════╗');
  77.     GotoXY(30,YPos + 1);
  78.     Write('║ ', Txt, '-Disk einlegen ║');
  79.     GotoXY(30,YPos + 2);
  80.     Write('╚══════════════════════╝');
  81.     Write(#7);
  82.     Ch := ReadKey;
  83.     FOR K := 0 TO 2 DO BEGIN
  84.       GotoXY(30, YPos + K);
  85.       ClrEol;
  86.     END;
  87.   END;
  88.  
  89.   PROCEDURE Suchen;
  90.   BEGIN
  91.    FOR i := 1 TO ParamCount DO BEGIN
  92.      FindFirst(ParamStr(i),
  93.                AnyFile - Directory - VolumeID,F);
  94.      WHILE DosError = 0 DO BEGIN
  95.        IF F.Size > (MaxMem - Length(F.Name) - 5) THEN
  96.          Fehler(5);
  97.        Inc(DateiAnzahl);
  98.        Kopiert[DateiAnzahl] := 0;
  99.        GotoXY(20, YPos);
  100.        Write(DateiAnzahl : 3);
  101.        GetMem(Datei[DateiAnzahl], Length(F.Name) + 5);
  102.        Move(F.Size, Datei[DateiAnzahl]^,
  103.             Length(F.Name) + 5);
  104.        FindNext(F);
  105.       END;
  106.     END;
  107.     IF DateiAnzahl = 0 THEN Fehler(2);
  108.   END;
  109.  
  110.   PROCEDURE Kopieren;
  111.   BEGIN
  112.     Suchen;
  113.     Geladen := 0;
  114.     Gespeichert := 0;
  115.     REPEAT
  116.       IF Geladen > 0 THEN Wechsel('Source');
  117.       FOR i := 1 TO DateiAnzahl DO
  118.         IF (Kopiert[i] = 0) AND
  119.            (Datei[i]^.Size <= MemAvail) THEN BEGIN
  120.           Kopiert[i] := 1;
  121.           Inc(Geladen);
  122.           Assign(FileIO, Datei[I]^.Name);
  123.           Reset(FileIO, 1);
  124.           Rest := Datei[i]^.Size;
  125.           K := 0;
  126.           REPEAT
  127.             Inc(K);
  128.             BlockSize[i,K] := Rest;
  129.             IF BlockSize[i, K] > 65522 THEN
  130.               BlockSize[i, K] := 65522;
  131.             IF BlockSize[i, K] > MaxAvail THEN
  132.               BlockSize[i, K] := MaxAvail;
  133.             GetMem(Puffer[i, K], BlockSize[i, K]);
  134.             BlockRead(FileIO, Puffer[i,K]^, BlockSize[i,K]);
  135.             Dec(Rest, BlockSize[i,K]);
  136.           UNTIL Rest = 0;
  137.           Close(FileIO);
  138.           GotoXY(20, YPos + 1);
  139.           Write(Geladen : 3);
  140.         END;
  141.       Wechsel('Target');
  142.       FOR i := 1 TO DateiAnzahl DO
  143.         IF Kopiert[i] = 1 THEN BEGIN
  144.           Kopiert[i] := 2;
  145.           Inc(Gespeichert);
  146.           Assign(FileIO, Datei[i]^.Name);
  147.           Rewrite(FileIO, 1);
  148.           Rest := Datei[i]^.Size;
  149.           K := 0;
  150.           REPEAT
  151.             Inc(K);
  152.             BlockWrite(FileIO, Puffer[i, K]^,
  153.                        BlockSize[i,K], Result);
  154.             FreeMem(Puffer[i, K], BlockSize[i, K]);
  155.             IF Result <> BlockSize[i, K] THEN Fehler(4);
  156.             Dec(Rest, BlockSize[i, K]);
  157.           UNTIL Rest = 0;
  158.           Close(FileIO);
  159.           FreeMem(Datei[i], Length(Datei[i]^.Name) + 5);
  160.           GotoXY(20, YPos + 2);
  161.           WRITE(Gespeichert : 3);
  162.         END;
  163.     UNTIL Gespeichert = DateiAnzahl;
  164.     WriteLn
  165.   END;
  166.  
  167. BEGIN
  168.   Init;
  169.   Kopieren;
  170. END.
  171. (* ------------------------------------------------------ *)
  172. (*                Ende von 1DCOPY.PAS                     *)
  173.