Delphi使用windows Api下载文件

分类：Delphi, Internet 阅读 (2,586) Add comments

8月 022012

转载请注明原文地址：http://bcoder.com/delphi/use-windows-api-to-download-files-in-delphi

Use windows api to download file in delphi

unit Unit1;

interface

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

type
TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);

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

var
Form1: TForm1;

implementation

{$R *.dfm}

function DownloadToString(const Url: string): string;
var
NetHandle: HINTERNET;
UrlHandle: HINTERNET;
Buffer: array[0..1024] of Char;
BytesRead: dWord;
begin
Result := &#039;&#039;;
NetHandle := InternetOpen(&#039;Delphi 5.x&#039;, INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);

if Assigned(NetHandle) then
begin
    UrlHandle := InternetOpenUrl(NetHandle, PChar(Url), nil, 0, INTERNET_FLAG_RELOAD, 0);

    if Assigned(UrlHandle) then
      { UrlHandle valid? Proceed with download }
    begin
      FillChar(Buffer, SizeOf(Buffer), 0);
      repeat
        Result := Result + Buffer;
        FillChar(Buffer, SizeOf(Buffer), 0);
        InternetReadFile(UrlHandle, @Buffer, SizeOf(Buffer), BytesRead);
      until BytesRead = 0;
      InternetCloseHandle(UrlHandle);
    end
    else
      { UrlHandle is not valid. Raise an exception. }
      raise Exception.CreateFmt(&#039;Cannot open URL %s&#039;, [Url]);

    InternetCloseHandle(NetHandle);
end
else
    { NetHandle is not valid. Raise an exception }
    raise Exception.Create(&#039;Unable to initialize Wininet&#039;);
end;

function DownloadToFile(const Url, LFile: string): Boolean;
var
NetHandle: HINTERNET;
UrlHandle: HINTERNET;
Buffer: array[0..1024] of Char;
BytesRead: dWord;
LFileStream: TFileStream;
begin
Result := False;
NetHandle := InternetOpen(&#039;Delphi 5.x&#039;, INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);

if Assigned(NetHandle) then
begin
    UrlHandle := InternetOpenUrl(NetHandle, PChar(Url), nil, 0, INTERNET_FLAG_RELOAD, 0);

    if Assigned(UrlHandle) then
      { UrlHandle valid? Proceed with download }
    begin
      LFileStream := TFileStream.Create(LFile, fmCreate);
      FillChar(Buffer, SizeOf(Buffer), 0);
      repeat
//        Result := Result + Buffer;
        FillChar(Buffer, SizeOf(Buffer), 0);
        InternetReadFile(UrlHandle, @Buffer, SizeOf(Buffer), BytesRead);
        LFileStream.Write(Buffer, BytesRead);
      until BytesRead = 0;
      LFileStream.Free;
      InternetCloseHandle(UrlHandle);
    end
    else
      { UrlHandle is not valid. Raise an exception. }
      raise Exception.CreateFmt(&#039;Cannot open URL %s&#039;, [Url]);

    InternetCloseHandle(NetHandle);
end
else
    { NetHandle is not valid. Raise an exception }
    raise Exception.Create(&#039;Unable to initialize Wininet&#039;);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Memo1.Lines.Text := DownloadToString(&#039;http://www.mailsextractor.com/&#039;)
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  DownloadToFile(&#039;http://www.mailsextractor.com/mailsextractor.exe&#039;, &#039;mailsextractor.exe&#039;);
end;

end.

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, WinInet, StdCtrls;

type

TForm1 = class(TForm)

Button1: TButton;

Memo1: TMemo;

Button2: TButton;

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

function DownloadToString(const Url: string): string;

var

NetHandle: HINTERNET;

UrlHandle: HINTERNET;

Buffer: array[0..1024] of Char;

BytesRead: dWord;

begin

Result := '';

NetHandle := InternetOpen('Delphi 5.x', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);

if Assigned(NetHandle) then

begin

UrlHandle := InternetOpenUrl(NetHandle, PChar(Url), nil, 0, INTERNET_FLAG_RELOAD, 0);

if Assigned(UrlHandle) then

{ UrlHandle valid? Proceed with download }

begin

FillChar(Buffer, SizeOf(Buffer), 0);

repeat

Result := Result + Buffer;

FillChar(Buffer, SizeOf(Buffer), 0);

InternetReadFile(UrlHandle, @Buffer, SizeOf(Buffer), BytesRead);

until BytesRead = 0;

InternetCloseHandle(UrlHandle);

end

else

{ UrlHandle is not valid. Raise an exception. }

raise Exception.CreateFmt('Cannot open URL %s', [Url]);

InternetCloseHandle(NetHandle);

end

else

{ NetHandle is not valid. Raise an exception }

raise Exception.Create('Unable to initialize Wininet');

end;

function DownloadToFile(const Url, LFile: string): Boolean;

var

NetHandle: HINTERNET;

UrlHandle: HINTERNET;

Buffer: array[0..1024] of Char;

BytesRead: dWord;

LFileStream: TFileStream;

begin

Result := False;

NetHandle := InternetOpen('Delphi 5.x', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);

if Assigned(NetHandle) then

begin

UrlHandle := InternetOpenUrl(NetHandle, PChar(Url), nil, 0, INTERNET_FLAG_RELOAD, 0);

if Assigned(UrlHandle) then

{ UrlHandle valid? Proceed with download }

begin

LFileStream := TFileStream.Create(LFile, fmCreate);

FillChar(Buffer, SizeOf(Buffer), 0);

repeat

// Result := Result + Buffer;

FillChar(Buffer, SizeOf(Buffer), 0);

InternetReadFile(UrlHandle, @Buffer, SizeOf(Buffer), BytesRead);

LFileStream.Write(Buffer, BytesRead);

until BytesRead = 0;

LFileStream.Free;

InternetCloseHandle(UrlHandle);

end

else

{ UrlHandle is not valid. Raise an exception. }

raise Exception.CreateFmt('Cannot open URL %s', [Url]);

InternetCloseHandle(NetHandle);

end

else

{ NetHandle is not valid. Raise an exception }

raise Exception.Create('Unable to initialize Wininet');

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

Memo1.Lines.Text := DownloadToString('http://www.mailsextractor.com/')

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

DownloadToFile('http://www.mailsextractor.com/mailsextractor.exe', 'mailsextractor.exe');

end;

end.

above is the code

打赏

Leave a Reply Cancel reply