Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > Интернет и сети
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 07.02.2010, 12:54
Looker Looker вне форума
Прохожий
 
Регистрация: 07.02.2010
Сообщения: 4
Репутация: 10
По умолчанию Скачивание EXE

Пишу программу которая должна скачать определенный файл из интернета.
И возникли 2 существенные проблемы:
1) при скачивании текстового файла напрочь теряются все ентеры, то есть то что было на разных строках сливается в одну длинющую, но при этом пробелы остаются.
2) при скачивании exe файла его не удается запустить, то есть он как бы запускается, но ничего не происходит

Пробовал вот такие функции, но результат один и тот же

Код:
function GetInetFile(const fileURL, FileName: string): boolean;
const
  BufferSize = 1024;
var
  hSession, hURL: HInternet;
  Buffer: array[1..BufferSize] of Byte;
  BufferLen: DWORD;
  f: file;
  sAppName: string;
begin
  Result := False;
  sAppName := ExtractFileName(Application.ExeName);
  hSession := InternetOpen(PChar(sAppName),
  INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
  try
    hURL := InternetOpenURL(hSession, PChar(fileURL), nil, 0, 0, 0);
    try
      AssignFile(f, FileName);
      Rewrite(f,1);
      repeat
        InternetReadFile(hURL, @Buffer, SizeOf(Buffer), BufferLen);
        BlockWrite(f, Buffer, BufferLen);
      until
        BufferLen = 0;
      CloseFile(f);
      Result := True;
    finally
      InternetCloseHandle(hURL);
    end;
  finally
    InternetCloseHandle(hSession);
  end;
end;  
(Взято отсюда)

и

Код:
procedure TForm1.Button1Click(Sender: TObject);
var
MS:TFileStream;
begin
try
   MS:=TFileStream.Create('SUt.exe',fmOpenReadWrite);
   except
   MS:=TFileStream.Create('SUt.exe',fmCreate);
   end;
   try
 

  try
    idHttp1.Get(URL,MS);
  finally
    idHttp1.Free;
  end;
finally
  MS.Free;
end;
end;

Помогите пожалуйста, или хотя бы подскажите в чем ошибка
Ответить с цитированием
  #2  
Старый 08.02.2010, 09:31
Аватар для friz
friz friz вне форума
Местный
 
Регистрация: 04.04.2008
Адрес: Минск
Сообщения: 596
Версия Delphi: 2007 & JAVA EE
Репутация: 10670
По умолчанию

первый метод плох тем, что он качает только по прямой ссылке, т.е. ссылку типа site.com/index.php?get=4 он не скачает.
Второй метод у меня нормально работает.
Ответить с цитированием
  #3  
Старый 08.02.2010, 18:40
Аватар для AleD
AleD AleD вне форума
Активный
 
Регистрация: 21.02.2009
Адрес: г.Краснокаменск
Сообщения: 383
Репутация: 91
По умолчанию

Попробуйте эту функцию, она конечно тоже не лишена недостатков, но я ей пользуюсь, пока хватает:
Код:
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;
__________________
TAleD = class(TUser)
public
function HelpMe(ASubject, ARequest: String): String;
function GiveMeExample(ASubject: String): TStringList;
procedure WriteReview(APost: Integer; ADescription: TStringList);
end;
Ответить с цитированием
  #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 просмотров)
Ответить с цитированием
  #5  
Старый 09.02.2010, 12:55
Аватар для AleD
AleD AleD вне форума
Активный
 
Регистрация: 21.02.2009
Адрес: г.Краснокаменск
Сообщения: 383
Репутация: 91
По умолчанию

это функции из моего пакета... допишите их до основной функции и будет работать
Код:
function ADExtractUrlHostName(const AUrl: String): String;
var
  s: String;
begin
  s := AUrl;
  s := AnsiReplaceStr(s,'\','/');

  if(Pos('//',s)<>0)then
    s := AnsiMidStr(s,Pos('//',s)+2,Length(s));
  if(Pos('/',s)<>0)then
    s := AnsiMidStr(s,1,Pos('/',s)-1);

  Result := s;
end;

function ADExtractUrlFilePath(const AUrl: String): String;
var
  s: String;
begin
  s := AUrl;
  s := AnsiReplaceStr(s,'\','/');

  if(Pos('//',s)<>0)then
    s := AnsiMidStr(s,Pos('//',s)+2,Length(s));
  if(Pos('/',s)<>0)and(Pos('//',AUrl)<>0)then
    s := AnsiMidStr(s,Pos('/',s)+1,Length(s));

  Result := s;
end;
__________________
TAleD = class(TUser)
public
function HelpMe(ASubject, ARequest: String): String;
function GiveMeExample(ASubject: String): TStringList;
procedure WriteReview(APost: Integer; ADescription: TStringList);
end;
Ответить с цитированием
  #6  
Старый 09.02.2010, 20:56
Looker Looker вне форума
Прохожий
 
Регистрация: 07.02.2010
Сообщения: 4
Репутация: 10
По умолчанию

все равно что-то не очень фурычит
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 00:41.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2023

ВКонтакте   Facebook   Twitter