高手看过来!!!!!附支持通过http、socks4、socks5代理的元件,求调用demo (急急急急急!!!帮忙)(100分)

  • 主题发起人 主题发起人 richard.zhb
  • 开始时间 开始时间
R

richard.zhb

Unregistered / Unconfirmed
GUEST, unregistred user!
积分全部奉送。
客串delphi开发,无经验,找来个元件。
哪位能在这个基础上提供一个demo(包含source code) ?
以下为源码:

unit USocketClient;
interface

uses
Classes, ScktComp, SysUtils, Winsock, Windows;

type
TProxyType = (proxyTypeNone, proxyTypeHTTP, proxyTypeSOCKS4, proxyTypeSOCKS5);

TProxyClientSocket = class(TObject)
private
FSocket: TClientSocket;
FAddress: String;
FHost: String;
FPort: Word;

FProxyType: TProxyType;
FProxyAddress: String;
FProxyHost: String;
FProxyPort: Word;
FProxyAccount: String;
FProxyPassword: String;

FOnConnect: TSocketNotifyEvent;
FOnConnecting: TSocketNotifyEvent;
FOnDisconnect: TSocketNotifyEvent;
FOnLookup: TSocketNotifyEvent;
FOnError: TSocketErrorEvent;
FOnRead: TSocketNotifyEvent;
FOnWrite: TSocketNotifyEvent;
FConnected: Boolean;
function GetClientWinSocket: TClientWinSocket;
function GetActive: Boolean;

procedure SetOnConnect(Proc: TSocketNotifyEvent);
procedure SetOnConnecting(Proc: TSocketNotifyEvent);
procedure SetOnDisconnect(Proc: TSocketNotifyEvent);
procedure SetOnLookup(Proc: TSocketNotifyEvent);
procedure SetOnError(Proc: TSocketErrorEvent);
procedure SetOnRead(Proc: TSocketNotifyEvent);
procedure SetOnWrite(Proc: TSocketNotifyEvent);

