Показать сообщение отдельно
  #4  
Старый 08.02.2010, 22:00
Looker Looker вне форума
Прохожий
 
Регистрация: 07.02.2010
Сообщения: 4
Репутация: 10
По умолчанию

Цитата:
Сообщение от AleD
Попробуйте эту функцию, она конечно тоже не лишена недостатков, но я ей пользуюсь, пока хватает:
Код:
type
  TADCallBack = procedure(DonePercent: Integer; var Done: Boolean);
...
function ADGetUrl(fURL : WideString; fCallBack: TADCallBack = nil): AnsiString;
var
  hInternet  : pointer;
  hConnect   : pointer;
  hRequest   : pointer;

  Size       : cardinal;
  B          : boolean;
  Buff       : ANSIString;
  ReadedSize : cardinal;
  I, L       : cardinal;
  total: Cardinal;
  done: Boolean;

  str: String;
  bl, rv: Cardinal;

function OpenInternet(Name: WideString): pointer;
begin
  result := InternetOpenW(@Name[1], INTERNET_OPEN_TYPE_PRECONFIG,
    nil, nil, 0);
end;
function Connect(hInternet : pointer): pointer;
var
  SiteURL: String;
begin
  result := nil;
  SiteURL := ADExtractUrlHostName(fURL);
  if hInternet = nil  then exit;

  result := InternetConnectW(hInternet, @SiteURL[1],
    INTERNET_DEFAULT_HTTP_PORT,
    'anonymous', nil, INTERNET_SERVICE_HTTP, 0, 0);
end;
function NewRequest(fURL : WideString; hConnect: pointer): pointer;
begin
  result := nil;
  if hConnect = nil then exit;

  result := HTTPopenRequestW(hConnect, nil, @fURL[1],
                             nil, nil, nil, INTERNET_FLAG_PRAGMA_NOCACHE or INTERNET_FLAG_RELOAD, 0);
end;
function SendRequest(hRequest: pointer): boolean;
begin
  result := false;
  if hRequest = nil then exit;

  result := HTTPsendRequestW(hRequest, nil, 0, nil, 0);
end;
function DataAvailable(hRequest: pointer; out Size : cardinal): boolean;
begin
  result := wininet.InternetQueryDataAvailable(hRequest, Size, 0, 0);
end;
function SizeQuery(hRequest: pointer; out Size : cardinal): boolean;
var
  RSize,rv : cardinal;
  p : pointer;
begin
  RSize  := 4;
  result := HttpQueryInfoW(hRequest,
    HTTP_QUERY_CONTENT_LENGTH or HTTP_QUERY_FLAG_NUMBER,
    @Size, RSize, rv);
  if NOT result then Size := 0;
end;

begin
  result := '';
  SetLastError(0);

  hInternet := OpenInternet('ADworldMiniDownloader');
  hConnect  := Connect(hInternet);
  hRequest  := NewRequest(ADExtractUrlFilePath(fURL), hConnect);
  if NOT SendRequest(hRequest) then
  begin
    if hRequest  <> nil then InternetCloseHandle(hRequest);
    if hConnect  <> nil then InternetCloseHandle(hConnect);
    if hInternet <> nil then InternetCloseHandle(hInternet);
    SetLastError(1);
    exit;
  end;

  SizeQuery(hRequest, Size);

  inc(Size);
  SetLength(Buff, Size);

  B := false;
  HttpQueryInfoW(hRequest,
    HTTP_QUERY_CONTENT_LENGTH or HTTP_QUERY_FLAG_NUMBER,
    @total, bl, rv);

  I := 1;
  while true do
  begin
    DataAvailable(hRequest, L);

    if L = 0 then
      break;

    if (I + L) > Size then
      SetLength(Buff, I + L);

    B := InternetReadFile(hRequest, @Buff[i], L, ReadedSize);

    if not B then
      break;

    inc(I, ReadedSize);
    if(@fCallBack<>nil)and(Assigned(fCallBack))then
      fCallBack(round(100/total*ReadedSize),done);
  end;
  if hRequest  <> nil then InternetCloseHandle(hRequest);
  if hConnect  <> nil then InternetCloseHandle(hConnect);
  if hInternet <> nil then InternetCloseHandle(hInternet);
  Result := Buff;
end;


Что-то у меня не выходит этот способ: ругается на строки

Код:
SiteURL := ADExtractUrlHostName(fURL);

и

hRequest  := NewRequest(ADExtractUrlFilePath(fURL), hConnect);

В частности на
ADExtractUrlFilePath и ADExtractUrlHostName


Цитата:
первый метод плох тем, что он качает только по прямой ссылке, т.е. ссылку типа site.com/index.php?get=4 он не скачает.
Второй метод у меня нормально работает.

Зато у меня теперь какой-то Access violation вылазит и exe все равно не запускается

Во вложении файл, который был скачан
Вложения
Тип файла: rar Project.rar (872 байт, 12 просмотров)
Ответить с цитированием