udsocks.pas

delphi完成端口Socks例子,纯Delphi做的

unit UDSocks;

interface

uses Windows, SysUtils, Classes;

type
  TSite = class
  private
    FID: Integer;
    FName, FAddress: string;
  public
    constructor Create(AID: Integer; const AName, AAddress: string);
    property ID: Integer read FID;
    property Name: string read FName;
    property Address: string read FAddress;
  end;

  TSites = class
  private
    FList: TList;
    function GetCount: Integer;
    function GetItem(Index: Integer): TSite;
  public
    constructor Create;
    destructor Destroy; override;
    property Count: Integer read GetCount;
    property Items[index: Integer]: TSite read GetItem; default;
  end;

  TService = class
  private
    FPort: Integer;
    FSites: TSites;
    procedure ReplyData(Site: Integer; Data: Pointer; Size: Integer;
      var Reply: Pointer; var ReplySize: Integer);
    function ReadData(Site: Integer; Data: Pointer; Size: Integer): Boolean;
  protected
  public
    constructor Create;
    destructor Destroy; override;
    function StartServer: Boolean;
    procedure SendData(Site: TSite; Data: Pointer; DataSize: Integer);
    property Sites: TSites read FSites;
    property Port: Integer read FPort;
  end;

implementation

type
  PSiteInfo = ^TSiteInfo;
  TSiteInfo = record
    Key: Cardinal;
    HostName: array[0..127] of Char;
    Address: array[0..15] of Char;
  end;

  TReplyProc = procedure(Site: Integer; Data: Pointer; Size: Integer;
    var Reply: Pointer; var ReplySize: Integer);
  TReadProc = procedure(Site: Integer; Data: Pointer; Size: Integer;
    var Entire: Boolean);

const
  UDISocksDll = 'UDSocks.dll';

function _InitializeService(MasterPath: PChar): Boolean; stdcall; external UDISocksDll name 'InitializeService';
procedure _FinailizeService; stdcall; external UDISocksDll name 'FinailizeService';
procedure _InsertSite(SiteName: PChar); stdcall; external UDISocksDll name 'InsertSite';
procedure _RemoveSite(SiteName: PChar); stdcall; external UDISocksDll name 'RemoveSite';
function _StartServer(Port: Integer; ReplyProc: TReplyProc; ReadProc: TReadProc): Boolean; stdcall; external UDISocksDll name 'StartServer';
function _GetSites: Integer; stdcall; external UDISocksDll name 'GetSites';
function _GetSiteInfo(Index: Integer; var Info: PSiteInfo): Boolean; stdcall; external UDISocksDll name 'GetSiteInfo';
function _FindSiteInfo(ID: Integer; var Info: PSiteInfo): Boolean; stdcall; external UDISocksDll name 'FindSiteInfo';
function _SendData(Site: Integer; Data: Pointer; Size: Integer): Boolean; stdcall; external UDISocksDll name 'SendData';

{ TSite }

constructor TSite.Create(AID: Integer; const AName, AAddress: string);
begin
  FID := AID;
  FName := AName;
  FAddress := AAddress;
end;

{ TSites }

constructor TSites.Create;
var
  I, N: Integer;
  Info: PSiteInfo;
  Site: TSite;
begin
  FList := TList.Create;
  N := _GetSites;
  for I := 0 to Pred(N) do
    if _GetSiteInfo(I, Info) then
    begin
      Site := TSite.Create(Info^.Key, Info^.HostName, Info^.Address);
      FList.Add(Site);
    end;
end;

destructor TSites.Destroy;
var
  I: Integer;
begin
  I := Count;
  while I > 0 do
  begin
    Dec(I);
    Items[I].Free;
  end;
  FList.Free;
  inherited;
end;

function TSites.GetCount: Integer;
begin
  Result := FList.Count;
end;

function TSites.GetItem(Index: Integer): TSite;
begin
  Result := FList[Index];
end;

{ TService }

var
  _Service: TService;
  _Reply: Integer;

procedure _ReplyData(Site: Integer; Data: Pointer; Size: Integer;
  var Reply: Pointer; var ReplySize: Integer);
begin
  if _Service <> nil then
    _Service.ReplyData(Site, Data, Size, Reply, ReplySize);
end;

procedure _ReadData(Site: Integer; Data: Pointer; Size: Integer;
  var Entire: Boolean);
begin
  if _Service <> nil then
    Entire := _Service.ReadData(Site, Data, Size);
end;

constructor TService.Create;
var
  Path: string;
begin
  Path := SysUtils.ExtractFilePath(ParamStr(0));
  if _InitializeService(PChar(Path)) then
  begin
    _InsertSite('T60-BARTON');
    _InsertSite('www.163.com');
    _InsertSite('NOTFOUND');
    FSites := TSites.Create;
    FPort := 1823
  end;
end;

destructor TService.Destroy;
begin
  if FSites <> nil then
    FSites.Free;
  _FinailizeService;
  inherited;
end;

procedure TService.ReplyData(Site: Integer; Data: Pointer; Size: Integer;
  var Reply: Pointer; var ReplySize: Integer);
begin
  ReplySize := SizeOf(Integer);
  Reply := @_Reply;
  _Reply := 200;
end;

function TService.ReadData(Site: Integer; Data: Pointer; Size: Integer): Boolean;
begin
  Result := True;
end;

procedure TService.SendData(Site: TSite; Data: Pointer; DataSize: Integer);
begin
  _SendData(Site.ID, Data, DataSize);
end;

function TService.StartServer: Boolean;
begin
  if FSites <> nil then
  begin
    _Service := Self;
    Result := _StartServer(FPort, @_ReplyData, @_ReadData);
  end
  else
    Result := False;
end;

end.