Текущий архив: 2008.04.27;
Скачать: CL | DM;

Вниз

Port Mapping своими силами   Найти похожие ветки 

← →
R.O.O.T ©   (2007-07-25 07:19) [0]

Господа подскажите пожалуйста как реализовать Port Mapping  своими силами т.е. используюя компаненты TServerSocket ClientSocket.
я знаю что в комплект Delphi входит IdPortMapped компанет в котором все уже реализованно, мне это неподходит. раньше была ветка с  обсуждением данной проблемы но потом она пропала

Помогите чем сможите...

---

← →
tesseract ©   (2007-07-25 17:44) [1]

То что код будет использовать многопоточный режим и кучу Asm чтобы не тормозило я сразу скажу. Не проще ли стандартный NAT использовать?

---

← →
SlymRO ©   (2007-07-26 06:20) [2]

unit TPortMapUn;

interface
uses
 Windows, scktcomp, SysUtils,Classes;
type
 TPortMap=class(TComponent)
 private
   FRemoteHost:string;
   FRemotePort:word;
   FServer:TServerSocket;
   FClientTimeOut:integer;
   procedure GetThread(Sender: TObject; ClientSocket: TServerClientWinSocket; var SocketThread: TServerClientThread);
   function GetLocalPort: word;
   procedure SetLocalPort(const Value: word);
   procedure SetRemoteHost(const Value: String);
   procedure SetRemotePort(const Value: word);
   function GetActive: boolean;
   procedure SetActive(const Value: boolean);
 public
   constructor Create(AOwner: TComponent); override;
   destructor Destroy;override;
   property LocalPort:word read GetLocalPort write SetLocalPort;
   property RemoteHost:String read FRemoteHost write SetRemoteHost;
   property RemotePort:word read FRemotePort write SetRemotePort;
   property Active:boolean read GetActive write SetActive;
   property ClientTimeOut:integer read FClientTimeOut write FClientTimeOut;
 end;

implementation
uses WinSock, RTLConsts;

type
 TPortMapClientThread=class(TServerClientThread)
 private
   FPortMap:TPortMap;
 protected
   procedure ClientExecute; override;
 public
   constructor Create(PortMap:TPortMap;CreateSuspended: Boolean; ASocket: TServerClientWinSocket);
 end;

constructor TPortMapClientThread.Create(PortMap: TPortMap;
 CreateSuspended: Boolean; ASocket: TServerClientWinSocket);
begin
 FPortMap:=PortMap;
 inherited Create(CreateSuspended,ASocket);
end;

procedure TPortMapClientThread.ClientExecute;
var
 RemoteSocket:TClientSocket;
 FDSet: TFDSet;
 TimeVal: TTimeVal;
 Buf:array[0..4095] of char;
 r,s:integer;
begin
 RemoteSocket:=TClientSocket.Create(nil);
 try
   RemoteSocket.ClientType:=ctBlocking;
   RemoteSocket.Host:=FPortMap.RemoteHost;
   RemoteSocket.Port:=FPortMap.RemotePort;
   RemoteSocket.Open;
   TimeVal.tv_sec := FPortMap.ClientTimeout div 1000;
   TimeVal.tv_usec := (FPortMap.ClientTimeout mod 1000) * 1000;
   while ClientSocket.Connected and RemoteSocket.Socket.Connected do
   begin
     FD_ZERO(FDSet);
     FD_SET(ClientSocket.SocketHandle, FDSet);
     FD_SET(RemoteSocket.Socket.SocketHandle, FDSet);
     if select(0, @FDSet, nil, nil, @TimeVal)>0 then
     begin
       if FD_ISSET(ClientSocket.SocketHandle, FDSet) then
       begin
         r:=ClientSocket.ReceiveBuf(Buf,Length(Buf));
         if r=0 then exit;
         s:=RemoteSocket.Socket.SendBuf(Buf,r);
         if r<>s then exit;
       end;
       if FD_ISSET(RemoteSocket.Socket.SocketHandle, FDSet) then
       begin
         r:=RemoteSocket.Socket.ReceiveBuf(Buf,Length(Buf));
         if r=0 then exit;
         s:=ClientSocket.SendBuf(Buf,r);
         if r<>s then exit;
       end;
     end else
       exit;
   end;
 finally
   RemoteSocket.Free;
 end;
end;

{ TPortMap }

constructor TPortMap.Create(AOwner: TComponent);
begin
 inherited;
 FClientTimeOut:=60000;
 FServer:=TServerSocket.Create(nil);
 FServer.ServerType:=stThreadBlocking;
 FServer.OnGetThread:=GetThread;
 FServer.Port:=LocalPort;
end;

destructor TPortMap.Destroy;
begin
 FServer.Free;
 inherited;
end;

procedure TPortMap.GetThread(Sender: TObject;
 ClientSocket: TServerClientWinSocket;
 var SocketThread: TServerClientThread);
begin
 SocketThread:=TPortMapClientThread.Create(self,false,ClientSocket);
end;

function TPortMap.GetLocalPort: word;
begin
 result:=FServer.Port;
end;

procedure TPortMap.SetLocalPort(const Value: word);
begin
 FServer.Port:=Value;
end;

procedure TPortMap.SetRemoteHost(const Value: String);
begin
 if FRemoteHost <> Value then
 begin
   if not (csLoading in ComponentState) and Active then
     raise ESocketError.CreateRes(@sCantChangeWhileActive);
   FRemoteHost := Value;
 end;
end;

procedure TPortMap.SetRemotePort(const Value: word);
begin
 if FRemotePort <> Value then
 begin
   if not (csLoading in ComponentState) and Active then
     raise ESocketError.CreateRes(@sCantChangeWhileActive);
   FRemotePort := Value;
 end;
end;

function TPortMap.GetActive: boolean;
begin
 result:=FServer.Active;
end;

procedure TPortMap.SetActive(const Value: boolean);
begin
 FServer.Active:=Value;
end;

end.


usage

program PortMap;
{$apptype console}

uses
 SysUtils,
 TPortMapUn in "TPortMapUn.pas";

var Server:TPortMap;

begin
 Server:=TPortMap.Create(nil);
 try
   Server.LocalPort:=3128;
   Server.RemoteHost:="192.168.14.2";
   Server.RemotePort:=3128;
   Server.Active:=true;
   while Server.Active do
     Sleep(100);
 finally
   Server.Free;
 end;
end.

---

Страницы: 1 вся ветка

Текущий архив: 2008.04.27;
Скачать: CL | DM;

Наверх

Память: 0.49 MB
Время: 0.016 c