деструктор при остановке idhttp.get (indy, delphi)

Question

Мое приложение может загружать одну картинку с каждого URL-адреса в memo1. Он использует idhttp.get и имеет skipbutton. После пропустить он загружает следующую картинку.

Q1: У вас есть код для ввода в деструктор и что такое код для «terminate» и «waitfor»? Я нашел это на другом сайте:

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

Q2: Как вызвать деструктор и заставить его работать?

Q3: Есть ли у вас подсказки (особенно проблемы с безопасностью) и дополнительные строки кода?

код моего приложения:

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. 

Answer 1

Поскольку ваши использует IdHttp из графического интерфейса (= основной поток) и Indy преграждает, у вас есть два варианта: а) использовать IdAntifreeze в сочетании с сообщениями (просто отбросьте компонент в форме), б) используйте потоки.

НЕApplication.Processmessages, так как это приведет к странным побочным эффектам.

теперь ответить на ваши вопросы:

Q1: код, который вы нашли на интернет-реализованного решения б), так что это не относится к текущему коду

Q2: такой же, как Q1

Q3: вот версия, что правильно реализует решение а)

Этот код по-прежнему не идеален на 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