Auf IdHttp.Get warten! [Gelöst](siehe Edit)

[Deadinpac]

Moin,

ich bräuchte mal wieder eure Hilfe!

Ich habe hier ein Code womit ich mir den Quelltext ca. 30 mal von einer Webseite hole.
Dann lasse ich in einer Listbox die Einträge färben. Klappt ja auch eigentlich ganz gut
nur beim Refresh nicht.

Und Ich denke mir mal das es an der IdHttp liegt da er mir den Quelltext nicht aktualisiert
oder nicht schnell genug holt.

Delphi-Quellcode:

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
begin
Juser := ListBox1.Items[Index];
Memo1.Text:= IdHttp1.Get('http://www.jappy.de/user/'+Juser);
  if Pos ('<a href="/line/start/'+Juser+'" target="' , Memo1.Text) <> 0 then
    ZeileFaerben(Index,ClGreen,Listbox1,Index,Rect)
  else
    ZeileFaerben(Index,ClRed,Listbox1,Index,Rect);
end;

Meine Frage wie bringe ich den Code dazu das er auf den Quelltext wartet bis er komplett geladen ist
wollte wenn es geht nicht mit TWebBrowser arbeiten dort würde es mit Readystate <> Complete gehen.

Hoffe Ihr habt eine Idee

Liebe Grüße
Deadinpac

[wicht]

Die Indys blockieren eigentlich doch Standardmäßig. Benutzt du das TIdAntiFreeze Teil?

[Deadinpac]

Ne ich nutze die ganz Normale IdHttp von der Delphi 7 Enterprise version

Hier mal der Komplette Quelltext vom Programm

Delphi-Quellcode:

unit jc;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Buttons, IdBaseComponent,
  IdComponent, IdTCPConnection, IdTCPClient, IdHTTP;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    Label1: TLabel;
    Memo1: TMemo;
    Timer1: TTimer;
    IdHTTP1: TIdHTTP;
    procedure FormCreate(Sender: TObject);
    procedure ListBox1DrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure BitBtn1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;
  Apppfad,Juser: String;
  Index: Integer;
implementation

uses Unit2;

{$R *.dfm}

procedure ZeileFaerben(Zeile:integer;Farbe:integer;Listbox:TListbox;
  Index:Integer;Rect:TRect);
begin
  if Index<>Zeile then
    Farbe:=clBlack;

  Listbox.Canvas.Brush.Color:=clWindow;
  Listbox.Canvas.Pen.Color:=Farbe;
  Listbox.Canvas.FillRect(Rect);
  Listbox.Canvas.Font.Color:=Farbe;
  Listbox.Canvas.TextOut(Rect.Left,Rect.Top,Listbox.Items[Index]);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Apppfad := ExtractFilePath(Application.ExeName);
if FileExists(Apppfad+'freunde.dat') Then
Listbox1.Items.LoadFromFile(Apppfad+'freunde.dat') else
ListBox1.Items.SaveToFile(Apppfad+'freunde.dat');
end;

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
begin
Juser := ListBox1.Items[Index];
Memo1.Text:= IdHttp1.Get('http://www.jappy.de/user/'+Juser);
  if Pos ('<a href="/line/start/'+Juser+'" target="' , Memo1.Text) <> 0 then
    ZeileFaerben(Index,ClGreen,Listbox1,Index,Rect)
  else
    ZeileFaerben(Index,ClRed,Listbox1,Index,Rect);
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
Form2.Show;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
Listbox1.Clear;
Listbox1.Items.LoadFromFile(Apppfad+'freunde.dat');
end;

end.

Wie gesagt das Programm funkt ja soweit wenn ich es jedes mal Schließen würde und immer wieder neustarten würde aber ich möchte ja gerne das Programm offen lassen eventuell nachher auch eine Benachrichtigung einbauen sobald jemand Online bzw Offline geht.

Das Problem tritt ja nur beim 10sek aktualisieren auf.

Habe es auch schon mit der Funktion probiert aber die macht den gleichen Effekt

Delphi-Quellcode:

uses WinINet;

Function GetHTML(AUrl: string): string;
var
  databuffer : array[0..4095] of char;
  ResStr : string;
  hSession, hfile, hRequest: hInternet;
  dwindex,dwcodelen,datalen,dwread,dwNumber: cardinal;
  dwcode : array[1..20] of char;
  res    : pchar;
  Str    : pchar;
begin
  ResStr:='';
  if pos('http://',lowercase(AUrl))=0 then
     AUrl:='http://'+AUrl;
  hSession:=InternetOpen('InetURL:/1.0',
                         INTERNET_OPEN_TYPE_PRECONFIG,
                         nil,
                         nil,
                         0);
  if assigned(hsession) then
  begin
    hfile:=InternetOpenUrl(
           hsession,
           pchar(AUrl),
           nil,
           0,
           INTERNET_FLAG_RELOAD,
           0);
    dwIndex  := 0;
    dwCodeLen := 10;
    HttpQueryInfo(hfile,
                  HTTP_QUERY_STATUS_CODE,
                  @dwcode,
                  dwcodeLen,
                  dwIndex);
    res := pchar(@dwcode);
    dwNumber := sizeof(databuffer)-1;
    if (res ='200') or (res ='302') then
    begin
      while (InternetReadfile(hfile,
                              @databuffer,
                              dwNumber,
                              DwRead)) do
      begin
        if dwRead =0 then
          break;
        databuffer[dwread]:=#0;
        Str := pchar(@databuffer);
        resStr := resStr + Str;
      end;
    end
    else
      ResStr := 'Status:'+res;
    if assigned(hfile) then
      InternetCloseHandle(hfile);
  end;
  InternetCloseHandle(hsession);
  Result := resStr;
end;

Lieben Gruß
Deadinpac

//Edit

Habs gefunden es lag an der Einstellung von IdHttp "AllowCookies" war auf True habs jetzt auf False gestellt und nun Funkt es.

Kann mir dazu jemand vielleicht erklären warum das damit jetzt zusammenhing?