L
linuxping
Unregistered / Unconfirmed
GUEST, unregistred user!
{*******************************************************}
{ }
{ http下载单元 }
{ }
{*******************************************************}
unit HTTPGet;
interface
uses
Windows, Messages, SysUtils, Classes, WinInet;
type
TProxyType=(ptNone,ptIE,ptHttp,ptSock,ptGopher,ptFTP,ptHttpTunnel);
type
TOnProgressEvent = procedure(Sender: TObject; TotalSize, Readed: Integer) of object;
TOnDoneFileEvent = procedure(Sender: TObject; FileName:String; FileSize: Integer) of object;
TOnDoneStringEvent = procedure(Sender: TObject; Result: String) of object;
THTTPGetThread=class(TThread)
private
FProxyInfo:TInternetProxyInfo;
FTAcceptTypes,
FTAgent,
FTURL,
FTFileName,
FTStringResult,
FTUserName,
FTPassword,
FTPostQuery,
FTReferer: String;
FTBinaryData,
FTUseCache: Boolean;
FTResult: Boolean;
FTFileSize: Integer;
FTToFile: Boolean;
FProxyType:TProxyType;
FPort:Integer;
FHost:string;
FProxyUserName,FProxyPassword:string;
BytesToRead,BytesReaded: DWord;
FTProgress:TOnProgressEvent;
procedure UpdateProgress;
protected
procedure Execute; override;
public
constructor Create(aProxyType:TProxyType;aHost:string;aPort:Integer;aProxyUserName,aProxyPasswordaPort,aAcceptTypes,aAgent,aURL,aFileName,aUserName,aPassword,aPostQuery,aReferer:String;
aBinaryData,aUseCache:Boolean;aProgress:TOnProgressEvent;aToFile:Boolean);
end;
THTTPGet = class(TComponent)
private
FAcceptTypes: String;
FAgent: String;
FBinaryData: Boolean;
FURL: String;
FUseCache: Boolean;
FFileName: String;
FUserName: String;
FPassword: String;
FPostQuery: String;
FReferer: String;
FWaitThread: Boolean;
FThread: THTTPGetThread;
FError: TNotifyEvent;
FResult: Boolean;
FProgress: TOnProgressEvent;
FDoneFile: TOnDoneFileEvent;
FDoneString: TOnDoneStringEvent;
FProxyType:TProxyType;
FPort:Integer;
FHost:string;
FProxyUserName,FProxyPassword:string;
procedure ThreadDone(Sender: TObject);
procedure SetProxyType(const Value: TProxyType);
public
constructor Create(aOwner: TComponent); override;
destructor Destroy; override;
procedure GetFile;
procedure GetString;
procedure Abort;
published
property AcceptTypes: String read FAcceptTypes write FAcceptTypes;
property Agent: String read FAgent write FAgent;
property BinaryData: Boolean read FBinaryData write FBinaryData;
property URL: String read FURL write FURL;
property UseCache: Boolean read FUseCache write FUseCache;
property FileName: String read FFileName write FFileName;
property UserName: String read FUserName write FUserName;
property Password: String read FPassword write FPassword;
property PostQuery: String read FPostQuery write FPostQuery;
property Referer: String read FReferer write FReferer;
property WaitThread: Boolean read FWaitThread write FWaitThread;
property ProxyType:TProxyType read FProxyType write SetProxyType default ptNone;
property Port:Integer read FPort write FPort default INTERNET_DEFAULT_HTTP_PORT;
property ProxyHost:string read FHost write FHost;
property ProxyUserName:string read FProxyUserName write FProxyUserName;
property ProxyPassword:string read FProxyPassword write FProxyPassword;
property OnProgress: TOnProgressEvent read FProgress write FProgress;
property OnDoneFile: TOnDoneFileEvent read FDoneFile write FDoneFile;
property OnDoneString: TOnDoneStringEvent read FDoneString write FDoneString;
property OnError: TNotifyEvent read FError write FError;
end;
procedure Register;
implementation
// THTTPGetThread
constructor THTTPGetThread.Create(aProxyType:TProxyType;aHost:string;aPort:Integer;aProxyUserName,aProxyPasswordaPort,aAcceptTypes, aAgent, aURL, aFileName, aUserName, aPassword, aPostQuery, aReferer: String;
aBinaryData, aUseCache: Boolean; aProgress: TOnProgressEvent; aToFile: Boolean);
begin
FreeOnTerminate := True;
inherited Create(True);
FTAcceptTypes := aAcceptTypes;
FTAgent := aAgent;
FTURL := aURL;
FTFileName :=aFileName;
FTUserName :=aUserName;
FTPassword :=aPassword;
FTPostQuery := aPostQuery;
FTReferer:=aReferer;
FTProgress :=aProgress;
FTBinaryData := aBinaryData;
FTUseCache := aUseCache;
FProxyType:=aProxyType;
FPort:=aPort;
FHost:=aHost;
FTToFile:= aToFile;
Resume;
end;
procedure THTTPGetThread.UpdateProgress;
begin
FTProgress(Self, FTFileSize, BytesReaded);
end;
procedure THTTPGetThread.Execute;
var
hSession, hConnect, hRequest: hInternet;
HostName, FileName: String;
f: File;
Buf: Pointer;
dwBufLen, dwIndex: DWord;
Data: Array[0..$400] of Char;
TempStr: String;
RequestMethod: PChar;
InternetFlag: DWord;
AcceptType: LPStr;
//检测文件状态 2个变量
dwcode: array[1..20] of char;
re: integer;
strProxy:string;
Len:Cardinal;
procedure ParseURL(URL:String; var HostName, FileName: String);
procedure ReplaceChar(c1,c2: Char; var St:String);
var
p:Integer;
begin
while True do
begin
p := Pos(c1, St);
if p = 0 then
Break
else
St[p] := c2;
end;
end;
var
i: Integer;
begin
if Pos('http://', LowerCase(URL)) <> 0 then
System.Delete(URL, 1, 7);
i := Pos('/', URL);
HostName := Copy(URL, 1, i);
FileName := Copy(URL, i, Length(URL)- i+ 1);
if (Length(HostName) > 0) and (HostName[Length(HostName)]='/') then
SetLength(HostName,Length(HostName)- 1);
end;
procedure CloseHandles;
begin
InternetCloseHandle(hRequest);
InternetCloseHandle(hConnect);
InternetCloseHandle(hSession);
end;
begin
try
ParseURL(FTURL, HostName, FileName);
if Terminated then
begin
FTResult := False;
Exit;
end;
if FTAgent <> '' then
hSession := InternetOpen(PChar(FTAgent),INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0)
else
hSession := InternetOpen(nil,INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
///////////////////////////////////////////////////////////////////////////////////
case FProxyType of
ptNone:
hConnect:=InternetConnect(hSession, PChar(HostName),INTERNET_DEFAULT_HTTP_PORT,
PChar(FTUserName),
PChar(FTPassword),
INTERNET_SERVICE_HTTP,
0,0);
ptHttp,ptSock,ptGopher,ptFTP,ptIE:
hConnect:=InternetConnect(hSession,PChar(FHost),INTERNET_INVALID_PORT_NUMBER,
nil,
nil,
INTERNET_SERVICE_HTTP,
0,0);
ptHttpTunnel: SysUtils.Exception.Create('ptHttpTunnel not allowed NOW!');
end;
/////////////////////////////////////////////////////////////////////////////////
if FTPostQuery= '' then
RequestMethod:= 'GET'
else
RequestMethod:= 'POST';
if FTUseCache then
InternetFlag := 0
else
InternetFlag := INTERNET_FLAG_RELOAD;
AcceptType:= PChar('Accept: ' + FTAcceptTypes);
//------------------------------------------------------------
case FProxyType of
ptNone:
hRequest:= HttpOpenRequest(hConnect, RequestMethod, PChar(FileName), 'HTTP/1.0',
PChar(FTReferer), @AcceptType, InternetFlag or INTERNET_FLAG_RELOAD or INTERNET_FLAG_NO_CACHE_WRITE, 0);
ptHttpTunnel:;
else
hRequest:= HttpOpenRequest(hConnect, RequestMethod, PChar(FileName), 'HTTP/1.0',
PChar(FTReferer), @AcceptType, InternetFlag or INTERNET_FLAG_RELOAD or INTERNET_FLAG_NO_CACHE_WRITE, INTERNET_FLAG_KEEP_CONNECTION);
end;
case FProxyType of
ptNone:;
ptHttpTunnel:;
else
begin
FProxyInfo.dwAccessType:=INTERNET_OPEN_TYPE_PROXY;
FProxyInfo.lpszProxyBypass:=nil;
case FProxyType of
ptHttp: strProxy:=Format('HTTP=HTTP://%S:%D',[FHost,FPort]); {HTTP=HTTP://proxyserverort }
ptSock: strProxy:=Format('SOCKS=%S:%D',[FHost,FPort]); {SOCKS=proxyserverort}
ptGopher:strProxy:=Format('GOPHER=HTTP://%S:%D',[FHost,FPort]);
ptFTP: strProxy:=Format('FTP=FTP://%S:%D',[FHost,FPort]);
ptHttpTunnel: Exception.Create('ptHttpTunnel not allowed!');
end;
FProxyInfo.lpszProxy:=PAnsiChar(strProxy);
len:=0;
if FProxyType=ptIE then
begin
InternetQueryOption(nil,INTERNET_OPTION_PROXY,@FProxyInfo,Len);
InternetQueryOption(nil,INTERNET_OPTION_PROXY,@FProxyInfo,Len);
end;
InternetSetOption(hSession,INTERNET_OPTION_PROXY, @FProxyInfo, sizeof(INTERNET_PROXY_INFO));
InternetSetOption(hRequest,INTERNET_OPTION_PROXY_USERNAME,PAnsiChar(FProxyUserName),Length(FTUserName)+1);
InternetSetOption(hRequest,INTERNET_OPTION_PROXY_PASSWORD,PAnsiChar(FProxyPassword),Length(FTPassword)+1);
end;
end;
if FTPostQuery= '' then
HttpSendRequest(hRequest,nil,0,nil,0)
else
HttpSendRequest(hRequest, 'Content-Type: application/x-www-form-urlencoded', 47,
PChar(FTPostQuery), Length(FTPostQuery));
if Terminated then
begin
CloseHandles;
FTResult := False;
Exit;
end;
//检测文件状态
dwIndex := 0;
dwBufLen := 1024;
FTResult := HttpQueryInfo(hRequest, HTTP_QUERY_STATUS_CODE, @dwcode, dwBufLen, dwIndex);
re := StrToIntDef(pchar(@dwcode), 404); //如果不能转换,则负直为404
///////////////////Added by wangping . Add code to suport proxy. //////////////////////
//
// if string(dwcode)='407' then //HTTP_STATUS_PROXY_AUTH_REQ
// begin
//
//
//
// if FTPostQuery= '' then
// HttpSendRequest(hRequest,nil,0,nil,0)
// else
// HttpSendRequest(hRequest, 'Content-Type: application/x-www-form-urlencoded', 47,
// PChar(FTPostQuery), Length(FTPostQuery));
// dwIndex := 0;
// dwBufLen := 1024;
// FTResult := HttpQueryInfo(hRequest, HTTP_QUERY_STATUS_CODE, @dwcode, dwBufLen, dwIndex);
// re := StrToIntDef(pchar(@dwcode), 404); //如果不能转换,则负直为404
// end;
////////////////////////////////////////////////////////////////////////////////////////
if re <> 200 then
begin
CloseHandles;
FTResult := False;
Exit;
end;
//获取文件大小
dwIndex := 0;
dwBufLen := 1024;
GetMem(Buf, dwBufLen);
FTResult := HttpQueryInfo(hRequest, HTTP_QUERY_CONTENT_LENGTH,Buf, dwBufLen, dwIndex);
if Terminated then
begin
FreeMem(Buf);
CloseHandles;
FTResult := False;
Exit;
end;
if FTResult or not FTBinaryData then
begin
if FTResult then
FTFileSize := StrToInt(StrPas(Buf));
BytesReaded := 0;
if FTToFile then
begin
AssignFile(f, FTFileName);
Rewrite(f, 1);
end
else FTStringResult := '';
while True do
begin
if Terminated then
begin
if FTToFile then CloseFile(f);
FreeMem(Buf);
CloseHandles;
FTResult := False;
Exit;
end;
if not InternetReadFile(hRequest, @Data, SizeOf(Data), BytesToRead) then Break
else
if BytesToRead = 0 then Break
else
begin
if FTToFile then
BlockWrite(f, Data, BytesToRead)
else
begin
TempStr := Data;
SetLength(TempStr, BytesToRead);
FTStringResult := FTStringResult + TempStr;
end;
inc(BytesReaded, BytesToRead);
if Assigned(FTProgress) then
Synchronize(UpdateProgress);
end;
end;
if FTToFile then
FTResult := FTFileSize = Integer(BytesReaded)
else
begin
SetLength(FTStringResult, BytesReaded);
FTResult := BytesReaded <> 0;
end;
if FTToFile then CloseFile(f);
end;
FreeMem(Buf);
CloseHandles;
except
end;
end;
// HTTPGet
constructor THTTPGet.Create(aOwner: TComponent);
begin
inherited Create(aOwner);
FAcceptTypes := '*/*';
FAgent := 'UtilMind HTTPGet';
end;
destructor THTTPGet.Destroy;
begin
Abort;
inherited Destroy;
end;
procedure THTTPGet.GetFile;
var
Msg: TMsg;
begin
if not Assigned(FThread) then
begin
FThread:=THTTPGetThread.Create(ProxyType,ProxyHost,Port,ProxyUserName,ProxyPassword,FAcceptTypes,FAgent,FURL,FFileName,FUserName, FPassword,FPostQuery, FReferer,
FBinaryData, FUseCache, FProgress, True);
FThread.OnTerminate := ThreadDone;
if FWaitThread then
while Assigned(FThread) do
while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end
end;
procedure THTTPGet.GetString;
var
Msg: TMsg;
begin
if not Assigned(FThread) then
begin
FThread := THTTPGetThread.Create(ProxyType,ProxyHost,Port,ProxyUserName,ProxyPassword,FAcceptTypes,FAgent,FURL,FFileName,FUserName, FPassword,FPostQuery, FReferer,
FBinaryData, FUseCache, FProgress, True);
FThread.OnTerminate := ThreadDone;
if FWaitThread then
while Assigned(FThread) do
while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end
end;
procedure THTTPGet.Abort;
begin
if Assigned(FThread) then
begin
FThread.Terminate;
FThread.FTResult := False;
end;
end;
procedure THTTPGet.ThreadDone(Sender: TObject);
begin
FResult := FThread.FTResult;
if FResult then
if FThread.FTToFile then
if Assigned(FDoneFile) then FDoneFile(Self, FThread.FTFileName, FThread.FTFileSize) else
else
if Assigned(FDoneString) then FDoneString(Self, FThread.FTStringResult) else
else
if Assigned(FError) then FError(Self);
FThread := nil;
end;
procedure Register;
begin
RegisterComponents('UtilMind', [THTTPGet]);
end;
procedure THTTPGet.SetProxyType(const Value: TProxyType);
begin
if FProxyType <> Value then
FProxyType := Value;
end;
{
http_query_status_code 19 && 状态代码
http_query_status_text 20 && 状态文本
http_query_content_type 1 && 类型
http_query_content_length 5 && 内容长度
http_query_content_range 53 && 范围
http_query_date 9 && 日期
http_query_last_modified 11 && 最后修订
http_query_version 18 && 协议
http_query_raw_headers 21 && 获取 http 信息 - 分隔符为 0
http_query_raw_headers_crlf 22 && 获取 http 信息 - 分隔符为“回车换行符”
http_query_server 37 && 服务器
http_query_rest_method 45 && http协议命令
http_query_etag 54 && etag
}
{
使用方法:
HTTPGet1.URL := 'http://www.baidu.com/ss.zip';
HTTPGet1.FileName := 'c:/1.zip';
HTTPGet1.GetFile;
procedure TForm1.HTTPGet1Progress(Sender: TObject; TotalSize,
Readed: Integer);
begin
label1.Caption:=inttostr(TotalSize);
label2.Caption:=inttostr(Readed);
ProgressBar1.Max:=TotalSize;
ProgressBar1.Position:=Readed;
end;
}
end.
1> 以前的版本如果重复从服务器下载同一个文件,如果服务器更新了文件,不能下载更新或的文件.因为它直接从缓存读取.
2>以前的版本不支持代理,现在添加了支持代理的代码(但未经过测试---没有测试环境,希望有人能帮忙测试一下)
{ }
{ http下载单元 }
{ }
{*******************************************************}
unit HTTPGet;
interface
uses
Windows, Messages, SysUtils, Classes, WinInet;
type
TProxyType=(ptNone,ptIE,ptHttp,ptSock,ptGopher,ptFTP,ptHttpTunnel);
type
TOnProgressEvent = procedure(Sender: TObject; TotalSize, Readed: Integer) of object;
TOnDoneFileEvent = procedure(Sender: TObject; FileName:String; FileSize: Integer) of object;
TOnDoneStringEvent = procedure(Sender: TObject; Result: String) of object;
THTTPGetThread=class(TThread)
private
FProxyInfo:TInternetProxyInfo;
FTAcceptTypes,
FTAgent,
FTURL,
FTFileName,
FTStringResult,
FTUserName,
FTPassword,
FTPostQuery,
FTReferer: String;
FTBinaryData,
FTUseCache: Boolean;
FTResult: Boolean;
FTFileSize: Integer;
FTToFile: Boolean;
FProxyType:TProxyType;
FPort:Integer;
FHost:string;
FProxyUserName,FProxyPassword:string;
BytesToRead,BytesReaded: DWord;
FTProgress:TOnProgressEvent;
procedure UpdateProgress;
protected
procedure Execute; override;
public
constructor Create(aProxyType:TProxyType;aHost:string;aPort:Integer;aProxyUserName,aProxyPasswordaPort,aAcceptTypes,aAgent,aURL,aFileName,aUserName,aPassword,aPostQuery,aReferer:String;
aBinaryData,aUseCache:Boolean;aProgress:TOnProgressEvent;aToFile:Boolean);
end;
THTTPGet = class(TComponent)
private
FAcceptTypes: String;
FAgent: String;
FBinaryData: Boolean;
FURL: String;
FUseCache: Boolean;
FFileName: String;
FUserName: String;
FPassword: String;
FPostQuery: String;
FReferer: String;
FWaitThread: Boolean;
FThread: THTTPGetThread;
FError: TNotifyEvent;
FResult: Boolean;
FProgress: TOnProgressEvent;
FDoneFile: TOnDoneFileEvent;
FDoneString: TOnDoneStringEvent;
FProxyType:TProxyType;
FPort:Integer;
FHost:string;
FProxyUserName,FProxyPassword:string;
procedure ThreadDone(Sender: TObject);
procedure SetProxyType(const Value: TProxyType);
public
constructor Create(aOwner: TComponent); override;
destructor Destroy; override;
procedure GetFile;
procedure GetString;
procedure Abort;
published
property AcceptTypes: String read FAcceptTypes write FAcceptTypes;
property Agent: String read FAgent write FAgent;
property BinaryData: Boolean read FBinaryData write FBinaryData;
property URL: String read FURL write FURL;
property UseCache: Boolean read FUseCache write FUseCache;
property FileName: String read FFileName write FFileName;
property UserName: String read FUserName write FUserName;
property Password: String read FPassword write FPassword;
property PostQuery: String read FPostQuery write FPostQuery;
property Referer: String read FReferer write FReferer;
property WaitThread: Boolean read FWaitThread write FWaitThread;
property ProxyType:TProxyType read FProxyType write SetProxyType default ptNone;
property Port:Integer read FPort write FPort default INTERNET_DEFAULT_HTTP_PORT;
property ProxyHost:string read FHost write FHost;
property ProxyUserName:string read FProxyUserName write FProxyUserName;
property ProxyPassword:string read FProxyPassword write FProxyPassword;
property OnProgress: TOnProgressEvent read FProgress write FProgress;
property OnDoneFile: TOnDoneFileEvent read FDoneFile write FDoneFile;
property OnDoneString: TOnDoneStringEvent read FDoneString write FDoneString;
property OnError: TNotifyEvent read FError write FError;
end;
procedure Register;
implementation
// THTTPGetThread
constructor THTTPGetThread.Create(aProxyType:TProxyType;aHost:string;aPort:Integer;aProxyUserName,aProxyPasswordaPort,aAcceptTypes, aAgent, aURL, aFileName, aUserName, aPassword, aPostQuery, aReferer: String;
aBinaryData, aUseCache: Boolean; aProgress: TOnProgressEvent; aToFile: Boolean);
begin
FreeOnTerminate := True;
inherited Create(True);
FTAcceptTypes := aAcceptTypes;
FTAgent := aAgent;
FTURL := aURL;
FTFileName :=aFileName;
FTUserName :=aUserName;
FTPassword :=aPassword;
FTPostQuery := aPostQuery;
FTReferer:=aReferer;
FTProgress :=aProgress;
FTBinaryData := aBinaryData;
FTUseCache := aUseCache;
FProxyType:=aProxyType;
FPort:=aPort;
FHost:=aHost;
FTToFile:= aToFile;
Resume;
end;
procedure THTTPGetThread.UpdateProgress;
begin
FTProgress(Self, FTFileSize, BytesReaded);
end;
procedure THTTPGetThread.Execute;
var
hSession, hConnect, hRequest: hInternet;
HostName, FileName: String;
f: File;
Buf: Pointer;
dwBufLen, dwIndex: DWord;
Data: Array[0..$400] of Char;
TempStr: String;
RequestMethod: PChar;
InternetFlag: DWord;
AcceptType: LPStr;
//检测文件状态 2个变量
dwcode: array[1..20] of char;
re: integer;
strProxy:string;
Len:Cardinal;
procedure ParseURL(URL:String; var HostName, FileName: String);
procedure ReplaceChar(c1,c2: Char; var St:String);
var
p:Integer;
begin
while True do
begin
p := Pos(c1, St);
if p = 0 then
Break
else
St[p] := c2;
end;
end;
var
i: Integer;
begin
if Pos('http://', LowerCase(URL)) <> 0 then
System.Delete(URL, 1, 7);
i := Pos('/', URL);
HostName := Copy(URL, 1, i);
FileName := Copy(URL, i, Length(URL)- i+ 1);
if (Length(HostName) > 0) and (HostName[Length(HostName)]='/') then
SetLength(HostName,Length(HostName)- 1);
end;
procedure CloseHandles;
begin
InternetCloseHandle(hRequest);
InternetCloseHandle(hConnect);
InternetCloseHandle(hSession);
end;
begin
try
ParseURL(FTURL, HostName, FileName);
if Terminated then
begin
FTResult := False;
Exit;
end;
if FTAgent <> '' then
hSession := InternetOpen(PChar(FTAgent),INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0)
else
hSession := InternetOpen(nil,INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
///////////////////////////////////////////////////////////////////////////////////
case FProxyType of
ptNone:
hConnect:=InternetConnect(hSession, PChar(HostName),INTERNET_DEFAULT_HTTP_PORT,
PChar(FTUserName),
PChar(FTPassword),
INTERNET_SERVICE_HTTP,
0,0);
ptHttp,ptSock,ptGopher,ptFTP,ptIE:
hConnect:=InternetConnect(hSession,PChar(FHost),INTERNET_INVALID_PORT_NUMBER,
nil,
nil,
INTERNET_SERVICE_HTTP,
0,0);
ptHttpTunnel: SysUtils.Exception.Create('ptHttpTunnel not allowed NOW!');
end;
/////////////////////////////////////////////////////////////////////////////////
if FTPostQuery= '' then
RequestMethod:= 'GET'
else
RequestMethod:= 'POST';
if FTUseCache then
InternetFlag := 0
else
InternetFlag := INTERNET_FLAG_RELOAD;
AcceptType:= PChar('Accept: ' + FTAcceptTypes);
//------------------------------------------------------------
case FProxyType of
ptNone:
hRequest:= HttpOpenRequest(hConnect, RequestMethod, PChar(FileName), 'HTTP/1.0',
PChar(FTReferer), @AcceptType, InternetFlag or INTERNET_FLAG_RELOAD or INTERNET_FLAG_NO_CACHE_WRITE, 0);
ptHttpTunnel:;
else
hRequest:= HttpOpenRequest(hConnect, RequestMethod, PChar(FileName), 'HTTP/1.0',
PChar(FTReferer), @AcceptType, InternetFlag or INTERNET_FLAG_RELOAD or INTERNET_FLAG_NO_CACHE_WRITE, INTERNET_FLAG_KEEP_CONNECTION);
end;
case FProxyType of
ptNone:;
ptHttpTunnel:;
else
begin
FProxyInfo.dwAccessType:=INTERNET_OPEN_TYPE_PROXY;
FProxyInfo.lpszProxyBypass:=nil;
case FProxyType of
ptHttp: strProxy:=Format('HTTP=HTTP://%S:%D',[FHost,FPort]); {HTTP=HTTP://proxyserverort }
ptSock: strProxy:=Format('SOCKS=%S:%D',[FHost,FPort]); {SOCKS=proxyserverort}
ptGopher:strProxy:=Format('GOPHER=HTTP://%S:%D',[FHost,FPort]);
ptFTP: strProxy:=Format('FTP=FTP://%S:%D',[FHost,FPort]);
ptHttpTunnel: Exception.Create('ptHttpTunnel not allowed!');
end;
FProxyInfo.lpszProxy:=PAnsiChar(strProxy);
len:=0;
if FProxyType=ptIE then
begin
InternetQueryOption(nil,INTERNET_OPTION_PROXY,@FProxyInfo,Len);
InternetQueryOption(nil,INTERNET_OPTION_PROXY,@FProxyInfo,Len);
end;
InternetSetOption(hSession,INTERNET_OPTION_PROXY, @FProxyInfo, sizeof(INTERNET_PROXY_INFO));
InternetSetOption(hRequest,INTERNET_OPTION_PROXY_USERNAME,PAnsiChar(FProxyUserName),Length(FTUserName)+1);
InternetSetOption(hRequest,INTERNET_OPTION_PROXY_PASSWORD,PAnsiChar(FProxyPassword),Length(FTPassword)+1);
end;
end;
if FTPostQuery= '' then
HttpSendRequest(hRequest,nil,0,nil,0)
else
HttpSendRequest(hRequest, 'Content-Type: application/x-www-form-urlencoded', 47,
PChar(FTPostQuery), Length(FTPostQuery));
if Terminated then
begin
CloseHandles;
FTResult := False;
Exit;
end;
//检测文件状态
dwIndex := 0;
dwBufLen := 1024;
FTResult := HttpQueryInfo(hRequest, HTTP_QUERY_STATUS_CODE, @dwcode, dwBufLen, dwIndex);
re := StrToIntDef(pchar(@dwcode), 404); //如果不能转换,则负直为404
///////////////////Added by wangping . Add code to suport proxy. //////////////////////
//
// if string(dwcode)='407' then //HTTP_STATUS_PROXY_AUTH_REQ
// begin
//
//
//
// if FTPostQuery= '' then
// HttpSendRequest(hRequest,nil,0,nil,0)
// else
// HttpSendRequest(hRequest, 'Content-Type: application/x-www-form-urlencoded', 47,
// PChar(FTPostQuery), Length(FTPostQuery));
// dwIndex := 0;
// dwBufLen := 1024;
// FTResult := HttpQueryInfo(hRequest, HTTP_QUERY_STATUS_CODE, @dwcode, dwBufLen, dwIndex);
// re := StrToIntDef(pchar(@dwcode), 404); //如果不能转换,则负直为404
// end;
////////////////////////////////////////////////////////////////////////////////////////
if re <> 200 then
begin
CloseHandles;
FTResult := False;
Exit;
end;
//获取文件大小
dwIndex := 0;
dwBufLen := 1024;
GetMem(Buf, dwBufLen);
FTResult := HttpQueryInfo(hRequest, HTTP_QUERY_CONTENT_LENGTH,Buf, dwBufLen, dwIndex);
if Terminated then
begin
FreeMem(Buf);
CloseHandles;
FTResult := False;
Exit;
end;
if FTResult or not FTBinaryData then
begin
if FTResult then
FTFileSize := StrToInt(StrPas(Buf));
BytesReaded := 0;
if FTToFile then
begin
AssignFile(f, FTFileName);
Rewrite(f, 1);
end
else FTStringResult := '';
while True do
begin
if Terminated then
begin
if FTToFile then CloseFile(f);
FreeMem(Buf);
CloseHandles;
FTResult := False;
Exit;
end;
if not InternetReadFile(hRequest, @Data, SizeOf(Data), BytesToRead) then Break
else
if BytesToRead = 0 then Break
else
begin
if FTToFile then
BlockWrite(f, Data, BytesToRead)
else
begin
TempStr := Data;
SetLength(TempStr, BytesToRead);
FTStringResult := FTStringResult + TempStr;
end;
inc(BytesReaded, BytesToRead);
if Assigned(FTProgress) then
Synchronize(UpdateProgress);
end;
end;
if FTToFile then
FTResult := FTFileSize = Integer(BytesReaded)
else
begin
SetLength(FTStringResult, BytesReaded);
FTResult := BytesReaded <> 0;
end;
if FTToFile then CloseFile(f);
end;
FreeMem(Buf);
CloseHandles;
except
end;
end;
// HTTPGet
constructor THTTPGet.Create(aOwner: TComponent);
begin
inherited Create(aOwner);
FAcceptTypes := '*/*';
FAgent := 'UtilMind HTTPGet';
end;
destructor THTTPGet.Destroy;
begin
Abort;
inherited Destroy;
end;
procedure THTTPGet.GetFile;
var
Msg: TMsg;
begin
if not Assigned(FThread) then
begin
FThread:=THTTPGetThread.Create(ProxyType,ProxyHost,Port,ProxyUserName,ProxyPassword,FAcceptTypes,FAgent,FURL,FFileName,FUserName, FPassword,FPostQuery, FReferer,
FBinaryData, FUseCache, FProgress, True);
FThread.OnTerminate := ThreadDone;
if FWaitThread then
while Assigned(FThread) do
while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end
end;
procedure THTTPGet.GetString;
var
Msg: TMsg;
begin
if not Assigned(FThread) then
begin
FThread := THTTPGetThread.Create(ProxyType,ProxyHost,Port,ProxyUserName,ProxyPassword,FAcceptTypes,FAgent,FURL,FFileName,FUserName, FPassword,FPostQuery, FReferer,
FBinaryData, FUseCache, FProgress, True);
FThread.OnTerminate := ThreadDone;
if FWaitThread then
while Assigned(FThread) do
while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end
end;
procedure THTTPGet.Abort;
begin
if Assigned(FThread) then
begin
FThread.Terminate;
FThread.FTResult := False;
end;
end;
procedure THTTPGet.ThreadDone(Sender: TObject);
begin
FResult := FThread.FTResult;
if FResult then
if FThread.FTToFile then
if Assigned(FDoneFile) then FDoneFile(Self, FThread.FTFileName, FThread.FTFileSize) else
else
if Assigned(FDoneString) then FDoneString(Self, FThread.FTStringResult) else
else
if Assigned(FError) then FError(Self);
FThread := nil;
end;
procedure Register;
begin
RegisterComponents('UtilMind', [THTTPGet]);
end;
procedure THTTPGet.SetProxyType(const Value: TProxyType);
begin
if FProxyType <> Value then
FProxyType := Value;
end;
{
http_query_status_code 19 && 状态代码
http_query_status_text 20 && 状态文本
http_query_content_type 1 && 类型
http_query_content_length 5 && 内容长度
http_query_content_range 53 && 范围
http_query_date 9 && 日期
http_query_last_modified 11 && 最后修订
http_query_version 18 && 协议
http_query_raw_headers 21 && 获取 http 信息 - 分隔符为 0
http_query_raw_headers_crlf 22 && 获取 http 信息 - 分隔符为“回车换行符”
http_query_server 37 && 服务器
http_query_rest_method 45 && http协议命令
http_query_etag 54 && etag
}
{
使用方法:
HTTPGet1.URL := 'http://www.baidu.com/ss.zip';
HTTPGet1.FileName := 'c:/1.zip';
HTTPGet1.GetFile;
procedure TForm1.HTTPGet1Progress(Sender: TObject; TotalSize,
Readed: Integer);
begin
label1.Caption:=inttostr(TotalSize);
label2.Caption:=inttostr(Readed);
ProgressBar1.Max:=TotalSize;
ProgressBar1.Position:=Readed;
end;
}
end.
1> 以前的版本如果重复从服务器下载同一个文件,如果服务器更新了文件,不能下载更新或的文件.因为它直接从缓存读取.
2>以前的版本不支持代理,现在添加了支持代理的代码(但未经过测试---没有测试环境,希望有人能帮忙测试一下)