Модераторы: Snowy, Poseidon, MetalFan

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Как скачать файл из интернета без зависания? 
:(
    Опции темы
Alexeis
Дата 12.9.2007, 16:40 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 2
Всего: 459
Я думаю дело в том что в память загружается еще дополнительно библиотека 'URLMON.DLL'. Вероятно она и занимает много оперативки.


--------------------
Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
MikeLevinN
Дата 12.9.2007, 17:23 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 21
Регистрация: 6.9.2007

Репутация: нет
Всего: нет
Ну об этом я в первую очередь и думал, но разве так должно быть? Почему она не выгружается, т.е. как её выгрузить?
PM MAIL   Вверх
Alexeis
Дата 12.9.2007, 17:31 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 2
Всего: 459
Цитата(MikeLevinN @  12.9.2007,  17:23 Найти цитируемый пост)
Почему она не выгружается, т.е. как её выгрузить? 

  Чтобы ее можно было выгрузить ее нужно динамически загрузить руками и получить адрес функции. Ну об этом же почти в любой книжке есть!


--------------------
Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
MikeLevinN
Дата 13.9.2007, 08:22 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 21
Регистрация: 6.9.2007

Репутация: нет
Всего: нет
Ничего не помогло. И не понимаю, что происходит. Избавился от UrlMon.pas сделал динамическую загрузку и выгрузку библиотеки.

В ходе выяснилось, что сама загрузка библиотеки памяти много не отжирает, а вот в результате выполнения кода - закачки файла, наблюдается тоже самое память стремительно кушается. При выгрузке библиотеки, память не освобождается. Что не так?

Код

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, ActiveX;


type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  _tagBINDINFO = packed record
    cbSize: ULONG;
    szExtraInfo: LPWSTR;
    stgmedData: TStgMedium;
    grfBindInfoF: DWORD;
    dwBindVerb: DWORD;
    szCustomVerb: LPWSTR;
    cbstgmedData: DWORD;
    dwOptions: DWORD;
    dwOptionsFlags: DWORD;
    dwCodePage: DWORD;
    securityAttributes: TSecurityAttributes;
    iid: TGUID;
    pUnk: IUnknown;
    dwReserved: DWORD;
  end;
  TBindInfo = _tagBINDINFO;

  IBinding = interface
    ['{79eac9c0-baf9-11ce-8c82-00aa004ba90b}']
    function Abort: HResult; stdcall;
    function Suspend: HResult; stdcall;
    function Resume: HResult; stdcall;
    function SetPriority(nPriority: Longint): HResult; stdcall;
    function GetPriority(out nPriority: Longint): HResult; stdcall;
    function GetBindResult(out clsidProtocol: TCLSID; out dwResult: DWORD;
      out szResult: POLEStr; dwReserved: DWORD): HResult; stdcall;
  end;  

  IBindStatusCallback = interface
    ['{79eac9c1-baf9-11ce-8c82-00aa004ba90b}']
    function OnStartBinding(dwReserved: DWORD; pib: IBinding): HResult; stdcall;
    function GetPriority(out nPriority): HResult; stdcall;
    function OnLowResource(reserved: DWORD): HResult; stdcall;
    function OnProgress(ulProgress, ulProgressMax, ulStatusCode: ULONG;
      szStatusText: LPCWSTR): HResult; stdcall;
    function OnStopBinding(hresult: HResult; szError: LPCWSTR): HResult; stdcall;
    function GetBindInfo(out grfBINDF: DWORD; var bindinfo: TBindInfo): HResult; stdcall;
    function OnDataAvailable(grfBSCF: DWORD; dwSize: DWORD; formatetc: PFormatEtc;
      stgmed: PStgMedium): HResult; stdcall;
    function OnObjectAvailable(const iid: TGUID; punk: IUnknown): HResult; stdcall;
  end;

  TURLDownloadToFile = function (Caller: IUnknown; URL: PChar; FileName: PChar; Reserved: DWORD;
                                                     StatusCB: IBindStatusCallback): HResult; stdcall;

   CalBackInet = class(TInterfacedObject, IBindStatusCallback)
    function OnStartBinding(dwReserved: DWORD; pib: IBinding): HResult; stdcall;
    function GetPriority(out nPriority): HResult; stdcall;
    function OnLowResource(reserved: DWORD): HResult; stdcall;
    function OnProgress(ulProgress, ulProgressMax, ulStatusCode: ULONG;
      szStatusText: LPCWSTR): HResult; stdcall;
    function OnStopBinding(hresult: HResult; szError: LPCWSTR): HResult; stdcall;
    function GetBindInfo(out grfBINDF: DWORD; var bindinfo: TBindInfo): HResult; stdcall;
    function OnDataAvailable(grfBSCF: DWORD; dwSize: DWORD; formatetc: PFormatEtc;
      stgmed: PStgMedium): HResult; stdcall;
    function OnObjectAvailable(const iid: TGUID; punk: IUnknown): HResult; stdcall;
   end;

var
  Form1: TForm1;
  UrlMonHandle: THandle = 0;
  URLDownloadToFile: TURLDownloadToFile;

implementation

{$R *.dfm}

procedure LoadURLMon;
const
  UrlMonLib = 'URLMON.DLL';
  URLDownloadToFileName = 'URLDownloadToFileA';

begin
  URLMonHandle := LoadLibrary(PChar(UrlMonLib));
  if URLMonHandle <= HINSTANCE_ERROR then
    URLMonHandle := 0
  else
  begin
    URLDownloadToFile := GetProcAddress(URLMonHandle, URLDownloadToFileName);
    if(not assigned(URLDownloadToFile)) then
    begin
      FreeLibrary(URLMonHandle);
      URLMonHandle := 0;
      ShowMessage('Fail...');
    end else
      ShowMessage('Loaded...');
  end;
end;

procedure ReleaseURLMon;
begin
  if(URLMonHandle <> 0) then
  begin
    FreeLibrary(URLMonHandle);
    URLMonHandle := 0;
  end;
end;

function DownloadFile(SourceFile, DestFile: string): Boolean;
var
  CLB : IBindStatusCallback;
begin
 CLB := CalBackInet.Create as IBindStatusCallback;
 try
   Result := UrlDownloadToFile(nil, PChar(SourceFile), PChar(DestFile), 0, CLB) = 0;
 except
   Result := False;
 end;
 CLB := nil;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  LoadURLMon;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  ReleaseURLMon;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
 if DownloadFile('http://wwtests', 'tests.zip')
 then
 begin
  ShowMessage('ok, downloaded');
 end
 else
   ShowMessage('Error while downloading')
end;

{ CalBackInet }

function CalBackInet.GetBindInfo(out grfBINDF: DWORD;
  var bindinfo: TBindInfo): HResult;
begin

end;

function CalBackInet.GetPriority(out nPriority): HResult;
begin

end;

function CalBackInet.OnDataAvailable(grfBSCF, dwSize: DWORD;
  formatetc: PFormatEtc; stgmed: PStgMedium): HResult;
begin

end;

function CalBackInet.OnLowResource(reserved: DWORD): HResult;
begin

end;

function CalBackInet.OnObjectAvailable(const iid: TGUID;
  punk: IInterface): HResult;
begin

end;

function CalBackInet.OnProgress(ulProgress, ulProgressMax, ulStatusCode: ULONG;
  szStatusText: LPCWSTR): HResult;
begin
  Application.ProcessMessages;
end;

function CalBackInet.OnStartBinding(dwReserved: DWORD; pib: IBinding): HResult;
begin
  //
end;

function CalBackInet.OnStopBinding(hresult: HResult; szError: LPCWSTR): HResult;
begin
  ShowMessage('Callback - Stop!');
end;

end.


Это сообщение отредактировал(а) MikeLevinN - 13.9.2007, 08:24
PM MAIL   Вверх
Alexeis
Дата 13.9.2007, 09:27 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 2
Всего: 459
MikeLevinN, это все же кэширование, причем возможно еще и кэширование винды. Если программу свернуть и развернуть, то первоначально память уменьшится до 600кб, а потом не будет превышать 2000 кб. таск мэнэнджер не показывает всей виртуальной памяти израсходованной программой, возможно такое увеличение связанно с подргрузкой из подкачки самой программы, ведь известно, что программа целиком в ОЗУ не загружается, только необходимый набор. 


--------------------
Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
MetalFan
Дата 13.9.2007, 09:43 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Аццкий Сотона
****


Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

Репутация: 14
Всего: 128
а ничего, что часть методов CalBackInet ничего не позвращает?


--------------------
There are always someone smarter than you...
PM MAIL   Вверх
Alexeis
Дата 13.9.2007, 10:37 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 2
Всего: 459
MetalFan, это же тестовый пример, а не реальный, да и не бывает так что ничего не возвращается совсем, просто значение результата неопределено.


--------------------
Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
Dragin
Дата 29.9.2007, 11:04 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 10
Регистрация: 29.9.2007

Репутация: нет
Всего: нет
TThread
PM MAIL   Вверх
Coderr
Дата 7.3.2008, 22:06 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


Профиль
Группа: Участник
Сообщений: 234
Регистрация: 27.1.2006
Где: Vesnet

Репутация: нет
Всего: 0
Хм. Что-то не пойму... То ли инет у меня быстрый, то ли я что-то не понял.
Использовал код Yanis'a из этого поста.
Вроде даже ничего не менял... Получается так что при скачке файла размером 1,38 Мб label показывает 0, подвисает и через мгновение показывает что всё скачалось. И действительно, всё скачивается. Только процесс не отображается. Собсно, в этом и проблем. smile 
Прикладываю сорс.

Присоединённый файл ( Кол-во скачиваний: 19 )
Присоединённый файл  Auto_Update.rar 14,84 Kb
--------------------
Кодинг - это стиль жизни!   
PM WWW ICQ   Вверх
Coderr
  Дата 14.3.2008, 02:47 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


Профиль
Группа: Участник
Сообщений: 234
Регистрация: 27.1.2006
Где: Vesnet

Репутация: нет
Всего: 0
Странно... теперь вобще не качает... :(
--------------------
Кодинг - это стиль жизни!   
PM WWW ICQ   Вверх
vovksextra
Дата 14.3.2008, 18:27 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 29
Регистрация: 15.2.2008

Репутация: нет
Всего: нет

http://forum.vingrad.ru/forum/topic-196305.html
PM MAIL   Вверх
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Сети"
Snowy
Poseidon
MetalFan

Запрещено:

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делится вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи

Если Вам помогли и атмосфера форума Вам понравилась, то заходите к нам чаще! С уважением, Snowy, Poseidon, MetalFan.
 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Сети | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.0573 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.