AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

Idhttp per Thread

Ein Thema von Steven2 · begonnen am 13. Aug 2007 · letzter Beitrag vom 14. Aug 2007
Antwort Antwort
Steven2

Registriert seit: 17. Nov 2006
94 Beiträge
 
Delphi 11 Alexandria
 
#1

Idhttp per Thread

  Alt 13. Aug 2007, 00:13
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"
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:
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.

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.
  Mit Zitat antworten Zitat
Steven2

Registriert seit: 17. Nov 2006
94 Beiträge
 
Delphi 11 Alexandria
 
#2

Re: Idhttp per Thread

  Alt 14. Aug 2007, 00:08
ist mir wichtig **PUSH**
  Mit Zitat antworten Zitat
Antwort Antwort


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 06:36 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz