unit XWebLoader;

interface

uses Classes, SysUtils, SyncObjs, IdHTTP, IdComponent, XWebDataTypes;

type

  TOnFinishLoadEvent = procedure(Sender: TObject; LoaderMessage: TXWebLoaderMessage) of object;
  TOnErrorLoadEvent = procedure(Sender: TObject; LoaderMessage: TXWebLoaderMessage) of object;
  TOnRemoveEvent = procedure(Sender: TObject) of object;

  TXWebLoader = class(TThread)
  strict private
   FCS: TCriticalSection;
   FHTTP: TIdHTTP;
   FXWebLink: string;
   FParameter: string;
   FCookie: string;
   FDeviceName: string;
   FMessageID: Integer;
   FDigit: Integer;
   FGoLoading: Boolean;
   FOnFinish: TOnFinishLoadEvent;
   FOnError: TOnErrorLoadEvent;
   FOnRemove: TOnRemoveEvent;
   FMsg: TXWebLoaderMessage;
   procedure SyncOnFinish;
   procedure SyncOnError;
   procedure CheckAbort(Sender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
  protected
    procedure Execute; override;
    procedure Remove(Sender: TObject);
  public
    constructor Create(Suspended: Boolean);
    destructor Destroy; override;
    procedure GetData(const XWebLink,Parameter,Cookie,DeviceName :string; MessageID,Digit: Integer);
    property OnFinish: TOnFinishLoadEvent read FOnFinish write FOnFinish;
    property OnError: TOnErrorLoadEvent read FOnError write FOnError;
    property OnRemove: TOnRemoveEvent read FOnRemove write FOnRemove;
  end;



implementation

{ TXWebLoader }

procedure TXWebLoader.CheckAbort(Sender: TObject; AWorkMode: TWorkMode;
  AWorkCount: Int64); // auch ein Versuch den Socket Error der Indys beim Programm Beenden zu kompensieren
begin // war ein Tipp in einem Beitrag. Hier kommt das Programm gar nicht an. Die Threads werden
  if Terminated then // einfach abgewürgt
    FHTTP.Disconnect;
end;

constructor TXWebLoader.Create(Suspended: Boolean);
begin
  inherited Create(Suspended);
  FCS:= TCriticalSection.Create;
  FHTTP:= TIdHTTP.Create;
  FHTTP.OnWork:= CheckAbort;
  FMsg:= TXWebLoaderMessage.Create;
  Self.OnTerminate:= Remove;
end;

destructor TXWebLoader.Destroy;
begin
  FHTTP.Free;
  FMsg.Free;
  FreeAndNil(FCS);
  inherited;
end;

procedure TXWebLoader.Execute;
var
  XWebParameter: TStringStream;
  ResponseStream: TStringStream;
  sl: TStringList;
begin
  inherited;
  if not Terminated then
  begin
    sl:= TStringList.Create;
    try
      XWebParameter:= TStringStream.Create(FParameter);
      try
        ResponseStream:= TStringStream.Create;
        try
          try
            FHTTP.Request.CustomHeaders.Add(FCookie);
            if FParameter = '' then
              FHTTP.Get(FXWebLink,ResponseStream)
            else
              FHTTP.Post(FXWebLink,XWebParameter,ResponseStream);
            ResponseStream.Position:= 0;
            sl.LoadFromStream(ResponseStream,TEncoding.UTF8);
            FMsg.Data:= sl.Text;
            Synchronize(SyncOnFinish);
          except
            on e: Exception do
              begin // evt. noch weitere Informationen in Stringlist oder Klasse dafür ?
                FMsg.Data:= e.Message;
                Synchronize(SyncOnError);
              end;
          end;
        finally
          ResponseStream.Free;
        end;
      finally
        XWebParameter.Free;
      end;
    finally
      sl.Free;
    end;
    Sleep(100); // extra eingefügt
  end;
end;

procedure TXWebLoader.GetData(const XWebLink, Parameter, Cookie, DeviceName :string; MessageID,Digit: Integer);
begin
  FCS.Enter;
  try
    FXWebLink:= XWebLink;
    FParameter:= Parameter;
    FCookie:= Cookie;
    FDeviceName:= DeviceName;
    FMessageID:= MessageID;
    FDigit:= Digit;
    FMsg.ID:= FMessageID;
    FMsg.DeviceName:= FDeviceName;
    FMsg.Digit:= FDigit;
    Self.Start;
  finally
    FCS.Leave;
  end;
end;

procedure TXWebLoader.SyncOnError;
begin
  FCS.Enter;
  try
    if Assigned(FOnError) then
      FOnError(Self,FMsg);
  finally
    FCS.Leave;
  end;
end;

procedure TXWebLoader.SyncOnFinish;
begin
  FCS.Enter;
  try
    if Assigned(FOnFinish) then
      FOnFinish(Self,FMsg);
  finally
    FCS.Leave;
  end;
end;

procedure TXWebLoader.Remove(Sender: TObject);
begin
  FCS.Enter;
  try
    if Assigned(FOnRemove) then
      FOnRemove(Self);
  finally
    FCS.Leave;
  end;
end;

end.