如何在多线程中使用Tnmpop控件?(100分)

  • 主题发起人 主题发起人 nuaaliao
  • 开始时间 开始时间
N

nuaaliao

Unregistered / Unconfirmed
GUEST, unregistred user!

我在线程中如何创建一个动态的Tnmpop控件?
在线程中他如何响应事件?
最好有实例!
 
这个问题已经讨论得太多了:-)
查查以前的贴子吧,比如
http://www.delphibbs.com/delphibbs/dispq.asp?LID=397147
 
to :左轻侯
给举个例子啥??
 
nmpop的例子我没有(本来是有的,后来因为nmpop控件有问题,被我改成sakemail了)
建议你使用sakemail或coolmail
这是在一个线程中封装sakemail的代码,是iCompanion源码的一部分
虽然只使了一个线程,功能也相当简单,但原理基本就是这样了
在大范围的使用中工作相当稳定。
const
WM_SHOWNOTIFY = WM_USER + 100;
type
TMailChkThread = class(TThread)
protected
procedure execute;override;
public
MailChk:TMailCheck;
SakPOP:TSakPOP;
MailIndex:integer;
MailChkInfo:string;
MailNumber:integer;

constructor Create(MailChkObj:TMailCheck);
destructor Destroy;override;
procedure RefMailInfo;
end;

constructor TMailChkThread.Create(MailChkObj:TMailCheck);
begin
Inherited Create(True);
SakPOP := TSakPOP.Create(nil);
MailChk := MailChkObj;
end;

destructor TMailChkThread.Destroy;
begin
SakPOP.free;
SakPOP := nil;
inherited Destroy;
end;

procedure TMailChkThread.execute;
var
i,j:integer;
PassInput:string;
MailCount,LoginCount:integer;
begin
MailCount := 0;
LoginCount := 0;
for i := 0 to MailCheck.count -1 do
// MailCheck是一个自定义,封装了对邮箱数据的访问
with MailChk.Itemsdo

