Reputation: 9
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
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