Werner Balleis
Werner Balleis

Reputation: 9

destructor when stopping idhttp.get ( indy, delphi)

My application can download one picture from every url in memo1. It uses idhttp.get and has a skipbutton. After skip it downloads the next picture.

Q1: Do you have code to put into the destructor and what is the code for " terminate" and "waitfor"? I found this on another website:

destructor thread.destroy;
begin
try
Terminate;
If HTTP.Connected then HTTP.Disconnect;
finally
WaitFor;
FreeAndNil(HTTP);
end;
inherited;
end;

Q2: How do I call the destructor and make it work?

Q3: Do you have hints (especially security concerns) and additional lines of code?

the code of my application:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection,
  IdTCPClient, IdHTTP;

type
       thread = class
  public
      Constructor Create; overload;
      Destructor  Destroy; override;
  end;

  TForm1 = class(TForm)
    IdHTTP1: TIdHTTP;
    Memo1: TMemo;
    Memo2: TMemo;
    Memo3: TMemo;
    startbutton: TButton;
    skipbutton: TButton;

    procedure startbuttonClick(Sender: TObject);
    procedure skipbuttonClick(Sender: TObject);
    procedure IdHTTP1Work(Sender: TObject; AWorkMode: TWorkMode;
      const AWorkCount: Integer);

         end;
var
  Form1: TForm1;
     http: tidhttp;
     s: boolean;
implementation

{$R *.dfm}

            constructor thread.Create;
begin
      HTTP := TIdHTTP.Create(nil);
      inherited ;
end;

           destructor thread.destroy;
begin
try

If HTTP.Connected then HTTP.Disconnect;
finally
FreeAndNil(HTTP);
end;
inherited;
end;


procedure TForm1.startbuttonClick(Sender: TObject);
var
i: integer;
  fs : TFileStream ;
begin
for i:= 0 to memo1.lines.count-1 do begin
s:= false;
   fs := TFileStream.Create(inttostr(i)+'abc.jpg', fmCreate);
   http:= idhttp1;
   try
   try
HTTP.Get(memo1.lines[i],fs);
memo2.Lines.add(memo1.Lines[i]);
except
on E: Exception do
begin
memo3.lines.add(' ha ha ha not working   '+syserrormessage(getlasterror));
end;
end;
finally
fs.free;
end;
end;

  end;

procedure TForm1.skipbuttonClick(Sender: TObject);
    begin
s:=true;
end;

procedure TForm1.IdHTTP1Work(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCount: Integer);
begin
application.ProcessMessages;

     if s = true then
http.Disconnect;

end;

end.

Upvotes: 0

Views: 2004

Answers (1)

whosrdaddy
whosrdaddy

Reputation: 11860

Since your are using IdHttp from the GUI (= main thread) and Indy is blocking, you have two options: a) use IdAntifreeze in combination with messages (just drop the component on the form), b) use threads.

Do NOT use Application.Processmessages as it will lead to strange side effects.

now to answer your questions:

Q1: the code you found on the internet implemented solution b) so this is not applicable for your current code

Q2: same as Q1

Q3 : here is a version that correctly implements solution a)

This code is still not 100% perfect as it does not implement logic for disabling/enabling the starttransfer and skiptransfer buttons (I leave that as an exercise for you :) ).

unit Unit16;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdAntiFreezeBase, IdAntiFreeze, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP;

const
  WM_TRANSFER = WM_USER + 1;

type
  TForm1 = class(TForm)
    IdHTTP1: TIdHTTP;
    IdAntiFreeze1: TIdAntiFreeze;
    Memo1: TMemo;
    Btn_start: TButton;
    Btn_skip: TButton;
    Memo2: TMemo;
    procedure IdHTTP1Work(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
    procedure Btn_startClick(Sender: TObject);
    procedure Btn_skipClick(Sender: TObject);
  private
    { Private declarations }
    Transferring : Boolean;
    UrlIndex : Integer;
    procedure NextTransfer(var msg : TMessage); message WM_TRANSFER;
    procedure StartTransfer;
    procedure DoTransfer;
    procedure SkipTransfer;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
procedure TForm1.NextTransfer(var msg: TMessage);
begin
 DoTransfer;
end;

procedure TForm1.SkipTransfer;
begin
 Transferring := false;
end;

procedure TForm1.StartTransfer;
begin
 UrlIndex := 0;
 DoTransfer;
end;

procedure TForm1.DoTransfer;

var
  Url : String;
  Stream : TStringStream;

begin
 if UrlIndex < Memo1.Lines.Count then
  begin
   Url := Memo1.Lines[UrlIndex];
   Memo2.Lines.Add(Format('getting data from URL: %s', [Url]));
   Inc(UrlIndex);
   Transferring := True;
   try
    Stream := TStringStream.Create;
    try
     IdHttp1.Get(Url, Stream);
     Memo2.Lines.Add(Format('Data: "%s"',[Stream.DataString]));
    finally
     Stream.Free;
    end;
   except
    on E: Exception do
     begin
      Memo2.Lines.Add(Format('error during transfer: %s', [E.Message]));
     end;
   end;
   Transferring := False;
   PostMessage(Handle, WM_TRANSFER, 0, 0);
  end;
end;

procedure TForm1.Btn_startClick(Sender: TObject);
begin
 Memo2.Lines.Add('starting transfer');
 StartTransfer;
end;

procedure TForm1.Btn_skipClick(Sender: TObject);
begin
 Memo2.Lines.Add('skipping current transfer');
 SkipTransfer;
end;

procedure TForm1.IdHTTP1Work(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
begin
  Memo2.Lines.Add('work event');
 if not Transferring and (AWorkMode = wmRead) then
 try
  Memo2.Lines.Add('disconnecting peer');
  IdHttp1.Disconnect;
 except
 end;
end;

end.

DFM file:

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 290
  ClientWidth = 707
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Memo1: TMemo
    Left = 92
    Top = 12
    Width = 213
    Height = 257
    Lines.Strings = (
      'http://stackoverflow.com'
      'http://www.google.com'
      'http://www.hardocp.com'
      '')
    TabOrder = 0
    WordWrap = False
  end
  object Btn_start: TButton
    Left = 8
    Top = 128
    Width = 75
    Height = 25
    Caption = 'Btn_start'
    TabOrder = 1
    OnClick = Btn_startClick
  end
  object Btn_skip: TButton
    Left = 8
    Top = 159
    Width = 75
    Height = 25
    Caption = 'Btn_skip'
    TabOrder = 2
    OnClick = Btn_skipClick
  end
  object Memo2: TMemo
    Left = 320
    Top = 12
    Width = 373
    Height = 257
    TabOrder = 3
    WordWrap = False
  end
  object IdHTTP1: TIdHTTP
    OnWork = IdHTTP1Work
    AllowCookies = True
    ProxyParams.BasicAuthentication = False
    ProxyParams.ProxyPort = 0
    Request.ContentLength = -1
    Request.ContentRangeEnd = -1
    Request.ContentRangeStart = -1
    Request.ContentRangeInstanceLength = -1
    Request.Accept = 'text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8'
    Request.BasicAuthentication = False
    Request.UserAgent = 'Mozilla/3.0 (compatible; Indy Library)'
    Request.Ranges.Units = 'bytes'
    Request.Ranges = <>
    HTTPOptions = [hoForceEncodeParams]
    Left = 24
    Top = 16
  end
  object IdAntiFreeze1: TIdAntiFreeze
    Left = 16
    Top = 72
  end
end

Upvotes: 6

Related Questions