begin
MailIndex := i;
if Enabled = false then
Continue;
if Pass = '' then
begin
if NOT CInputQuery ('网络伴侣 - 请输入密码', '服务器:'+Server+ #13#10 +'用户名:'+ Login+ #13#10 +'密码:' , PassInput,true) then
break
//CInputQuery 是一个自定义函数,显示输入窗体以取得输入的字符串
else
Pass := PassInput;
end;

SakPOP.Host := Server;
SakPOP.Port := '110';
SakPOP.UserId := Login;
SakPOP.UserPasswd := Pass;
try
SakPOP.Connect;
if SakPOP.POPError then
begin
MailNumber := 0;
MailChkInfo := '无效的服务器';
Synchronize(RefMailInfo);
Continue;
end;

Application.ProcessMessages;
if Terminated then
Break;
if not SakPOP.login then
begin
MailNumber := 0;
MailChkInfo := '无效的用户名或密码';
Synchronize(RefMailInfo);
Continue;
end;

Application.ProcessMessages;
if Terminated then
Break;
SakPOP.Init;
MailNumber := SakPOP.MsgsCount;
MailChkInfo := '完成';
Synchronize(RefMailInfo);
if SakPOP.MsgsCount > 0 then
begin
inc(LoginCount);
inc(MailCount,SakPOP.MsgsCount);
end;
SakPOP.Quit;
except
MailNumber := 0;
MailChkInfo := '网络错误';
Synchronize(RefMailInfo);
break;
end;

Application.ProcessMessages;
if Terminated then
Break;
end;

if MailCount > 0 then
begin
PostMessage(frmBody.Handle,WM_SHOWNOTIFY,LoginCount, MailCount);

//全部检测完成,向主窗体发送消息,主窗体做相应反应
end;
end;

procedure TMailChkThread.RefMailInfo;
//更新listview
var
ListItem: TListItem;
begin
begin
ListItem := frmbody.LVMail.Items.Add;
ListItem.ImageIndex := 3;
ListItem.Caption := MailChk.Items[MailIndex].Name;
ListItem.SubItems.Add(inttostr(MailNumber));
ListItem.SubItems.Add(MailChkInfo);
end;

end;

procedure TfrmBody.btnChkMailClick(Sender: TObject);
//启动检测邮件线程
var
dwExitCode:DWORD;
ThreadID:DWORD;
begin
if OnlineFlag = false then
begin
msgbox('在离线状态下不能检测邮件,请拨号上网。','提醒',MB_OK+MB_ICONINFORMATION);
exit;
end;

if ThreadMail <> nil then
//取消按钮被按下
begin
ThreadMail.Terminate;
exit;
end;

btnChkMail.Caption := '取消';
LVMail.Items.Clear;
ThreadMail := TMailChkThread.Create(MailCheck);
ThreadMail.OnTerminate := frmbody.onMailTerminated;
hThread := ThreadMail.Handle;
ThreadMail.Resume;
end;

procedure TfrmBody.WMShowNofity(var Message: TMessage);
begin

ShowNotifyForm('在' + inttostr(Message.WParam) + '个信箱检测到' + inttostr(Message.LParam) + '封信件!');
end;

procedure TfrmBody.FormDestroy(Sender: TObject);
var
i:integer;
dwExitCode:DWORD;
begin
//很重要的一步,在程序退出时如果线程仍在运行,必须强行杀死该线程
if ThreadMail <> nil then
begin
ThreadMail.Suspend;
CloseHandle(ThreadMail.Handle);
end;

end;

其他大虾有例子,也请拿出来交流交流。
 
谢谢:左轻侯
我好好分析分析!
还往别的大虾不吝赐教呀!!
 
接受答案了.
 
我用TThread 封装过
SakPOP,NMPOP3,idPOP3(indy),
收信没问题,程序退出时却老报错:
"raised exception class EWin32Error
with message A Win32 API function failed"
百思不解.....Why ????
程序大概如下:
type
TClsSakPOP = class(TThread)
private
FPOP:TSakPOP;
//FMSG:TSakMsg;
FstbAccount:TStatusBar;
FprbAccount:TProgressBar;
FlvRcpList:TListView;
protected
procedure Execute;
override;
public
constructor Create(RunNow:boolean;{POP:TSakPOP;MSG:TSakMsg;}
stbAccount:TStatusBar;prbAccount:TProgressBar;
lvRcpList:TListView);
destructor Destroy;override;
//-- 连接服务器
function ConnectServer(NewConnection:boolean):boolean;
//-- 连接成功之后,完成一次收当前Mail,并打印的功能
procedure RetireveEmails;//--test
procedure AddRcpInfoToLog(FileName,RefNo,Page,FaxTime, ReceiveTime,FaxFrom:string);
procedure GetParamsFormSubject(S:string;out RefNo,From,ReceivedTime:string);
//-- After Retrieve 一封 Mail 事件
procedure SakPOPAfterRetrieve(Sender: TObject);
//-- 正在收信事件
procedure SakPOPRetrieveProgress(Sender: TObject;
Percent: Word);
procedure SakPOPError(Sender: TObject;
Error: Integer;
Msg: String);
procedure SakPOPBeforeRetrieve(sender: TObject;
MsgIndex: Word);
end;

implementation
constructor TClsSakPOP.Create(RunNow:boolean;{POP:TSakPOP;MSG:TSakMsg;}
stbAccount:TStatusBar;prbAccount:TProgressBar;
lvRcpList:TListView);
begin
inherited Create(RunNow);
FPOP:=TSakPOP.Create(nil);
FPOP.Host:='xxx.xxx.xxx';
FPOP.Port:='110';
FPOP.UserId:='xxx';
FPOP.UserPasswd:='xxx';
FstbAccount:=stbAccount;
FprbAccount:=prbAccount;
FlvRcpList:=lvRcpList;
FPOP.OnBeforeRetrieve:= SakPOPBeforeRetrieve;
FPOP.OnAfterRetrieve:= SakPOPAfterRetrieve;
FPOP.OnRetrieveProgress:=SakPOPRetrieveProgress;
FPOP.OnError:= SakPOPError;
end;
//-----
destructor TClsSakPOP.Destroy;
begin
FPOP.free;
FPOP:=nil;
FstbAccount:=nil;
FprbAccount:=nil;
FlvRcpList:=nil;
inherited Destroy;
end;
//----
procedure TClsSakPOP.Execute;
var
sPath:string;
begin
FreeOnTerminate:=True;
ConnectServer(True);
if (not FPOP.Connected) then
exit;
sPath:=ExtractFilePath(Application.Exename)+ 'DownTiff/';
RetireveEmails;
end;

//-- 连接服务器
function TClsSakPOP.ConnectServer(NewConnection:boolean):boolean;
begin
//-- 连接服务器
end;
//== 把发送时的信息添加到 lstLog
procedure TClsSakPOP.AddRcpInfoToLog(FileName,RefNo,Page,FaxTime,
ReceiveTime,FaxFrom:string);
begin
//...
end;
//----
procedure TClsSakPOP.GetParamsFormSubject(S:string;out RefNo,From,ReceivedTime:string);
begin
//...
end;

//-- After Retrieve 一封 Mail 事件
procedure TClsSakPOP.SakPOPAfterRetrieve(Sender: TObject);
begin
FstbAccount.Panels[0].text := 'This Mail Retrieved ..';
FprbAccount.Visible:=False;
end;

//-- 正在收信事件
procedure TClsSakPOP.SakPOPRetrieveProgress(Sender: TObject;
Percent: Word);
begin
FprbAccount.Position := Percent;
end;

procedure TClsSakPOP.SakPOPError(Sender: TObject;
Error: Integer;Msg: String);
begin
FstbAccount.Panels[0].text := 'Error';
FstbAccount.Panels[1].text := Msg;
end;

procedure TClsSakPOP.SakPOPBeforeRetrieve(sender: TObject;
MsgIndex: Word);
begin
FprbAccount.Top:= 1;
FprbAccount.Left:= 1;
FprbAccount.Visible:=True;
FprbAccount.Position := 0;
end;

//-- 连接成功之后,完成一次收当前Mail,并打印的功能
procedure TClsSakPOP.RetireveEmails;
var
FMSG:TSakMsg;
iMsgNo,iMsgsMaxCount:integer;
begin
iMsgsMaxCount:=FPOP.MsgsCount;
if iMsgsMaxCount > 0 then
begin
for iMsgNo:= 1 to iMsgsMaxCountdo
begin
FMSG:=TSakMsg.Create(nil);
FprbAccount.Position := 0;
FstbAccount.Panels[1].text :='Retrieving ' + inttostr(iMsgNo) + ' of total ' + inttostr(iMsgsMaxCount);
try
FPOP.RetrieveMessage(iMsgNo,FMSG);
except
FstbAccount.Panels[0].text :='Abort,Disconnect';
FstbAccount.Panels[1].text :='Retrieve The ' + inttostr(iMsgNo) + ' Mail Fail';
FMSG.Free;
FPOP.Quit;
exit;
end;
//..保存并打印
//..
FMSG.AttachedFiles.Clear;

FMSG.Free;
end;
end
else
FstbAccount.Panels[1].text :='No Mail Found';
FPOP.quit;
FstbAccount.Panels[0].text :='Disconnect';
FstbAccount.Panels[1].text :='';
end;

end.
 
hi,左轻侯
你的线程中没有这句,只能检查,不能收Mail:
try
FPOP.RetrieveMessage(iMsgNo,FMSG);
// 如果去掉此句,则一切OK.不过收不了Mail又有什么用.
except
FstbAccount.Panels[0].text :='Abort,Disconnect';
FstbAccount.Panels[1].text :='Retrieve The ' + inttostr(iMsgNo) + ' Mail Fail';
FMSG.Free;
FPOP.Quit;
exit;
end;
如果有以上几句,程序退出时会莫名奇妙出错. 不知是何原因???
已检查程序退出时 ThreadXXXX = nil
 
我的程序就是一个EMail检查程序,没有收取功能
如果你想做一个完整的email客户端,恐怕只能自己去分析一下sakemail的源码了
 
后退
顶部