proxyform.pas

< Delphi网络通信协议分析与应用实现>>一书的源代码。

unit ProxyForm;

interface

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

type

  TFormMain = class(TForm)
    MemoLog: TMemo;
    sskIn: TServerSocket;
    GroupBox1: TGroupBox;
    btnStopServer: TButton;
    Label1: TLabel;
    edtPort: TEdit;
    btnChange: TButton;
    btnStartServer: TButton;
    procedure btnStartServerClick(Sender: TObject);
    procedure btnStopServerClick(Sender: TObject);
    procedure sskInClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure sskInClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure cskOutRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure cskOutDisconnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure sskInClientRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure sskInAccept(Sender: TObject; Socket: TCustomWinSocket);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure cskOutError(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure sskInClientError(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure CoolTrayIcon1DblClick(Sender: TObject);
    procedure btnChangeClick(Sender: TObject);
  private
    { Private declarations }
  public
        function Map(skt: TSocket):integer;
        function ClientMapServer(Skt: TSocket):Integer;
    { Public declarations }
  end;

var
  FormMain: TFormMain;
  UsrList:TList;

implementation

{$R *.DFM}

procedure TFormMain.btnStartServerClick(Sender: TObject);
begin
     if sskIn.Active then exit;
     if edtPort.Text='' then exit;
     sskIn.Port:=strtoint(edtPort.Text);
     sskIn.Active:=true;
end;

procedure TFormMain.btnStopServerClick(Sender: TObject);
begin
     sskIn.Active:=false;
end;

procedure TFormMain.sskInClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
     //cskOut.Active:=true;
     memoLog.Lines.add('Login from:'+Socket.RemoteAddress);
end;

procedure TFormMain.sskInClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
Var
   Index:integer;
   Item:^TMAP;
begin
     Index:=Map(Socket.SocketHandle);
     Item:=UsrList.Items[Index];
     Item.outSkt.Active:=false;
     memoLog.Lines.Add('LogOut from:'+Socket.RemoteAddress);
end;

procedure TFormMain.cskOutRead(Sender: TObject; Socket: TCustomWinSocket);
var
   pRecv:pchar;
   nCount:DWORD;
   Item:^TMAP;
   Index:Integer;
   sSocket:TCustomWinSocket;
begin
     nCount:= Socket.ReceiveLength();
     GetMem(pRecv,nCount);
     Socket.ReceiveBuf(pRecv^,nCount);
     Index:=ClientMapServer(Socket.SocketHandle);
     Item:=UsrList.Items[Index];
     sSocket:=TCustomWinSocket.Create(Item.hSocket);
     sSocket.SendBuf(pRecv^,nCount);
     //sskIn.Socket.Connections[0].SendBuf(pRecv^,nCount);
     Freemem(pRecv);
end;

procedure TFormMain.cskOutDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
var
   Item:^TMAP;
   Index:Integer;
   sSocket:TCustomWinSocket;
begin
     Index:=ClientMAPServer(Socket.SocketHandle);
     item:=UsrList.Items[Index];
     sSocket:=TCustomWinSocket.Create(Item.hSocket);
     sSocket.Close;
     UsrList.Delete(Index);
     memoLog.Lines.Add('Client:DisConnect from'+Socket.RemoteAddress);
end;

procedure TFormMain.sskInClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
   pRecv:pchar;
   nCount:DWORD;
   Index:Integer;
   Item:^TMAP;
begin
     Index:=Map(Socket.SocketHandle);
     if Index=-1 then
     begin
          memoLog.Lines.add('Internal Error Happened');
          exit;
     end;
     Item:=UsrList.Items[Index];

     nCount:= Socket.ReceiveLength();
     GetMem(pRecv,nCount+1);
     ZeroMemory(pRecv,nCount+1);
     Socket.ReceiveBuf(pRecv^,nCount);

     if NOT Item.bLogin then
        begin//these received info will used to select
             if nCount=1 then
                begin
                Try
                   Index:=StrtoInt(pRecv);
                except
                   Socket.SendText(CERRORCHAR);
                   Socket.SendText(CLOGIN);
                   Freemem(pRecv);
                   exit;
                end;
                Item.outSkt:=TClientSocket.Create(Self);
                Item.outSkt.Host:=CArrRemote[3];//Index];
                Item.outSkt.OnRead:=cskOutRead;
                Item.outSkt.OnDisconnect:=cskOutDisconnect;
                Item.outSkt.Port:=23;//default telnet port;
                Item.outSkt.Active:=true;
                Item.bLogin:=true;
                Freemem(pRecv);
                exit;
                end
             else//count<>1
                 begin
                   Socket.SendText(CERRORCHAR);
                   Socket.SendText(CLOGIN);
                   Freemem(pRecv);
                   exit;
                 end;
        end;
     Item.outSkt.Socket.SendBuf(pRecv^,nCount);
//     cskOut.Socket.SendBuf(pRecv^,nCount);
     Freemem(pRecv);
end;

procedure TFormMain.sskInAccept(Sender: TObject; Socket: TCustomWinSocket);
var
   idx:integer;
   Item:^TMap;
begin
     //Valid check first
     if UsrList.Count>=CMAXLOGIN then
        begin
             Socket.SendText(CMAXLINK);
             Socket.Close;
        end;
     GetMem(Item,Sizeof(TMap));
     Item.hSocket:=Socket.SocketHandle;//Server Terminal Handle
     Item.bLogin:=false;
     Item.inIP:=Socket.RemoteAddress;
     UsrList.Add(Item);
     Socket.SendText(CLOGIN);
     memoLog.Lines.Add(Item.inIP+' Quarying');
end;

procedure TFormMain.FormCreate(Sender: TObject);
begin
     UsrList:=TList.Create;
end;

procedure TFormMain.FormDestroy(Sender: TObject);
begin
     UsrList.Free;
end;

function TFormMain.Map(skt: TSocket):integer;
var
   i:integer;
   Item:^TMAP;
begin
     if UsrList.Count=0 then
        begin
             result:=-1;
             exit;
        end;
     for i:=0 to CMAXLOGIN-1 do
     begin
          Item:=UsrList.Items[i];
          if Item.hSocket=skt then
            begin
                 result:=i;
                 exit;
            end;
          result:=-1;
     end;
end;
function TFormMain.ClientMapServer(Skt: TSocket):Integer;
var
   i:integer;
   Item:^TMAP;
begin
     for i:=0 to CMAXLOGIN-1 do
     begin
          Item:=UsrList.Items[i];
          if Item.outSkt.Socket.SocketHandle=skt then
            begin
                 result:=i;
                 exit;
            end;
          result:=-1;
     end;
end;

procedure TFormMain.cskOutError(Sender: TObject; Socket: TCustomWinSocket;
  ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
     memoLog.Lines.Add('ClientSktErr:'+inttostr(ErrorCode));
     ErrorCode:=0;
end;

procedure TFormMain.sskInClientError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
     memoLog.Lines.Add('ServerSktErr:'+inttostr(ErrorCode));
end;

procedure TFormMain.CoolTrayIcon1DblClick(Sender: TObject);
begin
     self.Visible:=true;
end;

procedure TFormMain.btnChangeClick(Sender: TObject);
begin
     sskIn.Active:=false;
     sskIn.Port:=StrtoInt(edtPort.Text);
     btnStartServer.Click;

end;

end.