function TForm1.DownloadFile(
const URL:
String;
const FilePath:
String; FileName:
String = '
'): Boolean;
var
KbpsCounter, Kbps: Integer;
Ticks, BytesRead, acsize,
index, codelen: DWORD;
Buffer:
Array [0..1023]
of Byte;
hSession, hRequest: HINTERNET;
DlFile :
File;
code :
array[1..20]
of char;
begin
Result := False;
KbpsCounter := 0;
(* Dateinamen festlegen *)
if Filename <> '
'
then
Filename := FilePath + FileName
else
Filename := FilePath + ExtractFileName(Slashtobackslash(
URL));
(* Session öffnen *)
Label3.Caption := '
connecting ...';
hSession := InternetOpen('
AppTitel', INTERNET_OPEN_TYPE_DIRECT,
nil,
nil, 0);
if hSession <>
nil then
begin
(* URL öffnen *)
hRequest := InternetOpenUrl(hSession, PChar(
URL),
nil, 0, INTERNET_FLAG_RELOAD, 0);
if hRequest <>
nil then
begin
(* checken ob Datei schon existiert *)
if FileExists(FileName)
then
if idOK <> (Application.MessageBox('
File already exists. Replace ? '
, PChar(Caption)
, MB_OKCANCEL))
then exit;
(* Dateigröße herausfinden *)
Index:= 0;
CodeLen:= 10;
HttpQueryInfo(hRequest, HTTP_QUERY_CONTENT_LENGTH, @code, codeLen,
Index);
Label4.Caption := formatfloat('
0.00',Strtoint(Pchar(@code)) / 1024 / 1024)+'
mb';
(* Download starten *)
Label3.Caption := '
starting ...';
AssignFile(DlFile, FileName);
try
Rewrite(DlFile, 1);
Ticks := GetTickCount;
while True
do
begin
(* Daten auslesen *)
Label3.Caption := '
loading ...';
if InternetReadFile(hRequest, @Buffer, 1024, BytesRead) = False
then
Break;
(* bereits geladene kbps berechnen *)
acsize := acsize + BytesRead;
Label1.caption := formatfloat('
0.00', acsize / 1024 / 1024) + '
mb';
(* kbps jede Sekunde berechnen *)
Inc(KbpsCounter, BytesRead);
if Ticks <= (GetTickCount - 1000)
then
begin
Kbps := KbpsCounter
div 1024;
if Kbps < 1000
then
Label2.Caption := intToStr(Kbps) + '
kb/s'
else
Label2.Caption := formatfloat('
0.00', Kbps / 1024) + '
mb/s';
KbpsCounter := 0;
Ticks := GetTickCount;
end;
(* In Datei schreiben *)
if BytesRead <> 0
then
BlockWrite(DlFile, Buffer, BytesRead)
else //Download beendet
begin
Label3.Caption := '
finished';
Result := True;
Break;
end;
if usercancel
then
begin
Label3.Caption := '
canceled';
Label2.Caption := '
';
Result := False;
Break;
end;
Application.ProcessMessages;
end;
finally
CloseFile(DlFile);
InternetCloseHandle(hRequest);
end;
end;
InternetCloseHandle(hSession);
end;
end;