socksvcs.pas

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

unit SockSvcs;

interface

uses Windows, SockUtils;

type
  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);

function InitializeService(MasterPath: PChar): Boolean; stdcall;
procedure FinailizeService; stdcall;
procedure InsertSite(SiteName: PChar); stdcall;
procedure RemoveSite(SiteName: PChar); stdcall;
function StartServer(Port: Integer; ReplyProc: TReplyProc; ReadProc: TReadProc): Boolean; stdcall;
function GetSites: Integer; stdcall;
function GetSiteInfo(Index: Integer; var Info: PSiteInfo): Boolean; stdcall;
function FindSiteInfo(ID: Integer; var Info: PSiteInfo): Boolean; stdcall;
function SendData(Site: Integer; Data: Pointer; Size: Integer): Boolean; stdcall;

implementation

uses SysUtils, Lists, Streams, SyncObjects, Logs;

type
  TService = class(TCustomService)
  private
    FRunning, FEnabled: Boolean;
    FPort: Integer;
    FServerInfo: PServerInfo;
    FReplyProc: TReplyProc;
    FReadProc: TReadProc;
    procedure ClientConnected(Site: PSiteInfo);
    procedure ClientDisconnected(Site: PSiteInfo);
    procedure ServerConnected(Site: PSiteInfo);
    procedure ServerDisconnected(Site: PSiteInfo);
  protected
    function GetPort: Integer; override;
  public
    constructor Create;
    destructor Destroy; override;

    function StartServer: Boolean;
    procedure StopServer;

    procedure ClientChange(Site: PSiteInfo; Event: TSiteEvent); override;
    procedure ServerChange(Site: PSiteInfo; Event: TSiteEvent); override;
    procedure ProcessRequest(Site: PSiteInfo; Data: Pointer; Size: Integer); override;
    function ProcessReply(Site: PSiteInfo; Data: Pointer; Size: Integer): Boolean; override;
  end;

var
  Service: TService;
  Jet: TJet;

const
  BUFFER_SIZE = 8192;

procedure DoLog(const Msg: string);
begin
  Log.Write(Msg);
end;

{ Export Functions }

function InitializeService(MasterPath: PChar): Boolean; stdcall;
var
  LogFile: string;
begin
  InitializeLog;
  LogFile := 'UDSocks.Log';
  if MasterPath[Pred(StrLen(MasterPath))] <> '\' then
    LogFile := '\' + LogFile;
  TLog.SetLog(Format('%s%s', [MasterPath, LogFile]));
  Jet := InitializeWinSock2(@DoLog);
  Result := Jet <> nil;
  if Result then
    Service := TService.Create
  else
    Service := nil;
end;

procedure FinailizeService; stdcall;
begin
  if Service <> nil then
  begin
    Service.Free;
    Service := nil;
  end;
  FinalizeWinSock2;
  FinalizeLog;
end;

procedure InsertSite(SiteName: PChar); stdcall;
begin
  Jet.Sites.InsertSite(SiteName);
end;

procedure RemoveSite(SiteName: PChar); stdcall;
begin
  Jet.Sites.RemoveSite(SiteName);
end;

function StartServer(Port: Integer; ReplyProc: TReplyProc; ReadProc: TReadProc): Boolean; stdcall;
begin
  Service.FPort := Port;
  Service.FReplyProc := ReplyProc;
  Service.FReadProc := ReadProc;
  Result := Service.StartServer;
end;

function GetSites: Integer; stdcall;
begin
  Result := Jet.Sites.Count;
end;

function GetSiteInfo(Index: Integer; var Info: PSiteInfo): Boolean; stdcall;
begin
  Result := (Index >= 0) and (Index < Jet.Sites.Count);
  if Result then
    Info := Jet.Sites[Index];
end;

function FindSiteInfo(ID: Integer; var Info: PSiteInfo): Boolean; stdcall;
var
  Site: PSiteInfo;
begin
  Site := Jet.Sites.FindSite(ID);
  Result := Site <> nil;
  if Result then
    Info := Site;
