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.