home *** CD-ROM | disk | FTP | other *** search
/ Software Recommendations - 1998 Season 1 / DNBCD4.iso / share / filesplt / fs / FS.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1995-10-18  |  35.8 KB  |  1,073 lines
  1. {
  2. ┌─────────────────────────────────────────────────┐
  3. │                 Joe Forster/STA                 │
  4. │                                                 │
  5. │                     FS.PAS                      │
  6. │                                                 │
  7. │                   File Split                    │
  8. └─────────────────────────────────────────────────┘
  9. }
  10.  
  11. {$M 8192, 0, 65536}
  12.  
  13. uses
  14.   Crt, DOS;
  15.  
  16. const
  17.   BufferMax     = 64512;
  18.   BlankLine     = '                                                                               ';
  19.   HexaNum       : array [0..15] of Char = '0123456789ABCDEF';
  20.   NameLen       = 39;
  21.   HeaderEnd     : string[40]            = ' Start pos   End pos    Length Remaining';
  22.  
  23. type
  24.   TBuffer       = array [0..BufferMax - 1] of Byte;
  25.   PBuffer       = ^TBuffer;
  26.  
  27. var
  28.   DummyBool,
  29.   OverWrite,
  30.   FreeOk,
  31.   AppendFile,
  32.   DeleteFile,
  33.   ErrorBeep,
  34.   AskNum,
  35.   VolBeep,
  36.   AskExt,
  37.   VolYes,
  38.   AlreadyBeep,
  39.   AutoSize,
  40.   ZeroChunk,
  41.   FirstChunk,
  42.   Esc,
  43.   DelYes,
  44.   DelNo,
  45.   VolOk         : Boolean;
  46.   Count,
  47.   Drive         : Byte;
  48.   CmdChar,
  49.   Answer        : Char;
  50.   ChunkNum,
  51.   Remaining,
  52.   LastChunk,
  53.   NumOk,
  54.   ChunkOk,
  55.   IOError       : Integer;
  56.   DecSize,
  57.   FreeSize,
  58.   OrigSize,
  59.   ReadSize,
  60.   ReadDate,
  61.   BigPos,
  62.   ChunkMax,
  63.   ChunkSize,
  64.   CopySize,
  65.   CopiedSize,
  66.   BufferSize    : Longint;
  67.   Buffer        : PBuffer;
  68.   Ext1,
  69.   Ext2          : ExtStr;
  70.   Name1,
  71.   Name2         : NameStr;
  72.   Dir1,
  73.   Dir2          : DirStr;
  74.   Command,
  75.   DummyStr,
  76.   Header,
  77.   Text,
  78.   ComStr,
  79.   BigStr,
  80.   ChunkStr,
  81.   SizeStr,
  82.   BigName,
  83.   ChunkBase,
  84.   ChunkName     : string;
  85.   BigFile,
  86.   ChunkFile     : file;
  87.  
  88. procedure ClrLine;
  89. begin
  90.   Write(#13, BlankLine, #13);
  91. end;
  92.  
  93. function CloneName(Str1, Str2: string): string;
  94. var
  95.   C             : Char;
  96.   I,
  97.   J             : Integer;
  98.   S             : string;
  99. begin
  100.   I := 1;
  101.   J := 1;
  102.   S := '';
  103.   while (J <= Length(Str2)) and ((I <= Length(Str1)) or ((Str2[J] <> '?') and (Str2[J] <> '*'))) do
  104.   begin
  105.     if Str2[J] = '?' then
  106.     begin
  107.       C := Str1[I];
  108.       Inc(I);
  109.       Inc(J);
  110.     end
  111.     else
  112.     begin
  113.       if Str2[J] = '*' then
  114.       begin
  115.         C := Str1[I];
  116.         Inc(I);
  117.       end
  118.       else
  119.       begin
  120.         C := Str2[J];
  121.         Inc(I);
  122.         Inc(J);
  123.       end;
  124.     end;
  125.     S := S + C;
  126.   end;
  127.   CloneName := S;
  128. end;
  129.  
  130. function MakeName(S: string; L: Integer; F: Boolean): string;
  131. var
  132.   T             : string;
  133. begin
  134.   T := S;
  135.   if Length(T) > L then T := Copy(T, 1, 3) + '...' + Copy(T, Length(T) - L + 7, L - 6);
  136.   if F then while Length(T) < L do T := T + ' ';
  137.   MakeName := T;
  138. end;
  139.  
  140. procedure SplitName(Path: PathStr; var Dir: DirStr; var Name: NameStr; var Ext: ExtStr);
  141. begin
  142.   FSplit(Path, Dir, Name, Ext);
  143.   if (Ext = '') and (Name = '') then
  144.   begin
  145.     Name := '*';
  146.     Ext := '.**';
  147.   end;
  148.   if Ext = '.' then Ext := '. ';
  149. end;
  150.  
  151. function MakeExt(N: Integer): string;
  152. var
  153.   S             : string;
  154. begin
  155.   Str(N, S);
  156.   while Length(S) < 3 do S := '0' + S;
  157.   MakeExt := S;
  158. end;
  159.  
  160. function MakeNum(S: string): Integer;
  161. var
  162.   I,
  163.   N             : Integer;
  164. begin
  165.   S := Copy(S, 2, 3);
  166.   if (S = '') or (S[1] = '*') then
  167.   begin
  168.     N := 0;
  169.   end
  170.   else
  171.   begin
  172.     I := 1;
  173.     N := 0;
  174.     while (I <= 3) and (N >= 0) do
  175.     begin
  176.       if (S[I] >= '0') and (S[I] <= '9') then N := N * 10 + (Ord(S[I]) - 48) else N := -1;
  177.       Inc(I);
  178.     end;
  179.   end;
  180.   MakeNum := N;
  181. end;
  182.  
  183. procedure MakeHeader;
  184. begin
  185.   if BigPos > 0 then
  186.   begin
  187.     Str(BigPos, Header);
  188.     Header := Command + ' ' + MakeName(BigName + ' at pos ' + Header, 38 - Length(Command), True);
  189.   end
  190.   else
  191.   begin
  192.     Header := Command + ' ' + MakeName(BigName, 38 - Length(Command), True);
  193.   end;
  194. end;
  195.  
  196. procedure Percent;
  197. var
  198.   I             : Integer;
  199.   P             : Longint;
  200.   S             : string;
  201. begin
  202.   P := ChunkSize div 50;
  203.   if P = 0 then P := 100 else P := CopiedSize div P;
  204.   if P > 100 then P := 100;
  205.   Str(P:3, S);
  206.   Write(' ', S, '% complete', #13);
  207. end;
  208.  
  209. procedure Beep; assembler;
  210. asm
  211.     mov ah, 2;
  212.     mov dl, 7;
  213.     int $21;
  214. end;
  215.  
  216. procedure MakeVolBeep;
  217. begin
  218.   if VolBeep and not AlreadyBeep then Beep;
  219.   AlreadyBeep := True;
  220. end;
  221.  
  222. procedure MakeErrorBeep;
  223. begin
  224.   if ErrorBeep then Beep;
  225.   AlreadyBeep := True;
  226. end;
  227.  
  228. function AskStr(Text: string; Len: Integer; Min, Max: Char): string;
  229. var
  230.   O             : Boolean;
  231.   C             : Char;
  232.   S             : string;
  233. begin
  234.   ClrLine;
  235.   S := '';
  236.   O := True;
  237.   repeat
  238.     if O then
  239.     begin
  240.       O := False;
  241.       Write(#13, Text, S, ' ', #8);
  242.     end;
  243.     C := UpCase(ReadKey);
  244.     if ((C >= Min) and (C <= Max)) and (Length(S) < Len) then
  245.     begin
  246.       S := S + C;
  247.       O := True;
  248.     end;
  249.     if (C = #8) and (S <> '') then
  250.     begin
  251.       S := Copy(S, 1, Length(S) - 1);
  252.       O := True;
  253.     end;
  254.     if C = #27 then
  255.     begin
  256.       S := '';
  257.       C := #13;
  258.     end;
  259.   until (C = #13);
  260.   ClrLine;
  261.   AskStr := S;
  262. end;
  263.  
  264. function Eval(S: string; var Code: Integer): Longint;
  265. var
  266.   I,
  267.   X             : Integer;
  268.   V             : Longint;
  269. begin
  270.   if S[1] = '$' then
  271.   begin
  272.     V := 0;
  273.     I := 2;
  274.     Code := 0;
  275.     while (Code = 0) and (I <= Length(S)) do
  276.     begin
  277.       X := Pos(UpCase(S[I]), HexaNum);
  278.       if X = 0 then Code := I else V := V shl 4 + X - 1;
  279.       Inc(I);
  280.     end;
  281.   end
  282.   else
  283.   begin
  284.     Val(S, V, Code);
  285.   end;
  286.   Eval := V;
  287. end;
  288.  
  289. function ReadPar(S: string): Boolean;
  290. var
  291.   O             : Boolean;
  292.   C             : Char;
  293.   I             : Integer;
  294. begin
  295.   O := True;
  296.   C := S[1];
  297.   if (C = '/') or (C = '-') then I := 2 else I := 1;
  298.   while O and (I <= Length(S)) do
  299.   begin
  300.     O := False;
  301.     C := UpCase(S[I]);
  302.     if C = 'A' then
  303.     begin
  304.       AppendFile := True;
  305.       O := True;
  306.     end;
  307.     if C = 'D' then
  308.     begin
  309.       DeleteFile := True;
  310.       O := True;
  311.     end;
  312.     if C = 'E' then
  313.     begin
  314.       ErrorBeep := True;
  315.       O := True;
  316.     end;
  317.     if C = 'L' then
  318.     begin
  319.       DecSize := Eval(Copy(S, I + 1, Length(S)), NumOk);
  320.       if NumOk = 0 then I := Length(S) else DecSize := 512;
  321.       O := True;
  322.     end;
  323.     if C = 'N' then
  324.     begin
  325.       LastChunk := Eval(Copy(S, I + 1, Length(S)), NumOk);
  326.       AskNum := (NumOk <> 0);
  327.       if not AskNum then I := Length(S);
  328.       O := True;
  329.     end;
  330.     if C = 'S' then
  331.     begin
  332.       BigPos := Eval(Copy(S, I + 1, Length(S)), NumOk);
  333.       if NumOk = 0 then I := Length(S) else BigPos := 0;
  334.       O := True;
  335.     end;
  336.     if C = 'V' then
  337.     begin
  338.       VolBeep := True;
  339.       O := True;
  340.     end;
  341.     if C = 'X' then
  342.     begin
  343.       AskExt := True;
  344.       O := True;
  345.     end;
  346.     if C = 'Y' then
  347.     begin
  348.       VolYes := True;
  349.       O := True;
  350.     end;
  351.     if O then Inc(I);
  352.   end;
  353.   ReadPar := O;
  354. end;
  355.  
  356. function Question(T, A, E: string; B, H: Boolean): Char;
  357. var
  358.   C             : Char;
  359. begin
  360.   Write(T);
  361.   Write(' (Yes/No');
  362.   if A <> '' then Write('/', A);
  363.   if E <> '' then Write('/', E);
  364.   Write(') ? ');
  365.   if B then Beep;
  366.   repeat
  367.     C := UpCase(ReadKey);
  368.     case C of
  369.       #13: C := 'Y';
  370.       #27: C := 'N';
  371.     end;
  372.   until (H and ((C = 'C') or (C = 'P'))) or ((A <> '') and (C = 'A')) or ((E <> '') and (C = 'E')) or
  373.     (C = 'N') or (C = 'Y');
  374.   Write(C);
  375.   Question := C;
  376.   ClrLine;
  377. end;
  378.  
  379. function Query(T, A, E: string; var Y, N: Boolean; Z, B, H: Boolean): Boolean;
  380. var
  381.   Q             : Boolean;
  382.   C             : Char;
  383.   X             : ExtStr;
  384.   O             : NameStr;
  385.   D             : DirStr;
  386.   P             : string;
  387. begin
  388.   repeat
  389.     Q := True;
  390.     if (Y or N) and Z then
  391.     begin
  392.       if B then Beep;
  393.       if Y then C := 'Y' else C := 'N';
  394.     end
  395.     else
  396.     begin
  397.       C := Question(T, A, E, B, H);
  398.       if C = 'A' then
  399.       begin
  400.         Y := True;
  401.         N := False;
  402.         C := 'Y';
  403.       end;
  404.       if C = 'E' then
  405.       begin
  406.         Y := False;
  407.         N := True;
  408.         C := 'N';
  409.       end;
  410.       if C = 'C' then
  411.       begin
  412.         GetDir(0, P);
  413.         Exec(GetEnv('COMSPEC'), '');
  414.         ChDir(P);
  415.         MakeHeader;
  416.         WriteLn(Header, HeaderEnd);
  417.         Q := False;
  418.       end;
  419.       if C = 'P' then
  420.       begin
  421.         ClrLine;
  422.         SplitName(ChunkName, D, O, X);
  423.         P := AskStr('Enter new path : ', 61, ' ', #255);
  424.         if P <> '' then
  425.         begin
  426.           if (P[Length(P)] <> ':') and (P[Length(P)] <> '\') then P := P + '\';
  427.           SplitName(P, Dir1, Name1, Ext1);
  428.           if CmdChar = 'A' then
  429.           begin
  430.             ChunkBase := Dir1 + O + '.';
  431.             if ChunkBase[2] = ':' then Drive := Ord(ChunkBase[1]) - 64 else Drive := 0;
  432.           end
  433.           else
  434.           begin
  435.             ChunkBase := Dir1 + O + '.';
  436.           end;
  437.         end;
  438.         ClrLine;
  439.         Q := False;
  440.       end;
  441.     end;
  442.     B := False;
  443.   until Q;
  444.   Query := (C = 'Y');
  445. end;
  446.  
  447. function Escape: Boolean;
  448. var
  449.   B             : Boolean;
  450.   C             : Word;
  451. begin
  452.   B := False;
  453.   if KeyPressed then
  454.   begin
  455.     C := Ord(ReadKey);
  456.     if C = 0 then C := 256 + Ord(ReadKey);
  457.     if C = 27 then
  458.     begin
  459.       ClrLine;
  460.       B := (Question('Abort program', '', '', ErrorBeep, False) = 'Y');
  461.       if not B then Percent;
  462.     end;
  463.   end;
  464.   Escape := B;
  465. end;
  466.  
  467. function NextVol(N: Integer; Y: Boolean): Boolean;
  468. var
  469.   T             : string;
  470. begin
  471.   Str(N, T);
  472.   T := 'Process chunk ' + T;
  473.   NextVol := Query(T, 'All yes', '', VolYes, DummyBool, Y, VolBeep and not AlreadyBeep, True);
  474.   AlreadyBeep := True;
  475. end;
  476.  
  477. function UpperCase(S: string): string;
  478. var
  479.   I             : Integer;
  480.   T             : string;
  481. begin
  482.   T[0] := Chr(Length(S));
  483.   for I := 1 to Length(S) do T[I] := UpCase(S[I]);
  484.   UpperCase := T;
  485. end;
  486.  
  487. begin
  488.   WriteLn('File Split by Joe Forster/STA');
  489.   WriteLn;
  490.   ComStr := UpperCase(ParamStr(1));
  491.   CmdChar := ComStr[1];
  492.   if (ParamCount = 0) or (((CmdChar = '/') or (CmdChar = '-')) and ((ComStr[2] = '?') or (ComStr[2] = 'H'))) then
  493.   begin
  494.     WriteLn('This program splits big files into smaller chunks that can  easily  be  carried');
  495.     WriteLn('on floppy disks and builds the chunks back to the original big file. During the');
  496.     WriteLn('splitting the extension and the size of the big file is stored in the 0th chunk');
  497.     WriteLn('so that there is no additional information in the normal chunks.');
  498.     WriteLn;
  499.     WriteLn('Usage: FS <command> <chunkfile> [<bigfile>] [<chunksize>] [-|/<options>]');
  500.     WriteLn;
  501.     WriteLn('Commands:');
  502.     WriteLn('  A: Split up big file into chunks             X: Build chunks into big file');
  503.     WriteLn;
  504.     WriteLn('Chunk sizes:');
  505.     WriteLn('  A[UTO]: Auto-detect free space         xxxx[K]: Maximum of xxxx [K]B chunks');
  506.     WriteLn('  1.2[M]: 1.2 MB chunks                  1.44[M]: 1.44 MB chunks');
  507.     WriteLn;
  508.     WriteLn('Options:');
  509.     WriteLn('    A: Append big file if exists           Sxxxx: Start splitting from pos xxxx');
  510.     WriteLn('    D: Delete processed files                  V: Beep between chunks');
  511.     WriteLn('    E: Beep on errors                          X: Ask extension of big file');
  512.     WriteLn('Lxxxx: Dec length of first chunk with xxxx     Y: All yes on next chunk query');
  513.     WriteLn('N[xx]: Last chunk is #xx (ask if not given)');
  514.   end
  515.   else
  516.   begin
  517.     if (CmdChar <> 'A') and (CmdChar <> 'X') then
  518.     begin
  519.       WriteLn('Invalid command');
  520.     end
  521.     else
  522.     begin
  523.       AutoSize := False;
  524.       AppendFile := False;
  525.       DeleteFile := False;
  526.       ErrorBeep := False;
  527.       AskNum := False;
  528.       VolBeep := False;
  529.       AskExt := False;
  530.       VolYes := False;
  531.       DelYes := False;
  532.       ZeroChunk := False;
  533.       FirstChunk := True;
  534.       AlreadyBeep := True;
  535.       LastChunk := 0;
  536.       BigPos := 0;
  537.       DecSize := 512;
  538.       ChunkSize := 0;
  539.       OrigSize := 0;
  540.       CmdChar := ComStr[1];
  541.       ChunkStr := UpperCase(ParamStr(2));
  542.       ComStr := UpperCase(ParamStr(3));
  543.       BigStr := ComStr;
  544.       if (CmdChar = 'X') and ((BigStr[1] = '-') or (BigStr[1] = '/')) then BigStr := '';
  545.       SizeStr := UpperCase(ParamStr(4));
  546.       if SizeStr <> '' then if (SizeStr[1] = '-') or (SizeStr[1] = '/') then SizeStr := '';
  547.       SplitName(ChunkStr, Dir1, Name1, Ext1);
  548.       SplitName(BigStr, Dir2, Name2, Ext2);
  549.       if ((CmdChar = 'A') and (ParamCount < 3)) or ((CmdChar = 'X') and (ParamCount < 2)) then
  550.       begin
  551.         WriteLn('Parameters missing');
  552.       end
  553.       else
  554.       begin
  555.         if (CmdChar = 'A') and (SizeStr <> '') then Count := 5 else
  556.           if (CmdChar = 'X') and ((ParamCount < 3) or (ComStr[1] = '-') or (ComStr[1] = '/')) then
  557.             Count := 3 else Count := 4;
  558.         while (Count <= ParamCount) and ReadPar(ParamStr(Count)) do Inc(Count);
  559.         if Count <= ParamCount then
  560.         begin
  561.           WriteLn('Invalid switch: ', UpperCase(ParamStr(Count)));
  562.         end
  563.         else
  564.         begin
  565.           if CmdChar = 'A' then
  566.           begin
  567.             ChunkOk := MaxInt;
  568.             if (SizeStr = '') or (SizeStr = 'A') or (SizeStr = 'AUTO') then
  569.             begin
  570.               AutoSize := True;
  571.               ChunkMax := MaxLongInt;
  572.               ChunkOk := 0;
  573.             end
  574.             else
  575.             begin
  576.               ChunkMax := 0;
  577.               ChunkOk := 0;
  578.               if Copy(SizeStr, 1, 3) = '1.2' then ChunkMax := 1213952;
  579.               if Copy(SizeStr, 1, 4) = '1.44' then ChunkMax := 1457664;
  580.               if ChunkMax = 0 then
  581.               begin
  582.                 if SizeStr[Length(SizeStr)] = 'K' then ChunkMax := Eval(Copy(SizeStr, 1, Length(SizeStr) - 1), ChunkOk) shl 10
  583.                   else ChunkMax := Eval(SizeStr, ChunkOk);
  584.                 if (ChunkOk <> 0) or (ChunkMax = 0) or (ChunkMax >= MaxLongint shr 10) then
  585.                 begin
  586.                   WriteLn('Invalid chunk size');
  587.                   MakeErrorBeep;
  588.                   ChunkOk := 1;
  589.                 end
  590.                 else
  591.                 begin
  592.                   ChunkOk := 0;
  593.                 end;
  594.               end;
  595.             end;
  596.             if ChunkOk = 0 then
  597.             begin
  598.               ChunkBase := Dir1 + CloneName(Name2, Name1) + '.';
  599.               BigName := BigStr;
  600.               ChunkNum := MakeNum(Ext1);
  601.               if ChunkNum < 0 then
  602.               begin
  603.                 WriteLn('Invalid chunk number');
  604.                 MakeErrorBeep;
  605.               end
  606.               else
  607.               begin
  608.                 if (BigPos > 0) and (ChunkNum = 0) then ChunkNum := 1;
  609.                 if ChunkBase[2] = ':' then Drive := Ord(ChunkBase[1]) - 64 else Drive := 0;
  610.                 Assign(BigFile, BigName);
  611.                 FileMode := 0;
  612.                 Reset(BigFile, 1);
  613.                 IOError := IOResult;
  614.                 if (IOError = 0) and (FileSize(BigFile) >= BigPos) then
  615.                 begin
  616.                   GetFTime(BigFile, ReadDate);
  617.                   ReadSize := FileSize(BigFile) - BigPos;
  618.                   Command := 'Splitting';
  619.                   MakeHeader;
  620.                   Close(BigFile);
  621.                   while (ReadSize > 0) and (IOResult = 0) do
  622.                   begin
  623.                     VolOk := False;
  624.                     if ChunkSize = 0 then if ReadSize > ChunkMax then ChunkSize := ChunkMax else ChunkSize := ReadSize;
  625.                     FreeSize := DiskFree(Drive);
  626.                     if (FreeSize = 0) or (FreeSize = -1) then
  627.                     begin
  628.                       ClrLine;
  629.                       if FreeSize = 0 then Write('Disk full. ') else Write('Drive not ready. ');
  630.                       if not NextVol(ChunkNum, False) then ReadSize := 0;
  631.                     end
  632.                     else
  633.                     begin
  634.                       if ChunkMax = MaxLongInt then
  635.                         if ReadSize > FreeSize then ChunkSize := FreeSize else ChunkSize := ReadSize;
  636.                       if ChunkSize > FreeSize then
  637.                       begin
  638.                         Str(FreeSize, Text);
  639.                         Text := 'Insufficient free space - ' + Text + ' bytes. Try again';
  640.                         ClrLine;
  641.                         Answer := Question(Text, 'use All space', '', ErrorBeep, False);
  642.                         if Answer = 'N' then ReadSize := 0;
  643.                         if Answer = 'A' then if ReadSize > FreeSize then ChunkSize := FreeSize else ChunkSize := ReadSize;
  644.                       end
  645.                       else
  646.                       begin
  647.                         FileMode := 0;
  648.                         Reset(BigFile, 1);
  649.                         if IOResult = 0 then
  650.                         begin
  651.                           Seek(BigFile, BigPos);
  652.                           ChunkName := ChunkBase + MakeExt(ChunkNum);
  653.                           AlreadyBeep := False;
  654.                           Assign(ChunkFile, ChunkName);
  655.                           Reset(ChunkFile, 1);
  656.                           if IOResult = 0 then
  657.                           begin
  658.                             Close(BigFile);
  659.                             Close(ChunkFile);
  660.                             ClrLine;
  661.                             if Question(MakeName(ChunkName, 35, False) + ' already exists. Overwrite', '', '',
  662.                               ErrorBeep, False) = 'Y' then Erase(ChunkFile) else ReadSize := 0;
  663.                             ChunkSize := 0;
  664.                           end
  665.                           else
  666.                           begin
  667.                             Rewrite(ChunkFile, 1);
  668.                             if IOResult = 0 then
  669.                             begin
  670.                               if ZeroChunk and (ChunkNum = 1) and not AutoSize and (ChunkSize <> ReadSize) and
  671.                                 (ChunkSize > DecSize) then Dec(ChunkSize, DecSize);
  672.                               if ChunkNum > 0 then Dec(ReadSize, ChunkSize);
  673.                               ClrLine;
  674.                               if FirstChunk then WriteLn(Header, HeaderEnd);
  675.                               Write(MakeName(ChunkName, NameLen, True));
  676.                               if ChunkNum > 0 then
  677.                               begin
  678.                                 Write(BigPos:10, (BigPos + ChunkSize):10, ChunkSize:10);
  679.                                 if ReadSize > 0 then Write(ReadSize:10);
  680.                               end;
  681.                               WriteLn;
  682.                               New(Buffer);
  683.                               if ChunkNum = 0 then
  684.                               begin
  685.                                 ZeroChunk := True;
  686.                                 CopySize := 7;
  687.                                 FillChar(Buffer^, 7, 0);
  688.                                 if Ext2 <> '' then for Count := 1 to Length(Ext2) do
  689.                                   Buffer^[Count - 1] := Ord(Ext2[Count + 1]);
  690.                                 Move(ReadSize, Buffer^[3], 4);
  691.                               end
  692.                               else
  693.                               begin
  694.                                 CopySize := ChunkSize;
  695.                               end;
  696.                               CopiedSize := 0;
  697.                               Percent;
  698.                               IOError := IOResult;
  699.                               Esc := Escape;
  700.                               while (CopySize > 0) and (IOError = 0) and not Esc do
  701.                               begin
  702.                                 if CopySize > BufferMax then BufferSize := BufferMax else BufferSize := CopySize;
  703.                                 Dec(CopySize, BufferSize);
  704.                                 if ChunkNum > 0 then BlockRead(BigFile, Buffer^, BufferSize);
  705.                                 Inc(CopiedSize, BufferSize);
  706.                                 Percent;
  707.                                 Esc := Escape;
  708.                                 if not Esc then
  709.                                 begin
  710.                                   BlockWrite(ChunkFile, Buffer^, BufferSize);
  711.                                   Inc(CopiedSize, BufferSize);
  712.                                   Percent;
  713.                                   Esc := Escape;
  714.                                 end;
  715.                                 IOError := IOResult;
  716.                               end;
  717.                               Dispose(Buffer);
  718.                               SetFTime(ChunkFile, ReadDate);
  719.                               Close(ChunkFile);
  720.                               Close(BigFile);
  721.                               ClrLine;
  722.                               if Esc then
  723.                               begin
  724.                                 ReadSize := 0;
  725.                                 VolOk := False;
  726.                                 Write('Deleting ', MakeName(ChunkName, 70, False));
  727.                                 Erase(ChunkFile);
  728.                                 ClrLine;
  729.                               end
  730.                               else
  731.                               begin
  732.                                 if IOError = 0 then
  733.                                 begin
  734.                                   if ChunkNum > 0 then Inc(BigPos, ChunkSize);
  735.                                   Inc(ChunkNum);
  736.                                   ChunkSize := 0;
  737.                                   VolOk := True;
  738.                                 end;
  739.                                 FirstChunk := False;
  740.                               end;
  741.                             end
  742.                             else
  743.                             begin
  744.                               Close(BigFile);
  745.                               ClrLine;
  746.                               Write(MakeName(ChunkName, 23, False) , ' cannot be created. ');
  747.                               if ErrorBeep then
  748.                               begin
  749.                                 AlreadyBeep := True;
  750.                                 Beep;
  751.                               end;
  752.                               if not NextVol(ChunkNum, False) then ReadSize := 0;
  753.                               ChunkSize := 0;
  754.                             end;
  755.                           end;
  756.                           if (ReadSize > 0) and VolOk then
  757.                           begin
  758.                             ClrLine;
  759.                             VolOk := False;
  760.                             if not ZeroChunk or (ChunkNum > 1) then if not NextVol(ChunkNum, True) then ReadSize := 0;
  761.                           end
  762.                           else
  763.                           begin
  764.                             MakeVolBeep;
  765.                           end;
  766.                         end
  767.                         else
  768.                         begin
  769.                           WriteLn(MakeName(BigName, 69, False), ' not found');
  770.                           MakeErrorBeep;
  771.                         end;
  772.                       end;
  773.                     end;
  774.                   end;
  775.                   if (ReadSize = 0) and VolOk and DeleteFile then
  776.                   begin
  777.                     if Query('Delete ' + BigName, '', '', DummyBool, DummyBool, False, False, False) then
  778.                     begin
  779.                       Write('Deleting ', MakeName(BigName, 70, False));
  780.                       Erase(BigFile);
  781.                       ClrLine;
  782.                     end;
  783.                   end;
  784.                 end
  785.                 else
  786.                 begin
  787.                   if IOError = 0 then WriteLn(MakeName(BigName, 69, False), ' too short') else
  788.                     WriteLn(MakeName(BigName, 69, False), ' not found');
  789.                   MakeErrorBeep;
  790.                 end;
  791.               end;
  792.             end;
  793.           end;
  794.           if CmdChar = 'X' then
  795.           begin
  796.             ChunkBase := Dir1 + Name1 + '.';
  797.             BigName := Dir2 + CloneName(Name1, Name2);
  798.             ChunkNum := MakeNum(Ext1);
  799.             if ChunkNum < 0 then
  800.             begin
  801.               WriteLn('Invalid chunk number');
  802.             end
  803.             else
  804.             begin
  805.               if AskNum then Val(AskStr('Enter number of last chunk  : ', 3, '0', '9'), LastChunk, ChunkOk);
  806.               if ChunkNum > 0 then if Ext2 <> '.**' then BigName := BigName + CloneName(Ext1, Ext2) else
  807.                 if AskExt then BigName := BigName + '.' + AskStr('Enter extension of big file : ', 3, '!', #255);
  808.               if BigName[Length(BigName)] = '.' then BigName := Copy(BigName, 1, Length(BigName) - 1);
  809.               if BigName[2] = ':' then Drive := Ord(BigName[1]) - 64 else Drive := 0;
  810.               ChunkOk := MaxInt;
  811.               OverWrite := False;
  812.               ReadSize := MaxLongInt;
  813.               if ChunkNum = 0 then
  814.               begin
  815.                 ChunkName := ChunkBase + MakeExt(ChunkNum);
  816.                 Assign(ChunkFile, ChunkName);
  817.                 FileMode := 0;
  818.                 while (ChunkOk > 0) and (ReadSize > 0) do
  819.                 begin
  820.                   Reset(ChunkFile, 1);
  821.                   if IOResult = 0 then
  822.                   begin
  823.                     New(Buffer);
  824.                     BlockRead(ChunkFile, Buffer^, 7);
  825.                     Close(ChunkFile);
  826.                     Count := 0;
  827.                     Ext2 := '';
  828.                     while (Count < 3) and (Buffer^[Count] <> 0) do
  829.                     begin
  830.                       Ext2 := Ext2 + Chr(Buffer^[Count]);
  831.                       Inc(Count);
  832.                     end;
  833.                     if Ext2 <> '' then BigName := BigName + '.' + Ext2;
  834.                     Move(Buffer^[3], OrigSize, 4);
  835.                     Dispose(Buffer);
  836.                     ChunkOk := 0;
  837.                     Inc(ChunkNum);
  838.                     if DeleteFile then
  839.                     begin
  840.                       AlreadyBeep := True;
  841.                       if Query('Delete ' + MakeName(ChunkName, 31, False), 'Always', 'nEver', DelYes, DelNo,
  842.                         True, VolBeep, False) then
  843.                       begin
  844.                         ClrLine;
  845.                         Write('Deleting ', MakeName(ChunkName, 70, False));
  846.                         Erase(ChunkFile);
  847.                         ClrLine;
  848.                       end;
  849.                     end;
  850.                   end
  851.                   else
  852.                   begin
  853.                     ClrLine;
  854.                     Write(MakeName(ChunkName, 31, False), ' not found. ');
  855.                     MakeErrorBeep;
  856.                     if not NextVol(ChunkNum, False) then ReadSize := 0;
  857.                   end;
  858.                 end;
  859.               end;
  860.               if ReadSize > 0 then
  861.               begin
  862.                 ChunkOk := MaxInt;
  863.                 Assign(BigFile, BigName);
  864.                 FileMode := 2;
  865.                 Reset(BigFile, 1);
  866.                 IOError := IOResult;
  867.                 if IOError = 0 then
  868.                 begin
  869.                   BigPos := FileSize(BigFile);
  870.                   Close(BigFile);
  871.                   if AppendFile then Answer := 'A' else Answer :=
  872.                     Question(MakeName(BigName, 35, False) + ' already exists. Overwrite', 'Append', '', ErrorBeep, False);
  873.                   if Answer = 'Y' then
  874.                   begin
  875.                     OverWrite := True;
  876.                     ChunkOk := 0;
  877.                     BigPos := 0;
  878.                   end;
  879.                   if Answer = 'A' then ChunkOk := 0;
  880.                 end
  881.                 else
  882.                 begin
  883.                   if (IOError >= 2) and (IOError <= 5) then
  884.                   begin
  885.                     OverWrite := True;
  886.                     ChunkOk := 0;
  887.                     BigPos := 0;
  888.                   end;
  889.                 end;
  890.                 if ChunkOk = 0 then
  891.                 begin
  892.                   ClrLine;
  893.                   Command := 'Building';
  894.                   MakeHeader;
  895.                   if OrigSize = 0 then ReadSize := MaxLongInt else ReadSize := OrigSize;
  896.                   while (ReadSize > 0) and (IOResult = 0) do
  897.                   begin
  898.                     VolOk := False;
  899.                     ChunkName := ChunkBase + MakeExt(ChunkNum);
  900.                     Assign(ChunkFile, ChunkName);
  901.                     FileMode := 0;
  902.                     Reset(ChunkFile, 1);
  903.                     if IOResult = 0 then
  904.                     begin
  905.                       GetFTime(ChunkFile, ReadDate);
  906.                       ChunkSize := FileSize(ChunkFile);
  907.                       FreeSize := DiskFree(Drive);
  908.                       if FreeSize = 0 then
  909.                       begin
  910.                         Close(ChunkFile);
  911.                         ClrLine;
  912.                         Write('Disk full. ');
  913.                         if not NextVol(ChunkNum, False) then ReadSize := 0;
  914.                       end
  915.                       else
  916.                       begin
  917.                         if ChunkSize > FreeSize then
  918.                         begin
  919.                           Close(ChunkFile);
  920.                           Str(FreeSize, Text);
  921.                           Text := 'Insufficient free space - ' + Text + ' bytes. Try again';
  922.                           ClrLine;
  923.                           Answer := Question(Text, 'use All space', '', ErrorBeep, False);
  924.                           if Answer = 'N' then ReadSize := 0;
  925.                           if Answer = 'A' then ChunkSize := FreeSize;
  926.                         end
  927.                         else
  928.                         begin
  929.                           if OverWrite then
  930.                           begin
  931.                             Rewrite(BigFile, 1);
  932.                           end
  933.                           else
  934.                           begin
  935.                             FileMode := 2;
  936.                             Reset(BigFile, 1);
  937.                           end;
  938.                           AlreadyBeep := False;
  939.                           if IOResult = 0 then
  940.                           begin
  941.                             Seek(BigFile, BigPos);
  942.                             Dec(ReadSize, ChunkSize);
  943.                             ClrLine;
  944.                             if FirstChunk then WriteLn(Header, HeaderEnd);
  945.                             Write(MakeName(ChunkName, NameLen, True), BigPos:10, (BigPos + ChunkSize):10, ChunkSize:10);
  946.                             if OrigSize = 0 then
  947.                             begin
  948.                               Remaining := LastChunk - ChunkNum;
  949.                               if (LastChunk > 0) and (Remaining > 0) then
  950.                                 if Remaining = 1 then Write( '   1 file ') else Write(Remaining:4, ' files');
  951.                             end
  952.                             else
  953.                             begin
  954.                               if ReadSize > 0 then Write(ReadSize:10);
  955.                             end;
  956.                             WriteLn;
  957.                             New(Buffer);
  958.                             CopySize := ChunkSize;
  959.                             CopiedSize := 0;
  960.                             Percent;
  961.                             IOError := IOResult;
  962.                             Esc := Escape;
  963.                             while (CopySize > 0) and (IOError = 0) and not Esc do
  964.                             begin
  965.                               if CopySize > BufferMax then BufferSize := BufferMax else BufferSize := CopySize;
  966.                               Dec(CopySize, BufferSize);
  967.                               BlockRead(ChunkFile, Buffer^, BufferSize);
  968.                               Inc(CopiedSize, BufferSize);
  969.                               Percent;
  970.                               Esc := Escape;
  971.                               if not Esc then
  972.                               begin
  973.                                 BlockWrite(BigFile, Buffer^, BufferSize);
  974.                                 Inc(CopiedSize, BufferSize);
  975.                                 Percent;
  976.                                 Esc := Escape;
  977.                               end;
  978.                               IOError := IOResult;
  979.                             end;
  980.                             Dispose(Buffer);
  981.                             SetFTime(BigFile, ReadDate);
  982.                             Close(ChunkFile);
  983.                             Close(BigFile);
  984.                             ClrLine;
  985.                             if Esc then
  986.                             begin
  987.                               ReadSize := 0;
  988.                               VolOk := False;
  989.                               if BigPos = 0 then
  990.                               begin
  991.                                 Write('Deleting ', MakeName(BigName, 70, False));
  992.                                 Erase(BigFile);
  993.                                 ClrLine;
  994.                               end
  995.                               else
  996.                               begin
  997.                                 Write('Truncating ', MakeName(BigName, 50, False), ' at pos ', BigPos);
  998.                                 FileMode := 2;
  999.                                 Reset(BigFile, 1);
  1000.                                 Seek(BigFile, BigPos);
  1001.                                 Truncate(BigFile);
  1002.                                 SetFTime(BigFile, ReadDate);
  1003.                                 Close(BigFile);
  1004.                                 ClrLine;
  1005.                               end;
  1006.                             end
  1007.                             else
  1008.                             begin
  1009.                               if IOError = 0 then
  1010.                               begin
  1011.                                 if DeleteFile then
  1012.                                 begin
  1013.                                   AlreadyBeep := True;
  1014.                                   if Query('Delete ' + MakeName(ChunkName, 31, False), 'Always', 'nEver', DelYes, DelNo,
  1015.                                     True, VolBeep, False) then
  1016.                                   begin
  1017.                                     ClrLine;
  1018.                                     Write('Deleting ', MakeName(ChunkName, 70, False));
  1019.                                     Erase(ChunkFile);
  1020.                                     ClrLine;
  1021.                                   end;
  1022.                                 end;
  1023.                                 Inc(BigPos, ChunkSize);
  1024.                                 Inc(ChunkNum);
  1025.                                 ChunkSize := 0;
  1026.                                 VolOk := True;
  1027.                                 OverWrite := False;
  1028.                               end;
  1029.                               FirstChunk := False;
  1030.                             end;
  1031.                           end
  1032.                           else
  1033.                           begin
  1034.                             Close(ChunkFile);
  1035.                             ClrLine;
  1036.                             if OverWrite then Write(MakeName(BigName, 23, False) , ' cannot be created. ') else
  1037.                               Write(MakeName(BigName, 22, False) , ' cannot be appended. ');
  1038.                             MakeErrorBeep;
  1039.                             if not NextVol(ChunkNum, False) then ReadSize := 0;
  1040.                             ChunkSize := 0;
  1041.                           end;
  1042.                           if (ReadSize > 0) and VolOk then
  1043.                           begin
  1044.                             ClrLine;
  1045.                             if ((LastChunk <> 0) and (LastChunk + 1 = ChunkNum)) or not NextVol(ChunkNum, True) then
  1046.                               ReadSize := 0;
  1047.                           end
  1048.                           else
  1049.                           begin
  1050.                             MakeVolBeep;
  1051.                           end;
  1052.                         end;
  1053.                       end;
  1054.                     end
  1055.                     else
  1056.                     begin
  1057.                       ClrLine;
  1058.                       Write(MakeName(ChunkName, 31, False), ' not found. ');
  1059.                       MakeErrorBeep;
  1060.                       if not NextVol(ChunkNum, False) then ReadSize := 0;
  1061.                     end;
  1062.                   end;
  1063.                 end;
  1064.               end;
  1065.             end;
  1066.           end;
  1067.         end;
  1068.       end;
  1069.       ClrLine;
  1070.     end;
  1071.   end;
  1072. end.
  1073.