Fortschrittanzeige bei idhttp upload

[Kpa]

Hallo!
ich hab mich jetzt so nach und nach an mien uploadtool rangewurstelt und es funktioniert auch soweit!
jetzt hab ich aber ein weiteres problem und zwar: wie funktioniert das mit der fortschrittsanzeige?
kann mir der jemand einen tip geben?

ich hab mal das ganze projekt angehängt, ist vielleicht das einfachste!

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, idmultipartformdata, IdBaseComponent, IdComponent,
  IdTCPConnection, IdTCPClient, IdHTTP, Psock, NMHttp, IdAntiFreezeBase,
  IdAntiFreeze, ComCtrls, Menus;

type
  TForm1 = class(TForm)
    Button1: TButton;
    IdHTTP1: TIdHTTP;
    Memo1: TMemo;
    Button2: TButton;
    ListBox1: TListBox;
    OpenDialog1: TOpenDialog;
    NMHTTP1: TNMHTTP;
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    Button3: TButton;
    IdAntiFreeze1: TIdAntiFreeze;
    GroupBox3: TGroupBox;
    ProgressBar1: TProgressBar;
    StatusBar1: TStatusBar;
    PopupMenu1: TPopupMenu;
    Deletefilefromlist1: TMenuItem;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Deletefilefromlist1Click(Sender: TObject);
    procedure Idhttp1WorkBegin(Sender: TObject; AWorkMode: TWorkMode; const AWorkCountMax: Integer);
    procedure Idhttp1Work(Sender: TObject; AWorkMode: TWorkMode; const AWorkCount: Integer);
  private

  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}


procedure TForm1.Button1Click(Sender: TObject);
var
  Stream: TIdMultiPartFormDataStream;
  StringStream: TStringStream;

begin
Stream := TIdMultiPartFormDataStream.Create;
StringStream := TStringStream.Create('');
try
  Stream.AddFile('file',listbox1.Items[0], 'multipart/form-data');
  IdHTTP1.Post('http://filecoastcom.h1072562.serverkompetenz.net/submit.php', Stream, StringStream);
  Memo1.Text := StringStream.DataString;

finally
  Stream.Free;
  StringStream.Free;
end;
end;

// ########## Statusbalken ############ //
procedure TForm1.Idhttp1WorkBegin(Sender: TObject; AWorkMode: TWorkMode; const AWorkCountMax: Integer);
begin
  ProgressBar1.Max := AWorkCountMax;
  ProgressBar1.Position := 0;
end;
procedure TForm1.Idhttp1Work(Sender: TObject; AWorkMode: TWorkMode; const AWorkCount: Integer);
Var
  S: String;
  TotalTime: TDateTime;
  H, M, Sec, MS: Word;
  DLTime: Double;
  STime: TDateTime;
  AverageSpeed: Double;
begin
Application.ProcessMessages;
  //Errechnen der Transfergeschwindigkeit:
  TotalTime :=  Now - STime;
  DecodeTime(TotalTime, H, M, Sec, MS);
  Sec := Sec + M * 60 + H * 3600;
  DLTime := Sec + MS / 1000;
  if DLTime > 0 then
    AverageSpeed := (AWorkCount / 1024) / DLTime;
  S := FormatFloat('0.00 KB/s', AverageSpeed);
  case AWorkMode of
       wmWrite :StatusBar1.Panels[1].Text := 'Uploade speed ' + S;
  end;

  //Aktualisieren der Fortschrittsanzeige:
  ProgressBar1.Position := AWorkCount;
  Form1.ProgressBar1.Refresh;
end;
// ########## ENDE ############ //



procedure TForm1.Button2Click(Sender: TObject);
var
 anzahl_listbox: integer;
begin
  opendialog1.Execute;
  anzahl_listbox := listbox1.Items.Count;
  listbox1.Items[anzahl_listbox] := opendialog1.FileName;

  anzahl_listbox := listbox1.Items.Count;
  NMHTTP1.Get('http://www.filecoast.com/uploadtool/uploadtool_serverwahl.php');


end;

procedure TForm1.Button3Click(Sender: TObject);
begin
listbox1.DeleteSelected;
end;

procedure TForm1.Deletefilefromlist1Click(Sender: TObject);
begin
 listbox1.DeleteSelected;
end;

end.

DANKE für eure hilfe!

[SirThornberry]

schau mal hier:
http://www.delphipraxis.net/internal...=563250#563250
den Beitrag hab ich in letzter Zeit ein paar mal verlinkt, es sollten also auch noch einige andere Beiträge zu dem Thema zu finden sein.

[Kpa]

ok! nur leider ist deine klasse da etwas viel input auf einmal für mich

wie binde ich die klasse denn ein? eine zweite unit erstellen und an die erste ranhängen hab ich gemacht. und dann auch die in deinen code eingefügt zwischen "implementation" und "end."

:?: was muss ich nun noch an meinem code ändern damit es funktioniert :?:

dickes danke an dich aber schonmal!

[SirThornberry]

für deinen Fall müsstest du meine Klasse von TStringStream ableiten. Und anstelle des TStringStream dann eben diese Klasse verwenden.

[Kpa]

habe in meiner unit1 "stringstream" durch dein "TfilestreamEx" ersetzt.
jetzt bekomme ich aber schon gleich bei deinem code hier die meldung:

TStreamTransferEvnt = procedure(Sender: TStream; AMethodRes: LongInt) of Object;
undeclared identifier: TStream


was heisst das?
oh man delphi ist glaub ich soviel komplizierter als php.

[Kpa]

ok habs jetzt irgendwie hingekriegt...

nun hab ich ein neues problem:
Die seite auf der die datei hochgeladen wird gibt mir danach den downloadlink aus. allerdings kriege ich den kompletten html code mitgesendet.
wie ist es möglich das der string so beschnitten wird das am ende nur der downloadlink übrigbleibt?

beispiel:
aus

Delphi-Quellcode:

<html>
[...]



[url="http://www.filecoast.com"][img]http://www.filecoast.com/artwork/filecoast.gif[/img]</img>[/url]   



Downloadlink: 

[url='http://www.filecoast.com?pg=file&c1=2324465428&c2=CrRPtE5N']Click here to go to the download site.[/url]

wird:

Delphi-Quellcode:

Downloadlink: [url]http://www.filecoast.com?pg=file&c1=2324465428&c2=CrRPtE5N[/url]

bei php könnt ich da wohl einiges mit explode hinkriegen, aber sowas hab ich bei delphi noch nicht entdeckt.

vielen dank für eure hilfe!

[r2c2]

Geht mit den String-Funktionen von Delphi...

mfg

Christian

[SirThornberry]

bitte mach für das StringProblem einen neuen Thead

[Kpa]

naja nun klappts! danke euch allen!


hab nun ein weiteres problem, aber das mach ich dann auch in dieses topic da es direkt etwas mit dem upload der datei zu tun hat.

und zwar: wie breche ich den upload richtig ab?

ich habe einen "stop" button und wenn man darauf klickt wird
idhttp1.DisconnectSocket;
ausgeführt.
das ganze bricht dann auch mit der meldung "connection lost gracefully" ab. nur leider wird der teil der bereits übertragenden daten dennoch vom script verarbeitet.
wie kann ich das so abbrechen das nur komplette dateien an das script übertragen werden?