Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Скачиваний:
19
Добавлен:
10.12.2013
Размер:
7.43 Кб
Скачать
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.
Соседние файлы в папке samples