home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Simtel MSDOS 1996 June
/
Simtel-MSDOS-Jun1996-CD1.iso
/
00_start
/
uuencode.tp5
< prev
next >
Wrap
Pascal/Delphi Source File
|
1990-05-07
|
6KB
|
222 lines
PROGRAM uuencode;
{v1.1 Toad Hall Tweak, 9 May 90
- Converted reserved, other word case to my preferred style.
- Converted for Turbo Pascal v5.0 compilation ("Uses", etc.)
}
Uses Dos,Crt;
CONST
Header = 'begin';
Trailer = 'end';
DefaultMode = '644';
DefaultExtension = '.uue';
OFFSET = 32;
CHARSPERLINE = 60;
BYTESPERHUNK = 3;
SIXBITMASK = $3F;
TYPE
Str80 = STRING[80];
VAR
Infile: FILE OF Byte;
Outfile: TEXT;
Infilename, Outfilename, Mode: Str80;
lineLength, numbytes, bytesInLine: INTEGER;
Line: ARRAY [0..59] OF CHAR;
hunk: ARRAY [0..2] OF Byte;
chars: ARRAY [0..3] OF Byte;
size,remaining : longint; {v1.1 REAL;}
{ procedure debug;
var i: integer;
procedure writebin(x: byte);
var i: integer;
begin
for i := 1 to 8 do begin
write ((x and $80) shr 7);
x := x shl 1
end;
write (' ')
end;
begin
for i := 0 to 2 do writebin(hunk[i]);
writeln;
for i := 0 to 3 do writebin(chars[i]);
writeln;
for i := 0 to 3 do writebin(chars[i] and SIXBITMASK);
writeln
end; }
PROCEDURE Abort (Msg : Str80);
BEGIN
WRITELN(Msg);
{$I-} {v1.1}
CLOSE(Infile);
CLOSE(Outfile);
{$I+} {v1.1}
HALT
END; {of Abort}
PROCEDURE Init;
PROCEDURE GetFiles;
VAR
i : INTEGER;
TempS : Str80;
Ch : CHAR;
BEGIN
IF ParamCount < 1 THEN Abort ('No input file specified.');
Infilename := ParamStr(1);
{$I-}
ASSIGN (Infile, Infilename);
RESET (Infile);
{$I+}
IF IOResult > 0 THEN Abort (CONCAT ('Can''t open file ', Infilename));
size := FileSize(Infile);
{ IF size < 0 THEN size:=size+65536.0; }
remaining := size;
WRITE('Uuencoding file ', Infilename);
i := POS('.', Infilename);
IF i = 0
THEN Outfilename := Infilename
ELSE Outfilename := COPY (Infilename, 1, PRED(i));
Mode := DefaultMode;
{ Process 2d cmdline arg (if any).
It could be a new mode (rather than default "644")
or it could be a forced output name (rather than
"infile.uue")
}
IF ParamCount > 1 {got more args}
THEN FOR i := 2 TO ParamCount DO BEGIN
TempS := ParamStr(i);
IF TempS[1] IN ['0'..'9'] {numeric : it's a mode}
THEN Mode := TempS
ELSE Outfilename := TempS {it's output filename}
END;
IF POS ('.', Outfilename) = 0 {he didn't give us extension..}
{..so make it ".uue"}
THEN Outfilename := CONCAT(Outfilename, DefaultExtension);
ASSIGN (Outfile, Outfilename);
WRITELN (' to file ', Outfilename, '.');
{$I-}
RESET(Outfile);
{$I+}
IF IOResult = 0 THEN BEGIN {output file exists!}
WRITE ('Overwrite current ', Outfilename, '? [Y/N] ');
REPEAT
Ch := Upcase(ReadKey);
UNTIL Ch IN ['Y', 'N'];
WRITELN (Ch);
IF Ch = 'N' THEN Abort(CONCAT (Outfilename, ' not overwritten.'))
END;
{$I-}
CLOSE(Outfile);
IF IOResult <> 0 THEN ; {v1.1 we don't care}
REWRITE(Outfile);
{$I+}
IF IOResult > 0 THEN Abort(CONCAT('Can''t open ', Outfilename));
END; {of GetFiles}
BEGIN {Init}
GetFiles;
bytesInLine := 0;
lineLength := 0;
numbytes := 0;
WRITELN (Outfile, Header, ' ', Mode, ' ', Infilename);
END; {init}
{You'll notice from here on we don't do any error-trapping on disk
read/writes. We just let DOS do the job. Any errors are terminal
anyway, right?
}
PROCEDURE FlushLine;
VAR i: INTEGER;
PROCEDURE WriteOut(Ch: CHAR);
BEGIN
IF Ch = ' ' THEN WRITE(Outfile, '`')
ELSE WRITE(Outfile, Ch)
END; {of WriteOut}
BEGIN {FlushLine}
{write ('.');}
WRITE('bytes remaining: ',remaining:7,' (',
remaining/size*100.0:3:0,'%)',CHR(13));
WriteOut(CHR(bytesInLine + OFFSET));
FOR i := 0 TO PRED(lineLength) DO
WriteOut(Line[i]);
WRITELN (Outfile);
lineLength := 0;
bytesInLine := 0
END; {of FlushLine}
PROCEDURE FlushHunk;
VAR i: INTEGER;
BEGIN
IF lineLength = CHARSPERLINE THEN FlushLine;
chars[0] := hunk[0] ShR 2;
chars[1] := (hunk[0] ShL 4) + (hunk[1] ShR 4);
chars[2] := (hunk[1] ShL 2) + (hunk[2] ShR 6);
chars[3] := hunk[2] AND SIXBITMASK;
{debug;}
FOR i := 0 TO 3 DO BEGIN
Line[lineLength] := CHR((chars[i] AND SIXBITMASK) + OFFSET);
{write(line[linelength]:2);}
Inc(lineLength);
END;
{writeln;}
Inc(bytesInLine,numbytes);
numbytes := 0
END; {of FlushHunk}
PROCEDURE Encode1;
BEGIN
IF numbytes = BYTESPERHUNK THEN FlushHunk;
READ (Infile, hunk[numbytes]);
Dec(remaining);
Inc(numbytes);
END; {of Encode1}
PROCEDURE Terminate;
BEGIN
IF numbytes > 0 THEN FlushHunk;
IF lineLength > 0 THEN BEGIN
FlushLine;
FlushLine;
END
ELSE FlushLine;
WRITELN (Outfile, Trailer);
CLOSE (Outfile);
CLOSE (Infile);
END; {Terminate}
BEGIN {uuencode}
Init;
WHILE NOT EOF (Infile) DO Encode1;
Terminate;
WRITELN;
END. {uuencode}