AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Netzwerke Delphi Problem mit TWebbrowser und "Zeit schätzen"
Thema durchsuchen
Ansicht
Themen-Optionen

Problem mit TWebbrowser und "Zeit schätzen"

Ein Thema von Kathmai · begonnen am 30. Mai 2004
Antwort Antwort
Benutzerbild von Kathmai
Kathmai

Registriert seit: 3. Sep 2003
Ort: Böblingen
21 Beiträge
 
Delphi 11 Alexandria
 
#1

Problem mit TWebbrowser und "Zeit schätzen"

  Alt 30. Mai 2004, 16:08
Hallo !

Ich habe ein kleines Problem das indirekt mit TWebbrowser zu tun hat.

Ich hab ein Programm welches automatisch (PicGrabber) mehre Seiten hintereinander nach Bilder absucht und diese dann downloadet.

Nun will ich mit einer Routine schätzen lassen, wie lange es dauert bis die ganzen Seiten durchgearbeitet wurden.

In einem Testprogramm lädt er nur hintereinander die Seiten ohne irgendwelche Bilder zu laden.

Ich bin schon verzweifeln , weil es nicht richtig funzt oder auch Schwierigkeiten hab das mit TWebbrowser zu verbinden ( andere Dinge wie z.b Datei kopieren etc. ist ja nicht so schwer).

Erst mal hier der Code für die Timer Funktion:

Code:
unit aps_timer;

interface

uses Windows, SysUtils;

type

     TAPS_Timer = class(TObject)
      private

       // Speichert die Zeit per GetTickCount
       fStart_Timer : LongWord;
       fStop_Timer  : LongWord;

       // Zeit die seit Start vergangen ist
       fSart__Ver   : LongWord;


       fPos         : Integer;   // Position in der Liste
       fAktSek      : Integer;   // Speichert die aktuelle Anzahl an Sec. die noch gebraucht wird für die Liste

       fIdle        : Integer;   // Sekunden die noch für die Fertigstellung benötigt wird


       // Rechnet die Millisekunden in Sekunden (Rückgabewert) um
       function msToSec(msValue: LongWord): Integer;

       // Wandelt "Seconds" in String um - Format = hh:mm:ss
       // Erwartet in Seconds die Übergabe in Sekunden
       function SecToTime(Seconds: Longword): String;


       // Gibt die aktuelle Zeit die vergangen ist als Integer wieder
       function CurrentTimeInt: Integer;

      public
       Max    : Integer;   // Anzahl der Einträge der durch zu suchenden TGP-Seiten

       // Ausgabe der Restzeit als String
       function GetRestTime: string;


       // Gibt die aktuelle Zeit die vergangen seit Start des "Grabbens"
       // als String wieder
       function CurrentTimeStr: string;

       // Startet den Timer
       procedure Start;

       // Springt zur nächsten Position in der Liste und berechnet die Neue
       procedure NextPos;

       procedure StartTimer;
       procedure StopTimer;

       // Gibt die aktuelle Position in der Liste der abzufragenden URL's zurück
       function GetPos: Integer;

       // Erzeugen und Zerstören des Objektes
       constructor Create;
       destructor Destroy; override;
     end;





implementation

procedure TAPS_Timer.StopTimer;
begin
 fStop_Timer:= GetTickCount;
end;

//-------------------------------------------------------------------------

procedure TAPS_Timer.StartTimer;
begin
 fStart_Timer:= GetTickCount;
end;

//-------------------------------------------------------------------------

function TAPS_Timer.CurrentTimeInt: Integer;
 Var tmp: Integer;
begin
 tmp:= Round((GetTickCount - fSart__Ver) / 1000);
 Result:=tmp;
end;

//-------------------------------------------------------------------------

function TAPS_Timer.CurrentTimeStr: string;
 Var tmp: Integer;
begin
 tmp:= Round((GetTickCount - fSart__Ver) / 1000);
 Result:=SecToTime(tmp);
end;

//-------------------------------------------------------------------------

function TAPS_Timer.GetPos: Integer;
begin
 Result:= fPos;
end;

//-------------------------------------------------------------------------

procedure TAPS_Timer.Start;
begin
 // Zeit seit Beginn festhalten
 fSart__Ver:= GetTickCount;

 // Position in der Liste auf Anfang setzen
 fPos:=1;

 // Variable für aktuelle Sekunden auf null setzen
 fAktSek:=0; fIdle:=0;
end;

//-------------------------------------------------------------------------

procedure TAPS_Timer.NextPos;
begin
 Inc(fPos);

 fIdle:= fidle+(msToSec(fStop_Timer - fStart_Timer) div fpos);

end;

//-------------------------------------------------------------------------

