Показать сообщение отдельно
  #13  
Старый 03.01.2019, 11:41
Аватар для Помидоркин
Помидоркин Помидоркин вне форума
Новичок
 
Регистрация: 07.10.2012
Адрес: Дедовск
Сообщения: 97
Версия Delphi: Delphi 7 / XE4
Репутация: 10
По умолчанию

Опять возникла проблема
В целом все работает, "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;
Ответить с цитированием