如何编程实现Sock5的代理服务，最好有源码(delphi的)!

Question

油箱[email protected]

Answer 1

//偶前几天刚写过
//d5, indy9
//不支持IPv6, 不支持匿名访问unit u_Socks5Server;interfaceuses
  Windows, SysUtils, Classes, Forms, 
  IdBaseComponent, IdComponent, IdTCPServer, IdTCPConnection,  IdTCPClient;type
  TTextNotify = procedure(AText: String) of object;  Tdm_Kernal = class(TDataModule)
    ProxyServer: TIdTCPServer;
    procedure ProxyServerStatus(ASender: TObject; const AStatus: TIdStatus;
      const AStatusText: String);
    procedure ProxyServerConnect(AThread: TIdPeerThread);
    procedure ProxyServerExecute(AThread: TIdPeerThread);
    procedure ProxyServerException(AThread: TIdPeerThread;
      AException: Exception);
    procedure ProxyServerDisconnect(AThread: TIdPeerThread);
    procedure ClientDisconnected(Sender: TObject);
  private
    { Private declarations }
    FOnLog: TTextNotify;
    FOnStatus: TTextNotify;    procedure _Select_Method(AConn: TIdTcpConnection);
    procedure _Check_userpass(AConn: TIdTcpConnection);
    function  _Login(username, password: String): Boolean;
    procedure _Connect_Server(AThread: TIdPeerThread);
  public
    { Public declarations }
    property OnLog: TTextNotify read FOnLog write FOnLog;
    property OnStatus: TTextNotify read FOnStatus write FOnStatus;    procedure Log(msg: String);
    procedure Say(msg: String);
  end;var
  dm_Kernal: Tdm_Kernal;

Answer 2

implementation{$R *.DFM}
const
  VER_SOCKS5 = #05;
  VER_USERPASS = #01;
  METHOD_USERPASS = #02;
  METHOD_NOT_SURPORT = #$FF;
  STATUS_OK = #00;
  STATUS_FAILURE = #$FF;
  CMD_CONNECT = #01;
  CMD_BIND = #02;
  CMD_UDP = #03;
  IP_v4 = #01;
  IP_DNS = #03;
  IP_v6 = #04;
  CONNECTION_REFUSED = #05;
  CMD_NOT_SURPORT = #07;
  ADDRTYPE_NOT_SURPOTE = #08;
  
procedure Tdm_Kernal.Log(msg: String);
begin
  if Assigned(FOnLog) then
    FOnLog(FormatDatetime('[yyyy-mm-dd hh:nn:ss] ', Now) + msg);
end;procedure Tdm_Kernal.ProxyServerStatus(ASender: TObject;
  const AStatus: TIdStatus; const AStatusText: String);
begin
  Say(AStatusText);
end;procedure Tdm_Kernal._Check_userpass(AConn: TIdTcpConnection);
var
  Username, Password: ShortString;
  buf: String;
begin
  with AConn do if Connected then
  begin
    Log(Format('[%s] 正在校验用户....', [Socket.Binding.PeerIP]));
    if ReadChar <> VER_USERPASS then
      Disconnect
    else
    begin
      SetLength(Username, Byte(ReadChar));
      ReadBuffer(Username[1], Length(Username));
      SetLength(Password, Byte(ReadChar));
      ReadBuffer(Password[1], Length(Password));
      SetLength(buf, 2);
      buf[1] := VER_USERPASS;
      Username := LowerCase(Username); Password := LowerCase(Password);
      Log(Format('username=%s password=%s', [Username, Password]));
      if _login(username, password) then
        buf[2] := STATUS_OK
      else
        buf[2] := STATUS_FAILURE;
      WriteBuffer(buf[1], Length(buf), True);
      if buf[2] = STATUS_FAILURE then Disconnect;
    end;
  end;
end;procedure Tdm_Kernal._Select_Method(AConn: TIdTcpConnection);
var
  i: Char;
  buf: String;
begin
  with AConn do if Connected then
  begin
    Log('正在选择通信方法......');
    if ReadChar <> VER_SOCKS5 then
      Disconnect
    else
    begin
      SetLength(buf, 2);
      buf[1] := VER_SOCKS5;
      buf[2] := METHOD_NOT_SURPORT;
      for i := #01 to ReadChar do
        if ReadChar = METHOD_USERPASS then buf[2] := METHOD_USERPASS;
      WriteBuffer(buf[1], Length(buf), True);
      if Buf[2] <> METHOD_USERPASS then Disconnect;
    end;
  end;
end;procedure Tdm_Kernal._Connect_Server(AThread: TIdPeerThread);
var
  i: Integer;
  Cmd, AddressType: Char;
  AHost, buf: ShortString;
  APort: Word;
  c: TIdTcpClient;
