Паскаль / do9 / iriepas201 / Irie Pascal / samples / split

program split(option, name, output);
const
   OptionFlag1 = '-';
   OptionFlag2 = '/';
   BlockSize = 4096;
type
   BinaryFile = file of char;
   TextFile = text;
var
   option, name : string;
   buffer : packed array[1..BlockSize] of char;
   count, actual : integer;

   procedure syntax;
   begin
      writeln('Purpose: Splits a file into smaller files or');
      writeln('         joins files into a single file.');
      writeln('Syntax : split -sSIZE filename');
      writeln('    or   split -nNUMBER filename');
      writeln('    or   split -j filename');
      halt
   end;

   procedure error(Message : string);
   begin
      write('ERROR: ');
      writeln(message);
      halt
   end;

   procedure DoSplitting(size : integer);
   var
      num : integer;
      FileName, BaseName, Ext : string;
      outt : TextFile;
      InFile : BinaryFile;

      procedure WriteFile(var inf : BinaryFile; n, size : integer);
      var
         outf : BinaryFile;
         OutName, OutExt : string;
         (* c : char; *)
      begin (* WriteFile *)
         str(n, OutExt);
         OutExt := trim(OutExt);
         while length(OutExt) < 3 do
            OutExt := '0'+OutExt;
         OutName := BaseName + '.' + OutExt;
         assign(outf, OutName);
         rewrite(outf);
         while (size > 0) and not eof(inf) do
            begin
               rawread(inf, buffer, BlockSize, count);
               if count > 0 then
                  begin
                     rawwrite(outf, buffer, count, actual);
                     if count <> actual then
                        error('writing to output file')
                  end;
               dec(size, count)
            end;
         close(outf);
      end; (* WriteFile *)

   begin (* DoSplitting *)
      fsplit(name, ,BaseName, Ext);
      FileName := BaseName+Ext;
      assign(outt, BaseName+'.000');
      erase(outt);
      (*
      writeln('"', FileName, '"');
      writeln('"', BaseName, '"');
      writeln(size)
      *)
      assign(InFile, name);
      reset(InFile);
      num := 0;
      while not eof(InFile) do
         begin
            inc(num);
            if num > 999 then
               error('Too many files');
            WriteFile(InFile, num, size);
         end;
      assign(outt, BaseName+'.000');
      rewrite(outt);
      writeln(outt, FileName, ' ', num);
      close(outt);
   end; (* DoSplitting *)

   procedure SplitSize;
   var
      size : integer;

      function InterpretSize(s : string) : integer;
      const
         KB = 1024;
         MB = 1048576;   (* i.e. 1024 * 1024 *)
      type
         MemoryUnits = (bytes, kilobytes, megabytes);
      var
         trail : char;
         units : MemoryUnits;
         size, err : integer;
      begin
         trail := s[length(s)];
         case trail of
         'k', 'K':
            begin
               units := kilobytes;
               s := copy(s, 1, length(s)-1);   (* strip trailing char *)
            end;
         'm', 'M':
            begin
               units := megabytes;
               s := copy(s, 1, length(s)-1);   (* strip trailing char *)
            end;
         otherwise
            units := bytes;
         end;
         val(s, size, err);
         if err > 0 then
            size := 0;
         case units of
         bytes:
            ;   (* do nothing *)
         kilobytes:
            size := size * KB;
         megabytes:
            size := size * MB;
         end;
         InterpretSize := size
      end;

   begin (* SplitSize *)
      size := InterpretSize(copy(option, 3));
      if size < 1 then
         syntax;
      DoSplitting(size)
   end; (* SplitSize *)

   procedure SplitNumber;
   var
      number : string;
      num, err, size : integer;
      f : BinaryFile;
   begin   (* SplitNumber *)
      number := copy(option, 3);
      if number = "" then
         syntax;
      val(number, num, err);
      if err > 0 then
         syntax;
      assign(f, name);
      reset(f);
      size := FileSize(f);
      close(f);
      if (size mod num) = 0 then
         size := size div num
      else
         size := (size div num)+1;
      DoSplitting(size)
   end;   (* SplitNumber *)

   procedure join;
   var
     outf, inf : BinaryFile;
     outt : TextFile;
     DirPart, FileName, BaseName, ext, OutName, InName, line : string;
     num, i, err : integer;
     (* c : char; *)

     procedure extract(line : string; var name : string; var num : integer);
     var
        i : integer;
     begin   (* extract *)
        line := trim(line);
        if line = '' then
           begin
              name := '';
              num := 0
           end
        else
           begin
              i := pos(' ', line);
              if i = 0 then
                 begin
                    name := line;
                    num := 0
                 end
              else
                 begin
                    name := copy(line, 1, i-1);
                    line := trim(copy(line, i));
                    if line = '' then
                       num := 0
                    else
                       val(line, num, i)
                 end
           end
     end;   (* extract *)

   begin    (* join *)
      if length(option) <> 2 then
         syntax;
      fsplit(name, DirPart, BaseName, ext);
      FileName := BaseName+ext;
      (* writeln('Assigning '+DirPart+BaseName+'.000'); *)
      assign(outt, DirPart+BaseName+'.000');
      reset(outt);
      readln(outt, line);
      close(outt);
      extract(line, OutName, num);
      if num < 1 then
         num := maxint;
      if (OutName <> '') and (pos('.', FileName) < 1) then
         name := DirPart+OutName;
      assign(outf, name);
      rewrite(outf);
      for i := 1 to num do
         begin
            str(i, InName);
            InName := trim(InName);
            while length(InName) < 3 do
               InName := '0'+InName;
            InName := DirPart+BaseName+'.'+InName;
            writeln('In name = ', InName);
            assign(inf, InName);
            (*$I-*)
            reset(inf);
            (*$I+*)
            err := IOResult;
            if err <> 0 then
               begin
                  if num <> maxint then
                     error('File '''+InName+''' is missing');
               end;
            while (err = 0) and (not eof(inf)) do
               begin
                  rawread(inf, buffer, BlockSize, count);
                  if count > 0 then
                     begin
                        rawwrite(outf, buffer, count, actual);
                        if count <> actual then
                           error('writing to output file');
                     end
               end;
            if err = 0 then
               close(inf)
         end;
      close(outf)
   end;    (* join *)

begin   (* main program *)
   if paramcount <> 2 then
      syntax;
   if (option[1] <> OptionFlag1) and (option[1] <> OptionFlag2) then
      syntax;
   if length(option) < 2 then
      syntax;
   case option[2] of
   's', 'S': SplitSize;
   'n', 'N': SplitNumber;
   'j', 'J': Join;
   otherwise
      syntax
   end;
end.