我的应用程序可以从memo1中的每个网址下载一张图片。 它使用idhttp.get并有一个跳过按钮。跳过后,它会下载下一张图片。
Q1:你是否有代码放入析构函数中,"是什么代码?终止"和"等待"? 我在另一个网站上发现了这个:
destructor thread.destroy;
begin
try
Terminate;
If HTTP.Connected then HTTP.Disconnect;
finally
WaitFor;
FreeAndNil(HTTP);
end;
inherited;
end;
Q2:如何调用析构函数并使其正常工作?
问题3:您是否有提示(特别是安全问题)和其他代码?
我的申请代码:
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.
答案 0 :(得分:6)
由于你在GUI(=主线程)中使用IdHttp
并且Indy
被阻止,你有两个选择:a)将IdAntifreeze
与消息结合使用(只需删除表格上的组件),b)使用线程。
不要使用Application.Processmessages
因为它会导致奇怪的副作用。
现在回答你的问题:
Q1 :您在互联网上找到的代码实施的解决方案b)所以这不适用于您当前的代码
Q2 :与Q1相同
Q3 :这是一个正确实现解决方案的版本a)
这段代码仍然不是100%完美,因为它没有实现禁用/启用starttransfer和skiptransfer按钮的逻辑(我把它留作练习:))。
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档案:
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