![](/img/icon_plus.gif)
function GetUrlInfo(const FileURL: string):cardinal;
var
hSession, hFile: hInternet;
dwBuffer:array[0..20] of char;
dwBufferLen, dwIndex: DWORD;
begin
Result := 0;
hSession := InternetOpen('Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)',INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
if Assigned(hSession) then
begin
hFile := InternetOpenURL(hSession, PChar(FileURL),nil,0,INTERNET_FLAG_RELOAD, 0);
dwIndex := 0;
dwBufferLen := 20;
if HttpQueryInfo(hFile, HTTP_QUERY_CONTENT_LENGTH, @dwBuffer[0], dwBufferLen, dwIndex)
then Result := str2int(dwBuffer);
if Assigned(hFile) then InternetCloseHandle(hFile);
InternetCloseHandle(hsession);
end;
end;
var
hSession, hFile: hInternet;
dwBuffer:array[0..20] of char;
dwBufferLen, dwIndex: DWORD;
begin
Result := 0;
hSession := InternetOpen('Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)',INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
if Assigned(hSession) then
begin
hFile := InternetOpenURL(hSession, PChar(FileURL),nil,0,INTERNET_FLAG_RELOAD, 0);
dwIndex := 0;
dwBufferLen := 20;
if HttpQueryInfo(hFile, HTTP_QUERY_CONTENT_LENGTH, @dwBuffer[0], dwBufferLen, dwIndex)
then Result := str2int(dwBuffer);
if Assigned(hFile) then InternetCloseHandle(hFile);
InternetCloseHandle(hsession);
end;
end;
Дам 10$
![](/img/smilies/icon_smile.gif)
а лудше что бы сам определял Windows NT 5.0
------------ Дoбавленo в 19.30:
вот моя попытка сделать правильно ли я делаю?
#pas
unit hiHTTP_Get;
interface
{$I share.inc}
uses Kol,Share,WinInet,Windows,Debug,hiCharset;
type
THIHTTP_Get = class(TDebug)
private
th:PThread;
FStop:boolean;
GData:TData;
FSize:cardinal;
FBusy:boolean;
fs:PStream;
procedure ShowInfo;
procedure EndDownload;
procedure OnDownload;
function Execute(Sender:PThread): Integer;
public
_prop_URL:string;
_prop_FileName:string;
_prop_Wait:boolean;
_prop_Proxy:string;
_prop_ProxyUsername:string;
_prop_ProxyPassword:string;
_prop_Length:cardinal;
[b]_prop_UserAgent:string;
[/b]
_data_FileName:THI_Event;
_data_URL:THI_Event;
_data_Position:THI_Event;
_data_Length:THI_Event;
_data_Proxy:THI_Event;
_data_ProxyUsername:THI_Event;
_data_ProxyPassword:THI_Event;
_event_onURLSize:THI_Event;
_event_onDownload:THI_Event;
_event_onStatus:THI_Event;
_event_onStop:THI_Event;
procedure _work_doDownload(var _Data:TData; Index:word);
procedure _work_doStop(var _Data:TData; Index:word);
procedure _work_GetURLSize(var _Data:TData; Index:word);
procedure _var_Busy(var _Data:TData; Index:word);
end;
implementation
function GetUrlInfo(const FileURL: string):cardinal;
var
hSession, hFile: hInternet;
dwBuffer:array[0..20] of char;
dwBufferLen, dwIndex: DWORD;
[b] _prop_UserAgent:string;[/b]
begin
Result := 0;
hSession := InternetOpen('Mozilla/4.0 (compatible; MSIE 6.0; [b]_prop_UserAgent[/b])',INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
if Assigned(hSession) then
begin
hFile := InternetOpenURL(hSession, PChar(FileURL),nil,0,INTERNET_FLAG_RELOAD, 0);
dwIndex := 0;
dwBufferLen := 20;
if HttpQueryInfo(hFile, HTTP_QUERY_CONTENT_LENGTH, @dwBuffer[0], dwBufferLen, dwIndex)
then Result := str2int(dwBuffer);
if Assigned(hFile) then InternetCloseHandle(hFile);
InternetCloseHandle(hsession);
end;
end;
function THIHTTP_Get.Execute;
var
NetHandle: HINTERNET;
UrlHandle: HINTERNET;
Buffer: array[0..1024] of char;
BytesRead, len: cardinal;
Url,Fname,Head:string;
PI:TInternetProxyInfo;
dwStatus,dwStatusSize:cardinal;
dwNil:DWORD;
dt:TData; s,s1:string;
[b]_prop_UserAgent:string;[/b]
begin
FBusy := true; dtNull(dt);
NetHandle := InternetOpen('Mozilla/4.0 (compatible; MSIE 6.0; [b]_prop_UserAgent[/b])', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
s := ReadString(dt, _data_Proxy, _prop_Proxy);
if s<>'' then begin
PI.dwAccessType := INTERNET_OPEN_TYPE_PROXY;
PI.lpszProxy := PChar(s);
PI.lpszProxyByPass := nil;
InternetSetOption(NetHandle,INTERNET_OPTION_PROXY,@PI,sizeof(PI));
end;
FStop := false;
if Assigned(NetHandle) then
begin
Url := ReadString(GData,_data_URL,_prop_URL);
BytesRead := ReadInteger(GData,_data_Position,0);
len := ReadInteger(GData,_data_Length,_prop_Length);
if BytesRead > 0 then
Head := 'Range: bytes=' + Int2Str(BytesRead) + '-' + Int2Str(BytesRead + Len)
else Head := '';
UrlHandle := InternetOpenUrl(NetHandle, PChar(Url), PChar(Head), cardinal(-1), INTERNET_FLAG_RELOAD+INTERNET_FLAG_NO_AUTH, 0);
if Assigned(UrlHandle) then
begin
dwStatusSize := sizeof(dwStatus);
dwNil := 0;
HttpQueryInfo(UrlHandle, HTTP_QUERY_FLAG_NUMBER or
HTTP_QUERY_STATUS_CODE, @dwStatus, dwStatusSize, dwNil);
if dwStatus=HTTP_STATUS_PROXY_AUTH_REQ then begin
s := ReadString(dt, _data_ProxyUsername, _prop_ProxyUsername);
s1 := ReadString(dt, _data_ProxyPassword, _prop_ProxyPassword);
if (s<>'') and (s1<>'') then begin
repeat InternetReadFile(UrlHandle, @Buffer, SizeOf(Buffer), BytesRead); until BytesRead=0;
HttpSendRequest(UrlHandle,PAnsiChar('Proxy-Authorization: Basic '+Base64_Code(s+':'+s1)+#13#10),DWORD(-1),nil,0);
end;
end;
FillChar(Buffer, SizeOf(Buffer), 0);
FSize := 0;
Fname := ReadString(GData,_data_FileName,_prop_FileName);
if Fname = '' then fs := NewMemoryStream
else fs := NewWriteFileStream(Fname);
repeat
FillChar(Buffer, SizeOf(Buffer), 0);
InternetReadFile(UrlHandle, @Buffer, SizeOf(Buffer), BytesRead);
fs.Write(Buffer,BytesRead);
inc(FSize,BytesRead);
if _prop_Wait then
ShowInfo
else th.Synchronize( ShowInfo );
//ProcessMessages;
until (BytesRead = 0)or FStop;
InternetCloseHandle(UrlHandle);
if Fname = '' then
fs.Position := 0
else
begin
fs.Free;
fs := nil;
end;
if _prop_Wait then
OnDownload
else th.Synchronize( OnDownload );
end
else ;//MessageBox(0,'Can''t open URL!','Error',MB_OK);
InternetCloseHandle(NetHandle);
end
else ;//MessageBox(0,'I can not connect to Internet!','Error',MB_OK);
Result := 0;
//th.Free;
FBusy := false;
if _prop_Wait then
EndDownload
else th.Synchronize( EndDownload );
end;
procedure THIHTTP_Get.ShowInfo;
begin
_hi_OnEvent(_event_onStatus,integer(fsize));
end;
procedure THIHTTP_Get.EndDownload;
begin
_hi_OnEvent(_event_onStop);
end;
procedure THIHTTP_Get.OnDownload;
begin
if fs = nil then
_hi_OnEvent(_event_onDownload)
else
begin
_hi_OnEvent(_event_onDownload,fs);
fs.Free;
end;
end;
procedure THIHTTP_Get._work_doDownload;
begin
GData := _Data;
//if th <> nil then
// th.Free;
if _prop_Wait then
Execute(nil)
else
begin
{$ifdef F_P}
th := NewThreadForFPC;
{$else}
th := NewThread;
{$endif}
th.OnExecute := Execute;
th.AutoFree := true;
th.Resume;
end;
end;
procedure THIHTTP_Get._work_doStop;
begin
FStop := true;
//_debug('1');
//th.WaitFor;
//_debug('2');
//th.Free;
//th := nil;
end;
procedure THIHTTP_Get._var_Busy;
begin
dtInteger(_data,byte(FBusy));
end;
procedure THIHTTP_Get._work_GetURLSize;
var
Url:string;
begin
Url := ReadString(_Data,_data_URL,_prop_URL);
_hi_OnEvent(_event_onURLSize,integer(GetUrlInfo(URL)));
end;
end.