www.pudn.com > mail104s.lzh > POP3.PAS
////////////////////////////////////////////////////////////////////////
// POP3 Post office protocol
// It is refer to the [The Internet Application with Delphi 2.0]
// Author : Yhe Jehn Shan
// Date : 96 / 07 /20
// Modify : 96 / 08 /02
// Last : 96 / 08 /10
////////////////////////////////////////////////////////////////////////
unit pop3;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, Menus, Buttons, ExtCtrls,NWinsock,INSocket,Setup,MailList,IniFiles,
Abouts;
type
TPopDialog = class(TForm)
Panel1: TPanel;
SpeedButton1: TSpeedButton;
MainMenu1: TMainMenu;
SpeedButton2: TSpeedButton;
TreeView1: TTreeView;
ListView1: TListView;
StatusBar1: TStatusBar;
SpeedButton3: TSpeedButton;
Mail1: TMenuItem;
NewMail: TMenuItem;
GetMail: TMenuItem;
Send: TMenuItem;
PopupMenu1: TPopupMenu;
uDelete: TMenuItem;
MailList: TMenuItem;
DataProc: TMenuItem;
RecvBox: TMenuItem;
Clear: TMenuItem;
SaveDialog1: TSaveDialog;
Help: TMenuItem;
About: TMenuItem;
Browse: TMenuItem;
Read: TMenuItem;
Dele: TMenuItem;
Exit: TMenuItem;
Reply1: TMenuItem;
ReplyBtn: TSpeedButton;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure LookupPOPHost;
procedure PopReceive;
procedure PopConnect;
procedure PopSend;
{ POP MialStatus function }
procedure PopWelcome;
procedure PopStat;
procedure PopUser;
procedure PopPass;
procedure PopTop;
procedure PopRetr;
procedure PopQuit;
procedure GetLocalMail;
procedure DeleLocalMail;
procedure ListView1DblClick(Sender: TObject);
procedure Exit2Click(Sender: TObject);
procedure SpeedButton3Click(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure uDeleteClick(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure DataProcClick(Sender: TObject);
procedure TreeView1DragDrop(Sender, Source: TObject; X, Y: Integer);
procedure TreeView1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
procedure ClearClick(Sender: TObject);
procedure GetMailClick(Sender: TObject);
procedure AboutClick(Sender: TObject);
procedure BrowseClick(Sender: TObject);
procedure ExitClick(Sender: TObject);
procedure TreeView1Click(Sender: TObject);
procedure Reply1Click(Sender: TObject);
procedure TreeView1Expanded(Sender: TObject; Node: TTreeNode);
private
{ Private declarations }
{ Private declarations }
procedure UDFPOPSocketEvent(var Msg: TMessage); message UDF_SOCKETEVENT;
procedure UDFPOPHostLookup(var Msg: TMessage); message UDF_HOSTLOOKUP;
public
{ Public declarations }
// Socket concern
SMTPServer:string;
POP3Server:string;
UserName:string;
Passwd:string;
recv_buf:pchar;
HostName:pchar;
PopSocket:TSocket;
// 這個 Socket 物件是 用來收信的
NetPop:TSock;
// To retrieve mail concern
// doflag是當 Server送來 +OK時,程式應該開始接收資料
doflag:boolean;
FillIn:boolean;
// 讀取超過緩衝區 8K則再一次讀取
ReadAgain:Integer;
// Receive Buffer, it is used receive from remote server
PopBuf:array[0..8192] of char;
TempBuf:array[0..8192] of Char;
// 用來將兩次讀取的資料併在一起
MiddleBuf:array[0..8192] of Char;
// Mailstatus is used deceide the when it is what to do
MailStatus:Integer;
// 目前游標所在郵件的編號
CurMailNo:Integer;
// 共有N封郵件
TotalMessages:Integer;
MailCount:Integer;
ReplyFlag:boolean;
FirstLogin:Boolean;
// 標題 : 寄件人 :xxxx 主題 :xxxxxxxxxx
FromWhom:string;
SubjectCaption:string;
//EndMarker:boolean;
// 重新顯示 ListView
ListViewReDisplay:boolean;
// 用來儲放回收回來的郵件
LocalMailBox:TStringList;
RemoteMailBox:TStringList;
DirName:string;
FName:string;
// MIME concern
MIMEFile:TextFile;
MIMEFlag:boolean;
MIMEStatus:string;
MIMELinesNum:Integer;
MIMEFileList:TStringList;
FoundMIME:boolean;
Boundary:string;
BoundaryCount:Integer;
Decodetype:Integer;
HeaderFlag:boolean;
BodyFlag:boolean;
ExpandFlag:Integer;
// it is used as flag of writting tempfile
//DontWriteIN:Boolean;
ImgBMP:TICon;
end;
var
PopDialog: TPopDialog;
const
MAXBUF=8192;
implementation
uses smtpsend, Embade,uucp, mimelist, mailmap;
{$R *.DFM}
procedure TPopDialog.FormCreate(Sender: TObject);
var
FHandle:Integer;
begin
recv_buf:=PopBuf;
HostName:=StrAlloc(80);
////////////////////////////////////////////////////////////
// Setup SMTP and POP3 Host and get it's contents
// SMTPServer : ms1.hinet.net
// POP3Server : ms1.hinet.net
// UserName :hank@hinet.net
// PassWd :****
//
/////////////////////////////////////////////////////////////
SetupDialog:=TSetupDialog.Create(Self);
SetupDialog.parent:=SetupDialog;
SetupDialog.ShowModal;
{ Read Mail Dialog }
SMTPDialog:=TSMTPDialog.Create(Self);
SMTPDialog.parent:=SMTPDialog;
// 指定伺服器名稱及使用者密碼
SMTPServer:=SetupDialog.Edit4.Text;
Pop3Server:=SetupDialog.Edit1.Text;
UserName:=Setupdialog.Edit2.Text;
PassWd:=SetupDialog.Edit3.Text;
MailStatus:=MAIL_NOOP;
doflag:=true;
MIMEFlag:=false;
{ Open the POP and SMTP Host }
NetPop:=TSock.Create;
// 檢查動態連結檔 winsock.dll是否載入成功
if NetPop.StartSocket=False then
begin
Application.MessageBox('載入失敗', '訊息盒', MB_OK );
Close;
end;
// 狀態欄
StatusBar1.Panels.Items[0].Text:='搜尋主機位址中...';
StatusBar1.Update;
{ Read LocalMailBox }
{ ....it will insert in the LocalMail }
{ 用來儲存回收郵件 }
LocalMailBox:=TStringList.Create;
RemoteMailBox:=TStringList.Create;
MIMEFileList:=TStringList.Create;
FirstLogin:=true;
{ 載入回收筒資料 }
try
LocalMailbox.LoadfromFile(SetupDialog.FileDir);
except
{ 回收筒檔案不存在 }
FHandle:=FileCreate(SetupDialog.FileDir);
FileClose(FHandle);
LocalMailbox.LoadfromFile(SetupDialog.FileDir);
end;
MailStatus:=MAIL_CONNECT;
if (Length(POP3Server)<=0) and
(Length(UserName)<=0) and
(Length(PassWd)<=0) then
Application.MessageBox('請載入伺服器名稱', '訊息盒', MB_OK )
else
NetPop.GetHostAddr(Handle,UDF_HOSTLOOKUP,POP3Server);
end;
////////////////////////////////////////////////////////////////////
// 刪除 LocalMailBox:TStringList
// MIMEFileList:TStringList
// 釋放
// HostName
// NetPop :TSock
// SetupDialog
///////////////////////////////////////////////////////////////////
procedure TPopDialog.FormDestroy(Sender: TObject);
begin
///////////////////////////////////////////////////
// 本程式所用的字串變數
// 釋放記憶體
//////////////////////////////////////////////////
LocalMailBox.Destroy;
RemoteMailBox.Destroy;
MIMEFileList.Destroy;
StrDispose(HostName);
NetPop.CloseSocketConnection(PopSocket);
NetPop.ShutDownSocket;
NetPop.Destroy;
SetupDialog.Destroy;
end;
/////////////////////////////////////////////////////////////////
// 清除 接收緩衝區
/////////////////////////////////////////////////////////////////
procedure TPOPdialog.PopSend;
begin
if (MailStatus <> MAIL_NOOP) then
begin
Empty(PopBuf,MAXBUF);
end;
end;
/////////////////////////////////////////////////////////////////
// 指定 MAIL_CONNECT
/////////////////////////////////////////////////////////////////
procedure TPOPdialog.POPConnect;
begin
StatusBar1.Panels.Items[0].Text:='連結遠端郵件伺服器..';
StatusBar1.Update;
MailStatus := MAIL_CONNECT;
Empty(PopBuf, MAXBUF);
end;
/////////////////////////////////////////////////////////////////
// Selected Message Host receive Winsock message FD_READ from Remote
// Mail Server會持續回應
// Order
// :HELO ->USER->PASS->
/////////////////////////////////////////////////////////////////
procedure TPOPDialog.PopReceive;
var
RcvBytes:Integer;
begin
try { if you receive error message then Clear buffer }
RcvBytes:=recv(PopSocket,PopBuf,MAXBUF,0);
if RcvBytes=0 then Empty(PopBuf,MAXBUF)
else begin
case MailStatus of
MAIL_NOOP:;
MAIL_CONNECT: PopWelcome;
MAIL_USER: PopUser;
MAIL_PASS: PopPass;
MAIL_QUIT: PopQuit;
MAIL_STAT: PopStat;
MAIL_LIST:;
MAIL_RETR: PopRetr;
MAIL_DELE:;
MAIL_RSET:;
MAIL_APOP:;
MAIL_TOP: PopTop;
MAIL_UIDL:;
end;
end;
except
Empty(PopBuf,MAXBUF);
end;
end;
/////////////////////////////////////////////////////////////////
// POP Socket Event selected
// WSASelect函數通常會根據緩衝區,若有資料進來則
// Post FD_XXX訊息,讓使用者自己來決定做何動作。
/////////////////////////////////////////////////////////////////
procedure TPOPDialog.UDFPOPSocketEvent(var Msg:TMessage);
begin
case Msg.LParamLo of
FD_READ : PopReceive;
FD_WRITE : PopSend;
FD_CONNECT: PopConnect;
FD_CLOSE : ;
end;
end;
/////////////////////////////////////////////////////////////////
// POP Host Message Event it used to check the host address and connect
// Socket開始去檢查主機
/////////////////////////////////////////////////////////////////
procedure TPOPDialog.UDFPOPHostLookup(var Msg: TMessage);
begin
if (Msg.lParamHi = 0) then
LookupPOPHost
else
Application.MessageBox('主機不存在!!','訊息盒',MB_OK);
end;
/////////////////////////////////////////////////////////////////
// Event prcedure of UDF_POPHOSTLOOKUP , and BootSocket
// 搜尋POP3主機的Address並連線
/////////////////////////////////////////////////////////////////
procedure TPOPDialog.LookupPOPHost;
begin
if NetPOP.HostEntryVrify then
POPSocket:=NetPop.OpenSocketConnection(Handle,UDF_SOCKETEVENT,110)
else begin
StatusBar1.Panels.Items[0].Text:='不能連線到伺服器';
StatusBar1.Update;
end;
{ 取得主機名稱 }
if(gethostname(HostName, 80) = SOCKET_ERROR) then
begin
StatusBar1.Panels.Items[0].Text:='主機名稱錯誤!';
StatusBar1.Update;
Application.MessageBox('請載入伺服器名稱', '訊息盒', MB_OK );
NetPop.CloseSocketConnection(POPSocket);
end;
end;
/////////////////////////////////////////////////////////////////
// POP receive Welcome message and echo event
// 收到主機的歡迎訊息
// 並且送 USER :xxxx 給主機
/////////////////////////////////////////////////////////////////
procedure TPOPDialog.PopWelcome;
var
RcvMsg,WelStr:string;
SndMsg:pchar;
begin
RcvMsg:=StrPas(PopBuf);
WelStr:=Copy(RcvMsg,1,3);
doflag:=false;
StatusBar1.Panels.Items[0].Text:=RcvMsg;
StatusBar1.Update;
{ POP3 Server echo +OK message }
if WelStr='+OK' then doflag:=true;
MailStatus:=MAIL_NOOP ; { No Operator }
if doflag then
begin
MailStatus:=MAIL_USER;
StatusBar1.Panels.Items[0].Text:=RcvMsg;
StatusBar1.Update;
{ Reply user command and talk to pop Who am I? }
SndMsg:=StrAlloc(256);
RcvMsg:='USER '+UserName+#13#10;
StrPCopy(SndMsg,RcvMsg);
NetPop.SocketSend(PopSocket, handle, UDF_SOCKETEVENT,SndMsg);
Empty(PopBuf,MAXBUF);
StrDispose(SndMsg);
end;
end;
/////////////////////////////////////////////////////////////////
// 使用者名稱 OK 傳入使用者密碼
// 傳入 PASS 給主機程式碼與 上一個函數類似
/////////////////////////////////////////////////////////////////
procedure TPOPDialog.PopUser;
var
RcvMsg,WelStr:string;
SndMsg:pchar;
begin
RcvMsg:=StrPas(PopBuf);
WelStr:=Copy(RcvMsg,1,3);
// 開始接收旗標設為 False
doflag:=false;
StatusBar1.Panels.Items[0].Text:=RcvMsg;
StatusBar1.Update;
if WelStr='+OK' then doflag:=true;
MailStatus:=MAIL_NOOP ; { No Operator }
SndMsg:=StrAlloc(256);
if doflag then
begin
MailStatus:=MAIL_PASS;
StatusBar1.Panels.Items[0].Text:='密碼是'+'*****';
StatusBar1.Update;
{ Send Password to POP server }
RcvMsg:='PASS '+PassWd+#13#10;
StrPCopy(SndMsg,RcvMsg);
NetPop.SocketSend(PopSocket,handle, UDF_SOCKETEVENT,SndMsg);
Empty(PopBuf,MAXBUF);
end else
begin
MailStatus:=MAIL_QUIT;
StatusBar1.Panels.Items[0].Text:='使用者帳號不存在';
StatusBar1.Update;
// 送出一個 Quit訊息
RcvMsg:='QUIT'+#13#10;
StrPCopy(SndMsg,RcvMsg);
NetPop.SocketSend(PopSocket,handle, UDF_SOCKETEVENT,SndMsg);
Empty(PopBuf,MAXBUF);
end;
StrDispose(SndMsg);
end;
/////////////////////////////////////////////////////////////////
// 送出密碼給主機
//
/////////////////////////////////////////////////////////////////
procedure TPopDialog.PopPass;
var
RcvMsg,WelStr:String;
SpacePos:Integer;
SndMsg:pChar;
begin
doflag:=false;
SndMsg:=StrAlloc(256);
RcvMsg:=StrPas(PopBuf);
WelStr:=Copy(RcvMsg,1,3);
// 狀態列 Win95 Page
StatusBar1.Panels.Items[0].Text:=RcvMsg;
StatusBar1.Update;
if WelStr='+OK' then doflag:=true;
//StatusBar1.Panels.Items[0].Text:=RcvMsg;
//StatusBar1.Update;
MailStatus:=MAIL_NOOP;
if doflag then
begin
MailStatus:=MAIL_STAT;
StatusBar1.Panels.Items[0].Text:='檢查郵筒狀態...';
StatusBar1.Update;
WelStr:='STAT'+#13#10;
StrPCopy(SndMsg,WelStr);
NetPop.SocketSend(PopSocket,handle, UDF_SOCKETEVENT,SndMsg);
Empty(PopBuf,MAXBUF);
end else
begin
MailStatus:=MAIL_QUIT;
Application.MessageBox('密碼不正確,請重新輸入', '訊息盒', MB_OK );
WelStr:='QUIT'+#13#10;
StrPCopy(SndMsg,WelStr);
NetPop.SocketSend(PopSocket,handle, UDF_SOCKETEVENT,SndMsg);
Empty(PopBuf,MAXBUF);
end;
StrDisPose(SndMsg);
end;
/////////////////////////////////////////////////////////////////
// Receive mailbox status and request the first message Heaser
// 取得共有幾封訊息
/////////////////////////////////////////////////////////////////
procedure TPopDialog.PopStat;
var
RcvMsg,WelStr:String;
SpacePos:Integer;
SndMsg:pChar;
begin
doflag:=false;
SndMsg:=StrAlloc(256);
RcvMsg:=StrPas(PopBuf);
WelStr:=Copy(RcvMsg,1,3);
StatusBar1.Panels.Items[0].Text:=RcvMsg;
StatusBar1.Update;
if WelStr='+OK' then doflag:=true;
MailStatus:=MAIL_NOOP;
//StatusBar1.Panels.Items[0].Text:=RcvMsg;
//StatusBar1.Update;
if doflag then
begin
SpacePos:=Pos(' ',RcvMsg);
if SpacePos>0 then
begin
RcvMsg:=Copy(RcvMsg,SpacePos+1,Length(RcvMsg));
SpacePos:=Pos(' ',RcvMsg);
if SpacePos >0 then
TotalMessages:=StrToInt(Copy(RcvMsg,1,SpacePos-1));
end;
if TotalMessages>0 then
begin
MailStatus:=MAIL_TOP;
StatusBar1.Panels.Items[0].Text:='共有'+IntToStr(TotalMessages)+'封信';
StatusBar1.Update;
Mailcount:=1;
WelStr:='TOP 1 1'+#13#10;
StrPCopy(SndMsg,WelStr);
NetPop.SocketSend(PopSocket,handle,UDF_SOCKETEVENT,SndMsg);
Empty(Popbuf,MAXBUF);
ReadAgain:=1;
CurMailNo:=1;
end
else begin
Application.MessageBox('郵筒是空的', '訊息盒', MB_OK );
MailStatus:=MAIL_QUIT;
StatusBar1.Panels.Items[0].Text:='關閉郵筒!';
StatusBar1.Update;
StrPCopy(SndMsg,'QUIT ');
NetPop.SocketSend(PopSocket,handle,UDF_SOCKETEVENT,SndMsg);
Empty(PopBuf,MAXBUF);
end;
StrDispose(SndMsg);
end;
end;
/////////////////////////////////////////////////////////////////
// Procedure the message heaser and display at the Node of List View
// I Will use this function to receive message from 1 to end and
// add in the ListView window so I can Select the messages
// 用來讀取表頭資訊
/////////////////////////////////////////////////////////////////
procedure TPopDialog.PopTop;
var
RcvMsg:string;
WelStr:string;
SndMsg:pChar;
doComplete:boolean;
strposition:integer;
doflag:boolean;
I,J:Integer;
begin
if FirstLogin then
begin
docomplete:=false;
doflag:=false;
if ( ReadALine(TempBuf,PopBuf)) then
begin
if ReadAgain=1 then
begin
RcvMsg:=StrPas(TempBuf);
WelStr:=Copy(RcvMsg,1,3);
if Welstr='+OK' then doflag:=true;
end else
doflag:=true;
if Welstr='-ER' then doflag:=false;
// Receive the OK echo and begin processing the string
// REceive +OK command begin to Get Subject and FromWhom
if doflag then
begin
if ReadAgain=2 then
begin
WelStr:=StrPas(TempBuf);
ReadAgain:=1;
// Receive FromWhom string from who mail this mail.
if Pos('From:',WelStr)>0 then
begin
strposition:=Pos(' ',WelStr);
FromWhom:=Copy(WelStr,strposition+1,Length(WelStr));
end;
// Retrieve the Subject and make a subjectcaption string.
if Pos('Subject:',Welstr)>0 then
begin
strposition:=Pos(' ',Welstr);
SubjectCaption:=Copy(WelStr,strposition+1,Length(WelStr));
end;
{ Check the received data is dot }
if Pos('begin 644 ',WelStr)>0 then
MIMEStatus:='附帶檔案' else
MIMEStatus:='';
if WelStr='.' then
docomplete:=true;
end;
// Read data till it is '.' end marker
While( ReadALine(TempBuf,PopBuf) and not docomplete) do
begin
WelStr:=StrPas(TempBuf);
// Receive FromWhom string from who mail this mail
if Pos('From:',WelStr)>0 then
begin
strposition:=Pos(' ',WelStr);
FromWhom:=Copy(WelStr,strposition+1,Length(WelStr));
end;
// Retrieve the Subject and make a subjectcaption string
if Pos('Subject:',Welstr)>0 then
begin
strposition:=Pos(' ',Welstr);
SubjectCaption:=Copy(WelStr,strposition+1,Length(WelStr));
end;
{ Check the received data is dot }
if WelStr='.' then
docomplete:=true;
end;
///////////////////////////////////////////////////////////////////
// Reading over the receive I get message title as From+'--'+Subject
// 接收已經完成了
///////////////////////////////////////////////////////////////////
if docomplete then
begin
{ Add in the List view window }
if CurMailNo<=TotalMessages then
begin
StatusBar1.Panels.Items[0].Text:='還有其它訊息...';
StatusBar1.Update;
ReadAgain:=1;
//////////////////////////////////////////////////////
// Add in the List view to list it
// 加入 ListView 視窗中
/////////////////////////////////////////////////////
ListView1.Items.Add;
ListView1.Items[CurMailNo-1].Caption:=FromWhom;
ListView1.Items[CurMailNo-1].Subitems.Add(SubjectCaption);
RemoteMailBox.Add(FromWhom);
RemoteMailBox.Add(SubjectCaption);
inc(CurMailNo);
SndMsg:=StrAlloc(256);
WelStr:='TOP '+InttoStr(CurMailNo)+' 1'+#13#10;
StrPCopy(SndMsg,WelStr);
NetPop.SocketSend(PopSocket,handle,UDF_SOCKETEVENT,SndMsg);
StrDispose(SndMsg);
Empty(Popbuf,MAXBUF);
end else
{ received not completed yet }
begin
end;
end else
begin
{ It has not received the '.' marker to end the work }
{ So I must Receive more data to complete }
MailStatus:=MAIL_TOP;
StatusBar1.Panels.Items[0].Text:='接收訊息表頭中..';
StatusBar1.Update;
Empty(PopBuf,MAXBUF);
ReadAgain:=2;
end;
end else
begin
// doflag is false and there are not any mail exist or no such message.
StatusBar1.Panels.Items[0].Text:='接收完成!';
ListViewRedisplay:=true;
// 重此以後不再接收表頭資訊直到 檢查郵筒後
FirstLogin:=false;
// 回覆鈕設為可視
ReplyBtn.Enabled:=true;
Reply1.Enabled:=true;
StatusBar1.Update;
SMTPDialog.Edit1.Text:=SMTPServer;
MailStatus:=MAIL_NOOP;
Empty(PopBuf,MAXBUF);
end;
end else
begin
{ 沒有收到任何信件 }
MailStatus:=MAIL_NOOP;
Empty(PopBuf,MAXBUF);
StatusBar1.Panels.Items[0].Text:='郵筒是空的!!';
StatusBar1.Update;
end;
end else
///////////////////////////////////////////////////////////////
// 恢復 ListView 的遠端資訊
// FromWhom和 Subjection
// 設 FirstLogin 的好處是在於不用重覆讀取郵件的寄件人及主題
// 節省很多時間, 特別是在網路多個 Socket使用下
//////////////////////////////////////////////////////////////
begin
I:=0;
J:=0;
ListView1.Items.Clear;
while(RemoteMailBox.count>I) do
begin
ListView1.Items.Add;
ListView1.Items[J].Caption:=RemoteMailBox[I];
ListView1.Items[J].SubItems.Add(RemoteMailBox[I+1]);
inc(J);
I:=I+2;
end;
end;
end;
{ quit the mail pop }
procedure TPOPDialog.PopQuit;
var
RcvMsg,WelStr:string;
SndMsg:pchar;
begin
RcvMsg:=StrPas(PopBuf);
WelStr:=Copy(RcvMsg,1,3);
MailStatus:=MAIL_NOOP ; { No Operator }
StatusBar1.Panels.Items[0].Text:='結束郵件接收.';
StatusBar1.Update;
end;
///////////////////////////////////////////////////////////////////
// Retrieve mail from remote , there are 3 function
// first is Retrieve mail and display it with SMTPDialog
// second is when the mail is embaded MIME format ,save it to
// file.
// third is used to read local mail box
////////////////////////////////////////////////////////////////////
procedure TPopDialog.PopRetr;
var
RcvMsg:string;
WelStr:string;
SndMsg:pChar;
doComplete:boolean;
spos:integer;
doflag:boolean;
BeginAdd:boolean;
I,J:Integer;
begin
if TreeView1.Selected.SelectedIndex=0 then
begin
docomplete:=false;
doflag:=false;
// Get a line with #0D#0A }
if ( ReadALine(TempBuf,PopBuf)) then
begin
if ReadAgain=1 then
begin
RcvMsg:=StrPas(TempBuf);
WelStr:=Copy(RcvMsg,1,3);
// 主機端傳回 '+OK' 則開始回收資料
if Welstr='+OK' then doflag:=true;
WelStr:=Copy(RcvMsg,1,4);
if Welstr='-ERR' then begin
doflag:=false;
StatusBar1.Panels.Items[0].Text:='郵件已刪除';
StatusBar1.Update;
end;
end
else
doflag:=true;
///////////////////////////////////////////////////////////
// 可以開始接收資料
// Receive the OK echo and begin processing the string.
///////////////////////////////////////////////////////////
if doflag then
begin
if ReadAgain=2 then
begin
ReadAgain:=1;
StrCat(@MiddleBuf,TempBuf);
StrCopy(TempBuf,@MiddleBuf);
end;
WelStr:=StrPas(TempBuf);
// 將郵件內容加入 SMTP視窗
if ((BodyFlag=true) and (MIMEFlag=false)) then
begin
SMTPDialog.Memo1.Lines.Add(WelStr);
end;
//////////////////////////////////////////////////////
// Write main mail contents to Local mail box
// 回覆郵件時不再新增至本地郵筒
/////////////////////////////////////////////////////
if ((MIMEFlag=false) and (ReplyFlag=false)) then
begin
if Pos('Content-',WelStr)=0 then
LocalMailBox.Add(WelStr);
end;
// To write MIME-data To file.
if MIMEFlag=true then
begin
WriteLn(MIMEFile,WelStr);
Inc(MIMELinesNum);
end;
// Check the received data is dot
// To write end marker to local mail box
if WelStr='.' then begin
docomplete:=true;
MIMEFlag:=false;
end;
//////////////////////////////////////////////////////////
// Read a line to get
// 'From','Subject','MIME','Boundary'
// 重緩衝區讀取一行 #0D#0A
//////////////////////////////////////////////////////////
While( ReadALine(TempBuf,PopBuf) and not docomplete) do
begin
WelStr:=StrPas(TempBuf);
// 取得表頭 (From / To / CC / Subejct)
if HeaderFlag=false then
begin
if Pos('From:',WelStr)>0 then
begin
spos:=Pos(' ',WelStr);
FromWhom:=Copy(WelStr,spos+1,Length(WelStr));
end;
// Retrieve the Subject and make a subjectcaption string
if Pos('Subject:',Welstr)>0 then
begin
spos:=Pos(' ',Welstr);
SubjectCaption:=Copy(WelStr,spos+1,Length(WelStr));
HeaderFlag:=true;
end;
end;
/////////////////////////////////////////////
// 表頭完整則搜尋是否為 MIME
// Search boundary of MIMI
/////////////////////////////////////////////
if HeaderFlag then
begin
// To get contents of boundary.
if Pos('boundary=',WelStr)>0 then
begin
sPos:=Pos('boundary="',WelStr);
Boundary:=copy(Welstr,sPos+Length('boundary="'),Length(WelStr));
Boundary:=copy(Boundary,1,Length(Boundary)-1);
BoundaryCount:=0;
// 將旗標打開, 等待 MIME處理程序
MIMEFlag:=true;
end;
/////////////////////////////////////////////////////
// To found the filename of MIME.
// 發現 MIME 的檔名通常不止一個故使用 StringList來儲
// 但也有些 Mail 在發送 MIME 時並沒有提供檔名資訊
/////////////////////////////////////////////////////
if Pos('filename=',Welstr)>0 then
begin
sPos:=Pos('filename="',WelStr);
FName:=Copy(WelStr,sPos+Length('filename="'),Length(WelStr));
FName:=Copy(FName,1,Pos('"',FName)-1);
MIMEFlag:=true;
FoundMIME:=true;
BodyFlag:=false;
if MIMEFileList.count=0 then
begin
AssignFile(MIMEFile,'getbox.tmp');
ReWrite(MIMEFile);
UUCPForm.codeFlag:=2;
end;
MIMEFileList.Add(FName);
end;
end;
/////////////////////////////////////////////////////
// Boundary Test , There are 4 times to appear,
// if you have contents, or it will appear 3 times
// MIME 通常會提供 Boundary=這樣的資訊
////////////////////////////////////////////////////
if Pos(Boundary,WelStr)>0 then
begin
Inc(BoundaryCount);
end;
// 找到邊界 如 _NEXTPart_xxxxxxxxxxxx
if MIMEFlag=true then
begin
if Pos(Boundary,WelStr)>0 then
begin
MIMEFlag:=false;
end;
end;
//////////////////////////////////////////////////////////
// If it is not MIME ,fill in the Text mode memo editor.
// Get contents of message exclude the server reply.
// Display the true contents of mail.
// 將文字部份傳入給 SMTP
//////////////////////////////////////////////////////////
if ((BodyFlag=true) and (MIMEFlag=false)) then
begin
SMTPDialog.Memo1.Lines.Add(WelStr);
end;
//////////////////////////////////////////////////////
// 判斷傳來的郵件是否含有文字部份
// BodyFlag 用來檢視是否將本文顯示在 SMTP 視窗
//////////////////////////////////////////////////////
if ((Pos('text',Welstr)>0) or(Pos('TEXT',Welstr)>0)) then
begin
BodyFlag:=true;
end;
if WelStr='' then
begin
BodyFlag:=true;
end;
/////////////////////////////////////////////////////
// Write main mail contents to Local mail box
// 將非 MIME 部份的 資料寫入本地端
// 回覆郵件不再加入本地郵筒
/////////////////////////////////////////////////////
if ((MIMEFlag=false) and (ReplyFlag=false)) then
begin
if Pos('Content-',WelStr)=0 then
LocalMailBox.Add(WelStr);
end;
// This end marker, if meet it then set MIMEFlag is false
if WelStr='.' then begin
docomplete:=true;
MIMEFlag:=false;
FillIn:=False;
HeaderFlag:=false;
BodyFlag:=false;
end;
// 開始寫入 MIME 到暫存檔,
if MIMEFlag=true then
begin
WriteLn(MIMEFile,WelStr);
Inc(MIMELInesNum);
end;
end;
//////////////////////////////////////////////////////
// if ReadAgain flag is equal to 1 then
// receive buffer continue.
//////////////////////////////////////////////////////
if not docomplete then
begin
Empty(MiddleBuf,MAXBUF);
StrCopy(@MiddleBuf,TempBuf);
MailStatus:=MAIL_RETR;
Empty(PopBuf,MAXBUF);
{ I received not completed yet }
ReadAgain:=2;
end else
begin
/////////////////////////////////////////////////////
// Reset the mailstatus to idle and display message.
// 若 MIME 存在則關閉暫存檔
/////////////////////////////////////////////////////
if FoundMIME then CloseFile(MIMEFile);
MailStatus:=MAIL_NOOP;
if ReplyFlag=false then
begin
SMTPDialog.Edit3.Text:=FromWhom;
SMTPDialog.Edit5.Text:=SubjectCaption;
end else
begin
SMTPDialog.Edit3.Text:=SetupDialog.MailAcc;
SMTPDialog.Edit2.Text:=FromWhom;
SMTPDialog.Edit5.Text:='回覆:'+subjectCaption;
I:=0;
while(SMTPDialog.Memo1.Lines.count>I) do
begin
SMTPDialog.Memo1.Lines[I]:='>'+SMTPDialog.Memo1.Lines[I];
inc(I);
end;
I:=0;
/////////////////////////////////////////////////////////////////
// 某些 SMTP主機會將 From Whom 傳為 "yeh"<>
// 但某些主機則正常傳回 yeh@ms1.hinet.net
/////////////////////////////////////////////////////////////////
J:=Pos('@',FromWhom);
if Pos('<',FromWhom)>0 then
SMTPDialog.Edit1.Text:=Copy(FromWhom,J+1,Length(FromWhom)-J-1)
else
SMTPDialog.Edit1.Text:=Copy(FromWhom,J+1,Length(FromWhom)-J);
ReplyFlag:=false;
end;
//SMTPDialog.ShowModal;
SMTPDialog.Show;
LocalMailBox.SaveToFile(Setupdialog.FileDir);
Empty(PopBuf,MAXBUF);
bodyflag:=false;
FillIn:=False;
FoundMIME:=false;
MIMEFlag:=false;
//EndMarker:=false;
MIMEFileList.Clear;
HeaderFlag:=false;
end;
end;
end else
// There are not any data in the buffer to receive.
begin
MailStatus:=MAIL_NOOP;
Empty(PopBuf,MAXBUF);
end;
end else
/////////////////////////////////////////////////////////////////
// Process local mail to diaplaying.
// 顯示本地郵件的內容
/////////////////////////////////////////////////////////////////
begin
{ Local mail file retrieve process , this procedure used as user click
the Local mail box, and read it , }
I:=0;J:=-1;
BeginAdd:=false;
while(LocalMailBox.count>I) do
begin
// Using '+OK' to determined to specified or not
if Pos('+OK',LocalMailBox[I])>0 then
begin
//inc(I);
inc(J);
end;
if J=CurMailNo then
begin
// 取得送信人名稱-Put in the SMTPdialog
if LocalMailBox[I]='' then BeginAdd:=true;
if Pos('From:',LocalMailBox[I])>0 then
begin
spos:=Pos(' ',LocalMailBox[I]);
FromWhom:=Copy(LocalMailBox[I],spos+1,Length(LocalMailBox[I]));
end;
// 取得信件標題的名稱- Get mail caption to SMTPDialog
if Pos('Subject:',LocalMailBox[I])>0 then
begin
spos:=Pos(' ',LocalMailBox[I]);
SubjectCaption:=Copy(LocalMailBox[I],spos+1,Length(LocalMailBox[I]));
end;
// 顯示內容到 Memo編輯器
if BeginAdd then
SMTPDialog.Memo1.Lines.Add(LocalMailBox[I]);
// End of the mail.
if LocalMailBox[I]='.' then
I:=LocalMailBox.Count;
end;
Inc(I);
end;
MailStatus:=MAIL_NOOP;
// 顯示送信視窗
SMTPDialog.Edit3.Text:=FromWhom;
SMTPDialog.Edit5.Text:=SubjectCaption;
SMTPDialog.Show;
end;
end;
/////////////////////////////////////////////////////////////////
// User retrieve mail and put it in the local mail box
// 在 ListView 視窗 Double Click 將 Mail 取回
// 20/08 修改離線讀信時不會產生 Windows socket 傳送失敗
/////////////////////////////////////////////////////////////////
procedure TPopDialog.ListView1DblClick(Sender: TObject);
var
MsgIndex:Integer;
SndMsg:pChar;
WelStr:string;
begin
// Which mail will be retrieve.
if ListView1.Items.count<>0 then
begin
MsgIndex:=ListView1.Selected.Index;
CurMailNo:=MsgIndex;
SndMsg:=StrAlloc(256);
SMTPDialog.Memo1.Clear;
// Send the RETR command to Retrieve mail.
StatusBar1.Panels.Items[0].Text:='郵件接收中 請稍候';
StatusBar1.Update;
if ListViewReDisplay then
begin
if MsgIndex>-1 then
begin
MailStatus:=MAIL_RETR;
WelStr:='RETR '+INtToStr(MsgIndex+1)+#13#10;
StrPCopy(SndMsg,WelStr);
NetPop.SocketSend(PopSocket,handle,UDF_SOCKETEVENT,SndMsg);
Empty(PopBuf,MAXBUF);
end;
end else
PopRetr;
StrDispose(SndMsg);
end else
Application.MessageBox('回收筒沒有資料!','訊息盒',MB_OK);
end;
procedure TPopDialog.Exit2Click(Sender: TObject);
begin
Close;
end;
// 重新設定 SMTP / POP3 主機名稱
procedure TPopDialog.SpeedButton3Click(Sender: TObject);
begin
SetupDialog.ShowModal;
SMTPServer:=SetupDialog.Edit4.Text;
Pop3Server:=SetupDialog.Edit1.Text;
UserName:=Setupdialog.Edit2.Text;
PassWd:=SetupDialog.Edit3.Text;
FirstLogin:=true;
RemoteMailBox.Clear;
ListView1.Items.Clear;
NetPop.CloseSocketConnection(PopSocket);
NetPop.GetHostAddr(Handle,UDF_HOSTLOOKUP,POP3Server);
end;
//////////////////////////////////////////////////////////////////
// Write a new mail and send.
// Re read the remote mail box
// 重新讀取遠端的郵件
/////////////////////////////////////////////////////////////////
procedure TPopDialog.SpeedButton1Click(Sender: TObject);
begin
{ Reread the mailbox }
ListView1.Items.Clear;
RemoteMailBox.Clear;
FirstLogin:=true;
NetPop.CloseSocketConnection(PopSocket);
NetPop.GetHostAddr(Handle,UDF_HOSTLOOKUP,POP3Server);
end;
///////////////////////////////////////////////////////////////
// 刪除遠端的郵件-根據 Focus 所在
// To Send DELE command to delete remote server
///////////////////////////////////////////////////////////////
procedure TPopDialog.uDeleteClick(Sender: TObject);
var
MsgIndex:Integer;
SndMsg:pChar;
WelStr:string;
begin
// CurMailNo 是目前郵件的編號
if TreeView1.Selected.SelectedIndex=0 then
begin
MsgIndex:=ListView1.Selected.Index;
CurMailNo:=MsgIndex;
SndMsg:=StrAlloc(256);
if MsgIndex>-1 then
begin
WelStr:='DELE '+INtToStr(MsgIndex+1)+#13#10;
StrPCopy(SndMsg,WelStr);;
NetPop.SocketSend(PopSocket,handle,UDF_SOCKETEVENT,SndMsg);
//WelStr:='RSET '+#13#10;
//StrPCopy(SndMsg,WelStr);
//NetPop.SocketSend(PopSocket,handle,UDF_SOCKETEVENT,SndMsg);
Empty(PopBuf,MAXBUF);
SMTPDialog.Memo1.Clear;
MailStatus:=MAIL_NOOP;
end;
StrDispose(SndMsg);
ListView1.Items[MsgIndex].SubItems.Add('刪除');
end else
DeleLocalMail;
end;
// Same as the write a new mail button.
procedure TPopDialog.SpeedButton2Click(Sender: TObject);
begin
SMTPDialog.Memo1.Clear;
SMTPDialog.Edit3.Text:=SetupDialog.MailAcc;
SMTPDialog.Edit5.Text:='';
SMTPDialog.Edit2.Text:='';
SMTPDialog.Show;
end;
procedure TPopDialog.DataProcClick(Sender: TObject);
begin
MailDataForm.ShowModal;
end;
// Get local mail box mail and display in
procedure TPopDialog.GetLocalMail;
var
I,J:Integer;
spos:Integer;
FromExist:Boolean;
BeginToDo:boolean;
begin
// 重新顯示 ListView 視窗中的內容
ListView1.Items.Clear;
I:=0;J:=0;
FromExist:=false;
BeginToDo:=false;
while(LocalMailBox.count>I) do
begin
if Pos('+OK',LocalMailBox[I])>0 then BeginToDo:=true;
if BeginToDo then
begin
if Pos('From:',LocalMailBox[I])>0 then
begin
spos:=Pos(' ',LocalMailBox[I]);
FromWhom:=Copy(LocalMailBox[I],spos+1,Length(LocalMailBox[I]));
ListView1.Items.Add;
ListView1.Items[J].Caption:=FromWhom;
FromExist:=true;
end;
////////////////////////////////////////////////////////////
// From 與 Subject 成對出現 , 如果本文中存在 Subject則忽略
// FromExist用來確定 From與 Subject
////////////////////////////////////////////////////////////
if FromExist then
begin
if Pos('Subject:',LocalMailBox[I])>0 then
begin
spos:=Pos(' ',LocalMailBox[I]);
SubjectCaption:=Copy(LocalMailBox[I],spos+1,Length(LocalMailBox[I]));
ListView1.Items[J].SubItems.Add(SubjectCaption);
inc(J);
FromExist:=false;
BeginToDo:=false;
end;
end;
end;
Inc(I);
end;
end;
//////////////////////////////////////////////////////////////////////
// To Select to retrieve Local mail box or remote mail box
// To Delete remote mail and to retrieve to local mail box
// 將遠端的 Mail 拖至本地郵件
//////////////////////////////////////////////////////////////////////
procedure TPopDialog.TreeView1DragDrop(Sender, Source: TObject; X,
Y: Integer);
var
MsgIndex:Integer;
WelStr:string;
SndMsg:pchar;
begin
if (Sender is TTreeView) and (Source is TListView) then
begin
MsgIndex:=ListView1.Selected.Index;
CurMailNo:=MsgIndex;
SndMsg:=StrAlloc(256);
if MsgIndex>-1 then
begin
WelStr:='DELE '+INtToStr(MsgIndex+1)+#13#10;
StrPCopy(SndMsg,WelStr);;
NetPop.SocketSend(PopSocket,handle,UDF_SOCKETEVENT,SndMsg);
Empty(PopBuf,MAXBUF);
SMTPDialog.Memo1.Clear;
MailStatus:=MAIL_TOP;
end;
StrDispose(SndMsg);
end;
end;
procedure TPopDialog.TreeView1DragOver(Sender, Source: TObject; X,
Y: Integer; State: TDragState; var Accept: Boolean);
begin
Accept:=Source is TListView;
end;
// To delete local mail box.
procedure TPopDialog.DeleLocalMail;
var
I,J:Integer;
timeflag:Integer;
intoflag:boolean;
MsgNo:Integer;
begin
I:=0;J:=0;
if ListView1.Items.count<>0 then
begin
MsgNo:=ListView1.Selected.Index;
ListView1.Selected.Delete;
SMTPDialog.Memo1.Lines.Clear;
while(LocalMailBox.count>I) do
begin
{ CurMailNo is specified at ListView Click }
{ 跳至第幾個郵件結尾 }
{ 利用 SMTPDialog的 Memo1元件來將未刪除的資料儲回檔案 }
if ((J<>MsgNo)and (LocalMailBox.count>I)) then
begin
SMTPDialog.Memo1.Lines.Add(LocalMailBox[I]);
end;
if LocalMailBox[I]='.' then inc(J);
Inc(I);
end;
MailStatus:=MAIL_NOOP;
SMTPDialog.Memo1.Lines.SaveToFile(SetupDialog.FileDir);
LocalMailBox.LoadFromFile(SetupDialog.FileDir);
end else
Application.MessageBox('郵筒沒有信件!','訊息盒',MB_OK);
end;
procedure TPopDialog.ClearClick(Sender: TObject);
begin
// Clear the local mail box
LocalMailBox.Clear;
LocalMailBox.SaveToFile(SetupDialog.FileDir);
end;
procedure TPopDialog.GetMailClick(Sender: TObject);
begin
{ Reread the mailbox }
NetPop.CloseSocketConnection(PopSocket);
NetPop.GetHostAddr(Handle,UDF_HOSTLOOKUP,POP3Server);
end;
procedure TPopDialog.AboutClick(Sender: TObject);
begin
OkBottomDlg.ShowModal;
end;
// Boot up the local mail reader.
procedure TPopDialog.BrowseClick(Sender: TObject);
begin
GetLocalMail;
end;
// Exit the mail program , set the status to No operator
procedure TPopDialog.ExitClick(Sender: TObject);
begin
MailStatus:=MAIL_NOOP;
PopDialog.Close;
end;
procedure TPopDialog.TreeView1Click(Sender: TObject);
var
SndMsg:pChar;
WelStr:string;
begin
if ExpandFlag<>0 then
begin
ListView1.Items.Clear;
if TreeView1.Selected.SelectedIndex=1 then
begin
RecvBox.Enabled:=true;
Mail1.Enabled:=false;
GetLocalMail;
end
else
begin
if ListViewReDisplay then
begin
RecvBox.Enabled:=false;
Mail1.Enabled:=true;
MailStatus:=MAIL_TOP;
SndMsg:=StrAlloc(64);
Mailcount:=1;
WelStr:='TOP 1 1'+#13#10;
StrPCopy(SndMsg,WelStr);
NetPop.SocketSend(PopSocket,handle,UDF_SOCKETEVENT,SndMsg);
Empty(Popbuf,MAXBUF);
StrDispose(SndMsg);
ReadAgain:=1;
CurMailNo:=1;
end;
end;
end;
inc(ExpandFlag);
end;
procedure TPopDialog.Reply1Click(Sender: TObject);
var
MsgIndex:Integer;
SndMsg:pChar;
WelStr:string;
begin
MsgIndex:=ListView1.Selected.Index;
ReplyFlag:=true;
CurMailNo:=MsgIndex;
SndMsg:=StrAlloc(256);
SMTPDialog.Memo1.Clear;
// Send the RETR command to Retrieve mail.
StatusBar1.Panels.Items[0].Text:='郵件接收中 請稍候';
StatusBar1.Update;
//if ListViewReDisplay then
//begin
if MsgIndex>-1 then
begin
MailStatus:=MAIL_RETR;
WelStr:='RETR '+INtToStr(MsgIndex+1)+#13#10;
StrPCopy(SndMsg,WelStr);;
NetPop.SocketSend(PopSocket,handle,UDF_SOCKETEVENT,SndMsg);
Empty(PopBuf,MAXBUF);
end;
StrDispose(SndMsg);
end;
procedure TPopDialog.TreeView1Expanded(Sender: TObject; Node: TTreeNode);
begin
ExpandFlag:=0;
end;
end.