ClientSocket

[Bummi]

Diese Uraltkomponente hatte ich ewig nicht mehr in der Hand, die Blockingmethode mit Streams bekomme ich auf die schnelle scheinbar nicht zum laufen ... vielleicht hilft Dir folgende Kapselung für das erste ...

Delphi-Quellcode:

unit ClientSocketBlocking;
// 2012 by Thomas Wassermann
interface

uses
  Windows, Messages, SysUtils, ScktComp, Classes,Forms;

Type

  TOldClientSocketTest = Class
  Private
    FCs: TClientSocket;
    FSL: TStringList;
    FHost:String;
    FContent:String;
    FReady:Boolean;
    procedure MyDisconnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure MyOnRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure MyOnWrite(Sender: TObject; Socket: TCustomWinSocket);
  protected
    Constructor Create(Const AUrl: String; Port: Integer = 80);
    Destructor Destroy ;
  public
    Class Function GetPage(Const AUrl: String; Port: Integer = 80):String;

    End;
implementation

{ TOldClientSocketTest }

destructor TOldClientSocketTest.Destroy;
begin
   FSL.Free;
   FCS.Free;
end;

class function TOldClientSocketTest.GetPage(const AUrl: String; Port: Integer=80): String;
begin
    With Create(AUrl,Port) do
      begin
         Result := FSL.Text;
         Destroy;
      end;
end;

procedure TOldClientSocketTest.MyDisconnect(Sender: TObject; Socket: TCustomWinSocket);
begin
  FReady := true;
end;

procedure TOldClientSocketTest.MyOnRead(Sender: TObject; Socket: TCustomWinSocket);
begin
  FSL.Add(TClientSocket(Sender).Socket.ReceiveText);
end;

procedure TOldClientSocketTest.MyOnWrite(Sender: TObject; Socket: TCustomWinSocket);
begin
  Socket.SendText('GET ' + FContent + ' HTTP/1.0' + #13#10#13#10);
end;

constructor TOldClientSocketTest.Create(const AUrl: String; Port: Integer);
var
 i:Integer;
begin
  FSL := TStringList.Create;
  FCs := TClientSocket.Create(nil);
  try
    if pos('http://',Lowercase(AUrl))>0 then FHost := Copy(Aurl,8,Length(Aurl))
    else FHost :=(AUrl);

    i := Pos('/',FHost);
    if i>0 then
      begin
        FContent := Copy(FHost,i,length(FHost));
        FHost    := Copy(FHost,1,i-1);
      end;

    if Length(FContent)=0 then  FContent := '/';
    FCs.OnDisconnect := MyDisconnect;
    FCs.OnRead := MyOnRead;
    FCs.OnWrite := MyOnWrite;
    FCs.Host := FHost;
    FCs.Port := Port;
    FCs.ClientType := ctNonBlocking;
    FCs.active := true;
    while not FReady do
      begin
      Application.Processmessages;
      Sleep(50);
      end;
  finally
  end;
end;




{
procedure TForm3.Button3Click(Sender: TObject);
Procedure AddSep;
  begin
      Memo1.Lines.Add('_______________________________________________');
  end;

begin
  Memo1.Text := Memo1.Text + TOldClientSocketTest.GetPage('www.devworx.com');
  AddSep;
  Memo1.Text := Memo1.Text + TOldClientSocketTest.GetPage('http://www.jmarshall.com/easy/http/');
  AddSep;
  Memo1.Text := Memo1.Text + TOldClientSocketTest.GetPage('http://www.delphipraxis.net');
  AddSep;

end;
}

end.