|
Antwort |
Registriert seit: 3. Sep 2003 Ort: Böblingen 21 Beiträge Delphi 11 Alexandria |
#1
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:
Hab die Klasse schon mehrmals Umgeschrieben aber nix hilft - ich weiss nicht mehr weiter.
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. 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 |
Zitat |
Ansicht |
Linear-Darstellung |
Zur Hybrid-Darstellung wechseln |
Zur Baum-Darstellung wechseln |
ForumregelnEs 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
|
|
Nützliche Links |
Heutige Beiträge |
Sitemap |
Suchen |
Code-Library |
Wer ist online |
Alle Foren als gelesen markieren |
Gehe zu... |
LinkBack |
LinkBack URL |
About LinkBacks |