0

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.
  • 1
    Why do you have a class named `thread` that isn't a `TThread`? It's a generic `TObject` descendant that basically does nothing except create the *global* instance of `TIdHTTP`. You also never assign the `IdHttp1.OnWork` event to anything, so `TForm1.IdHTTP1Work` will never be called, so it can't disconnect. – Ken White Dec 04 '12 at 13:41
  • @KenWhite: I suspect he dropped a IdHttp on his form and implemented the event via the designer. The naming of the "thread" class is really confusing indeed :) – whosrdaddy Dec 04 '12 at 13:45
  • the application is working like a charm with the code i pasted here. Just the destructor doesn't work. – Werner Balleis Dec 04 '12 at 14:00
  • Are you thinking you are really using threads in your code?? – whosrdaddy Dec 04 '12 at 14:17
  • I can't see where your class `thread` is used in your example. Please show a test case where your destructor fails. – LU RD Dec 04 '12 at 14:27
  • @ whosrdaddy: Thanks to your fast answer i know that i don't use threads. But the amazing thing is that the code works. Before i simply disconnected idhttp1 and it raised exceptions and the next picture didn't download. Do you have code for me to use threads? – Werner Balleis Dec 04 '12 at 14:29
  • 1
    @whosrdaddy: Except he's clearly creating a different one than the one dropped on the form in the `thread` class. (The form has `IdHTTP1`, but there's an `http` declared and created in the code, which is then just discarded when the `IdHTTP1` is assigned to it in `startButtonClick`.) This code really is something of a mess, I think. – Ken White Dec 04 '12 at 14:45
  • @KenWhite: that's why I posted a cleaner version :) – whosrdaddy Dec 04 '12 at 14:48
  • @whosrdaddy - probably a good idea to also use the Delphi code formatter before pasting. – Leonardo Herrera Dec 05 '12 at 14:04

1 Answers1

6

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
whosrdaddy
  • 11,720
  • 4
  • 50
  • 99
  • 2
    +1. Much cleaner, and `TIdAntiFreeze` was specifically designed to keep the GUI responsive without calling `Application.ProcessMessage` (ugh; I felt a little sick just typing it ). – Ken White Dec 04 '12 at 15:23
  • 1
    @whosrdaddy: THANK YOU for your code. I love the idea of option a. g2g now I will thoroughly test your code later. – Werner Balleis Dec 04 '12 at 15:36