function EncodeURL(URL: string): string;
{* 将 URL 中的特殊字符转换成 %XX 的形式}
implementation
const
csBufferSize = 4096;
function EncodeURL(URL: string): string;
const
UnsafeChars = ['*', '#', '%', '<', '>', '+', ' '];
var
i: Integer;
begin
Result := '';
for i := 1 to Length(URL) do begin
if (URL in UnsafeChars) or (URL >= #$80) or (URL[1] < #32) then
Result := Result + '%' + IntToHex(Ord(URL), 2)
else
Result := Result + URL;
end;
end;
constructor TCnInet.Create;
begin
inherited;
FUserAgent := 'CnPack Internet Utils';
FProcMsg := True;
end;
destructor TCnInet.Destroy;
begin
CloseInet;
inherited;
end;
procedure TCnInet.CloseInet;
begin
if hSession <> nil then
begin
InternetCloseHandle(hSession);
hSession := nil;
end;
end;
function TCnInet.InitInet: Boolean;
begin
if hSession = nil then
begin
if Length(FProxyServer) = 0 then
begin
hSession := InternetOpen(PChar(FUserAgent), INTERNET_OPEN_TYPE_PRECONFIG,
nil, nil, 0);
end else begin
hSession := InternetOpen(PChar(FUserAgent), INTERNET_OPEN_TYPE_PROXY,
PChar(FProxyServer), nil, 0);
if Length(FProxyUserName) > 0 then
InternetSetOption(hSession,INTERNET_OPTION_PROXY_USERNAME,PChar(FProxyUserName),Length(FProxyUserName));
if Length(FProxyPassWord) > 0 then
InternetSetOption(hSession,INTERNET_OPTION_PROXY_PASSWORD,PChar(FProxyPassWord),Length(FProxyPassWord));
end;
end;
Result := hSession <> nil;
end;
procedure TCnInet.Abort;
begin
FAborted := True;
end;
procedure TCnInet.DoProgress(TotalSize, CurrSize: Integer);
begin
if Assigned(FOnProgress) then
FOnProgress(Self, TotalSize, CurrSize, FAborted);
if ProcMsg then
Application.ProcessMessages;
end;
function TCnInet.ParseURL(URL: string; var Info: TCnURLInfo): Boolean;
var
Idx: Integer;
Buff: string;
function ExtractStr(var ASrc: string; ADelim: string;
ADelete: Boolean = True): string;
var
Idx: Integer;
begin
Idx := Pos(ADelim, ASrc);
if Idx = 0 then
begin
Result := ASrc;
if ADelete then
ASrc := '';
end
else
begin
Result := Copy(ASrc, 1, Idx - 1);
if ADelete then
ASrc := Copy(ASrc, Idx + Length(ADelim), MaxInt);
end;
end;
begin
Result := False;
URL := Trim(URL);
Idx := Pos('://', URL);
if Idx > 0 then
begin
Info.Protocol := Copy(URL, 1, Idx - 1);
Delete(URL, 1, Idx + 2);
if URL = '' then Exit;
function TCnInet.GetStream(const AURL: string; Stream: TStream): Boolean;
var
Info: TCnURLInfo;
begin
Result := False;
if not ParseURL(AURL, Info) then
Exit;
FAborted := False;
if not InitInet or FAborted then
Exit;
if SameText(Info.Protocol, 'http') then
Result := GetHTTPStream(Info, Stream)
else if SameText(Info.Protocol, 'ftp') then
Result := GetFTPStream(Info, Stream);
if FAborted then
Result := False;
FGetDataFail := not Result;
end;
function TCnInet.GetStreamFromHandle(Handle: HINTERNET; TotalSize: Integer;
Stream: TStream): Boolean;
var
CurrSize, Readed: DWORD;
Buf: array[0..csBufferSize - 1] of Byte;
begin
Result := False;
CurrSize := 0;
Readed := 0;
repeat
if not InternetReadFile(Handle, @Buf, csBufferSize, Readed) then
Exit;
if Readed > 0 then
begin
Stream.Write(Buf, Readed);
Inc(CurrSize, Readed);
DoProgress(TotalSize, CurrSize);
if Aborted then Exit;
end;
until Readed = 0;
Result := True;
end;
function TCnInet.GetFTPStream(Info: TCnURLInfo; Stream: TStream): Boolean;
var
hConnect, hFtp: HINTERNET;
FindData: TWin32FindData;
TotalSize: Integer;
begin
Result := False;
hConnect := nil;
hFtp := nil;
try
hConnect := InternetConnect(hSession, PChar(Info.Host),
StrToIntDef(Info.Port, INTERNET_DEFAULT_FTP_PORT),
PChar(Info.Username), PChar(Info.Password),
INTERNET_SERVICE_FTP, 0, 0);
if (hConnect = nil) or FAborted then
Exit;
hFtp := FtpFindFirstFile(hConnect, PChar(Info.PathName), FindData,
INTERNET_FLAG_NEED_FILE, 0);
if hFtp <> nil then
begin
InternetCloseHandle(hFtp);
TotalSize := FindData.nFileSizeLow;
end
else
TotalSize := -1;
hFtp := FtpOpenFile(hConnect, PChar(Info.PathName), GENERIC_READ,
FTP_TRANSFER_TYPE_BINARY, 0);
if (hFtp = nil) or FAborted then
Exit;
Result := GetStreamFromHandle(hFtp, TotalSize, Stream);
finally
if hFtp <> nil then InternetCloseHandle(hFtp);
if hConnect <> nil then InternetCloseHandle(hConnect);
end;
end;
function TCnInet.GetHTTPStream(Info: TCnURLInfo; Stream: TStream): Boolean;
var
hConnect, hRequest: HINTERNET;
SizeStr: array[0..63] of Char;
BufLen, Index: DWORD;
begin
Result := False;
hConnect := nil;
hRequest := nil;
try
hConnect := InternetConnect(hSession, PChar(Info.Host),
StrToIntDef(Info.Port, INTERNET_DEFAULT_HTTP_PORT), nil, nil,
INTERNET_SERVICE_HTTP, 0, 0);
if (hConnect = nil) or FAborted then
Exit;
hRequest := HttpOpenRequest(hConnect, 'GET', PChar(EncodeURL(Info.PathName)),
'HTTP/1.0', nil, nil, INTERNET_FLAG_RELOAD, 0);
if (hRequest = nil) or FAborted then
Exit;
if HttpSendRequest(hRequest, nil, 0, nil, 0) then
begin
if FAborted then Exit;
Result := GetStreamFromHandle(hRequest, StrToIntDef(SizeStr, -1), Stream);
end;
finally
if hRequest <> nil then InternetCloseHandle(hRequest);
if hConnect <> nil then InternetCloseHandle(hConnect);
end;
end;
function TCnInet.GetString(const AURL: string): string;
var
Stream: TMemoryStream;
begin
try
Stream := TMemoryStream.Create;
try
if GetStream(AURL, Stream) then
begin
SetLength(Result, Stream.Size);
Move(Stream.Memory^, PChar(Result)^, Stream.Size);
end
else
Result := '';
finally
Stream.Free;
end;
except
Result := '';
end;
end;
function TCnInet.GetFile(const AURL, FileName: string): Boolean;
var
Stream: TFileStream;
begin
try
Stream := TFileStream.Create(FileName, fmCreate or fmShareDenyWrite);
try
Stream.Size := 0;
Result := GetStream(AURL, Stream);
finally
Stream.Free;
end;
except
Result := False;
end;
end;
{ Important: Methods and properties of objects in visual components can only be
used in a method called using Synchronize, for example,
Synchronize(UpdateCaption);
and UpdateCaption could look like,
procedure TCnTheadInet.UpdateCaption;
begin
Form1.Caption := 'Updated in a thread';
end; }
{$IFDEF MSWINDOWS}
type
TThreadNameInfo = record
FType: LongWord; // must be 0x1000
FName: PChar; // pointer to name (in user address space)
FThreadID: LongWord; // thread ID (-1 indicates caller thread)
FFlags: LongWord; // reserved for future use, must be zero
end;
{$ENDIF}
procedure TCnTheadInet.Execute;
begin
SetName;
{ Place thread code here }
if Length(FUrl) > 0 then
begin
FBin := FInet.GetString(FUrl);
if Assigned(FOnComplete) then FOnComplete(FBin);
end;
end;
