Привет всем.
Животрепещущий вопрос: возможно ли в консоли присвоить событию сокета (OnRead, например) свою процедуру? Например, Client.onread:=myevent;. Описать её (myevent) получается, а вот присвоить правильно - нет..
program Project1;
{$APPTYPE CONSOLE}
uses
Windows,
SysUtils,
Classes,
ScktComp,
Graphics;
var server:TServersocket;
Procedure EVENT1(Sender: TObject; Socket: TCustomWinSocket);
begin
writeln(socket.receivetext);
end;
begin
server:=TServerSocket.create(nil);
server.port:=1001;
server.OnClientRead:=event1(); //<===здесь, во входных параметрах, определённо нужно что--то написать
Server.ServerType:=stNonBlocking;
server.Open;
while server.active do sleep(100);
end.
type TSocketNotifyEvent = procedure (Sender: TObject; Socket: TCustomWinSocket) of object;
typeМожешь еще добавить try/finally, как положено, и создавать сокет в конструкторе класса TFooClass...
TFooClass = class(TObject)
server:TServersocket;
procedure Event1(Sender: TObject; Socket: TCustomWinSocket);
end;
Procedure TFooClass.Event1(Sender: TObject; Socket: TCustomWinSocket);
begin
writeln(socket.receivetext);
end;
var
obj: TFooClass;
begin
obj := TFooClass.Create;
with obj do begin
server:=TServerSocket.create(nil);
server.port:=1001;
server.OnClientRead:=event1;
server.ServerType := stNonBlocking;
server.Open;
while server.active do sleep(100);
end;
obj.Free;
end.
program Project1;
{$APPTYPE CONSOLE}
uses
Windows,
SysUtils,
Classes,
ScktComp,
Graphics;
type
TFooClass = class(TObject)
server:TServersocket;
procedure Event1(Sender: TObject; Socket: TCustomWinSocket);
end;
Procedure TFooClass.Event1(Sender: TObject; Socket: TCustomWinSocket);
begin
writeln(socket.receivetext);
end;
var
obj:TFooClass;
begin
obj:=TFooClass.Create;
with obj do begin
server:=TServerSocket.create(nil);
server.port:=1001;
server.OnClientRead:=event1;
server.ServerType:=stNonBlocking;
server.Open;
while server.active do sleep(100);
end;
obj.Free;
end.
program Project1;
{$APPTYPE CONSOLE}
uses
Windows,
SysUtils,
Classes,
ScktComp,
Graphics;
type
TFooClass = class(TObject)
client:Tclientsocket;
procedure Event2(Sender: TObject; Socket: TCustomWinSocket);
end;
var host:string;
key:string;
Procedure TFooClass.Event2(Sender: TObject; Socket: TCustomWinSocket);
begin
writeln('СОЕДИНЕНО!!!');
end;
var
obj:TFooClass;
begin
writeln('Введите IP-адрес сервера');
readln(host);
obj:=TFooClass.Create;
with obj do begin
client:=TClientSocket.create(nil);
client.port:=1001;
client.Onconnect:=event2;
client.clientType:=CtNonBlocking;
client.Address:=host;
client.Open;
repeat
key:='';
readln(key);
client.Socket.SendText(key);
until key='EXIT';
end;
obj.Free;
end.
// Client
program Project1;
{$APPTYPE CONSOLE}
uses
ScktComp, windows;
type
TCustomWinSocketA = class helper for TCustomWinSocket
function ReceiveTextAnsi: AnsiString;
end;
function TCustomWinSocketA.ReceiveTextAnsi: AnsiString;
begin
SetLength(Result, ReceiveBuf(Pointer(nil)^, -1));
SetLength(Result, ReceiveBuf(Pointer(Result)^, Length(Result)));
end;
var
ClientMy:TClientSocket;
Msg:TMsg;
begin
ClientMy:=TClientSocket.Create(nil);
ClientMy.ClientType:=ctBlocking;
ClientMy.Address:='127.0.0.1';
ClientMy.Port:=8080;
ClientMy.Active:=true;
ClientMy.Socket.SendText('hello');
Sleep(5);
writeln(ClientMy.Socket.ReceiveTextAnsi);
while GetMessage(Msg,0,0,0) do DispatchMessage(Msg);
readln;
ClientMy.Free;
end.
program Project1;Все условия выполняются: все на Эвентах + окно консольное... Класс-Хелперы понадобились для того, чтоб программа была работоспособна на D2009 (без них в Юникодной версии Дельфи принимается совсем не то, что отсылается - баг в исходниках), если у тебя версия ниже 2009, то можешь Class Helper-ы смело убирать, а вместо ReceiveTextAnsi использовать обычный ReceiveText.
{$APPTYPE CONSOLE}
uses
ScktComp,SysUtils,windows;
type
TCustomWinSocketA = class helper for TCustomWinSocket
function ReceiveTextAnsi: AnsiString;
end;
function TCustomWinSocketA.ReceiveTextAnsi: AnsiString;
begin
SetLength(Result, ReceiveBuf(Pointer(nil)^, -1));
SetLength(Result, ReceiveBuf(Pointer(Result)^, Length(Result)));
end;
type
ServSock=class
serv:TServerSocket;
procedure ClientRead(Sender:TObject; Socket:TCustomWinSocket);
procedure ClientConnect(Sender:TObject; Socket:TCustomWinSocket);
public
constructor Create;
destructor Destroy; override;
end;
{ServSock}
constructor ServSock.Create;
Begin
inherited Create;
Serv:=TServerSocket.Create(nil);
Serv.ServerType:=stNonBlocking;
Serv.OnClientConnect:=ClientConnect;
Serv.OnClientRead:=ClientRead;
Serv.Port:=8080;
Serv.Active:=true;
End;
procedure ServSock.ClientRead(Sender:TObject; Socket:TCustomWinSocket);
var
a:ansistring;
Begin
a:=Socket.ReceiveTextAnsi;
Writeln(a);
if a='hello' then Socket.SendText('Hello goes back...');
End;
procedure ServSock.ClientConnect(Sender:TObject; Socket:TCustomWinSocket);
Begin
Socket.SendText('To Client: You are connected...');
End;
destructor ServSock.Destroy;
Begin
Serv.Free;
inherited Destroy;
End;
var
Server1:ServSock;
MSG: TMSG;
begin
Server1 := ServSock.Create;
try
while GetMessage(MSG, 0, 0, 0) do
begin
TranslateMessage(msg);
DispatchMessage(msg);
end;
finally
readln;
Server1.Free;
end;
readln;
end.