本人寫了一個多線程的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

不知道為什麼把CHttpCli.GetAsync; 改成CHttpCli.Get就正常了，但新的問題出現了。 就是ICS的HTTPCLI控件好象不正常，出現什麼找不到IP錯誤。