多線程ICS問題 |
尚未結案
|
stockdisk
一般會員 發表:9 回覆:14 積分:4 註冊:2003-06-06 發送簡訊給我 |
本人寫了一個多線程的HTTPGET的程序,線程設為20個,但不明白 為什麼一運行,就是40個線線,目標是100個,自動運行,直到結束。寫了一個PING的多線程就好用,但不清楚為什麼同樣的方法改成HTTPGET就不行了。求教。請大大刪除另一個貼子吧,一不小心發了兩個,SORRY。
UNIT thread_httpcheck; INTERFACE USES
Classes, sysutils, syncobjs, comctrls, HttpProt, Wait; TYPE
T_httpcheck = CLASS(TThread)
Private
Fprocess: longword;
PROCEDURE update_check;
Protected
PROCEDURE Execute; Override;
Public
CHttpCli: THttpCli;
CWait: TWait;
aSource: STRING;
aSpeed: Cardinal;
t_index: longword;
CONSTRUCTOR Create(CreateSuspended: Boolean);
PROCEDURE AHttpCliDocData(Sender: TObject; Buffer: Pointer; Len: Integer);
PROCEDURE AHttpCliRequestDone(Sender: TObject; RqType: THttpRequest; Error: Word);
PROCEDURE ThreadDone(Sender: TObject);
PROCEDURE AWaitTimeout(Sender: TObject);
PROCEDURE Retry(Sender: TObject);
END; IMPLEMENTATION
USES main, functions; CONSTRUCTOR T_httpcheck.Create(CreateSuspended: Boolean);
BEGIN CHttpCli := THttpCli.Create(mainform);
CHttpCli.MultiThreaded := TRUE;
CHttpCli.OnDocData := AHttpCliDocData;
CHttpCli.OnRequestDone := AHttpCliRequestDone;
CWait := TWait.Create(CHttpCli);
OnTerminate := ThreadDone;
freeOnTerminate := True;
inc(ping_thread_no);
mainform.suiStatusBar1.Panels[1].Text := '線程數量:' inttostr(ping_thread_no);
INHERITED Create(CreateSuspended);
END; PROCEDURE T_httpcheck.Execute;
BEGIN
INHERITED;
WHILE (thread_run) DO BEGIN {//判斷是否線程還准許運行}
ping_criticalsection.Enter;//臨界定義
mainform.test1.Lines.Add(inttostr(cur_ip)); //
Fprocess := cur_ip;
inc(cur_ip);
ping_criticalsection.Leave; //析放臨界狀態
IF fprocess <= httptestPItems.Count THEN BEGIN
CHttpCli.URL := mainform.httpwwwtext.Text;//HTTP的網址
CHttpCli.Tag := Fprocess;
PhttpcheckItem(httptestPItems.Items[Fprocess]).ping := '正在分析';
mainform.httpcheck1.Items.Item[Fprocess].Update;
CWait.Caption := mainform.Edit11.Text;
CWait.OnTimeout := AWaitTimeout;
CWait.Start;
CHttpCli.GetAsync;
synchronize(update_check);
END ELSE exit; {break;}
END;
END; PROCEDURE T_httpcheck.update_check;
BEGIN
mainform.suiStatusBar1.Panels[5].Text := PhttpcheckItem(httptestPItems.Items[Fprocess]).http '測試中';//顯示網址
END;
{------------------------------------------------------------------------------}
PROCEDURE T_httpcheck.AHttpCliDocData(Sender: TObject; Buffer: Pointer; Len: Integer);
BEGIN
aSource := aSource StrPas(Buffer);
// mainform.test1.Lines.Add(aSource);
END;
{------------------------------------------------------------------------------}
PROCEDURE T_httpcheck.AHttpCliRequestDone(Sender: TObject; RqType: THttpRequest; Error: Word);
BEGIN
IF ((aSource = '') AND (CHttpCli.StatusCode = 200))
OR ((mainform.chkretrychk.Checked = True) AND (CHttpCli.StatusCode = 503)) THEN BEGIN
Retry(CHttpCli);
exit;
END; IF PhttpcheckItem(httptestPItems.Items[Fprocess]).ImageIndex = 3 THEN
PhttpcheckItem(httptestPItems.Items[Fprocess]).ping := 'Timeout'
ELSE IF CHttpCli.StatusCode = 200 THEN BEGIN
mainform.test1.Lines.Add(aSource);
END
ELSE BEGIN
PhttpcheckItem(httptestPItems.Items[Fprocess]).ImageIndex := 2;
PhttpcheckItem(httptestPItems.Items[Fprocess]).ping := inttostr(CHttpCli.StatusCode) ' - ' CHttpCli.ReasonPhrase;
END;
END;
{------------------------------------------------------------------------------}
PROCEDURE T_httpcheck.Retry(Sender: TObject);
BEGIN
PhttpcheckItem(httptestPItems.Items[Fprocess]).ping := 'Retrying';//ping這個是顯示狀態的。
PhttpcheckItem(httptestPItems.Items[Fprocess]).ImageIndex := 8;
aSource := '';
CWait.Stop;
CWait.Start;
CHttpCli.GetAsync;
END;
{------------------------------------------------------------------------------}
PROCEDURE T_httpcheck.AWaitTimeout(Sender: TObject);
BEGIN
CHttpCli.Abort;
PhttpcheckItem(httptestPItems.Items[Fprocess]).ImageIndex := 3;
inc(iTimeout);
mainform.suiStatusBar1.Panels[3].Text := '超時:' inttostr(iTimeout);
END;
{------------------------------------------------------------------------------}
PROCEDURE T_httpcheck.ThreadDone(Sender: TObject);
BEGIN
(T_httpcheck(Sender)).CHttpCli.Free;
(T_httpcheck(Sender)).CWait.Free;
dec(ping_thread_no); //遞差事線程數變量值
// mainform.Label38.Caption := IntToStr(ping_thread_no);
mainform.suiStatusBar1.Panels[1].Text := '線程數量:' inttostr(ping_thread_no);
IF ping_thread_no = 0 THEN
mainform.test1.Lines.Add('http結束請查看');
END;
END. 發表人 - stockdisk 於 2005/04/08 00:03:05
|
stockdisk
一般會員 發表:9 回覆:14 積分:4 註冊:2003-06-06 發送簡訊給我 |
本站聲明 |
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇! |