1
我有一個多線程應用程序，需要通過idhttp發送數據到一些http主機......主機的數量不同，我把它們放在一個TXT文件中，讀入一個TStringList中。但每天約有5k主機。好吧，運行3天后，或多或少，以及大約15k主機檢查，線程開始掛在代碼的某一點，程序變得非常慢，就像它開始每10分鐘檢查一臺主機一樣......有時候會發生遠遠的，並保持1周運行非常好，但在這個相同的問題後：看起來像大多數線程開始掛起......我不知道問題到底在哪裏，因爲我用100個線程運行它，就像我說的之後，15K或多個主機也開始變得緩慢......Delphi執行多線程後掛起的線程
這裏的幾乎全部源代碼（抱歉發帖全部，但我認爲這是更好小於以上）
type
MyThread = class(TThread)
strict private
URL, FormPostData1, FormPostData2: String;
iData1, iData2: integer;
procedure TerminateProc(Sender: TObject);
procedure AddPosted;
procedure AddStatus;
function PickAData: bool;
function CheckHost: bool;
function DoPostData(const FormPostData1: string; const FormPostData2: string): bool;
protected
constructor Create(const HostLine: string);
procedure Execute; override;
end;
var
Form1: TForm1;
HostsFile, Data1, Data2: TStringList;
iHost, iThreads, iPanels: integer;
MyCritical: TCriticalSection;
implementation
function MyThread.CheckHost: bool;
var
http: TIdHTTP;
code: string;
begin
Result:= false;
http:= TIdHTTP.Create(Nil);
http.IOHandler:= TIdSSLIOHandlerSocketOpenSSL.Create(http);
http.Request.UserAgent:= 'Mozilla/5.0 (compatible, MSIE 11, Windows NT 6.3; Trident/7.0; rv:11.0) like Gecko';
http.HandleRedirects:= True;
try
try
code:= http.Get(URL);
if(POS('T2ServersForm', code) <> 0) then
Result:= true;
except
Result:= false;
end;
finally
http.Free;
end;
end;
function MyThread.PickAData: bool;
begin
Result:= false;
if (iData2 = Data2.Count) then
begin
inc(iData1);
iData2:= 0;
end;
if iData1 < Data1.Count then
begin
if iData2 < Data2.Count then
begin
FormPostData2:= Data2.Strings[iData2];
inc(iData2);
end;
FormPostData1:= Data1.Strings[iData1];
Result:= true;
end;
end;
function MyThread.DoPostData(const FormPostData1: string; const FormPostData2: string): bool;
var
http: TIdHTTP;
params: TStringList;
response: string;
begin
Result:= false;
http:= TIdHTTP.Create(Nil);
http.Request.UserAgent := 'Mozilla/5.0 (compatible, MSIE 11, Windows NT 6.3; Trident/7.0; rv:11.0) like Gecko';
http.Request.ContentType := 'application/x-www-form-urlencoded';
params:= TStringList.Create;
try
params.Add('LoginType=Explicit');
params.Add('Medium='+FormPostData1);
params.Add('High='+FormPostData2);
try
response:= http.Post(Copy(URL, 1, POS('?', URL) - 1), params);
if http.ResponseCode = 200 then
Result:= true;
except
if (http.ResponseCode = 302) then
begin
if(POS('Invalid', http.Response.RawHeaders.Values['Location']) = 0) then
Result:= true;
end
else
Result:= true;
end;
finally
http.Free;
params.Free;
end;
end;
procedure MyThread.AddPosted;
begin
Form1.Memo1.Lines.Add('POSTED: ' + URL + ':' + FormPostData1 + ':' + FormPostData2)
end;
procedure MyThread.AddStatus;
begin
inc(iPanels);
Form1.StatusBar1.Panels[1].Text:= 'Hosts Panels: ' + IntToStr(iPanels);
end;
procedure MainControl;
var
HostLine: string;
begin
try
MyCritical.Acquire;
dec(iThreads);
while(iHost <= HostsFile.Count - 1) and (iThreads < 100) do
begin
HostLine:= HostsFile.Strings[iHost];
inc(iThreads);
inc(iHost);
MyThread.Create(HostLine);
end;
Form1.StatusBar1.Panels[0].Text:= 'Hosts Checked: ' + IntToStr(iHost);
if(iHost = HostsFile.Count - 1) then
begin
Form1.Memo1.Lines.Add(#13#10'--------------------------------------------');
Form1.Memo1.Lines.Add('Finished!!');
end;
finally
MyCritical.Release;
end;
end;
{$R *.dfm}
constructor MyThread.Create(const HostLine: string);
begin
inherited Create(false);
OnTerminate:= TerminateProc;
URL:= 'http://' + HostLine + '/ServLan/Controller.php?action=WAIT_FOR';
iData2:= 0;
iData1:= 0;
end;
procedure MyThread.Execute;
begin
if(CheckHost = true) then
begin
Synchronize(AddStatus);
while not Terminated and PickAData do
begin
try
if(DoPostData(FormPostData1, FormPostData2) = true) then
begin
iData1:= Data1.Count;
Synchronize(AddPosted);
end;
except
Terminate;
end;
end;
Terminate;
end;
end;
procedure MyThread.TerminateProc(Sender: TObject);
begin
MainControl;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
if (FileExists('data2.txt') = false) OR (FileExists('data1.txt') = false) then
begin
Button1.Enabled:= false;
Memo1.Lines.Add('data2.txt/data1.txt not found!!');
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
openDialog : TOpenDialog;
begin
try
HostsFile:= TStringList.Create;
openDialog := TOpenDialog.Create(Nil);
openDialog.InitialDir := GetCurrentDir;
openDialog.Options := [ofFileMustExist];
openDialog.Filter := 'Text File|*.txt';
if openDialog.Execute then
begin
HostsFile.LoadFromFile(openDialog.FileName);
Button2.Enabled:= true;
Button1.Enabled:= false;
end;
finally
openDialog.Free;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Button2.Enabled:= false;
Data1:= TStringList.Create;
Data1.LoadFromFile('data1.txt');
Data2:= TStringList.Create;
Data2.LoadFromFile('data2.txt');
MyCritical:= TCriticalSection.Create;
iHost:= 0;
iThreads:= 0;
MainControl;
end;
Humm ...我想我只是在Memo1中添加行。我不建立它，我只是使用Add.Lines方法... – user3810691
@ user3810691是的，你正在添加行 - 它們可能是無限的。這些線需要空間！ –