Опять возникла проблема
В целом все работает, "without debugging" все срабатывает как и должно, но по F9 дебаггер ругается "access violation" на строчку: Synchronize(CallMainForm);
Код:
unit DLThrd;
interface
.......
type.
TCallMainFormEvent = procedure (Success: Boolean; Response: string) of object;
TDLThrd = class(TThread)
private
FMode: TDlMode;
FCallBack : TCallMainFormEvent;
FQueue: TObjectList<TObject>;
FData: TObject;
FTaskExist: Boolean;
FDL: TIdHTTP;
FSuccess: Boolean;
FResponse: string;
procedure CallMainForm;
procedure CheckUrlProc(AData: TCheckerData);.
protected
procedure Execute; override;
public
constructor Create(Mode: TDlMode; AQueue: TObjectList<TObject>; CallBack: TCallMainFormEvent);
destructor Destroy; override;
end;
var CS: TCriticalSection;
implementation
constructor TDLThrd.Create(Mode: TDlMode; AQueue: TObjectList<TObject>;CallBack: TCallMainFormEvent);
begin
inherited Create(True);
FreeOnTerminate:= True;
FMode:= Mode;
FQueue:= AQueue;
FCallBack:= CallBack;
FData:= nil;
FTaskExist:= False;
FDL:= TIdHTTP.Create(nil);
FDL.HandleRedirects:= True;
end;
destructor TDLThrd.Destroy;
begin
FDL.Free;
inherited Destroy; end;
procedure TDLThrd.Execute;
begin
while not FTaskExist do //Ожидание задачи
begin
CS.Enter;
try
FTaskExist:= FQueue.Count > 0
finally
CS.Leave;
end;
if not FTaskExist then Sleep(333);
end;
while FTaskExist do //Обработка заданий из очереди
begin
CS.Enter;
try
if FQueue.Count > 0 then
FData:= FQueue.Extract(FQueue.First);
finally
CS.Leave;
end;
FTaskExist:= FData <> nil;
if FTaskExist then
begin
case FMode of
dmCheck: CheckUrlProc(TCheckerData(FData));
//другие варианты обработки
end;
Synchronize(CallMainForm); //Дебаггер ругается
end;
end;
end;
procedure TDLThrd.CallMainForm;
begin
CS.Enter;
try
if Assigned(FCallBack) then FCallBack(FSuccess,FResponse);
finally
CS.Leave;
end;
end;
procedure TDLThrd.CheckUrlProc(AData: TCheckerData);
var i: Integer; url: string;
begin
url:= //задаю url
try
FDL.Head(url);
except on E: Exception do begin FSuccess:= False; FResponse:= E.Message; end;
end;
FSuccess:= (FDL.ResponseCode = 200);
FResponse:= FDL.URL.URI+' - '+FDL.ResponseText;
FreeAndNil(AData);
end;
initialization
CS := TCriticalSection.Create;
finalization
CS.Free;
end.
Код:
unit Unit1;
...............
//Процедура которая передается потоку в поле FCallBack:TCallMainFormEvent
procedure TForm1.WriteResult(Success: Boolean; Response: String);
begin
ProgressBar1.Position:= ProgressBar1.Position+1;
ListBox1.Items.Append(Response);
end;