Маппинг сетевых портов на Delphi 6 (portMapping)

Расположите на форме Delphi три однострочных поля ввода (Edit), а так же кнопку Button1 после чего скопируйте в проект весь код из листинга. Первый Edit - это порт создаваемого портового сервера, второй адрес для соединения с удалённым сервером, а третий Edit - порт удалённого сервера. Кнопкой Button1 осуществляется старт сервера.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ScktComp;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Label1: TLabel;
    Button1: TButton;
    Button2: TButton;
    Edit2: TEdit;
    Label2: TLabel;
    Label3: TLabel;
    Edit3: TEdit;
    ServerSocket1: TServerSocket;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure ServerSocket1ClientError(Sender: TObject;
      Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
      var ErrorCode: Integer);
    procedure ServerSocket1ClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocket1ClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
  private
    { Private declarations }
  public
    procedure myDinClientSocketError(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure myDinClientSocketDisconnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure myDinClientSocketRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure myDinClientSocketConnect(Sender: TObject; Socket: TCustomWinSocket);
    { Public declarations }
  end;

var
  Form1: TForm1;
  socketClients: Array[0..25000] of TClientSocket;
  socketServers: Array[0..25000] of TCustomWinSocket;
  socketServerBuffers: Array[0..25000,0..500] of string;
  socketServerBuffersCount: Array[0..25000] of integer;
  socketClientsStatus: Array[0..25000] of integer;

socketsCounter: integer;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  ServerSocket1.Port:= StrToInt(Edit1.Text);
  ServerSocket1.Active:= true;
  Button1.Enabled:= false;
end;

procedure TForm1.ServerSocket1ClientError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
  Memo1.Lines.Add('Ошибка клиента на сервере');
  Socket.Close;
  ErrorCode:= 0;
end;

procedure TForm1.myDinClientSocketError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
  var socketNum: integer;
begin
  socketNum:= integer(Socket.Data);
  Memo1.Lines.Add('Ошибка клиента:'+IntToStr(socketNum));
  Socket.Close;
  ErrorCode:= 0;
  socketClientsStatus[socketNum]:= 2;
  if (socketServers[socketNum].Connected = true) then
    socketServers[socketNum].Close;
end;

procedure TForm1.myDinClientSocketDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
  var socketNum: integer;
begin
  socketNum:= integer(Socket.Data);
  Memo1.Lines.Add('Дисконект клиента:'+IntToStr(socketNum));
  socketClientsStatus[socketNum]:= 2;
  if (socketServers[socketNum].Connected = true) then
    socketServers[socketNum].Close;
end;

procedure TForm1.myDinClientSocketRead(Sender: TObject;
  Socket: TCustomWinSocket);
  var socketNum: integer;
begin
  socketNum:= integer(Socket.Data);
  Memo1.Lines.Add('Чтение клиента:'+IntToStr(socketNum));
  socketServers[socketNum].SendText(Socket.ReceiveText);
end;

procedure TForm1.myDinClientSocketConnect(Sender: TObject;
  Socket: TCustomWinSocket);
  var socketNum,buffersCount,i: integer;
begin
  socketNum:= integer(Socket.Data);
  Memo1.Lines.Add('Подключение клиента:'+IntToStr(socketNum));
  socketClientsStatus[socketNum]:= 1;
  buffersCount:= socketServerBuffersCount[socketNum];
  if (buffersCount > 0) then
      Memo1.Lines.Add('БуферКаунт больше 0:'+IntToStr(socketNum));
  begin
    socketServerBuffersCount[socketNum]:= 0;
    for i:=0 to buffersCount-1 do begin
      Memo1.Lines.Add('Чтение из буфер:'+IntToStr(socketNum));
      Socket.SendText(socketServerBuffers[socketNum,i]);
      socketServerBuffers[socketNum,i]:= '';
    end;
  end;

end;

procedure TForm1.ServerSocket1ClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
  var socketNum: integer;
begin
  socketNum:= socketsCounter;
  Memo1.Lines.Add('Подключение к сереру клиента:'+IntToStr(socketNum));
  Inc(socketsCounter);
  Socket.Data:= pointer(socketNum);
  socketServers[socketNum]:= Socket;

socketClients[socketNum]:= TClientSocket.Create(Form1);
  socketClients[socketNum].Host:= Edit2.Text;
  socketClients[socketNum].Port:= StrToInt(Edit3.Text);
  socketClients[socketNum].socket.Data:= pointer(socketNum);

socketClients[socketNum].OnError:= myDinClientSocketError;
  socketClients[socketNum].OnDisconnect:= myDinClientSocketDisconnect;
  socketClients[socketNum].OnRead:= myDinClientSocketRead;
  socketClients[socketNum].OnConnect:= myDinClientSocketConnect;

socketClients[socketNum].Active:= true;

socketClientsStatus[socketNum]:= 0;
end;

procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
  var socketNum: integer;
begin
  socketNum:= integer(Socket.Data);
  Memo1.Lines.Add('Чтение сервера:'+IntToStr(socketNum));
  if (socketClientsStatus[socketNum] = 1) then
    socketClients[socketNum].Socket.SendText(Socket.ReceiveText)
  else
  begin
    Memo1.Lines.Add('Сервер пишет в буфер:'+IntToStr(socketNum));
    socketServerBuffers[socketNum,socketServerBuffersCount[socketNum]]:= Socket.ReceiveText;
    Inc(socketServerBuffersCount[socketNum]);
  end;
end;

end.

Комментарии