www.pudn.com > mail104s.lzh > UUCP.PAS
unit uucp;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls,pop3, StdCtrls, Buttons;
type
TUUCPForm = class(TForm)
PrgBar: TProgressBar;
procedure FormActivate(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
private
{ Private declarations }
{ Public declarations }
function uuEncode(ThisByte:Byte):Char;
function uuDecode(ThisByte:Byte):Byte;
procedure DoEncode;
procedure DoStdDecode;
procedure Base64Decode;
Procedure LoadTable(uuType:Integer);
procedure LoadBase64Table(p64Table:pByte);
procedure AppMessage(var Msg: TMsg; var Handled: Boolean);
public
EncodeTable:array[0..63] of char;
EncodedFile: TextFile;
DecodedFile:File of Byte;
SourceFile: File of byte;
// Encode paramaters
EnSrc:string;
// Encode and Decode parameters
EnDest:string;
EnMode:Integer;
// End flag
EndFlag:Boolean;
CodeFlag:Integer;
ParaFlag:Boolean;
ParaEndFlag:boolean;
end;
var
UUCPForm: TUUCPForm;
const
{ 若發現它是一個標準碼則 EnMode=ENSTDMODE }
ENSTDMODE=0;
ENBASE64MODE=1;
FILENOTEXIST=99;
NOTSTDDECODE=98;
StdTable:array[0..63] of byte=
($60,$21,$22,$23,$24,$25,$26,$27,$28,$29,$2A,$2B,$2C,$2D,$2E,
$2F,$30,$31,$32,$33,$34,$35,$36,$37,$38,$39,$3A,$3B,$3C,$3D,
$3E,$3F,$40,$41,$42,$43,$44,$45,$46,$47,$48,$49,$4A,$4B,$4C,
$4D,$4E,$4F,$50,$51,$52,$53,$54,$55,$56,$57,$58,$59,$5A,$5B,
$5C,$5D,$5E,$5F);
Base64Table:array[0..63] of byte=
($41,$42,$43,$44,$45,$46,$47,$48,$49,$4A,$4B,$4C,$4D,$4E,$4F,
$50,$51,$52,$53,$54,$55,$56,$57,$58,$59,$5A,$61,$62,$63,$64,
$65,$66,$67,$68,$69,$6A,$6B,$6C,$6D,$6E,$6F,$70,$71,$72,$73,
$74,$75,$76,$77,$78,$79,$7A,$30,$31,$32,$33,$34,$35,$36,$37,
$38,$39,$2B,$2F);
// For Base64 decode
Table64:array[0..79] of byte=
($3E,$7F,$7F,$7F,$3F,$34,$35,$36,$37,$38,$39,$3A,$3B,$3C,$3D,
$7F,$7F,$7F,$40,$7F,$7F,$7F,$00,$01,$02,$03,$04,$05,$06,$07,
$08,$09,$0A,$0B,$0C,$0D,$0E,$0F,$10,$11,$12,$13,$14,$15,$16,
$17,$18,$19,$7F,$7F,$7F,$7F,$7F,$7F,$1A,$1B,$1C,$1D,$1E,$1F,
$20,$21,$22,$23,$24,$25,$26,$27,$28,$29,$2A,$2B,$2C,$2D,$2E,
$2F,$30,$31,$32,$33);
implementation
uses mimelist;
{$R *.DFM}
procedure TUUCPForm.AppMessage(var Msg: TMsg; var Handled: Boolean);
begin
if EndFlag=true then Close;
end;
{ Unix To Unix communication }
function TUUCPForm.uuEncode(ThisByte:Byte):Char;
begin
Result:=Char((EncodeTable[((ThisByte) and $3F)]));
end;
// 載入標準編碼表 Standard Encode Table
Procedure TUUCPForm.LoadTable(uuType:Integer);
var
I:Integer;
begin
if uuType=ENSTDMODE then
begin
for I:=0 to 63 do
begin
EnCodeTable[I]:=Char(StdTable[I]);
if StdTable[I]=$3B then
EnCodeTable[I]:=';';
end;
end
else begin
for I:=0 to 63 do
EnCodeTable[I]:=Char(Base64Table[I]);
end;
end;
procedure TUUCPForm.DoEncode;
var
CurPos:Integer;
CurByte:Byte;
ELines:string;
CurLine:array[1..54]of Byte;
Counts:Integer;
Remainder:Integer;
Times:Integer;
begin
{ Open the Source file and Encoded File }
AssignFile(SourceFile,EnSrc);
Reset(SourceFile);
AssignFile(EncodedFile,EnDest);
FileMode:=2;
Times:=1;
ELines:=EnSrc;
CurPos:=Pos('\',ELines);
{ 設定純檔名 }
while(CurPos>0) do
begin
ELines:=Copy(ELines,(CurPos+1),Length(ELines));
CurPos:=Pos('\',ELines);
end;
{ Base 64 Option , Load MIME Table }
if EnMode=ENBASE64MODE then
begin
Append(EncodedFile);
WriteLn(EncodedFile,'--------------66443322');
Append(EncodedFile);
writeLn(EncodedFile,'Content-Type: application/octet-stream');
Append(EncodedFile);
WriteLn(EncodedFile,'Content-Transfer-Encoding: base64');
Append(EncodedFile);
WriteLn(EncodedFile,'Content-Disposition: attachement; filename="'+ELines+'"');
Append(EncodedFile);
WriteLn(EncodedFile,'');
ParaFlag:=true;
LoadTable(ENBASE64MODE);
end else
begin
WriteLn(EncodedFile,'begin 644 '+ELines);
{EnDest.Add('begin 644 '+ELines);}
LoadTable(ENSTDMODE);
end;
{ 讀取要編碼的檔案 use 45 to 60 模式 }
Counts:=0;
while(not Eof(Sourcefile)) do
begin
Counts:=0;
while ((Counts<54) and (not Eof(SourceFile))) do
begin
{ 逐次讀取-45位元存入緩衝區 }
Read(Sourcefile,CurByte);
inc(Counts);
CurLine[Counts]:=CurByte;
end;
if Prgbar.Position<100 then
Prgbar.Position:=PrgBar.Position+1
else
Prgbar.Position:=0;
// Base 64 Encode mode and standard mode
if EnMode=ENSTDMODE then
ELines:=uuEncode(Byte(Counts))
else
ELines:='';
CurPos:=1;
{ 正常處理填滿 45個位元 }
while(CurPos<=(Counts-2)) do
begin
CurByte:=(CurLine[CurPos] SHR 2);
ELines:=ELines+uuEncode(CurByte);
CurByte:=((CurLine[CurPos] SHL 4) or (CurLine[(CurPos+1)] SHR 4));
ELines:=Elines+uuEncode(CurByte);
CurByte:=((CurLine[(CurPos+1)] SHL 2) or (CurLine[(CurPos+2)] shr 6));
ELines:=ELines+uuEncode(CurByte);
CurByte:=(CurLine[(CurPos+2)] and $3F);
ELines:=ELines+uuEncode(CurByte);
CurPos:=CurPos+3;
end;
{ get remainder 取餘數 }
Remainder:=(Counts mod 3);
if Remainder>0 then
begin
CurByte:=(CurLine[CurPos] shr 2);
ELines:=ELines+uuEncode(CurByte);
if Remainder=1 then
begin
CurByte:=((CurLine[CurPos] shl 4) and $30);
Elines:=ELines+uuEncode(CurByte);
if EnMode=ENBASE64MODE then ELines:=ELines+'=';
end else
{ remain 2 bytes }
begin
CurByte:=(((CurLine[CurPos] shl 4) and $30) or
((CurLine[(CurPos+1)] shl 4) and $0F));
ELines:=ELines+uuEncode(CurByte);
CurByte:=((CurLine[(CurPos+1)] shl 2) and $3C);
end;
{ Append in the buffer if it is BASE64 then fill in "=" }
ELines:=ELines+uuEncode(CurByte);
if EnMode=ENBASE64MODE then
ELines:=ELines+'=';
end;
Append(EncodedFile);
WriteLn(EncodedFile,ELines);
end;
if EnMode=ENSTDMODE then
begin
ELines:=uuEncode(0);
Append(EncodedFile);
WriteLn(EncodedFile,ELines);
end;
if ParaFlag then
begin
if ParaEndFlag then
begin
Append(EncodedFile);
WriteLn(EncodedFile,'--------------66443322--');
end;
end;
//WriteLn(EncodedFile,'begin-base64 644');
closeFile(EncodedFile);
CloseFile(SourceFile);
EndFlag:=true;
// Close Form
end;
function TUUCPForm.uuDecode(ThisByte:Byte):Byte;
begin
Result:=((ThisByte-Byte(' ')) and $3F);
end;
// it is prepareing to modified to 7bit decoded
// 修改成取得一行就解碼一行
procedure TUUCPForm.DoStdDecode;
var
I:Integer;
FName:string;
sPos:Integer;
BeginNo:Integer;
ReadAble:Boolean;
Counts:Integer;
LineEnd:boolean;
CurPos:Integer;
Remainder:Integer;
CurChar:Byte;
Lines:string;
Times:Integer;
XTimes:Integer;
begin
{ Open Source file }
AssignFile(EncodedFile,EnSrc);
Reset(EncodedFile);
I:=0;
BeginNo:=0;
Times:=1;
While((BeginNo=0) and (not Eof(EncodedFile))) do
begin
ReadLn(EncodedFile,Lines);
sPos:=Pos('begin 644 ',Lines);
if sPos>0 then
begin
{ 取檔名 }
//FName:=Copy(Lines,sPos+length('begin 644 '),length(Lines));
BeginNo:=1;
end;
end;
AssignFile(DecodedFile,EnDest);
ReWrite(DecodedFile);
CurPos:=0;
XTimes:=Popdialog.MIMELinesNum div 100;
if BeginNo>0 then
begin
ReadAble:=true;
while(ReadAble=true) do
begin
ReadLn(EncodedFile,Lines);
if Length(Lines)>2 then
begin
Counts:=Integer(uuDecode(Byte(Lines[1])));
// Process the Progress bar
if Prgbar.Position<100 then
Prgbar.Position:=PrgBar.Position+1
else
Prgbar.Position:=0;
CurPos:=2;
while (Counts>0) do
begin
if Counts>=3 then
begin
CurChar:=((uuDecode(Byte(Lines[CurPos])) shl 2) or
(uuDecode(Byte(Lines[(CurPos+1)])) shr 4));
write(DecodedFile,CurChar);
CurChar:=((uuDecode(Byte(Lines[(CurPos+1)])) shl 4) or
(uuDecode(Byte(Lines[(CurPos+2)])) shr 2));
write(DecodedFile,CurChar);
CurChar:=((uuDecode(Byte(Lines[(CurPos+2)])) shl 6) or
uuDecode(Byte(Lines[(CurPos+3)])));
write(DecodedFile,CurChar);
end
else begin
if Counts>=1 then
begin
CurChar:=((uuDecode(Byte(Lines[CurPos])) shl 2) or
(uuDecode(Byte(Lines[(CurPos+1)])) shr 4));
write(DecodedFile,CurChar);
end;
if Counts>=2 then
begin
CurChar:=((uuDecode(Byte(Lines[(CurPos+1)])) shl 4) or
(uuDecode(Byte(Lines[(CurPos+2)])) shr 2));
write(DecodedFile,CurChar);
end;
end;
CurPos:=CurPos+4;
Counts:=Counts-3;
end;
end else
begin
ReadLn(EncodedFile,Lines);
if(CompareStr(Lines,'end')=0) then
ReadAble:=false;
end;
end;
end;
//POPDialog.StatusBar1.Panels.Items[0].Text:='解碼完成';
//PopDialog.StatusBar1.Update;
CloseFile(DecodedFile);
CloseFile(EncodedFile);
EndFlag:=true;
end;
////////////////////////////////////////////////////////////////////////
// > Load Base64 Table function it is special byte
// >
////////////////////////////////////////////////////////////////////////
procedure TUUCPForm.LoadBase64Table(p64Table:pByte);
var
I:Integer;
begin
for I:=0 to 79 do
begin
p64Table^:=Table64[I];
inc(p64Table);
end;
end;
procedure TUUCPForm.Base64Decode;
var
NumChars: Integer;
CurPos: Integer;
CurLineLength: Integer;
CurLine: String;
CurChar: Byte;
MoreToRead: Boolean;
LineBegin:boolean;
LineEnd: Boolean;
base64Table: array[43..122] of Byte;
c1, c2, c3: Byte;
I:Integer;
BeginNo:Integer;
Times:Integer;
sPos:Integer;
XTimes:Integer;
begin
{ Open Source file }
AssignFile(EncodedFile,EnSrc);
Reset(EncodedFile);
// OPen Destint file
AssignFile(DecodedFile,EnDest);
ReWrite(DecodedFile);
I:=0;
BeginNo:=0;
Times:=1;
//XTimes:=PopDialog.MIMELinesNum div 100;
LoadBase64Table(@base64Table);
MoreToRead := TRUE;
While((BeginNo=0) and (not Eof(EncodedFile))) do
begin
ReadLn(EncodedFile,CurLine);
sPos:=Pos('begin-base64 644 ',CurLine);
if sPos>0 then BeginNo:=1;
if LineBegin=true then
if CurLine='' then BeginNo:=1;
if Pos(MIMEListForm.IconList.selected.caption,CurLine)>0 then
LineBegin:=true;
end;
// To Calculate the progress of the decoding
// How much lines will decoded?
if PopDialog.Boundary='' then PopDialog.Boundary:='------=_NextPart_';
while (MoreToRead = TRUE) do
begin
ReadLn(EncodedFile, CurLine);
if Prgbar.Position<100 then
Prgbar.Position:=PrgBar.Position+1
else
Prgbar.Position:=0;
LineEnd := FALSE;
if Pos(PopDialog.Boundary,CurLine)<=0 then
begin
if Pos('Content',CurLine)<=0 then
begin
if (Length(CurLine) > 2) then
begin
if (CompareStr(Copy(CurLine, 1, 4), '====') <> 0) then
begin
CurPos := 1;
CurLineLength := Length(CurLine);
while (((base64Table[Integer(CurLine[CurPos])] and $40) <> 0) and
(CurPos < CurLineLength)) do
begin
if ((CurLine[CurPos] = #13) or (CurLine[CurPos] = #10) or
(CurLine[CurPos] = '=')) then
begin
LineEnd := TRUE;
Exit;
end;
Inc(CurPos);
end;
if (CurPos = CurLineLength) then LineEnd := TRUE;
if (not LineEnd) then
begin
while ((CurPos < CurLineLength) and (not LineEnd)) do
begin
if (Byte(CurLine[CurPos]) < 43) then
Inc(CurPos)
else
begin
if (Byte(CurLine[CurPos]) > 122) then
Inc(CurPos)
else
begin
if (base64Table[Byte(CurLine[CurPos])] = $7F) then
Inc(CurPos)
else
begin
c1 := base64Table[Byte(CurLine[CurPos])];
Inc(CurPos);
c2 := base64Table[Byte(CurLine[CurPos])];
Inc(CurPos);
c3 := base64Table[Byte(CurLine[CurPos])];
Inc(CurPos);
CurChar := ((c1 SHL 2) or (c2 SHR 4));
Write(DecodedFile, CurChar);
if (CurLine[(CurPos - 1)] <> '=') then
begin
CurChar := ((c2 SHL 4) or (c3 SHR 2));
Write(DecodedFile, CurChar);
if (CurLine[CurPos] <> '=') then
begin
CurChar := ((c3 SHL 6) or (base64Table[Byte(CurLine[CurPos])]));
Write(DecodedFile, CurChar);
Inc(CurPos);
end
else
MoreToRead := FALSE;
end
else
MoreToRead := FALSE;
end;
end;
end;
end;
end;
end;
end;
if (Eof(EncodedFile)) then
MoreToRead := FALSE;
end else
MoreToRead:=False;
end else
MoreToRead :=False;
// Repeat to read data till CurLine=''.
end;
//POPDialog.StatusBar1.Panels.Items[0].Text:='解碼完成';
//PopDialog.StatusBar1.Update;
CloseFile(EncodedFile);
CloseFile(DecodedFile);
EndFlag:=true;
end;
procedure TUUCPForm.FormActivate(Sender: TObject);
begin
// There are 4 modes transfered from
// the POPDialog and SMTPDialog
// 0 = Encode with Standard mode
// 1 = Encode with Base64-644 mode
// 2 = Decode with Standard mode
// 3 = Decode with Base64-644 mode
Application.OnMessage:=AppMessage;
EndFlag:=false;
case CodeFlag of
0 : begin
DoEnCode;
end;
1 : begin
DoStdDeCode;
end;
2 : begin
Base64Decode;
end;
end;
end;
procedure TUUCPForm.BitBtn1Click(Sender: TObject);
begin
Close;
end;
end.