Ich versuche eine Phpdatei mehrfach über idHttp mit Threads abzufragen um dann den Inhalt der Abfrgae auszulesen.

Die Werte die an die Phpdatei übermittelt werden stehen in einer Splate eines Stringgrids.
Ich möchte die Werte die im Stringgrid stehen Zeile für Zeile(oder gleich mehrere übergeben) durchgehen und an die Phpdatei übergeben.
Das klappt wenn ich den Button "von Hand klicke"

markieren

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
begin
  msg.Lines.Append('--------------------------');
  msg.Lines.Append('Starte Download ...');
  download('http://localhost/tools/checkhttp.php?name='+ edit1.text);
  msg.Lines.Append('Download abgeschlossen');
  SpeedLabel.Caption := 'Fertig';
  Button2.Click;
end;

Mein Problem ist das dazu immer eine Datei heruntergeladen wird und das das je nach Wert kürzer oderlänger dauern kann und es zu Fehlermeldungen kommen kann.
Außerdem nutze ich dadurch die Thread Technik nicht wirklch weil ich ja immer nur einen Wert an das Script übergebe
Ich habe wenig Ahnung von Threads, kann sich das mal jemand ansehen und Kritik äußern und mir einen Rat geben?

Ich mache das so:

zusammenfalten · markieren

Delphi-Quellcode:

unit UUpdater;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdHTTP, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  xpman, Gauges, ComCtrls, UDownThread, zlib, Grids, BaseGrid, AdvGrid;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Status: TLabel;
    SpeedLabel: TLabel;
    msg: TMemo;
    Progress: TProgressBar;
    Edit1: TEdit;
    Button2: TButton;
    Button3: TButton;
    StringGrid1: TAdvStringGrid;
    Button4: TButton;
    Edit2: TEdit;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
    StartTime: Cardinal;
    procedure download(wwwurl: string);
    procedure OnThreadWork(Sender: TThread; AWorkCount: Integer);
    procedure OnThreadWorkBegin(Sender: TThread; AWorkCountMax: Integer);
   // procedure DownResultHandle(Sender: TObject; ResponseCode: Integer);

  public
    { Public declarations }
  end;

var
  Form1: TForm1;
   abbruch :Boolean;
    ndx:integer;
implementation

{$R *.dfm}

procedure TForm1.OnThreadWork(Sender: TThread; AWorkCount: Integer);
var
  speed: single;
begin
  Progress.Position := AWorkCount;
  speed := AWorkCount/(GetTickCount - StartTime + 1); //+1 um DivbyZero zu verhindern
  Status.caption := Format('%f s|%.2f KB/s', [(((Sender as TDownThread).WorkCountMax-AWorkCount)/1000)/speed, speed]);
end;

procedure TForm1.OnThreadWorkBegin(Sender: TThread; AWorkCountMax: Integer);
begin
  Progress.Max := AWorkCountMax;
  msg.Lines.Append(FormatFloat('Dateigröße: 0, Bytes', AWorkCountMax));
  StartTime := GetTickCount;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  msg.Lines.Append('--------------------------');
  msg.Lines.Append('Starte Download ...');
  download('http://localhost/tools/checkhttp.php?name='+ edit1.text);
  msg.Lines.Append('Download abgeschlossen');
  SpeedLabel.Caption := 'Fertig';
  Button2.Click;
end;




procedure TForm1.download(wwwurl: string);
var
  path: string;
  Down: TDownThread;
begin
  path := ExtractFilePath(paramstr(0)) + 'Update\tmp.txt';
  Status.Caption := '';
  Progress.Position := 0;

  msg.Lines.Append('Downloade Datei ' + path);

  Down := TDownThread.Create(true);
  with Down do
  begin
    FreeOnTerminate := true;
    OnWork := OnThreadWork;
    OnWorkBegin := OnThreadWorkBegin;
  // OnFinish := DownResultHandle;
    URL := wwwurl;
    FileName := path;
    Resume;
    end;
end;



procedure TForm1.FormCreate(Sender: TObject);
begin
ndx:=1;
end;

procedure TForm1.Button2Click(Sender: TObject);

var

