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

[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?