Текущий архив: 2006.05.14;
Скачать: CL | DM;

Вниз

Загрузка с интернета с проверкой размера файла после загр   Найти похожие ветки 

← →
DrNemo   (2006-02-20 10:36) [0]

Уважаемые др. Уменя вот такой вопрос моя программа при загрузке большого файла зависает как от етого избавиться?

---

← →
n0name   (2006-02-20 10:37) [1]

CreateThread

---

← →
DrNemo   (2006-02-20 10:39) [2]

Щас я выложу код моего детища может поможите найти ошибки?

---

← →
DrNemo   (2006-02-20 10:40) [3]

unit Unit2;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, ExtCtrls, wininet, StdCtrls, Buttons;

type
 Tlogo = class(TForm)
   Image1: TImage;
   Label1: TLabel;
   Timer1: TTimer;
   refresh: TSpeedButton;
   SpeedButton1: TSpeedButton;

   procedure FormCreate(Sender: TObject);
   procedure Timer1Timer(Sender: TObject);
    //procedure ReadParams;
   procedure refreshClick(Sender: TObject);
   procedure SpeedButton1Click(Sender: TObject);

 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 logo: Tlogo;

implementation
 uses Unit1;
{$R *.dfm}
{
procedure Tlogo.Image1Click(Sender: TObject);
begin
 close;
end;
}
 function GetUrlSize(const URL:string):integer;//????????? ? ??????
var
 hSession,hFile:hInternet;
 dwBuffer:array[1..20] of char;
 dwBufferLen,dwIndex:DWORD;
begin
Result:=0;
hSession:=InternetOpen("GetUrlSize",INTERNET_OPEN_TYPE_PRECONFIG,nil,nil,0);
if Assigned(hSession) then begin
hFile:=InternetOpenURL(hSession,PChar(URL),nil,0,INTERNET_FLAG_RELOAD,0);
dwIndex:=0;
dwBufferLen:=20;
if HttpQueryInfo(hFile,HTTP_QUERY_CONTENT_LENGTH,@dwBuffer,dwBufferLen,dwIndex) then Result:=StrToInt(StrPas(@dwBuffer));
if Assigned(hFile) then InternetCloseHandle(hFile);
InternetCloseHandle(hsession);
end;
end;
function HttpDownloadFile(URL, FileName: string): boolean;
const
BufferSize = 1024;
var
hSession, hURL: HInternet;
Buffer: array[1..BufferSize] of Byte;
BufferLen: DWORD;
f: file;
sAppName: string;
begin
//sAppName := "MyProgram";
hSession := InternetOpen(PChar(sAppName),
INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
try
hURL := InternetOpenURL(hSession, PChar(URL), 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;
function GetFileSize(const FileName:string):longint;
{??????????? ??????? ?????}
var
SearchRec:TSearchRec;
begin
if FindFirst(ExpandFileName(FileName),faAnyFile,SearchRec)=0
then Result:=SearchRec.Size
else Result:=-1;
FindClose(SearchRec);
end;
procedure Tlogo.FormCreate(Sender: TObject);
begin
Label1.Caption:="connection please wait";
timer1.Enabled:=true;
end;
procedure Tlogo.Timer1Timer(Sender: TObject);
 var FileOnNet, LocalFileName: string;
begin
   timer1.Enabled:=false;
  FileOnNet:="http://egold/setup.exe";
  LocalFileName:="db.jpg";

 if HttpDownloadFile(FileOnNet,LocalFileName)=True then
  begin
  if (GetUrlSize(FileOnNet)=GetFileSize("db.jpg"))
    then
    close

    else
      Label1.Caption:="Failed to connect" ;
      refresh.Visible:=true;
   end;
   end;
procedure Tlogo.refreshClick(Sender: TObject);
begin
Label1.Caption:="connection please wait";
timer1.Enabled:=true;
end;

procedure Tlogo.SpeedButton1Click(Sender: TObject);
begin
logo.Close;
main.Close;
end;

end.


---

← →
isasa ©   (2006-02-20 11:18) [4]

После

HttpSendRequest(...

пробуем этим ...

BOOL InternetQueryDataAvailable(
 HINTERNET hFile,
 LPDWORD lpdwNumberOfBytesAvailable,
 DWORD dwFlags,
 DWORD_PTR dwContext
);

Parameters
...
lpdwNumberOfBytesAvailable - [out] Pointer to a variable that receives the number of available bytes. May be NULL.


---

← →
isasa ©   (2006-02-20 11:20) [5]

Кстати, а где оно?
HttpSendRequest(...

---

← →
isasa ©   (2006-02-20 11:26) [6]

:)
Все, увидел - InternetOpenURL, значит после него.

---

← →
DrNemo   (2006-02-20 12:17) [7]

Спосибо щас попробую

---

← →
n0name   (2006-02-20 13:43) [8]


function DownloadPage(hPage: HINTERNET; Len: PCardinal): PChar;
var
Ptr, bw: Cardinal;
begin
result := GetMemory(1024 * 50);
Ptr := 0;
while true do
 begin
  if not InternetQueryDataAvailable(hPage, bw, 0, 0) then break;
  if bw = 0 then break;
  if Len <> nil then
   Len^ := Ptr + bw;
  if not InternetReadFile(hPage, Pointer(Cardinal(result) + Ptr), bw, bw) then break;
  if bw = 0 then break;
  Ptr := Ptr + bw;
 end
end;


---

← →
DrNemo   (2006-02-20 16:23) [9]

function DownloadPage(hPage: HINTERNET; Len: PCardinal): PChar;
var
Ptr, bw: Cardinal;
begin
result := GetMemory(1024 * 50);
Ptr := 0;
while true do
begin
 if not InternetQueryDataAvailable(hPage, bw, 0, 0) then break;
 if bw = 0 then break;
 if Len <> nil then
  Len^ := Ptr + bw;
 if not InternetReadFile(hPage, Pointer(Cardinal(result) + Ptr), bw, bw) then break;
 if bw = 0 then break;
 Ptr := Ptr + bw;
end
end;
Чо делает ета функция?

---

← →
n0name   (2006-02-20 17:07) [10]

Скачивает файл/страницу по открытому её хендлу, например, с помошью InetrnetOpenUrl.

---

← →
o   (2006-02-21 10:23) [11]

ok

---

← →
Ormada ©   (2006-02-22 07:39) [12]

можно инди юзать и не париться или посмотри как у них реализован AntoFreeze

---

Страницы: 1 вся ветка

Текущий архив: 2006.05.14;
Скачать: CL | DM;

Наверх

Память: 0.5 MB
Время: 0.029 c