////////////////////////
// http get component //
// program designer //
// wangchangyu //
// 2004-06 //
////////////////////////
unit HttpGet;
interface
uses
Windows, SysUtils, WinInet;
type
TSaveType=(stFile,stString);
type
THTTPGet = class
private
FAcceptTypes: String;
FAgent: String;
FBinaryData: Boolean;
FURL: String;
Ffilesize:Integer;
FUseCache: Boolean;
FFileName: String;
FUserName: String;
FPassword: String;
FPostQuery: String;
FReferer: String;
fStringResult:String;
FResult: Boolean;
fSaveType:TSaveType;
BytesToRead, BytesReaded: DWord;
Function Exectue:Boolean;
protected
{}
public
constructor Create;
//destructor Destroy;
Function GetFile(var aFileName:String; var aFileSize:Cardinal):Boolean;
Function GetString(var aResult:String):Boolean;
published
property AcceptTypes: String read FAcceptTypes write FAcceptTypes;
property Agent: String read FAgent write FAgent;
property BinaryData: Boolean read FBinaryData write FBinaryData default false;
property URL: String read FURL write FURL;
property UseCache: Boolean read FUseCache write FUseCache default false;
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;
end;
implementation
constructor THttpGet.Create;
begin
FAcceptTypes := '*/*';
FAgent := 'zzutrain Soft HTTPGet';
fBinaryData:=False;
fUseCache:=False;
fSaveType:=stString;
end;
{destructor THttpGet.Destroy;
begin
end;
}
Function THttpGet.Exectue:Boolean;
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;
TcpPort:Word;
procedure ParseURL(URL: String; var HostName, FileName: String);
var
i: Integer;
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;
begin
if Pos('http://', LowerCase(URL)) <> 0 then System.Delete(URL, 1, 7);
i := Pos('/', URL);
HostName := Copy(URL, 1, i-1);
TcpPort:=Pos(':',HostName);
if TcpPort>0 then begin
FileName:=Copy(HostName,1,TcpPort-1);
Delete(HostName,1,TcpPort);
TcpPort:=StrToInt(HostName);
HostName:=FileName;
end else TcpPort:=INTERNET_DEFAULT_HTTP_PORT;
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(FURL, HostName, FileName);
if FAgent <> '' then
hSession := InternetOpen(PChar(FAgent),INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0)
else
hSession := InternetOpen(nil,INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
hConnect := InternetConnect(hSession, PChar(HostName),TcpPort, PChar(FUserName), PChar(FPassword), INTERNET_SERVICE_HTTP, 0, 0);
if FPostQuery = '' then RequestMethod := 'GET' else RequestMethod := 'POST';
if FUseCache then InternetFlag := 0 else InternetFlag := INTERNET_FLAG_RELOAD;
AcceptType := PChar('Accept: ' + FAcceptTypes);
hRequest := HttpOpenRequest(hConnect, RequestMethod, PChar(FileName), 'HTTP/1.0',PChar(FReferer), @AcceptType, InternetFlag, 0);
if FPostQuery = '' then
HttpSendRequest(hRequest, nil, 0, nil, 0)
else
HttpSendRequest(hRequest, 'Content-Type: application/x-www-form-urlencoded', 47,PChar(FPostQuery), Length(FPostQuery));
dwIndex := 0;
dwBufLen := 1024;
GetMem(Buf, dwBufLen);
FResult := HttpQueryInfo(hRequest, HTTP_QUERY_CONTENT_LENGTH, Buf, dwBufLen, dwIndex);
if FResult or not FBinaryData then begin
if FResult then FFileSize := StrToInt(StrPas(Buf));
BytesReaded := 0;
Case fSaveType of
stFile: begin
AssignFile( f, FFileName);
Rewrite(f, 1);
end
else FStringResult := '';
end;
while True do begin
if not InternetReadFile(hRequest, @Data, SizeOf(Data), BytesToRead) then Break
else
if BytesToRead = 0 then Break else begin
if fSaveType=stfile then BlockWrite(f, Data, BytesToRead) else begin
TempStr := Data;
SetLength(TempStr, BytesToRead);
FStringResult := FStringResult + TempStr;
end;
inc(BytesReaded, BytesToRead);
//if Assigned(FProgress) then UpdateProgress;
end;
end;
if fSavetype=stFile then
FResult := FFileSize = Integer(BytesReaded)
else begin
SetLength(FStringResult, BytesReaded);
FResult := BytesReaded <> 0;
end;
if FSaveType=stFile then CloseFile(f);
end;
FreeMem(Buf);
CloseHandles;
Result:=FResult;
except
Result:=False;
end;
end;
Function THttpGet.GetFile(var aFileName:String; var aFileSize:Cardinal):Boolean;
begin
fSaveType:=stFile;
fBinaryData:=True;
Result:=Exectue;
aFileName:=fFileName;
aFileSize:=fFileSize;
end;
Function THttpGet.GetString(var aResult:String):Boolean;
begin
fSaveType:=stString;
fBinaryData:=False;
Result:=Exectue;
aResult:=fStringResult;
end;
end.
][