我真的找不到我这个线程的问题到底出在哪里了.代码我全部复制了到下面,为了更好的请教大家,我把所有的两个单元的代码全部复制出来了.其中第一单元是主单元,第二单元是线程的单元,具体的实现代码也只是那么几行,我都注释出来了,希望大家帮忙看一下到底问题出在哪里.我实在是找不到了,程序编译也好好的都可以通过编译的.具体出的问题是,好像线程根本没有运行.我点击了按钮,可是用网络数据包监控工具根本查看不到该程序跟网络有数据包的传递.就是说我线程里面的代码根本没有实现…………代码如下×××××××××××××××××××××××××××××××××××××
我用了bsBusinessSkin第三方皮肤控件,所以代码中的那些空间名是那个样子的。unit Unit1;interfaceuses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, bsSkinTabs, bsSkinCtrls, bsSkinData, BusinessSkinForm,
StdCtrls, bsSkinBoxCtrls, Mask,unit2,unit3, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient, IdHTTP;type
TForm1 = class(TForm)
bsBusinessSkinForm1: TbsBusinessSkinForm;
bsSkinData1: TbsSkinData;
bsCompressedStoredSkin1: TbsCompressedStoredSkin;
bsSkinPanel1: TbsSkinPanel;
bsSkinPageControl1: TbsSkinPageControl;
bsSkinTabSheet1: TbsSkinTabSheet;
bsSkinTabSheet2: TbsSkinTabSheet;
bsSkinGroupBox1: TbsSkinGroupBox;
user1: TbsSkinEdit; //这个是填写登录用户名
psw1: TbsSkinEdit; //这个是填写登录密码
bsSkinLabel1: TbsSkinLabel;
bsSkinLabel2: TbsSkinLabel;
bsSkinGroupBox2: TbsSkinGroupBox;
bookid: TbsSkinEdit; //这个是填写提交目标
count: TbsSkinEdit; //这个是填写提交次数
bsSkinLabel3: TbsSkinLabel;
bsSkinLabel4: TbsSkinLabel;
bsSkinLabel5: TbsSkinLabel;
Memo1: TbsSkinMemo; //这个是填写提交内容
bsSkinGroupBox3: TbsSkinGroupBox;
user2: TbsSkinEdit;
psw2: TbsSkinEdit;
bsSkinLabel6: TbsSkinLabel;
bsSkinLabel7: TbsSkinLabel;
button1: TbsSkinButton;
bsSkinGroupBox4: TbsSkinGroupBox;
bookidbegin: TbsSkinEdit;
bookidend: TbsSkinEdit;
bsSkinLabel8: TbsSkinLabel;
bsSkinLabel9: TbsSkinLabel;
bsSkinLabel10: TbsSkinLabel;
Memo2: TbsSkinMemo;
Button2: TbsSkinButton;
ListView1: TListView;
StatusBar1: TStatusBar;
IdHTTP1: TIdHTTP;
procedure button1Click(Sender: TObject); private
{ Private declarations }
public
{ Public declarations }
end;var
Form1: TForm1;
dan_shua: array of danshua;
implementation{$R *.dfm}
//总共就一个按钮想要实现多线程提交数据
procedure TForm1.button1Click(Sender: TObject);
var
i,icount:integer;
begin
try
icount:=strtoint(count.Text);
except
begin
showmessage('请填写一个正整数,否则程序无法运行!');
exit;
end;
end; setlength(dan_shua,icount);//动态设置线程数量,根据提交次数 for i:=0 to icount-1 do
begin
dan_shua[i]:=danshua.create(user1.Text,psw1.Text,bookid.Text,memo1.Text);
end;
end;end.**********************************************************************unit Unit2;interfaceuses
Classes,idhttp,windows;var
CS:TRTLCriticalSection; //定义全局临界区type
danshua = class(TThread)
private
tmp_usr,tmp_psw,tmp_bid,tmp_shp:string;
idhttp1:tidhttp;
protected
procedure Execute; override;
procedure post;
public
constructor create(usr,psw,bid,shp:string);
end;implementationuses unit1;//定义几个URL常量
constloginurl:string='http://www.test.com/loginuser.asp';
posturl:string='http://www.test.com/bookreview/bookreview_savetopic.asp';
logouturl:string='http://www.test.com/loginout.asp';constructor danshua.create(usr,psw,bid,shp:string);
begin
Freeonterminate := true;
tmp_usr:=usr;
tmp_psw:=psw;
tmp_bid:=bid;
tmp_shp:=shp;
InitializeCriticalSection(CS); //初始化临界区
inherited create(false);
end;//网页数据提交过程
procedure danshua.post;
var
str:tstringlist;
r:tstringstream;
begin
idhttp1.Create(nil);
str:=tstringlist.Create;
r:=tstringstream.Create('');
idhttp1.HandleRedirects:=true;
idhttp1.HTTPOptions:=[];
str.Clear;
r.CleanupInstance;
str.Add('user_name='+tmp_usr+'&pass_word='+tmp_psw+'&ekey=%CE%DE%D4%F2%B2%BB%CC%EE&user_type=1&sendpost=%B5%C7%C2%BC%CA%E9%CE%DD');
//尝试登录
try
idhttp1.Post(loginurl,str,r);
except
end;
//尝试提交
str.Clear;
str.Add('Ms_sendcontent='+tmp_shp+'&bl_id='+tmp_bid+'&sendup=%B7%A2%CB%CD%D6%F7%CC%E2');
r.CleanupInstance;
try
idhttp1.Post(posturl,str,r);
except
end; //尝试登出
try
idhttp1.Get(logouturl);
except
end; sleep(20);
idhttp1.Free;
end;//线程实现部分
procedure danshua.Execute;
begin
Entercriticalsection(cs);
if Terminated then exit;
post;
leavecriticalsection(cs);
sleep(20);
end;end.
×××××××××××××××××××××××××××××××××××××××××就是这个了~!!救命啊……
再找不出来,我好不容易才有的热情和兴趣就要被折磨地消失殆尽了…………三天了都不知道错在哪里…………………………………………
我用了bsBusinessSkin第三方皮肤控件,所以代码中的那些空间名是那个样子的。unit Unit1;interfaceuses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, bsSkinTabs, bsSkinCtrls, bsSkinData, BusinessSkinForm,
StdCtrls, bsSkinBoxCtrls, Mask,unit2,unit3, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient, IdHTTP;type
TForm1 = class(TForm)
bsBusinessSkinForm1: TbsBusinessSkinForm;
bsSkinData1: TbsSkinData;
bsCompressedStoredSkin1: TbsCompressedStoredSkin;
bsSkinPanel1: TbsSkinPanel;
bsSkinPageControl1: TbsSkinPageControl;
bsSkinTabSheet1: TbsSkinTabSheet;
bsSkinTabSheet2: TbsSkinTabSheet;
bsSkinGroupBox1: TbsSkinGroupBox;
user1: TbsSkinEdit; //这个是填写登录用户名
psw1: TbsSkinEdit; //这个是填写登录密码
bsSkinLabel1: TbsSkinLabel;
bsSkinLabel2: TbsSkinLabel;
bsSkinGroupBox2: TbsSkinGroupBox;
bookid: TbsSkinEdit; //这个是填写提交目标
count: TbsSkinEdit; //这个是填写提交次数
bsSkinLabel3: TbsSkinLabel;
bsSkinLabel4: TbsSkinLabel;
bsSkinLabel5: TbsSkinLabel;
Memo1: TbsSkinMemo; //这个是填写提交内容
bsSkinGroupBox3: TbsSkinGroupBox;
user2: TbsSkinEdit;
psw2: TbsSkinEdit;
bsSkinLabel6: TbsSkinLabel;
bsSkinLabel7: TbsSkinLabel;
button1: TbsSkinButton;
bsSkinGroupBox4: TbsSkinGroupBox;
bookidbegin: TbsSkinEdit;
bookidend: TbsSkinEdit;
bsSkinLabel8: TbsSkinLabel;
bsSkinLabel9: TbsSkinLabel;
bsSkinLabel10: TbsSkinLabel;
Memo2: TbsSkinMemo;
Button2: TbsSkinButton;
ListView1: TListView;
StatusBar1: TStatusBar;
IdHTTP1: TIdHTTP;
procedure button1Click(Sender: TObject); private
{ Private declarations }
public
{ Public declarations }
end;var
Form1: TForm1;
dan_shua: array of danshua;
implementation{$R *.dfm}
//总共就一个按钮想要实现多线程提交数据
procedure TForm1.button1Click(Sender: TObject);
var
i,icount:integer;
begin
try
icount:=strtoint(count.Text);
except
begin
showmessage('请填写一个正整数,否则程序无法运行!');
exit;
end;
end; setlength(dan_shua,icount);//动态设置线程数量,根据提交次数 for i:=0 to icount-1 do
begin
dan_shua[i]:=danshua.create(user1.Text,psw1.Text,bookid.Text,memo1.Text);
end;
end;end.**********************************************************************unit Unit2;interfaceuses
Classes,idhttp,windows;var
CS:TRTLCriticalSection; //定义全局临界区type
danshua = class(TThread)
private
tmp_usr,tmp_psw,tmp_bid,tmp_shp:string;
idhttp1:tidhttp;
protected
procedure Execute; override;
procedure post;
public
constructor create(usr,psw,bid,shp:string);
end;implementationuses unit1;//定义几个URL常量
constloginurl:string='http://www.test.com/loginuser.asp';
posturl:string='http://www.test.com/bookreview/bookreview_savetopic.asp';
logouturl:string='http://www.test.com/loginout.asp';constructor danshua.create(usr,psw,bid,shp:string);
begin
Freeonterminate := true;
tmp_usr:=usr;
tmp_psw:=psw;
tmp_bid:=bid;
tmp_shp:=shp;
InitializeCriticalSection(CS); //初始化临界区
inherited create(false);
end;//网页数据提交过程
procedure danshua.post;
var
str:tstringlist;
r:tstringstream;
begin
idhttp1.Create(nil);
str:=tstringlist.Create;
r:=tstringstream.Create('');
idhttp1.HandleRedirects:=true;
idhttp1.HTTPOptions:=[];
str.Clear;
r.CleanupInstance;
str.Add('user_name='+tmp_usr+'&pass_word='+tmp_psw+'&ekey=%CE%DE%D4%F2%B2%BB%CC%EE&user_type=1&sendpost=%B5%C7%C2%BC%CA%E9%CE%DD');
//尝试登录
try
idhttp1.Post(loginurl,str,r);
except
end;
//尝试提交
str.Clear;
str.Add('Ms_sendcontent='+tmp_shp+'&bl_id='+tmp_bid+'&sendup=%B7%A2%CB%CD%D6%F7%CC%E2');
r.CleanupInstance;
try
idhttp1.Post(posturl,str,r);
except
end; //尝试登出
try
idhttp1.Get(logouturl);
except
end; sleep(20);
idhttp1.Free;
end;//线程实现部分
procedure danshua.Execute;
begin
Entercriticalsection(cs);
if Terminated then exit;
post;
leavecriticalsection(cs);
sleep(20);
end;end.
×××××××××××××××××××××××××××××××××××××××××就是这个了~!!救命啊……
再找不出来,我好不容易才有的热情和兴趣就要被折磨地消失殆尽了…………三天了都不知道错在哪里…………………………………………
简单的讲几句吧..临界区的Enterxx和Leavexx必须配对出现,而且中间的代码不能太消耗时间.所以你的Execute代码写法是不规范的..
你的post中,对象在使用完后,没有释放.
你的临界区也没有释放.
一个全局的临界区的创建和释放,应该放在unit的initialization,finalization中,而不是你的线程对象的OnCreate中.其他的我没有细看...反正问题不少.建议你先在单线程环境下测试你的代码.然后再遗址到多线程中.
应该换成idhttp1:=tidhttp.create(nil);这样程序就OK了……回楼上的朋友我idhttp使用后有free掉滴。至于临界区,我也是看教程这般写的或许有些不合理吧,呵呵。答案已经得到,不过既然老纪不来领分,我就不结这个帖子了。哈,