"Wer ist Online"-Box auslesen ohne Indy

[turboPASCAL]

So, ich habs nun erst mal in der Form:

Delphi-Quellcode:

uses
  wininet;

function _PosEx(const Substr: string; const S: string; Offset: Integer): Integer;
begin
  if Offset <= 0 then Result := 0 else
    Result := Pos(Substr, Copy(S, Offset, Length(S)));

  if Result <> 0 then
    Result := Result + Offset - 1;
end;

function CopyFileFromURL(const URL: String; MS: TMemoryStream): Boolean;
const
  BufferSize = 1024;
var
  hSession, hURL: HInternet;
  Buffer: array[0..BufferSize-1] of Char;
  BufferLength: DWORD;
begin
  Result := False;
  hSession := InternetOpen(PChar(Application.Title),
                INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
  try
    hURL := InternetOpenURL(hSession, PChar(URL), nil, 0, 0, 0);
    try
      MS.Position := 0;
      repeat
        InternetReadFile(hURL, @Buffer, BufferSize, BufferLength);
        MS.WriteBuffer(Buffer, BufferLength);
      until BufferLength = 0;
      Result := True;
    finally
      InternetCloseHandle(hURL);
    end;
  finally
    InternetCloseHandle(hSession);
  end;
end;

function IsOnline: Boolean;
var dlvFlag : DWord;
begin
  Result := FALSE;
  dlvFlag := Internet_Connection_Modem + Internet_Connection_Lan + Internet_Connection_Proxy;
  if InternetGetConnectedState ( @dlvFlag, 0 ) = TRUE Then
    Result := dlvFlag = 81;
end;

function GetDPOnlineUsers: String;
const
  strDP_URL = 'http://www.delphipraxis.net/index.html';
var
  ms: tmemorystream;
  buf: array [0..pred(1024)] of Char;
  count: Int64;
  FoundAt, i, n: Integer;
  s: String;
begin
  Result := '';

  if not IsOnline then
  begin
    Result := 'n/a';
    exit;
  end;

  ZeroMemory(@Buf, sizeof(Buf));
  ms := tmemorystream.Create;
  try
    if CopyFileFromURL(strDP_URL, ms) then
    begin
      if ms.Size >= length(buf) then
      begin
        count := 0;
        repeat
         ms.Position := count;
         ms.ReadBuffer(buf, sizeof(Buf));

         // Find Users in HTML

         FoundAt := Pos('Registrierte Benutzer:', String(buf));
         if FoundAt <> 0 then
         begin
           count := count + FoundAt;
           break;
         end;
         inc(count);
        until count+sizeof(buf) >= ms.Size ;

        if FoundAt <> 0 then
        begin
          ZeroMemory(@Buf, sizeof(Buf));
          s := '';
          while not (Pos('</span>', s) <> 0) do
          begin
            ms.ReadBuffer(buf, sizeof(Buf));
            s := s + String(buf);
          end;
        end;
      end;
    end else
      MessageBox(Application.Handle, 'Error', 'Information', MB_OK);
  finally
    ms.Free;
  end;

  if length(s) > 0 then  // Parse HTML
  begin
    s := Copy(s, 1, Pos('</span>', s)-1);
    for i := 1 to length(s) do
      if s[i] < #32 then delete(s,i,1);
      i := 1;
    repeat
      i := _PosEx('<', s, i);
      n := _PosEx('>', s, i);
      delete(s, i, n-i+1);
    until not (i <> 0);
    Result := Trim(s);
  end;
end;