G
goodman
Unregistered / Unconfirmed
GUEST, unregistred user!
我用INDYTCPSERVER 和INDYTCPCLIENT收发文件时总是无法用进度条显示过程的,再有,发文件
时窗体不可移动啊有时发200多M是好象是死了似的要等发完才会正常的移动那界面的,
我现贴一段源程序如下是发邮件的,和上面的问题是一样的,请高手给看一下啊问题在哪的,一开始拨号发邮件时就会
界面死掉要等发完了才可移动界面的。可微软的拨号是没有问题的呢那界面是可移动的呢
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, ToolWin, ComCtrls, Buttons, ImgList, ExtCtrls,
IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
IdMessageClient, IdPOP3 ,IdAntiFreezeBase,idmessage,IdAntiFreeze, IdSMTP
;
threadvar
gloalstr:string;
type
tsendmail=class(tthread)
private
sendmailstr:string;
protected
function sendmails:boolean;
procedure beginsend;
procedure execute;override;
public
//constructor create(const aname:string);
end;
type
Tnetaa = class(TForm)
MainMenu1: TMainMenu;
CoolBar1: TCoolBar;
netset: TMenuItem;
sendfile: TSpeedButton;
sendmail: TSpeedButton;
ImageList1: TImageList;
voicechat: TSpeedButton;
vismonitot: TSpeedButton;
remotecontrol: TSpeedButton;
updateprogress: TSpeedButton;
sendoperation: TMenuItem;
chatoperation: TMenuItem;
update: TMenuItem;
filesend: TMenuItem;
mailsend: TMenuItem;
voice: TMenuItem;
visible: TMenuItem;
remote: TMenuItem;
dialset: TMenuItem;
linoset: TMenuItem;
help: TMenuItem;
ffile: TMenuItem;
exit: TMenuItem;
Splitter1: TSplitter;
Splitter2: TSplitter;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
procedure dialsetClick(Sender: TObject);
procedure linosetClick(Sender: TObject);
procedure sendmailClick(Sender: TObject);
procedure sendfileClick(Sender: TObject);
private
public
{ Public declarations }
end;
var
netaa: Tnetaa;
implementation
uses neta,status,netshare,IniFiles, netb;
{$R *.dfm}
procedure tsendmail.execute;
begin
freeonterminate:=true;
Synchronize(beginsend);
end;
procedure Tnetaa.dialsetClick(Sender: TObject);
begin
netac:=tnetac.create(self);
try
with netac do
begin
notebook.ActivePage :='dial';
showmodal;
end;
finally
netac.Free;
end;
end;
procedure Tnetaa.linosetClick(Sender: TObject);
begin
netac:=tnetac.create(self);
try
with netac do
begin
notebook.ActivePage :='linetoline';
showmodal;
end;
finally
netac.Free;
end;
end;
procedure Tnetaa.sendmailClick(Sender: TObject);
var sendthread:tsendmail;
begin
sendthread:=tsendmail.Create(false);
end;
function tsendmail.sendmails:boolean;
var sendmail:TIniFile;
address,appdir,attfilea,attfileb,attfilec,subj:string;
idmsge:tidmessage;
idsmtp:tidsmtp;
IdAntiFreeze:tidantifreeze;
begin
idmsge:=tidmessage.Create(application);
idsmtp:=tidsmtp.Create(application);
idantifreeze:=tidantifreeze.Create(application);
idsmtp.AuthenticationType:=atlogin;
appdir:=extractfilepath(application.ExeName);
if fileexists(appdir+'/sendmail.ini') then
begin //0
sendmail := TIniFile.Create(appdir+'/sendmail.ini');
with sendmail do
begin //1
if (length(readstring('shop','ida',''))>0) and (length(readstring('shop','idb',''))>0) then
begin
idsmtp.Host:=readstring('email','host','');
idsmtp.UserId:=readstring('email','user','') ;
idsmtp.Password:=readstring('email','pass','');
idsmtp.Port:=readinteger('email','port',0);
attfilea:=readstring('email','attfilea','');
attfileb:=readstring('email','attfileb','');
attfilec:=readstring('email','attfilec','');
address:=readstring('email','address','');
subj:=readstring('email','subject','');
end;
end;//1
if (length(attfilea)+length(attfileb)+length(attfilec))>0 then
begin
if length(attfilea)>0 then
tidattachment.Create(idmsge.MessageParts,attfilea);
if length(attfileb)>0 then
tidattachment.Create(idmsge.MessageParts,attfileb);
if length(attfilec)>0 then
tidattachment.Create(idmsge.MessageParts,attfilec);
idmsge.Subject:=trim(subj);
idmsge.Recipients.EMailAddresses:=trim(address);
try
begin //
if idsmtp.Connected then idsmtp.Disconnect;
idsmtp.Connect;
//idsmtp.Authenticate:=true;
idsmtp.Send(idmsge);
idsmtp.Disconnect;
deletefile(appdir+'/sendmail.ini');//正式时出掉
result:=true;
end
except//错误日志
deletefile(appdir+'/sendmail.ini');
result:=false;
end; //
end;
idmsge.Free;
IdAntiFreeze.free;
idsmtp.Free;
end //
else
begin
result:=false;
end;
idmsge.Free;
IdAntiFreeze.free;
idsmtp.Free;
end;
procedure tsendmail.beginsend;
var username,passwords,linenoes:string;
begin
try
showstatus:=tshowstatus.Create(nil);
showstatus.Show;
showstatus.Update;
{ if isonline then
begin
showstatus.Progress.Visible:=false;
showstatus.processdata.Caption:=' 正在发送邮件.........';
if sendmails then //发邮件操作
showstatus.processdata.Caption:=' 邮件发送成功......'
else showstatus.processdata.Caption:=' 邮件发送失败......'
end
else}
begin
showstatus.progressing(20);
showstatus.processdata.Caption:='正在检测有无指定拨号连接.......';
if judgeconnection then////是否有指定的拨号连接
begin
showstatus.progressing(40);
showstatus.processdata.Caption:='正在检测拨号用户设置......';
if checkdialdat then //检查拨号保存设置
begin
showstatus.progressing(60);
showstatus.processdata.Caption:='正在读拨号用户设置数据......';
if readdialdat(username,passwords,linenoes) then
begin
showstatus.progressing(80);
showstatus.processdata.Caption:='设定用户设置数据......';
setrasuser(pchar(username),pchar(passwords),pchar(linenoes));
end
else
begin
showstatus.progressing(80);
showstatus.processdata.Caption:='用缺省的用户设定......';
username:='961619';
passwords:='961619';
linenoes:='9,961619';
end;
end
else
begin
showstatus.progressing(80);
showstatus.processdata.Caption:='用缺省的用户设定......';
username:='961619';
passwords:='961619';
linenoes:='9,961619';
end;
if rasdialtel then
begin
showstatus.processdata.Caption:='正在发送邮件.........';
sendmails; //发送邮件;
showstatus.progressing(100);
showstatus.processdata.Caption:='发送成功.........';
end
else
begin
showstatus.processdata.Caption:='拨号不成功,检查一下设置!';
//showmessage('拨号不成功,检查一下设置!');
//exit;
end; //
end
else
begin
showstatus.processdata.Caption:='指定拨号''clientdialup''不存在!,请建立指定拨号连接.';
//showmessage('指定拨号''clientdialup''不存在!,请建立指定拨号连接.');
//exit;
end;
end;
showstatus.Hide;
showstatus.Update;
showstatus.Free
except
showstatus.Hide;
showstatus.Update;
showstatus.Free
end;
end;
procedure Tnetaa.sendfileClick(Sender: TObject);
begin
netab:=tnetab.create(self);
end;
end.
时窗体不可移动啊有时发200多M是好象是死了似的要等发完才会正常的移动那界面的,
我现贴一段源程序如下是发邮件的,和上面的问题是一样的,请高手给看一下啊问题在哪的,一开始拨号发邮件时就会
界面死掉要等发完了才可移动界面的。可微软的拨号是没有问题的呢那界面是可移动的呢
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, ToolWin, ComCtrls, Buttons, ImgList, ExtCtrls,
IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
IdMessageClient, IdPOP3 ,IdAntiFreezeBase,idmessage,IdAntiFreeze, IdSMTP
;
threadvar
gloalstr:string;
type
tsendmail=class(tthread)
private
sendmailstr:string;
protected
function sendmails:boolean;
procedure beginsend;
procedure execute;override;
public
//constructor create(const aname:string);
end;
type
Tnetaa = class(TForm)
MainMenu1: TMainMenu;
CoolBar1: TCoolBar;
netset: TMenuItem;
sendfile: TSpeedButton;
sendmail: TSpeedButton;
ImageList1: TImageList;
voicechat: TSpeedButton;
vismonitot: TSpeedButton;
remotecontrol: TSpeedButton;
updateprogress: TSpeedButton;
sendoperation: TMenuItem;
chatoperation: TMenuItem;
update: TMenuItem;
filesend: TMenuItem;
mailsend: TMenuItem;
voice: TMenuItem;
visible: TMenuItem;
remote: TMenuItem;
dialset: TMenuItem;
linoset: TMenuItem;
help: TMenuItem;
ffile: TMenuItem;
exit: TMenuItem;
Splitter1: TSplitter;
Splitter2: TSplitter;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
procedure dialsetClick(Sender: TObject);
procedure linosetClick(Sender: TObject);
procedure sendmailClick(Sender: TObject);
procedure sendfileClick(Sender: TObject);
private
public
{ Public declarations }
end;
var
netaa: Tnetaa;
implementation
uses neta,status,netshare,IniFiles, netb;
{$R *.dfm}
procedure tsendmail.execute;
begin
freeonterminate:=true;
Synchronize(beginsend);
end;
procedure Tnetaa.dialsetClick(Sender: TObject);
begin
netac:=tnetac.create(self);
try
with netac do
begin
notebook.ActivePage :='dial';
showmodal;
end;
finally
netac.Free;
end;
end;
procedure Tnetaa.linosetClick(Sender: TObject);
begin
netac:=tnetac.create(self);
try
with netac do
begin
notebook.ActivePage :='linetoline';
showmodal;
end;
finally
netac.Free;
end;
end;
procedure Tnetaa.sendmailClick(Sender: TObject);
var sendthread:tsendmail;
begin
sendthread:=tsendmail.Create(false);
end;
function tsendmail.sendmails:boolean;
var sendmail:TIniFile;
address,appdir,attfilea,attfileb,attfilec,subj:string;
idmsge:tidmessage;
idsmtp:tidsmtp;
IdAntiFreeze:tidantifreeze;
begin
idmsge:=tidmessage.Create(application);
idsmtp:=tidsmtp.Create(application);
idantifreeze:=tidantifreeze.Create(application);
idsmtp.AuthenticationType:=atlogin;
appdir:=extractfilepath(application.ExeName);
if fileexists(appdir+'/sendmail.ini') then
begin //0
sendmail := TIniFile.Create(appdir+'/sendmail.ini');
with sendmail do
begin //1
if (length(readstring('shop','ida',''))>0) and (length(readstring('shop','idb',''))>0) then
begin
idsmtp.Host:=readstring('email','host','');
idsmtp.UserId:=readstring('email','user','') ;
idsmtp.Password:=readstring('email','pass','');
idsmtp.Port:=readinteger('email','port',0);
attfilea:=readstring('email','attfilea','');
attfileb:=readstring('email','attfileb','');
attfilec:=readstring('email','attfilec','');
address:=readstring('email','address','');
subj:=readstring('email','subject','');
end;
end;//1
if (length(attfilea)+length(attfileb)+length(attfilec))>0 then
begin
if length(attfilea)>0 then
tidattachment.Create(idmsge.MessageParts,attfilea);
if length(attfileb)>0 then
tidattachment.Create(idmsge.MessageParts,attfileb);
if length(attfilec)>0 then
tidattachment.Create(idmsge.MessageParts,attfilec);
idmsge.Subject:=trim(subj);
idmsge.Recipients.EMailAddresses:=trim(address);
try
begin //
if idsmtp.Connected then idsmtp.Disconnect;
idsmtp.Connect;
//idsmtp.Authenticate:=true;
idsmtp.Send(idmsge);
idsmtp.Disconnect;
deletefile(appdir+'/sendmail.ini');//正式时出掉
result:=true;
end
except//错误日志
deletefile(appdir+'/sendmail.ini');
result:=false;
end; //
end;
idmsge.Free;
IdAntiFreeze.free;
idsmtp.Free;
end //
else
begin
result:=false;
end;
idmsge.Free;
IdAntiFreeze.free;
idsmtp.Free;
end;
procedure tsendmail.beginsend;
var username,passwords,linenoes:string;
begin
try
showstatus:=tshowstatus.Create(nil);
showstatus.Show;
showstatus.Update;
{ if isonline then
begin
showstatus.Progress.Visible:=false;
showstatus.processdata.Caption:=' 正在发送邮件.........';
if sendmails then //发邮件操作
showstatus.processdata.Caption:=' 邮件发送成功......'
else showstatus.processdata.Caption:=' 邮件发送失败......'
end
else}
begin
showstatus.progressing(20);
showstatus.processdata.Caption:='正在检测有无指定拨号连接.......';
if judgeconnection then////是否有指定的拨号连接
begin
showstatus.progressing(40);
showstatus.processdata.Caption:='正在检测拨号用户设置......';
if checkdialdat then //检查拨号保存设置
begin
showstatus.progressing(60);
showstatus.processdata.Caption:='正在读拨号用户设置数据......';
if readdialdat(username,passwords,linenoes) then
begin
showstatus.progressing(80);
showstatus.processdata.Caption:='设定用户设置数据......';
setrasuser(pchar(username),pchar(passwords),pchar(linenoes));
end
else
begin
showstatus.progressing(80);
showstatus.processdata.Caption:='用缺省的用户设定......';
username:='961619';
passwords:='961619';
linenoes:='9,961619';
end;
end
else
begin
showstatus.progressing(80);
showstatus.processdata.Caption:='用缺省的用户设定......';
username:='961619';
passwords:='961619';
linenoes:='9,961619';
end;
if rasdialtel then
begin
showstatus.processdata.Caption:='正在发送邮件.........';
sendmails; //发送邮件;
showstatus.progressing(100);
showstatus.processdata.Caption:='发送成功.........';
end
else
begin
showstatus.processdata.Caption:='拨号不成功,检查一下设置!';
//showmessage('拨号不成功,检查一下设置!');
//exit;
end; //
end
else
begin
showstatus.processdata.Caption:='指定拨号''clientdialup''不存在!,请建立指定拨号连接.';
//showmessage('指定拨号''clientdialup''不存在!,请建立指定拨号连接.');
//exit;
end;
end;
showstatus.Hide;
showstatus.Update;
showstatus.Free
except
showstatus.Hide;
showstatus.Update;
showstatus.Free
end;
end;
procedure Tnetaa.sendfileClick(Sender: TObject);
begin
netab:=tnetab.create(self);
end;
end.