home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Simtel MSDOS 1995 October
/
Simtel-MSDOS-Oct1995-CD2.iso
/
starter
/
uudecode.tp5
< prev
next >
Wrap
Pascal/Delphi Source File
|
1990-05-08
|
6KB
|
230 lines
PROGRAM uudecode;
{v1.1 Toad Hall Tweak, 9 May 90
- Reformatted in case, style, indentation, etc. to my preferences.
- Tweaked for Turbo Pascal v5.0
David Kirschbaum
Toad Hall
}
Uses Dos,Crt;
CONST
DefaultSuffix = '.uue';
OFFSET = 32;
TYPE
Str80 = STRING[80];
VAR
Infile: TEXT;
Fi : FILE OF Byte;
Outfile: FILE OF Byte;
linenum: INTEGER;
Line: Str80;
size,remaining : longint; {v1.1 REAL;}
PROCEDURE Abort(Msg: Str80);
BEGIN
WRITELN;
IF linenum > 0 THEN WRITE('Line ', linenum, ': ');
WRITELN(Msg);
HALT
END; {of Abort}
PROCEDURE NextLine(VAR S: Str80);
BEGIN
Inc(linenum);
{write('.');}
READLN(Infile, S);
Dec(remaining,LENGTH(S)-2); {-2 is for CR/LF}
WRITE('bytes remaining: ',remaining:7,' (',
remaining/size*100.0:3:0,'%)',CHR(13));
END; {of NextLine}
PROCEDURE Init;
PROCEDURE GetInFile;
VAR Infilename: Str80;
BEGIN
IF ParamCount = 0 THEN Abort ('Usage: uudecode <filename>');
Infilename := ParamStr(1);
IF POS('.', Infilename) = 0
THEN Infilename := CONCAT(Infilename, DefaultSuffix);
ASSIGN(Infile, Infilename);
{$I-}
RESET(Infile);
{$i+}
IF IOResult > 0 THEN Abort (CONCAT('Can''t open ', Infilename));
WRITELN ('Decoding ', Infilename);
ASSIGN(Fi,Infilename); RESET(Fi);
size := FileSize(Fi);
CLOSE(Fi);
{ IF size < 0 THEN size:=size+65536.0; }
remaining := size;
END; {of GetInFile}
PROCEDURE GetOutFile;
VAR
Header, Mode, Outfilename: Str80;
Ch: CHAR;
PROCEDURE ParseHeader;
VAR index: INTEGER;
PROCEDURE NextWord(VAR Word:Str80; VAR index: INTEGER);
BEGIN
Word := '';
WHILE Header[index] = ' ' DO BEGIN
Inc(index);
IF index > LENGTH(Header) THEN Abort ('Incomplete header')
END;
WHILE Header[index] <> ' ' DO BEGIN
Word := CONCAT(Word, Header[index]);
Inc(index);
END
END; {of NextWord}
BEGIN {ParseHeader}
Header := CONCAT(Header, ' ');
index := 7;
NextWord(Mode, index);
NextWord(Outfilename, index)
END; {of ParseHeader}
BEGIN {GetOutFile}
IF EOF(Infile) THEN Abort('Nothing to decode.');
NextLine (Header);
WHILE NOT ((COPY(Header, 1, 6) = 'begin ') OR EOF(Infile)) DO
NextLine(Header);
WRITELN;
IF EOF(Infile) THEN Abort('Nothing to decode.');
ParseHeader;
ASSIGN(Outfile, Outfilename);
WRITELN ('Destination is ', Outfilename);
{$I-}
RESET(Outfile);
{$I+}
IF IOResult = 0 THEN BEGIN
WRITE ('Overwrite current ', Outfilename, '? [Y/N] ');
REPEAT
Ch := Upcase(ReadKey); {v1.1}
UNTIL Ch IN ['Y', 'N'];
WRITELN(Ch);
IF Ch = 'N' THEN Abort ('Overwrite cancelled.')
END;
REWRITE (Outfile);
END; {of GetOutFile}
BEGIN {Init}
linenum := 0;
GetInFile;
GetOutFile;
END; { init}
FUNCTION Check_Line: BOOLEAN;
BEGIN
IF Line = '' THEN Abort ('Blank line in file');
Check_Line := NOT (Line[1] IN [' ', '`'])
END; {of Check_Line}
PROCEDURE DecodeLine;
VAR
lineIndex, byteNum, count, i: INTEGER;
chars: ARRAY [0..3] OF Byte;
hunk: ARRAY [0..2] OF Byte;
{ 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
writeln;
for i := 0 to 3 do writebin(chars[i]);
writeln;
for i := 0 to 2 do writebin(hunk[i]);
writeln
end; }
FUNCTION Next_Ch: CHAR;
BEGIN
Inc(lineIndex);
IF lineIndex > LENGTH(Line) THEN Abort('Line too short.');
IF NOT (Line[lineindex] IN [' '..'`'])
THEN Abort('Illegal character in line.');
{ write(line[lineindex]:2);}
IF Line[lineindex] = '`' THEN Next_Ch := ' '
ELSE Next_Ch := Line[lineIndex]
END; {of Next_Ch}
PROCEDURE DecodeByte;
PROCEDURE GetNextHunk;
VAR i: INTEGER;
BEGIN
FOR i := 0 TO 3 DO chars[i] := ORD(Next_Ch) - OFFSET;
hunk[0] := (chars[0] ShL 2) + (chars[1] ShR 4);
hunk[1] := (chars[1] ShL 4) + (chars[2] ShR 2);
hunk[2] := (chars[2] ShL 6) + chars[3];
byteNum := 0 {;
debug }
END; {of GetNextHunk}
BEGIN {DecodeByte}
IF byteNum = 3 THEN GetNextHunk;
WRITE (Outfile, hunk[byteNum]);
{writeln(bytenum, ' ', hunk[byteNum]);}
Inc(byteNum)
END; {of DecodeByte}
BEGIN {DecodeLine}
lineIndex := 0;
byteNum := 3;
count := (ORD(Next_Ch) - OFFSET);
FOR i := 1 TO count DO DecodeByte
END; {of DecodeLine}
PROCEDURE Terminate;
VAR Trailer: Str80;
BEGIN
IF EOF(Infile) THEN Abort ('Abnormal end.');
NextLine (trailer);
IF LENGTH (trailer) < 3 THEN Abort ('Abnormal end.');
IF COPY (trailer, 1, 3) <> 'end' THEN Abort ('Abnormal end.');
CLOSE (Infile);
CLOSE (Outfile)
END; {of Terminate}
BEGIN {uudecode}
Init;
NextLine(Line);
WHILE Check_Line DO BEGIN
DecodeLine;
NextLine(Line)
END;
Terminate
END.