end;

function SendData(Site: Integer; Data: Pointer; Size: Integer): Boolean; stdcall;
var
  ASite: PSiteInfo;
begin
  Result := (Data <> nil) and (Size > 0);
  if Result then
  begin
    ASite := Jet.Sites.FindSite(Site);
    Result := ASite <> nil;
    if Result then
      Jet.Send(ASite, Data, Size);
  end;
end;

{ TService }

function JobsThreadProc(Param: Pointer): Integer;
var
  Svc: TService;
begin
  LogMessage('Jobs Thread Start...');
  Svc := Param;
  while True do
    if Jet.WaitFor then
      if Svc.FEnabled then
        Jet.Rollup
      else
        Break;
  LogMessage('Jobs Thread Terminated');
  Result := 0;
end;

constructor TService.Create;
begin
  FRunning := False;
  FEnabled := StartThread(@JobsThreadProc, Self);
end;

destructor TService.Destroy;
begin
  StopServer;
  if FEnabled then
  begin
    FEnabled := False;
    SetEvent(Jet.Event);
  end;
  inherited;
end;

procedure TService.ClientConnected(Site: PSiteInfo);
begin
  LogMessage('CONNECTED AS CLIENT: %s[%s]', [Site^.HostName, Site^.Address]);
end;

procedure TService.ClientDisconnected(Site: PSiteInfo);
begin
  LogMessage('DISCONNECTED AS CLIENT: %s[%s]', [Site^.HostName, Site^.Address]);
end;

procedure TService.ServerConnected(Site: PSiteInfo);
begin
  LogMessage('CONNECTED AS SERVER: %s[%s]', [Site^.HostName, Site^.Address]);
end;

procedure TService.ServerDisconnected(Site: PSiteInfo);
begin
  LogMessage('DISCONNECTED AS SERVER: %s[%s]', [Site^.HostName, Site^.Address]);
end;

function TService.GetPort: Integer;
begin
  Result := FPort;
end;

function TService.StartServer: Boolean;
begin
  Result := (FPort > 0) and Assigned(FReplyProc) and Assigned(FReadProc);
  if Result then
    Result := StartSockServer(Self, FServerInfo);
end;

procedure TService.StopServer;
begin
  StopSockServer(FServerInfo);
end;

procedure TService.ClientChange(Site: PSiteInfo; Event: TSiteEvent);
begin
  if Event = seConnected then
    ClientConnected(Site)
  else
    ClientDisconnected(Site);
end;

procedure TService.ServerChange(Site: PSiteInfo; Event: TSiteEvent);
begin
  if Event = seConnected then
    ServerConnected(Site)
  else
    ServerDisconnected(Site);
end;

// 处理从客户端获取的数据
procedure TService.ProcessRequest(Site: PSiteInfo; Data: Pointer; Size: Integer);
var
  Response: Pointer;
  ResponseSize: Integer;
begin
  LogMessage('SVC: PROCESS REQUEST %d BYTES FROM SERVER %s[%s]', [Size, Site^.HostName, Site^.Address]);
  FReplyProc(Site^.Key, Data, Size, Response, ResponseSize);
  LogMessage('A3: WOULD REPLY %d BYTES TO CLIENT %s[%s]', [ResponseSize, Site^.HostName, Site^.Address]);
  if ResponseSize > 0 then
    Jet.Reply(Site, Response, ResponseSize);
end;

// 服务器回传数据
function TService.ProcessReply(Site: PSiteInfo; Data: Pointer;
  Size: Integer): Boolean;
begin
  LogMessage('SVC: RECEIVED REPLY %d BYTES FROM SERVER %s[%s]', [Size, Site^.HostName, Site^.Address]);
  FReadProc(Site^.Key, Data, Size, Result);
  LogMessage('B5: RECEIVED %d BYTES REPLY FROM CLIENT %s[%s]', [Size, Site^.HostName, Site^.Address]);
end;

end.