三代坦克说的是*.eml文件的格式
但是内部的Base64编码和解码，没有交待
unit mimecode;
// ?? : 拦蝴в (DWJ)
// E-Mail Address : u8106117@cseserv.cse.ttit.edu.tw
interface
procedure base64d(infile : string; outfile : string);
procedure base64e(infile : string; outfile : string);
procedure qpd( infile: string; outfile : string );
procedure qpe( infile:string; outfile:string );
implementation
uses
SysUtils;
(*---- Decoder ----*)
procedure base64d(infile : string; outfile : string);
var infp, outfp : TEXT;
in1, in2, in3, in4, t : char;
v1, v2, v3, v4 : integer;
out1, out2, out3 : char;
index, final : integer;
function ct(inchar : char) : integer;
begin
case inchar of
'A' : ct := 0 ; 'B' : ct := 1 ; 'C' : ct := 2 ; 'D' : ct := 3 ;
'E' : ct := 4 ; 'F' : ct := 5 ; 'G' : ct := 6 ; 'H' : ct := 7 ;
'I' : ct := 8 ; 'J' : ct := 9 ; 'K' : ct := 10 ; 'L' : ct := 11 ;
'M' : ct := 12 ; 'N' : ct := 13 ; 'O' : ct := 14 ; 'P' : ct := 15 ;
'Q' : ct := 16 ; 'R' : ct := 17 ; 'S' : ct := 18 ; 'T' : ct := 19 ;
'U' : ct := 20 ; 'V' : ct := 21 ; 'W' : ct := 22 ; 'X' : ct := 23 ;
'Y' : ct := 24 ; 'Z' : ct := 25 ; 'a' : ct := 26 ; 'b' : ct := 27 ;
'c' : ct := 28 ; 'd' : ct := 29 ; 'e' : ct := 30 ; 'f' : ct := 31 ;
'g' : ct := 32 ; 'h' : ct := 33 ; 'i' : ct := 34 ; 'j' : ct := 35 ;
'k' : ct := 36 ; 'l' : ct := 37 ; 'm' : ct := 38 ; 'n' : ct := 39 ;
'o' : ct := 40 ; 'p' : ct := 41 ; 'q' : ct := 42 ; 'r' : ct := 43 ;
's' : ct := 44 ; 't' : ct := 45 ; 'u' : ct := 46 ; 'v' : ct := 47 ;
'w' : ct := 48 ; 'x' : ct := 49 ; 'y' : ct := 50 ; 'z' : ct := 51 ;
'0' : ct := 52 ; '1' : ct := 53 ; '2' : ct := 54 ; '3' : ct := 55 ;
'4' : ct := 56 ; '5' : ct := 57 ; '6' : ct := 58 ; '7' : ct := 59 ;
'8' : ct := 60 ; '9' : ct := 61 ; '+' : ct := 62 ; '/' : ct := 63 ;
end;
end;
begin
try
Assign(infp,infile);
Assign(outfp,outfile);
Reset(infp);
Rewrite(outfp);
while not eof(infp) do
begin
read(infp,in1);
read(infp,in2);
read(infp,in3);
read(infp,in4);
if eoln(infp) then
begin
read(infp,t);
read(infp,t);
end;
v1 := ct(in1);
v2 := ct(in2);
v3 := ct(in3);
v4 := ct(in4);
if ((in3 = '=') and (in4 = '=')) then
begin
out1 := chr((v1 shl 2)+(v2 shr 4));
write(outfp,out1);
Close(infp);
Close(outfp);
Exit;
end
else if ((in3 <> '=') and (in4 = '=')) then
begin
out1 := chr((v1 shl 2)+(v2 shr 4));
out2 := chr((v2 shl 4)+(v3 shr 2));
write(outfp,out1);
write(outfp,out2);
Close(infp);
Close(outfp);
Exit;
end
else
begin
out1 := chr((v1 shl 2)+(v2 shr 4));
out2 := chr((v2 shl 4)+(v3 shr 2));
out3 := chr((v3 shl 6)+v4);
write(outfp,out1);
write(outfp,out2);
write(outfp,out3);
end;
end;
finally
close(outfp);
close(infp);
end;
end;
(*---- Encoder ----*)
procedure base64e(infile : string; outfile : string);
var infp, outfp : TEXT;
f : File of BYTE;
fsize,nsize : longInt;
in1, in2, in3, t : char;
out1, out2, out3, out4 : integer;
index, final : integer;
function ct(inchar : integer) : char;
begin
case inchar of
0 : ct := 'A' ; 1 : ct := 'B' ; 2 : ct := 'C' ; 3 : ct := 'D' ;
4 : ct := 'E' ; 5 : ct := 'F' ; 6 : ct := 'G' ; 7 : ct := 'H' ;
8 : ct := 'I' ; 9 : ct := 'J' ; 10 : ct := 'K' ; 11 : ct := 'L' ;
12 : ct := 'M' ; 13 : ct := 'N' ; 14 : ct := 'O' ; 15 : ct := 'P' ;
16 : ct := 'Q' ; 17 : ct := 'R' ; 18 : ct := 'S' ; 19 : ct := 'T' ;
20 : ct := 'U' ; 21 : ct := 'V' ; 22 : ct := 'W' ; 23 : ct := 'X' ;
24 : ct := 'Y' ; 25 : ct := 'Z' ; 26 : ct := 'a' ; 27 : ct := 'b' ;
28 : ct := 'c' ; 29 : ct := 'd' ; 30 : ct := 'e' ; 31 : ct := 'f' ;
32 : ct := 'g' ; 33 : ct := 'h' ; 34 : ct := 'i' ; 35 : ct := 'j' ;
36 : ct := 'k' ; 37 : ct := 'l' ; 38 : ct := 'm' ; 39 : ct := 'n' ;
40 : ct := 'o' ; 41 : ct := 'p' ; 42 : ct := 'q' ; 43 : ct := 'r' ;
44 : ct := 's' ; 45 : ct := 't' ; 46 : ct := 'u' ; 47 : ct := 'v' ;
48 : ct := 'w' ; 49 : ct := 'x' ; 50 : ct := 'y' ; 51 : ct := 'z' ;
52 : ct := '0' ; 53 : ct := '1' ; 54 : ct := '2' ; 55 : ct := '3' ;
56 : ct := '4' ; 57 : ct := '5' ; 58 : ct := '6' ; 59 : ct := '7' ;
60 : ct := '8' ; 61 : ct := '9' ; 62 : ct := '+' ; 63 : ct := '/' ;
end;
end;
begin
try
Assign(f, infile);
Reset(f);
fsize := Filesize(f);
finally
Close(f);
end;
try
Assign(infp,infile);
Assign(outfp,outfile);
Reset(infp);
Rewrite(outfp);
nsize := 0;
index := 0;
while (nsize < fsize) do
begin
inc(nsize);
read(infp,in1);
final := 8;
if (nsize < fsize) then
begin
inc(nsize);
read(infp,in2);
final := 16;
end
else in2 := chr(0);
if (nsize < fsize) then
begin
inc(nsize);
read(infp,in3);
final := 24;
end
else in3 := chr(0);
out1 := ord(in1) shr 2;
out2 := ((ord(in1) and 3) shl 4) + (ord(in2) shr 4);
out3 := ((ord(in2) and 15) shl 2) + ((ord(in3) and 192) shr 6);
out4 := ord(in3) and 63;
t := ct(out1);
inc(index);
write(outfp,t);
t := ct(out2);
inc(index);
write(outfp,t);
if ((final = 8) and (nsize = fsize)) then
begin
writeln(outfp,'==');
close(outfp);
exit;
end;
t := ct(out3);
inc(index);
write(outfp,t);
if ((final = 16) and (nsize = fsize)) then
begin
writeln(outfp,'=');
close(outfp);
close(infp);
exit;
end;
t := ct(out4);
inc(index);
write(outfp,t);
if index = 72 then
begin
writeln(outfp,'');
index := 0;
end;
end;
finally
close(outfp);
close(infp);
end;
end;
(*---- Encoder ----*)
procedure qpe( infile:string; outfile:string );
const keep = [#33..#60, #62..#126, #9, ' '];
var
f : file of byte;
infp, outfp : Text;
inchar : char;
oc1, oc2 : char;
len, icv, ocv1, ocv2 : integer;
fsize, nsize : longint;
begin
try
Assign( f, infile );
Reset( f );
fsize := Filesize( f );
nsize := 0;
finally
Close( f );
end;
try
Assign( infp, infile );
Assign( outfp, outfile );
Reset( infp );
Rewrite( outfp );
len := 0;
while ( nsize < fsize ) do
begin
read( infp, inchar );
inc( nsize );
if ( inchar = #13 ) then
begin
read( infp, inchar );
inc( nsize );
if ( inchar = #10 ) then
begin
writeln( outfp, '' );
len := 0;
end
else
begin
write( outfp, '=0D' );
len := len + 3;
if ( len > 70 ) then
begin
writeln( outfp, '=' );
len := 0;
end;
icv := ord( inchar );
ocv1 := icv DIV 16;
ocv2 := icv MOD 16;
if ocv1 < 10 then
oc1 := chr( ord( '0' ) + ocv1 )
else
oc1 := chr( ord( 'A' ) + ocv1 - 10 );
if ocv2 < 10 then
oc2 := chr( ord( '0' ) + ocv2 )
else
oc2 := chr( ord( 'A' ) + ocv2 - 10 );
write( outfp, '=', oc1, oc2 );
len := len + 3;
if ( len > 70 ) then
begin
writeln( outfp, '=' );
len := 0;
end;
end;
end
else
begin
if inchar in keep then
begin
write( outfp, inchar );
inc(len);
if ( len > 70 ) then
begin
writeln( outfp, '=' );
len := 0;
end;
end
else
begin
icv := ord( inchar );
ocv1 := icv DIV 16;
ocv2 := icv MOD 16;
if ocv1 < 10 then
oc1 := chr( ord( '0' ) + ocv1 )
else
oc1 := chr( ord( 'A' ) + ocv1 - 10 );
if ocv2 < 10 then
oc2 := chr( ord( '0' ) + ocv2 )
else
oc2 := chr( ord( 'A' ) + ocv2 - 10 );
write( outfp, '=', oc1, oc2 );
len := len + 3;
if ( len > 70 ) then
begin
writeln( outfp, '=' );
len := 0;
end;
end;
end;
end;
finally
Close( infp );
Close( outfp );
end;
end;
(*---- Decoder ----*)
procedure qpd( infile: string; outfile : string );
var infp, outfp : TEXT;
inchar : char;
line : string;
cl : boolean;
i1, i2 : integer;
procedure getnum( const c1 : char; const c2 : char );
var outchar : char;
t1, t2, t3, code : integer;
begin
t1 := 0;
t2 := 0;
t3 := 0;
outchar := ' ';
if ( c1 in ['0'..'9'] ) then
begin
val( c1, t1, code );
t1:= t1*16;
end
else if ( c1 in ['A'..'F'] ) then
begin
t1 := ( ord( c1 ) - ord( 'A' ) + 10 ) * 16;
end;
if ( c2 in ['0'..'9'] ) then
val(c2,t2,code)
else if ( c2 in ['A'..'F'] ) then
t2 := ( ord( c2 ) - ord( 'A' ) + 10 );
t3 := t1 + t2;
outchar := chr( t3 );
write( outfp, outchar );
end;
begin
try
inchar := ' ';
cl := false;
Assign( infp, infile );
Assign( outfp, outfile );
Reset( infp );
Rewrite( outfp );
while not eof( infp ) do
begin
readln( infp, line );
i2 := length( line );
if i2=0 then
begin
writeln( outfp, '' );
continue;
end;
cl := false;
if ( line[i2] <> '=' ) then
cl := true;
if line[i2] = '=' then
begin
delete( line, i2, 1 );
i2 := i2-1;
end;
i1 := 1;
while i1 <= i2 do
begin
if line[i1] = '=' then
begin
getnum( line[i1+1], line[i1+2] );
i1 := i1 + 2;
end
else write( outfp, line[i1] );
inc( i1 );
end;
if cl = true then
writeln( outfp, '' );
end;
finally
Close( infp );
Close( outfp );
end;
end;
end.
