ممنون از پاسخت مهربانانه استادان عزیز
من تردمو تو کد زیر گذاشتم
این برنامه حدود چند دقیقه درست کار می کنه . اما بعد از اون دیگه کار نمی کنه . یعنی دیگه عمل ping رو هم انجام نمی ده . نمی دونم تو کجای ترد گیر می افته . در این وضعیت وقتی همون پارامتر stop رو واسه تردا می فرستم تا تردارو خاتمه بدم ، از ترد بیرون نمی آد .( چون موقع بیرون اومدن هر کدوم از تردا وضعیت خودشونو تغییر می دن از طریق این کد
StopThread[tid]:=true;
نمی دونم کد من چه مشکلی داره . آیا ping من مشکلی داره . یا try except های من مشکلدارن ؟
لطفا راهنمایی فرمایید دوستا ن عزیز ؟
در رابطه با استفاده از criticalsection خواهشا یه توضیحی بدین که باید چظور و کجا تعریف بشه
procedure my.Execute;
var
myht:TIdHTTP;
V: OleVariant;
Doc: IHTMLDocument2;
Cache:string;
elem:IHTMLElement;
i,searchrow:integer;
label br;
begin
while true do
begin
sleep(1000);
if form1.stop then
begin
form1.StopThread[tid]:=true;
break;
end;
if not Check_Ping (tip) then continue;
myht:=TIdHTTP.Create(nil);
try
myht.Request.Clear;
myht.Request.BasicAuthentication:= true;
myht.Request.UserName := 'admin';
myht.Request.Password := tpass;
myht.port:=tport;
myht.readtimeout:=2000;
Cache:= myht.Get('http://'+tip+'/yekta.cgi');
finally
myht.Free;
end;
CoInitialize(nil);
try
Doc := coHTMLDocument.Create as IHTMLDocument2; // create IHTMLDocument2 instance
V := VarArrayCreate([0,0], varVariant);
V[0] := Cache;
Doc.Write(PSafeArray(TVarData(v).VArray));
finally
CoUninitialize;
end;
searchrow:=form1.sitegrid.Search(tip);
if searchrow<0 then exit;
for i:=searchrow+1 to form1.sitegrid.GetNodespan(searchrow)-1+searchrow do
begin
Elem := GetElementById(Doc, 'SignWord'+inttostr(i-searchrow)) as IHTMLElement;
if Assigned(Elem) then
form1.sitegrid.Cells[3,i]:=Elem.innerHTML;
end;
end;
end;
constructor my.Create(Suspend:Boolean;ip:string;id:integer;pas s:string;port:integer{; ALock: TCriticalSection});
begin
tip:=ip;
tport:=port;
tpass:=pass;
tid:=id;
// tlock:=ALock;
inherited Create(false);
///
end;
destructor my.Destroy;
begin
inherited;
end;
function my.GetElementById(const Doc: IDispatch; const Id: string): IDispatch;
var
Document: IHTMLDocument2; // IHTMLDocument2 interface of Doc
Body: IHTMLElement2; // document body element
Tags: IHTMLElementCollection; // all tags in document body
Tag: IHTMLElement; // a tag in document body
I: Integer; // loops thru tags in document body
begin
Result := nil;
// Check for valid document: require IHTMLDocument2 interface to it
if not Supports(Doc, IHTMLDocument2, Document) then
raise Exception.Create('Invalid HTML document');
// Check for valid body element: require IHTMLElement2 interface to it
if not Supports(Document.body, IHTMLElement2, Body) then
raise Exception.Create('Can''t find <body> element');
// Get all tags in body element ('*' => any tag name)
Tags := Body.getElementsByTagName('*');
// Scan through all tags in body
for I := 0 to Pred(Tags.length) do
begin
// Get reference to a tag
Tag := Tags.item(I, EmptyParam) as IHTMLElement;
// Check tag's id and return it if id matches
if AnsiSameText(Tag.id, Id) then
begin
Result := Tag;
Break;
end;
end;
end;
function my.Check_Ping(ip: string): Boolean;
var
MyIdIcmpClient : TIdIcmpClient;
begin
Result := True;
Application.ProcessMessages;
MyIdIcmpClient := TIdIcmpClient.Create(nil);
try
MyIdIcmpClient.ReceiveTimeout := 1000;
MyIdIcmpClient.Host := ip;
MyIdIcmpClient.TTL := 24;
MyIdIcmpClient.Protocol := 1;
try
MyIdIcmpClient.Ping(ip,tid);;
if MyIdIcmpClient.ReplyStatus.BytesReceived=0 then Result := False;
except
Result := False;
//Exit;
end;
finally
MyIdIcmpClient.Free;
end;
end;