function TAPS_Timer.GetRestTime: string;
begin
 fAktSek:= fidle * (Max - fpos);
 result:=SecToTime(fAktSek);
end;

//-------------------------------------------------------------------------

function TAPS_Timer.SecToTime(Seconds: Longword): String;
 Var
    rest, xx, hh, mm, ss: integer;
    thh, tmm, tss: string;

begin
 xx:=seconds;

 hh:= xx div 3600;   // 1 Stunde = 3600 Sekunden
 rest:=xx mod 3600;  // Rest = Überbleibende Sekunden

 xx:=rest;
 mm:= xx div 60;     // 1 Minute = 60 Sekunden
 rest:=xx mod 60;    // Rest = Überbleibende Sekunden
 ss:=rest;

 if hh < 10 then thh:='0'+IntToStr(hh)
 else thh:= IntToStr(hh);

 if mm < 10 then tmm:='0'+IntToStr(mm)
 else tmm:= IntToStr(mm);

 if ss < 10 then tss:='0'+IntToStr(ss)
 else tss:= IntToStr(ss);

 result:=thh+':'+tmm+':'+tss;
end;

//-------------------------------------------------------------------------

function TAPS_Timer.msToSec(msValue: LongWord): Integer;
begin
 Result:= Round(msValue / 1000);
end;

//-------------------------------------------------------------------------

constructor TAPS_Timer.Create;
begin
 // Als erstes kommt das geerbte Create !
 inherited Create;

end;

//-------------------------------------------------------------------------

destructor TAPS_Timer.Destroy;
begin


 // Als letztes kommt das geerbte Destroy !
 inherited Destroy;
end;

end.
Hab die Klasse schon mehrmals Umgeschrieben aber nix hilft - ich weiss nicht mehr weiter.

Hier noch das einbinden.

Code:
procedure TForm1.Button1Click(Sender: TObject);
begin
 APS_Timer.Max:=lbox1.Items.Count-1; //Listbox mit Temp-URL's
 APS_Timer.Start;
 timer1.Enabled:=True;
 timer2.Enabled:=True;

 web.Navigate(lbox1.Items.Strings[APS_Timer.GetPos-1]);

end;

procedure TForm1.webDocumentComplete(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
begin

 APS_Timer.StopTimer;
 if APS_Timer.GetPos >= APS_Timer.Max then
 begin
  timer1.Enabled:=False;
  timer2.Enabled:=False;
  showmessage('Fertig...');
  exit;
 end;
 
 // Zur nächsten Position in der Liste springen - Setzt auch die Pos Variable
 APS_Timer.NextPos;

 label2.caption:='Link: '+inttostr(APS_Timer.GetPos)+'/'+inttostr(APS_Timer.Max);

 web.Navigate(lbox1.Items.Strings[APS_Timer.GetPos-1]);

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 APS_Timer:= TAPS_Timer.Create;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 APS_Timer.Free;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
 // Das ist diese blöde funktion
 Label1.Caption:='Restzeit: '+APS_Timer.GetRestTime;
end;

function TForm1.webShowMessage(hwnd: Cardinal; lpstrText,
  lpstrCaption: PWideChar; dwType: Integer; lpstrHelpFile: PWideChar;
  dwHelpContext: Integer; var plResult: Integer): HRESULT;
begin
 // verhindert das der TWebbrowser irgendwelche Meldungen anzeigt
 // wie etwas ActiveX oder JavaScript Meldungen
 Result:=S_OK;
end;

procedure TForm1.Timer2Timer(Sender: TObject);
begin
 label4.caption:='Abgelaufene Zeit: '+APS_Timer.CurrentTimeStr;
end;

procedure TForm1.webBeforeNavigate2(ASender: TObject;
  const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
  Headers: OleVariant; var Cancel: WordBool);
begin
 APS_Timer.StartTimer;
end;

end.

So... Puhh das wars
Mein Problem ist jetzt, daß ich nicht die richtige Zeit bekomme und dann wird zwar die Zeit einmal im Timer1 für die Restzeit ausgegeben (die sich aber auch nur ändert wenn TWebbrowser ein Dokument geladen hat (mitAPS_Timer.NextPos) und Timer2 stellt die bisher abgelaufene Zeit dar.

Das wird aber

1.) Nicht richtig berechnet und
2.) Wenn Die Seite "hängt" bzw. länger brauch um zu laden wird das nicht berücksichtigt
3.) Die Restzeit verringert sich zu schnell also bei Aufruf der 1. URL ist die Zeit z.b. 00:04:00 beim 2. URL schon 00:03:22

Hat jemand da ne Idee?

Danke schonmal im voraus !

cya
Kathmai

PS: Der TWebbrowser ist von/mit embeddedweb
  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 11:46 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