P
paf
Unregistered / Unconfirmed
GUEST, unregistred user!
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Winsock;
type
PSocket = ^TSocket;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
//==== 域名、IP自动转为IP ====
function D_HostToIP(S: string): DWord;
var
Host: pHostent;
begin
Result := $FFFFFFFF;
Host := GetHostByName(Pchar(S)); //读取域名信息
if Host = nil then exit; //如果读取域名失败就EXIT
Result := longint(pointer(Host^.h_addr_list^)^);
end;
//连接函数
function d_connect(IP: Dword; Port: integer; var sock: TSocket): integer;
var
SockAddrIn: TSockAddrIn;
begin
//if sock <=0 then
//begin
sock := socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
SockAddrIn.sin_family := AF_INET;
SockAddrIn.sin_addr.s_addr := IP; //指定IP
SockAddrIn.sin_port := htons(Port); //设置端口
//end;
//建立 Socket 连接
Result := connect(sock, SockAddrIn, SizeOf(SockAddrIn));
end;
//用于代理连接
function THProxyClientCon(Ptr: Pointer): LongInt; stdcall;
const BufLen = 4096;
var
FdRead, AllFdSet: TFDSet;
ReSize: u_long;
i, re1, ConRe, bl, conPort, j, Pend1, end1, re: integer;
sendIndex: integer;
Buf: array[0..BufLen] of char;
tempSocket, SSocket, Dsocket: integer;
ConHost: string;
ConIP: dword;
Host: pHostent;
begin
if ptr = nil then exit;
SSocket := Psocket(ptr)^;
re := recv(SSocket, buf, BufLen, 0); //先读取数据
if re <= 0 then
begin
closesocket(SSocket);
exit;
end;
FD_ZERO(AllFdSet); //初始化Set为空集合
case Pdword(@buf)^ of
$20544547, $54534F50: //如果是 GET POST 才进行处理
begin
//=======================================================
// 处理GET 和 POST 头的一些代码
//=======================================================
Pend1 := -1;
end1 := -1;
for j := re downto 10 do
begin
case buf[j] of
#13: end1 := j;
#58: if (end1 > 0) and (Pend1 = -1) then Pend1 := j; // : 的位置
end;
if Pdword(@buf[j])^ = $74736F48 then //找到了 Host的位置了
begin
conPort := 80; //默认端口
ConHost := copy(buf, j + 7, end1 - j - 6); //域名信息(如果不是80端口时包括端口号)
bl := length(ConHost);
if (Pend1 > 0) and (Pend1 < end1) then //如果不是80端口的就分解端口
begin
Pend1 := Pend1 - j + 9;
conPort := strtointdef(copy(ConHost, Pend1 + 2, 5), 80); //得到端口信息,一般不是80端口的才要处理
ConHost := copy(ConHost, 1, Pend1); //得到相关的域名信息
end;
ConIP := D_HostToIP(ConHost); //域名转为IP
case Pdword(@buf)^ of
$20544547: //GET
begin
bl := bl + 7;
CopyMemory(@buf[bl], @buf, 4); //将 GET 向后移
end;
$54534F50: //POST
begin
bl := bl + 8;
CopyMemory(@buf[bl], @buf, 5); //将 POST 向后移
end;
else ;
end;
//========================================
ConRe := d_connect(ConIP, conPort, Dsocket); //开始连接
re := send(Dsocket, buf[bl], (re - bl), 0); //将读取到的GET或POST信息转发
if (re > 0) then //连接成功
begin //成功时
FD_SET(Ssocket, AllFdSet); //将客户连接添加集合中
FD_SET(Dsocket, AllFdSet); //将客户连接添加集合中
while true do
begin
FdRead := AllFdSet;
re := Select(0, @FdRead, nil, nil, nil); //用 Select 进行两个连接的监听
if re <= 0 then break;
for i := 0 to FdRead.fd_count - 1 do
begin
if FD_ISSET(FdRead.fd_array, AllFdSet) = false then break; //检测是否为 SET 成员
re := recv(FdRead.fd_array, buf, BufLen, 0);
if re > 0 then
begin
tempSocket := SSocket;
if FdRead.fd_array = SSocket then tempSocket := Dsocket;
re := send(tempSocket, buf, re, 0); //发送接收到的数据
if re <= 0 then
begin //发送失败就关掉
closesocket(SSocket);
closesocket(DSocket);
break;
end;
end
else begin //读取有错就关掉连接
closesocket(SSocket);
closesocket(DSocket);
break;
end;
end;
end;
end;
end;
end;
end;
else
begin //如果不是GET和POST命令的全部关掉
closesocket(SSocket);
end;
end;
end;
function THHttpProxy2(Ptr: Pointer): LongInt; stdcall;
var
wsadata: TWsadata;
HttpPoxySocket, Clientsocket: TSocket; //服务器 Socket
re: integer;
ClientAddr, Addr: TSockAddrIn;
ClientAddrLen: integer;
thid: dword;
HttpSocket: PSocket;
begin
if ptr = nil then exit;
WSAStartup($101, wsaData); //初始化网络
HttpPoxySocket := Socket(AF_INET, SOCK_STREAM, 0); //建立一个TCP的socket变量
with Addr do
begin
sin_family := AF_INET; //
sin_port := htons(Pdword(ptr)^); //端口
sin_addr.S_addr := htonl(INADDR_ANY); //任何地址
end;
re := bind(HttpPoxySocket, Addr, SizeOf(TSockAddrIn)); //邦定
if re = SOCKET_ERROR then exit;
re := listen(HttpPoxySocket, 5); //听
if re <> 0 then exit;
while true do
begin
ClientAddrLen := SizeOf(ClientAddr);
Clientsocket := accept(HttpPoxySocket, @ClientAddr, @ClientAddrLen); //处理连接
//为建立的连接创建一个监听线程
new(HttpSocket);
HttpSocket^ := Clientsocket; //保存些socket信息传到线程函数中
CreateThread(nil, 0, @THProxyClientCon, HttpSocket, 0, thid); //创建线程
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
thid: dword;
PPort: Pdword;
begin
new(PPort);
PPort^ := 5000; //代理开5000端口
CreateThread(nil, 0, @THHttpProxy2, PPort, 0, thid); //创建服务线程
Button1.Enabled := false;
end;
end.
像打开百度之类的网站没问题
http://www.baidu.com
但像网易
http://www.163.com
这样的站就不成，会有些图片不显示了！ 好像是网页中的内容太多，同时加载的连接过多就不正常一样，我也不知道为什么，不知问题出在哪里！
请大家帮忙看看！
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Winsock;
type
PSocket = ^TSocket;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
//==== 域名、IP自动转为IP ====
function D_HostToIP(S: string): DWord;
var
Host: pHostent;
begin
Result := $FFFFFFFF;
Host := GetHostByName(Pchar(S)); //读取域名信息
if Host = nil then exit; //如果读取域名失败就EXIT
Result := longint(pointer(Host^.h_addr_list^)^);
end;
//连接函数
function d_connect(IP: Dword; Port: integer; var sock: TSocket): integer;
var
SockAddrIn: TSockAddrIn;
begin
//if sock <=0 then
//begin
sock := socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
SockAddrIn.sin_family := AF_INET;
SockAddrIn.sin_addr.s_addr := IP; //指定IP
SockAddrIn.sin_port := htons(Port); //设置端口
//end;
//建立 Socket 连接
Result := connect(sock, SockAddrIn, SizeOf(SockAddrIn));
end;
//用于代理连接
function THProxyClientCon(Ptr: Pointer): LongInt; stdcall;
const BufLen = 4096;
var
FdRead, AllFdSet: TFDSet;
ReSize: u_long;
i, re1, ConRe, bl, conPort, j, Pend1, end1, re: integer;
sendIndex: integer;
Buf: array[0..BufLen] of char;
tempSocket, SSocket, Dsocket: integer;
ConHost: string;
ConIP: dword;
Host: pHostent;
begin
if ptr = nil then exit;
SSocket := Psocket(ptr)^;
re := recv(SSocket, buf, BufLen, 0); //先读取数据
if re <= 0 then
begin
closesocket(SSocket);
exit;
end;
FD_ZERO(AllFdSet); //初始化Set为空集合
case Pdword(@buf)^ of
$20544547, $54534F50: //如果是 GET POST 才进行处理
begin
//=======================================================
// 处理GET 和 POST 头的一些代码
//=======================================================
Pend1 := -1;
end1 := -1;
for j := re downto 10 do
begin
case buf[j] of
#13: end1 := j;
#58: if (end1 > 0) and (Pend1 = -1) then Pend1 := j; // : 的位置
end;
if Pdword(@buf[j])^ = $74736F48 then //找到了 Host的位置了
begin
conPort := 80; //默认端口
ConHost := copy(buf, j + 7, end1 - j - 6); //域名信息(如果不是80端口时包括端口号)
bl := length(ConHost);
if (Pend1 > 0) and (Pend1 < end1) then //如果不是80端口的就分解端口
begin
Pend1 := Pend1 - j + 9;
conPort := strtointdef(copy(ConHost, Pend1 + 2, 5), 80); //得到端口信息,一般不是80端口的才要处理
ConHost := copy(ConHost, 1, Pend1); //得到相关的域名信息
end;
ConIP := D_HostToIP(ConHost); //域名转为IP
case Pdword(@buf)^ of
$20544547: //GET
begin
bl := bl + 7;
CopyMemory(@buf[bl], @buf, 4); //将 GET 向后移
end;
$54534F50: //POST
begin
bl := bl + 8;
CopyMemory(@buf[bl], @buf, 5); //将 POST 向后移
end;
else ;
end;
//========================================
ConRe := d_connect(ConIP, conPort, Dsocket); //开始连接
re := send(Dsocket, buf[bl], (re - bl), 0); //将读取到的GET或POST信息转发
if (re > 0) then //连接成功
begin //成功时
FD_SET(Ssocket, AllFdSet); //将客户连接添加集合中
FD_SET(Dsocket, AllFdSet); //将客户连接添加集合中
while true do
begin
FdRead := AllFdSet;
re := Select(0, @FdRead, nil, nil, nil); //用 Select 进行两个连接的监听
if re <= 0 then break;
for i := 0 to FdRead.fd_count - 1 do
begin
if FD_ISSET(FdRead.fd_array, AllFdSet) = false then break; //检测是否为 SET 成员
re := recv(FdRead.fd_array, buf, BufLen, 0);
if re > 0 then
begin
tempSocket := SSocket;
if FdRead.fd_array = SSocket then tempSocket := Dsocket;
re := send(tempSocket, buf, re, 0); //发送接收到的数据
if re <= 0 then
begin //发送失败就关掉
closesocket(SSocket);
closesocket(DSocket);
break;
end;
end
else begin //读取有错就关掉连接
closesocket(SSocket);
closesocket(DSocket);
break;
end;
end;
end;
end;
end;
end;
end;
else
begin //如果不是GET和POST命令的全部关掉
closesocket(SSocket);
end;
end;
end;
function THHttpProxy2(Ptr: Pointer): LongInt; stdcall;
var
wsadata: TWsadata;
HttpPoxySocket, Clientsocket: TSocket; //服务器 Socket
re: integer;
ClientAddr, Addr: TSockAddrIn;
ClientAddrLen: integer;
thid: dword;
HttpSocket: PSocket;
begin
if ptr = nil then exit;
WSAStartup($101, wsaData); //初始化网络
HttpPoxySocket := Socket(AF_INET, SOCK_STREAM, 0); //建立一个TCP的socket变量
with Addr do
begin
sin_family := AF_INET; //
sin_port := htons(Pdword(ptr)^); //端口
sin_addr.S_addr := htonl(INADDR_ANY); //任何地址
end;
re := bind(HttpPoxySocket, Addr, SizeOf(TSockAddrIn)); //邦定
if re = SOCKET_ERROR then exit;
re := listen(HttpPoxySocket, 5); //听
if re <> 0 then exit;
while true do
begin
ClientAddrLen := SizeOf(ClientAddr);
Clientsocket := accept(HttpPoxySocket, @ClientAddr, @ClientAddrLen); //处理连接
//为建立的连接创建一个监听线程
new(HttpSocket);
HttpSocket^ := Clientsocket; //保存些socket信息传到线程函数中
CreateThread(nil, 0, @THProxyClientCon, HttpSocket, 0, thid); //创建线程
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
thid: dword;
PPort: Pdword;
begin
new(PPort);
PPort^ := 5000; //代理开5000端口
CreateThread(nil, 0, @THHttpProxy2, PPort, 0, thid); //创建服务线程
Button1.Enabled := false;
end;
end.
像打开百度之类的网站没问题
http://www.baidu.com
但像网易
http://www.163.com
这样的站就不成，会有些图片不显示了！ 好像是网页中的内容太多，同时加载的连接过多就不正常一样，我也不知道为什么，不知问题出在哪里！
请大家帮忙看看！
]