begin
  with AThread.Connection do if Connected then
  begin
    if ReadChar <> VER_SOCKS5 then
      Disconnect
    else
    begin
      Cmd := ReadChar;
      ReadChar; // RSVED;
      AddressType := ReadChar;
      if not (AddressType in [IP_v4, IP_v6, IP_DNS]) then
        Disconnect
      else
      begin
        case AddressType of
          IP_V4:
            begin
              AHost := IntToStr(Ord(ReadChar));
              for i := 1 to 3 do  AHost :=  AHost +  '.' + IntToStr(Ord(ReadChar));
            end;
          IP_V6:
            begin
              SetLength(AHost, 16);
              ReadBuffer(AHost[1], Length(AHost));
            end;
          IP_DNS:
            begin
              SetLength(AHost, Byte(ReadChar));
              ReadBuffer(AHost[1], Length(AHost));
            end;
          else
        end;
        APort := Byte(ReadChar);
        APort := (APort shl 8) or Byte(ReadChar);
        Log(Format('[%s -> %s:%d] 尝试连接', [Socket.Binding.PeerIP, AHost, APort]));        
        Buf := VER_SOCKS5 + STATUS_OK + #00 + AddressType + AHost + Chr(Hi(APort)) + Chr(Lo(APort));
        if Cmd <> CMD_CONNECT then
          Buf[2] := CMD_NOT_SURPORT
        else
        begin
          if AddressType in [IP_v4, IP_DNS] then
          begin
            c := TIdTcpClient.Create(AThread.Connection);
            c.OnDisconnected := ClientDisconnected;
            AThread.Data := c;
            with TIdTcpClient(AThread.Data) do
            begin
              Host := AHost;
              Port := APort;
              Connect(ReadTimeout);
              if not Connected then Buf[2] := CONNECTION_REFUSED;
            end;
          end
          else
            Buf[2] := ADDRTYPE_NOT_SURPOTE;
        end;
        WriteBuffer(buf[1], Length(buf), True);
        if Buf[2] = CONNECTION_REFUSED then
        begin
          AThread.Data.Free;
          AThread.Data := nil;
          Disconnect;
        end;
      end;
    end;
  end;
end;procedure Tdm_Kernal.ProxyServerConnect(AThread: TIdPeerThread);
begin
  with AThread.Connection do
  try
    Log(Format('[%s] 连接成功', [Socket.Binding.PeerIP]));
    _Select_Method(AThread.Connection);
    _Check_Userpass(AThread.Connection);
    _Connect_Server(AThread);
  except
    on E: Exception do Log(Format('[%s] 连接错误: %s', [Socket.Binding.PeerIP, E.Message]));
  end;
end;procedure Tdm_Kernal.ProxyServerExecute(AThread: TIdPeerThread);
var
 bufsize: Integer;
 c: TIdTcpClient;
begin
  c := TIdTcpClient(AThread.Data);
  with AThread.Connection do
  begin
    if Assigned(c) then
    begin
      Log(Format('[%s -> %s:%d] 正在传输数据....', [Socket.Binding.PeerIP, c.Host, c.Port]));
      while c.Connected and Connected and not AThread.Terminated do
      begin
        bufsize := ReadFromStack(False, 1000, False);
        if bufsize > 0 then
        begin
          c.WriteBuffer(InputBuffer.Memory^, bufsize, True);
          InputBuffer.Remove(bufsize);
        end;
        bufsize := c.ReadFromStack(False, 1000, False);
        if bufsize > 0 then
        begin
          WriteBuffer(c.InputBuffer.Memory^, bufsize, True);
          c.InputBuffer.Remove(bufsize);
        end;
      end;
      Log(Format('[%s -> %s:%d] 传输数据结束.', [Socket.Binding.PeerIP, c.Host, c.Port]));
      c.Disconnect;
    end;
    Disconnect;
  end;
end;procedure Tdm_Kernal.ProxyServerException(AThread: TIdPeerThread;
  AException: Exception);
begin
  Log(AException.Message);
end;procedure Tdm_Kernal.ProxyServerDisconnect(AThread: TIdPeerThread);
begin
  with AThread.Connection.Socket.Binding do
    Log(Format('[%s (%8.0x)] 断开连接.', [PeerIP, Handle]));
end;procedure Tdm_Kernal.ClientDisconnected(Sender: TObject);
var c: TIdTcpConnection;
begin
  with TIdTcpClient(Sender) do
  begin
    if Owner is TIdTcpConnection then
    begin
      c := TIdTcpConnection(Owner);
      if Assigned(c) then
      begin
        Log(
          Format(
             '[%s -> %s:%d] 断开连接',
             [c.Socket.Binding.PeerIP, Host, Port]
          )
        );
        if c.Connected then c.Disconnect;
      end;
    end;
  end;
end;procedure Tdm_Kernal.Say(msg: String);
begin
  if Assigned(FOnStatus) then FOnStatus(msg);
end;function Tdm_Kernal._Login(username, password: String): Boolean;
begin
  //校验用户
  Result := True;
end;end.

Answer 3

LY Proxy Serverhttp://lysoft.7u7.net暂时没开放Code，但免费使用支持HTTP，Socks5TCP和Tunnel方法有很多的，下载LyProxyServer文档去看看了

Answer 4

嘿嘿，我的方案很好的
使用Message Queue代替Multi-thread，都算新鲜了呵呵：）

Answer 5

Tdm_Kernal是从什么地方引用过来的呢?请指教