procedure DoOnConnect(Sender: TObject; Socket: TCustomWinSocket);
procedure DoOnConnecting(Sender: TObject; Socket: TCustomWinSocket);
procedure DoOnDisconnect(Sender: TObject; Socket: TCustomWinSocket);
procedure DoOnLookup(Sender: TObject; Socket: TCustomWinSocket);
procedure DoOnError(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure DoOnRead(Sender: TObject; Socket: TCustomWinSocket);
procedure DoOnWrite(Sender: TObject; Socket: TCustomWinSocket);

procedure ProxyConnectionSuccess(Sender: TObject; Socket: TCustomWinSocket);
procedure ProxyConnectionFailure(Sender: TObject; Socket: TCustomWinSocket; ErrorCode: Integer);
procedure DoOnErrorOnConnecting(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer);

procedure DoInitProxyHTTPStage1(Sender: TObject; Socket: TCustomWinSocket);
procedure DoInitProxyHTTPStage2(Sender: TObject; Socket: TCustomWinSocket);

procedure DoInitProxySOCKS4Stage1(Sender: TObject; Socket: TCustomWinSocket);
procedure DoInitProxySOCKS4Stage2(Sender: TObject; Socket: TCustomWinSocket);

procedure DoInitProxySOCKS5Stage1(Sender: TObject; Socket: TCustomWinSocket);
procedure DoInitProxySOCKS5Stage2(Sender: TObject; Socket: TCustomWinSocket);
procedure DoInitProxySOCKS5Stage3(Sender: TObject; Socket: TCustomWinSocket);
procedure DoInitProxySOCKS5Stage4(Sender: TObject; Socket: TCustomWinSocket);
procedure DoInitProxySOCKS5AuthStage1(Sender: TObject; Socket: TCustomWinSocket);
procedure DoInitProxySOCKS5AuthStage2(Sender: TObject; Socket: TCustomWinSocket);

function GetHostAddr: u_long;
function EncodeBase64(Str: String): String;
public
constructor Create(AOwner: TComponent);
destructor Destroy; override;
procedure Open;
procedure Close;

property Address: String read FAddress write FAddress;
property Host: String read FHost write FHost;
property Port: Word read FPort write FPort;
property ProxyType: TProxyType read FProxyType write FProxyType;
property ProxyAddress: String read FProxyAddress write FProxyAddress;
property ProxyHost: String read FProxyHost write FProxyHost;
property ProxyPort: Word read FProxyPort write FProxyPort;
property ProxyAccount: String write FProxyAccount;
property ProxyPassword: String write FProxyPassword;
property OnConnect: TSocketNotifyEvent read FOnConnect write SetOnConnect;
property OnConnecting: TSocketNotifyEvent read FOnConnecting write SetOnConnecting;
property OnDisconnect: TSocketNotifyEvent read FOnDisconnect write SetOnDisconnect;
property OnLookup: TSocketNotifyEvent read FOnLookup write SetOnLookup;
property OnError: TSocketErrorEvent read FOnError write SetOnError;
property OnRead: TSocketNotifyEvent read FOnRead write SetOnRead;
property OnWrite: TSocketNotifyEvent read FOnWrite write SetOnWrite;
property Socket: TClientWinSocket read GetClientWinSocket;
property Active: Boolean read GetActive;
end;

implementation

constructor TProxyClientSocket.Create(AOwner: TComponent);
begin
If not Assigned(FSocket) then
FSocket := TClientSocket.Create(AOwner);
FConnected := False;
FAddress := '';
FHost := '';
FPort := 0;
FProxyType := proxyTypeNone;
FProxyAddress := '';
FProxyHost := '';
FProxyPort := 0;
FProxyAccount := '';
FProxyPassword := '';

FSocket.OnConnect := DoOnConnect;
FSocket.OnDisconnect := DoOnDisconnect;
FSocket.OnRead := DoOnRead;
FSocket.OnError := DoOnError;
end;

destructor TProxyClientSocket.Destroy;
begin
if Assigned(FSocket) then
FreeAndNil(FSocket);
end;

procedure TProxyClientSocket.Open;
begin
case FProxyType of
proxyTypeNone:
begin
FSocket.Address := FAddress;
FSocket.Host := FHost;
FSocket.Port := FPort;
end;
proxyTypeHTTP, proxyTypeSOCKS4, proxyTypeSOCKS5:
begin
FSocket.Address := FProxyAddress;
FSocket.Host := FProxyHost;
FSocket.Port := FProxyPort;
end;
end;
FSocket.Open;
end;

procedure TProxyClientSocket.Close;
begin
If FSocket.Active Then
FSocket.Close;
end;

procedure TProxyClientSocket.SetOnConnect(Proc: TSocketNotifyEvent);
begin
FOnConnect := Proc;
end;

procedure TProxyClientSocket.SetOnConnecting(Proc: TSocketNotifyEvent);
begin
FOnConnecting := Proc;
FSocket.OnConnecting := DoOnConnecting;
end;

procedure TProxyClientSocket.SetOnDisconnect(Proc: TSocketNotifyEvent);
begin
FOnDisconnect := Proc;
end;

procedure TProxyClientSocket.SetOnLookup(Proc: TSocketNotifyEvent);
begin
FOnLookup := Proc;
FSocket.OnLookup := DoOnLookup;
end;

procedure TProxyClientSocket.SetOnError(Proc: TSocketErrorEvent);
begin
FOnError := Proc;
end;

procedure TProxyClientSocket.SetOnRead(Proc: TSocketNotifyEvent);
begin
FOnRead := Proc;
end;

procedure TProxyClientSocket.SetOnWrite(Proc: TSocketNotifyEvent);
begin
FOnWrite := Proc;
FSocket.OnWrite := DoOnWrite;
end;

procedure TProxyClientSocket.DoOnConnecting(Sender: TObject; Socket: TCustomWinSocket);
begin
If Assigned(FOnConnecting) then
FOnConnecting(Sender, Socket);
end;

procedure TProxyClientSocket.DoOnConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
case FProxyType of
proxyTypeNone:
begin
FConnected := True;
If Assigned(FOnConnect) then
FOnConnect(Sender, Socket);
end;
proxyTypeHTTP:
begin
FSocket.OnError := DoOnErrorOnConnecting;
DoInitProxyHTTPStage1(Sender, Socket);
end;
proxyTypeSOCKS4:
begin
FSocket.OnError := DoOnErrorOnConnecting;
DoInitProxySOCKS4Stage1(Sender, Socket);
end;
proxyTypeSOCKS5:
begin
FSocket.OnError := DoOnErrorOnConnecting;
DoInitProxySOCKS5Stage1(Sender, Socket);
end;
end;
end;

procedure TProxyClientSocket.DoOnDisconnect(Sender: TObject; Socket: TCustomWinSocket);
begin
If FConnected then
begin
If Assigned(FOnDisconnect) then
FOnDisconnect(Sender, Socket);
FConnected := False;
end;
end;

procedure TProxyClientSocket.DoOnLookup(Sender: TObject; Socket: TCustomWinSocket);
begin
If Assigned(FOnLookup) then
FOnLookup(Sender, Socket);
end;

procedure TProxyClientSocket.DoOnError(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
If Assigned(FOnError) then
FOnError(Sender, Socket, ErrorEvent, ErrorCode);
end;

procedure TProxyClientSocket.DoOnRead(Sender: TObject; Socket: TCustomWinSocket);
begin
If Assigned(FOnRead) then
FOnRead(Sender, Socket);
end;

procedure TProxyClientSocket.DoOnWrite(Sender: TObject; Socket: TCustomWinSocket);
begin
If Assigned(FOnWrite) then
FOnWrite(Sender, Socket);
end;

function TProxyClientSocket.GetClientWinSocket: TClientWinSocket;
begin
Result := nil;
If Assigned(FSocket) then
Result := FSocket.Socket;
end;

function TProxyClientSocket.GetActive: Boolean;
begin
Result := False;
If Assigned(FSocket) then
Result := FSocket.Active;
end;

//-------------------------------------------------------------------------------
// Handle events on connecting via proxy servers.
//-------------------------------------------------------------------------------

procedure TProxyClientSocket.ProxyConnectionSuccess(Sender: TObject; Socket: TCustomWinSocket);
begin
FConnected := True;
FSocket.OnRead := DoOnRead;
FSocket.OnError := DoOnError;
If Assigned(FOnConnect) then
FOnConnect(Sender, Socket);
end;

procedure TProxyClientSocket.ProxyConnectionFailure(Sender: TObject; Socket: TCustomWinSocket; ErrorCode: Integer);
begin
FSocket.OnRead := DoOnRead;
FSocket.OnError := DoOnError;
FSocket.Close;
DoOnError(Sender, Socket, eeConnect, ErrorCode);
end;

procedure TProxyClientSocket.DoOnErrorOnConnecting(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
FSocket.OnRead := DoOnRead;
FSocket.OnError := DoOnError;
FSocket.Close;
DoOnError(Sender, Socket, ErrorEvent, ErrorCode);
end;

//-------------------------------------------------------------------------------
// HTTP Proxy
//-------------------------------------------------------------------------------

procedure TProxyClientSocket.DoInitProxyHTTPStage1(Sender: TObject; Socket: TCustomWinSocket);
var
Cmd, CmdConnect, CmdAuth: String;
begin
If FHost <> '' then
CmdConnect := Format('CONNECT %s:%d HTTP/1.1'#13#10 +
'Host: %s:%d'#13#10 +
'Connection: Keep-Alive'#13#10,
[FHost, FPort, FHost, FPort])
else
CmdConnect := Format('CONNECT %s:%d HTTP/1.1'#13#10 +
'Host: %s:%d'#13#10 +
'Connection: Keep-Alive'#13#10,
[FAddress, FPort, FAddress, FPort]);
If (FProxyAccount <> '') and (FProxyPassword <> '') then
CmdAuth := 'Proxy-Authorization: Basic ' +
EncodeBase64(Format('%s:%s'#13#10, [FProxyAccount, FProxyPassword]))
else
CmdAuth := '';
Cmd := Format('%s%s'#13#10, [CmdConnect, CmdAuth]);

FSocket.OnRead := DoInitProxyHTTPStage2;
FSocket.Socket.SendText(Cmd);
end;

procedure TProxyClientSocket.DoInitProxyHTTPStage2(Sender: TObject; Socket: TCustomWinSocket);
var
ReceiveText: String;
StatusStr: String;
StatusCode: Integer;
P, ErrPos: Integer;
begin
StatusCode := 0;
ReceiveText := Socket.ReceiveText;
P := Pos('HTTP/', ReceiveText);
If P > 0 then
begin
StatusStr := Copy(ReceiveText, P + 9, 3);
Val(StatusStr, StatusCode, ErrPos);
end;

If StatusCode = 200 then
ProxyConnectionSuccess(Sender, Socket)
else
ProxyConnectionFailure(Sender, Socket, 1000 + StatusCode);
end;

//-------------------------------------------------------------------------------
// SOCKS4 Proxy
//-------------------------------------------------------------------------------

procedure TProxyClientSocket.DoInitProxySOCKS4Stage1(Sender: TObject; Socket: TCustomWinSocket);
var
I, PcktLen: Integer;
Pckt: String;
AuthStr: String;
HostAddr: TInAddr;
begin
HostAddr.S_addr := GetHostAddr;
If HostAddr.S_addr = INADDR_NONE then
ProxyConnectionFailure(Sender, Socket, WSAHOST_NOT_FOUND)
else
begin
AuthStr := '';
If (FProxyAccount <> '') and (FProxyPassword <> '') then
AuthStr := EncodeBase64(Format('%s:%s'#13#10, [FProxyAccount, FProxyPassword]));
PcktLen := 1 + 1 + 2 + 4 + Length(AuthStr) + 1;
SetLength(Pckt, PcktLen);

Pckt[1] := Char(4); // Version
Pckt[2] := Char(1); // Cmd: CONNECT
Pckt[3] := Char(Hi(FPort)); // Hi-bits of the port
Pckt[4] := Char(Lo(FPort)); // Lo-bits of the port
Pckt[5] := HostAddr.S_un_b.s_b1; // Remote IP Address
Pckt[6] := HostAddr.S_un_b.s_b2;
Pckt[7] := HostAddr.S_un_b.s_b3;
Pckt[8] := HostAddr.S_un_b.s_b4;
If AuthStr <> '' then
For I := 1 to Length(AuthStr) do
Pckt[8 + I] := AuthStr;
Pckt[9 + Length(AuthStr)] := #0;

FSocket.OnRead := DoInitProxySOCKS4Stage2;
FSocket.Socket.SendText(Pckt);
end;
end;

procedure TProxyClientSocket.DoInitProxySOCKS4Stage2(Sender: TObject; Socket: TCustomWinSocket);
var
L: Integer;
RcvBuf: array[1..10] of Byte;
begin
L := Socket.ReceiveBuf(RcvBuf, 10);
If (L >= 2) and (RcvBuf[1] = 0) then
begin
If RcvBuf[2] = 90 then
ProxyConnectionSuccess(Sender, Socket)
else
ProxyConnectionFailure(Sender, Socket, 4000 + RcvBuf[2]);
end else
ProxyConnectionFailure(Sender, Socket, 4000);
end;

//-------------------------------------------------------------------------------
// SOCKS5 Proxy
//-------------------------------------------------------------------------------

procedure TProxyClientSocket.DoInitProxySOCKS5Stage1(Sender: TObject; Socket: TCustomWinSocket);
var
Pckt: String;
begin
FSocket.OnRead := DoInitProxySOCKS5Stage2;
If (FProxyAccount <> '') and (FProxyPassword <> '') then
begin
SetLength(Pckt, 4);
Pckt[1] := Char(5); // Version
Pckt[2] := Char(2); // # of methods to identify
Pckt[3] := Char(0); // No authentication
Pckt[4] := Char(2); // Username/Password
FSocket.Socket.SendText(Pckt);
end else
begin
SetLength(Pckt, 3);
Pckt[1] := Char(5); // Version
Pckt[2] := Char(1); // # of methods to identify
Pckt[3] := Char(0); // No authentication
FSocket.Socket.SendText(Pckt);
end;
end;

procedure TProxyClientSocket.DoInitProxySOCKS5Stage2(Sender: TObject; Socket: TCustomWinSocket);
var
L: Integer;
RcvBuf: array[1..10] of Byte;
begin
L := Socket.ReceiveBuf(RcvBuf, 10);
If L >= 2 then
begin
If RcvBuf[2] = $00 then
DoInitProxySOCKS5Stage3(Sender, Socket)
else If RcvBuf[2] = $02 then
DoInitProxySOCKS5AuthStage1(Sender, Socket)
else
ProxyConnectionFailure(Sender, Socket, 5200 + RcvBuf[2]);
end else
ProxyConnectionFailure(Sender, Socket, 5200);
end;

procedure TProxyClientSocket.DoInitProxySOCKS5Stage3(Sender: TObject; Socket: TCustomWinSocket);
var
I: Integer;
Pckt: String;
PcktLen: Integer;
HostAddr: TInAddr;
begin
PcktLen := 0;
If FHost <> '' then
begin
PcktLen := 7 + Length(FHost);
end else If FAddress <> '' then
begin
HostAddr.S_addr := inet_addr(PChar(FAddress));
If HostAddr.S_addr <> INADDR_NONE then
PcktLen := 10;
end;

If PcktLen > 0 then
begin
SetLength(Pckt, PcktLen);

Pckt[1] := Char(5); // Version
Pckt[2] := Char(1); // Cmd: CONNECT
Pckt[3] := Char(0); // Reserved
If FHost <> '' then
begin
Pckt[4] := Char($03); // Addr. Type: FQDN
Pckt[5] := Char(Length(FHost));
For I := 1 to Length(FHost) do
Pckt[5 + I] := FHost;
end else
begin
Pckt[4] := Char($01); // Addr. Type: IP-V4
Pckt[5] := HostAddr.S_un_b.s_b1; // Remote IP Address
Pckt[6] := HostAddr.S_un_b.s_b2;
Pckt[7] := HostAddr.S_un_b.s_b3;
Pckt[8] := HostAddr.S_un_b.s_b4;
end;
Pckt[PcktLen - 1] := Char(Hi(FPort));
Pckt[PcktLen ] := Char(Lo(FPort));

FSocket.OnRead := DoInitProxySOCKS5Stage4;
FSocket.Socket.SendText(Pckt);
end else
ProxyConnectionFailure(Sender, Socket, WSAHOST_NOT_FOUND);
end;

procedure TProxyClientSocket.DoInitProxySOCKS5Stage4(Sender: TObject; Socket: TCustomWinSocket);
var
L: Integer;
RcvBuf: array[1..10] of Byte;
begin
L := Socket.ReceiveBuf(RcvBuf, 10);

If L >= 2 then
begin
If RcvBuf[2] = $00 then
ProxyConnectionSuccess(Sender, Socket)
else
ProxyConnectionFailure(Sender, Socket, 5400 + RcvBuf[2]);
end else
ProxyConnectionFailure(Sender, Socket, 5400);
end;

//-------------------------------------------------------------------------------
// SOCKS5 Username/Password Auth
//-------------------------------------------------------------------------------

procedure TProxyClientSocket.DoInitProxySOCKS5AuthStage1(Sender: TObject; Socket: TCustomWinSocket);
var
I, PcktLen: Integer;
ULen, PLen: Byte;
Pckt: array of Byte;
begin
ULen := Byte(Length(FProxyAccount));
PLen := Byte(Length(FProxyPassword));
PcktLen := 1 + 1 + ULen + 1 + PLen;

Pckt[0] := 1; // Version
Pckt[1] := ULen; // Length of account
// Account
For I := 1 to ULen do
Pckt[1 + I] := Byte(FProxyAccount);
Pckt[2 + ULen] := PLen; // Length of password
// Password
For I := 1 to PLen do
Pckt[2 + ULen + I] := Byte(FProxyPassword);

FSocket.OnRead := DoInitProxySOCKS5AuthStage2;
FSocket.Socket.SendBuf(Pckt, PcktLen);
end;

procedure TProxyClientSocket.DoInitProxySOCKS5AuthStage2(Sender: TObject; Socket: TCustomWinSocket);
var
L: Integer;
RcvBuf: array[1..10] of Byte;
begin
L := Socket.ReceiveBuf(RcvBuf, 10);
If (L >= 2) then
begin
If RcvBuf[2] = $00 then
DoInitProxySOCKS5Stage3(Sender, Socket)
else
ProxyConnectionFailure(Sender, Socket, 5300 + RcvBuf[2]);
end else
ProxyConnectionFailure(Sender, Socket, 5300);
end;

//-------------------------------------------------------------------------------
// Obtain host addr
//-------------------------------------------------------------------------------

function TProxyClientSocket.GetHostAddr: u_long;
var
Ip: u_long;
HostEnt: PHostEnt;
begin
Result := INADDR_NONE;
If FHost <> '' then
begin
HostEnt := gethostbyname(PChar(FHost));
If Assigned(HostEnt) then
begin
Result := PInAddr(HostEnt^.h_addr_list^)^.S_addr;
end;
end;

If (Result = INADDR_NONE) and (FAddress <> '') then
begin
Ip := inet_addr(PChar(FAddress));
If Ip <> INADDR_NONE then
begin
Result := Ip;
end;
end;
end;

//-------------------------------------------------------------------------------
// Base64 Encoding for Authentication
//-------------------------------------------------------------------------------

const
Base64 = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';

function TProxyClientSocket.EncodeBase64(Str: String): String;
var
I, J, K: Integer;
SubStr: array[1..3] of Integer;
ChrPos: array[1..4] of Integer;
begin
Result := '';
J := 1;
For I := 1 to Length(Str) do
begin
SubStr[J] := Integer(Str);
Inc(J);
If J > 3 then
begin
ChrPos[1] := (SubStr[1] and $FC) shr 2;
ChrPos[2] := ((SubStr[1] and $03) shl 4) or ((SubStr[2] and $F0) shr 4);
ChrPos[3] := ((SubStr[2] and $0F) shl 2) or ((SubStr[3] and $C0) shr 6);
ChrPos[4] := (SubStr[3] and $3F);
For K := 1 to 4 do
Result := Result + Base64[ChrPos[K] + 1];
J := 1;
end;
end;

If J > 1 then
begin
For K := J to 3 do
SubStr[K] := 0;

ChrPos[1] := (SubStr[1] and $FC) shr 2;
ChrPos[2] := ((SubStr[1] and $03) shl 4) or ((SubStr[2] and $F0) shr 4);
ChrPos[3] := ((SubStr[2] and $0F) shl 2) or ((SubStr[3] and $C0) shr 6);
ChrPos[4] := (SubStr[3] and $3F);

For K := 1 to 4 do
begin
If K > J then
Result := Result + '='
else
Result := Result + Base64[ChrPos[K] + 1];
end;
end;
end;

end.
 
有兴趣研究一下,请联系我,QQ:10609090
 
没兴趣~~我是新人~~
Borland不是建议不用TClientSocket了么?
 
搞定了。
 

Similar threads

后退
顶部