Сокеты и консоль Опции

[Unconnected]

Привет всем.

Животрепещущий вопрос: возможно ли в консоли присвоить событию сокета (OnRead, например) свою процедуру? Например, Client.onread:=myevent;. Описать её (myevent) получается, а вот присвоить правильно - нет..

[volvo]

Звони своему "одному человеку", и требуй с него ящик пива

1) клиент:

// 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.

2) сервер:

program Project1;
{$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.

Все условия выполняются: все на Эвентах + окно консольное... Класс-Хелперы понадобились для того, чтоб программа была работоспособна на D2009 (без них в Юникодной версии Дельфи принимается совсем не то, что отсылается - баг в исходниках), если у тебя версия ниже 2009, то можешь Class Helper-ы смело убирать, а вместо ReceiveTextAnsi использовать обычный ReceiveText.

Проверялось на D2009 + WinXP SP3, работает... Запускается сначала сервер (как всегда), потом - клиент...