s:string;
begin

abbruch := false;

      while (ndx < StringGrid1.RowCount - 1) and (not abbruch) do // war sonst 0
    begin
    edit1.text:= StringGrid1.Cells[4, ndx]; //name
   abbruch := true;
   inc(ndx);
  end;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  abbruch := True;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
StringGrid1.LoadFromCSV(ExtractFilePath(Application.ExeName) + 'komma.csv');
end;

end.

zusammenfalten · markieren

Delphi-Quellcode:

unit UDownThread;

interface

uses
  Windows, SysUtils, Classes, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP, IdBaseComponent;

type
  //external prototypes
  TOnWorkBeginEvent = procedure(Sender: TThread; AWorkCountMax: Integer) of object;
  TOnWorkEvent = procedure(Sender: TThread; AWorkCount: Integer) of object;
  TOnFinish = procedure(Sender: TObject; ResponseCode: Integer) of object;

  TDownThread = class(TThread)
  private
    { Private declarations }
    HTTP: TIdHTTP;
    //external
    FOnWorkBeginEvent: TOnWorkBeginEvent;
    FOnWorkEvent: TOnWorkEvent;
    FOnFinish: TOnFinish;

    FResponseCode: Integer;
    FURL: string;
    FFileName: String;
    FWorkCountMax: Integer;
    FWorkCount: Integer;
    procedure InternalOnWork(Sender: TObject; AWorkMode: TWorkMode; AWorkCount: Integer);
    procedure InternalOnWorkBegin(Sender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Integer);
    procedure DoNotifyFinish;
    procedure DoNotifyWorkBegin;
    procedure DoNotifyWork;
  protected
    procedure Execute; override;
  public
    { Public declarations }
    constructor Create(CreateSuspended: Boolean);
    destructor Destroy; override;
    property URL: String read FURL write FURL;
    property FileName: String read FFileName write FFileName;
    property WorkCountMax: Integer read FWorkCountMax;
    property OnWork: TOnWorkEvent read FOnWorkEvent write FOnWorkEvent;
    property OnWorkBegin: TOnWorkBeginEvent read FOnWorkBeginEvent write FOnWorkBeginEvent;
    property OnFinish: TOnFinish read FOnFinish write FOnFinish;
  end;

implementation



constructor TDownThread.Create;
begin
  inherited Create(True);
  HTTP := TIdHTTP.Create(nil); // HTTP-Kompo wird dynamisch erstellt
  with HTTP do
  begin
    OnWorkBegin := InternalOnWorkBegin;
    OnWork := InternalOnWork;
// HTTP.IOHandler.RecvBufferSize:=4096; //löst AccessViolation aus !?!
  end;
end;

destructor TDownThread.Destroy;
begin
  HTTP.Free;
  inherited Destroy;
end;

procedure TDownThread.Execute;
var
  lStream: TFileStream;
begin
  lStream:=TFileStream.Create(FileName, fmCreate or fmShareDenyNone);
  try
    HTTP.Get(FURL, lStream);
    FResponseCode := HTTP.ResponseCode;
  finally
    if Assigned(lStream) then lStream.Free;
  end;
  Synchronize(DoNotifyFinish);
end;

procedure TDownThread.DoNotifyFinish;
begin
  if Assigned(OnFinish) then OnFinish(Self, FResponseCode);
end;
//##############################################################################
procedure TDownThread.InternalOnWorkBegin(Sender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Integer);
begin
  FWorkCountMax := AWorkCountMax;
  Synchronize(DoNotifyWorkBegin);
end;

procedure TDownThread.DoNotifyWorkBegin;
begin
  if Assigned(OnWorkBegin) then OnWorkBegin(Self, FWorkCountMax);
end;
//##############################################################################
procedure TDownThread.InternalOnWork(Sender: TObject; AWorkMode: TWorkMode; AWorkCount: Integer);
begin
  FWorkCount := AWorkCount;
  Synchronize(DoNotifyWork);
end;

procedure TDownThread.DoNotifyWork;
begin
  if Assigned(OnWork) then OnWork(Self, FWorkCount);
end;

end.

ist mir wichtig **PUSH**