Fatal编程技术网
  • delphi/
  • 在Delphi中的线程内从internet下载文件

在Delphi中的线程内从internet下载文件

delphi download

在Delphi中的线程内从internet下载文件,delphi,download,Delphi,Download,如何使用Delphi 2009/10中的线程在没有Indy组件的情况下使用进度条从internet下载文件？这使用了聪明的internet套件来处理下载，我甚至没有在IDE中检查它，因此我不希望它编译，毫无疑问，它充满了错误，但应该足以让您开始 我不知道你为什么不想使用Indy，但我强烈建议你使用一些组件来帮助下载Http。。。真的没有必要重新发明轮子 interface type TMyDownloadThread= Class(TThread) private

如何使用Delphi 2009/10中的线程在没有Indy组件的情况下使用进度条从internet下载文件？

这使用了聪明的internet套件来处理下载，我甚至没有在IDE中检查它，因此我不希望它编译，毫无疑问，它充满了错误，但应该足以让您开始

我不知道你为什么不想使用Indy，但我强烈建议你使用一些组件来帮助下载Http。。。真的没有必要重新发明轮子

interface
type
    TMyDownloadThread= Class(TThread)
    private
        FUrl: String;
        FFileName: String;
        FProgressHandle: HWND;
        procedure GetFile (Url: String; Stream: TStream; ReceiveProgress: TclSocketProgressEvent);
        procedure OnReceiveProgress(Sender: TObject; ABytesProceed, ATotalBytes: Integer);
        procedure SetPercent(Percent: Double);
    protected
        Procedure Execute; Override;
    public
        Constructor Create(Url, FileName: String; PrograssHandle: HWND);
    End;

implementation

constructor TMyDownloadThread.Create(Url, FileName: String; PrograssHandle: HWND);
begin
    Inherited Create(True);
    FUrl:= Url;
    FFileName:= FileName;
    FProgressHandle:= PrograssHandle;
    Resume;
end;


procedure TMyDownloadThread.GetFile(Url: String; Stream: TStream; ReceiveProgress: TclSocketProgressEvent);
var
    Http: TclHttp;
begin
    Http := TclHTTP.Create(nil);
    try
        try
            Http.OnReceiveProgress := ReceiveProgress;
            Http.Get(Url, Stream);
        except
        end;
    finally
        Http.Free;
    end;
end;

procedure TMyDownloadThread.OnReceiveProgress(Sender: TObject; ABytesProceed, ATotalBytes: Integer);
begin
    SetPercent((ABytesProceed / ATotalBytes) * 100);
end;

procedure TMyDownloadThread.SetPercent(Percent: Double);
begin
    PostMessage(FProgressHandle, AM_DownloadPercent, LowBytes(Percent), HighBytes(Percent));
end;

procedure TMyDownloadThread.Execute;
var
    FileStream: TFileStream;
begin
    FileStream := TFileStream.Create(FFileName, fmCreate);
    try
        GetFile(FUrl, FileStream, OnReceiveProgress);
    finally
        FileStream.Free;
    end;        
end;
我也不喜欢用印地，我的理由是它太大了。您也可以使用wininet。我已经写了一个小项目需要小应用程序大小以下

unit wininetUtils;

interface

uses Windows, WinInet
{$IFDEF KOL}
,KOL
{$ELSE}
,Classes
{$ENDIF}
;

type

{$IFDEF KOL}
  _STREAM = PStream;
  _STRLIST = PStrList;
{$ELSE}
  _STREAM = TStream;
  _STRLIST = TStrings;
{$ENDIF}

TProgressCallback = function (ATotalSize, ATotalRead, AStartTime: DWORD): Boolean;

function DownloadToFile(const AURL: String; const AFilename: String;
  const  AAgent: String = '';
  const AHeaders: _STRLIST = nil;
  const ACallback: TProgressCallback = nil
  ) : LongInt;

function DownloadToStream(AURL: String; AStream: _STREAM;
  const  AAgent: String = '';
  const AHeaders: _STRLIST = nil;
  const ACallback: TProgressCallback = nil
  ) : LongInt;

implementation

function DownloadToFile(const AURL: String; const AFilename: String;
  const  AAgent: String = '';
  const AHeaders: _STRLIST = nil;
  const ACallback: TProgressCallback = nil
  ) : LongInt;
var
  FStream: _STREAM;
begin
  {$IFDEF KOL}
//    fStream := NewFileStream(AFilename, ofCreateNew or ofOpenWrite);
//    fStream := NewWriteFileStream(AFilename);
    fStream := NewMemoryStream;
  {$ELSE}
    fStream := TFileStream.Create(AFilename, fmCreate);
//    _STRLIST = TStrings;
  {$ENDIF}
  try
    Result := DownloadToStream(AURL, FStream, AAgent, AHeaders, ACallback);
    fStream.SaveToFile(AFilename, 0, fStream.Size);
  finally
    fStream.Free;
  end;
end;

function StrToIntDef(const S: string; Default: Integer): Integer;
var
  E: Integer;
begin
  Val(S, Result, E);
  if E <> 0 then Result := Default;
end;

function DownloadToStream(AURL: String; AStream: _STREAM;
  const  AAgent: String = '';
  const AHeaders: _STRLIST = nil;
  const ACallback: TProgressCallback = nil
  ) : LongInt;

  function _HttpQueryInfo(AFile: HINTERNET; AInfo: DWORD): string;
  var
    infoBuffer: PChar;
    dummy: DWORD;
    err, bufLen: DWORD;
    res: LongBool;
  begin
    Result := '';
    bufLen := 0;
    dummy := 0;
    infoBuffer := nil;
    res := HttpQueryInfo(AFile, AInfo, infoBuffer, bufLen, dummy);
    if not res then
    begin
      // Probably working offline, or no internet connection.
      err := GetLastError;
      if err = ERROR_HTTP_HEADER_NOT_FOUND then
      begin
        // No headers
      end else if err = ERROR_INSUFFICIENT_BUFFER then
      begin
        GetMem(infoBuffer, bufLen);
        try
          HttpQueryInfo(AFile, AInfo, infoBuffer, bufLen, dummy);
          Result := infoBuffer;
        finally
          FreeMem(infoBuffer);
        end;
      end;
    end;
  end;

  procedure ParseHeaders;
  begin

  end;


const
  BUFFER_SIZE = 16184;
var
  buffer: array[1..BUFFER_SIZE] of byte;
  Totalbytes, Totalread, bytesRead, StartTime: DWORD;
  hInet: HINTERNET;
  reply: String;
  hFile: HINTERNET;
begin
  Totalread := 0;
  Result := 0;
  hInet := InternetOpen(PChar(AAgent), INTERNET_OPEN_TYPE_PRECONFIG, nil,nil,0);
  if hInet = nil then Exit;

  try
    hFile := InternetOpenURL(hInet, PChar(AURL), nil, 0, 0, 0);
    if hFile = nil then Exit;
    StartTime := GetTickCount;
    try
      if AHeaders <> nil then
      begin
        AHeaders.Text := _HttpQueryInfo(hFile, HTTP_QUERY_RAW_HEADERS_CRLF);
        ParseHeaders;
      end;

      Totalbytes := StrToIntDef(_HttpQueryInfo(hFile,
        HTTP_QUERY_CONTENT_LENGTH), 0);

      reply := _HttpQueryInfo(hFile, HTTP_QUERY_STATUS_CODE);
      if reply = '200' then
        // File exists, all ok.
        result := 200
      else if reply = '401' then
        // Not authorised. Assume page exists,
        // but we can't check it.
        result := 401
      else if reply = '404' then
        // No such file.
        result := 404
      else if reply = '500' then
        // Internal server error.
        result := 500
      else
        Result := StrToIntDef(reply, 0);

      repeat
        InternetReadFile(hFile, @buffer, SizeOf(buffer), bytesRead);
        if bytesRead > 0 then
        begin
          AStream.Write(buffer, bytesRead);
          Inc(Totalread, bytesRead);
          if Assigned(ACallback) then
          begin
            if not ACallback(TotalBytes, Totalread, StartTime) then Break;
          end;
          Sleep(10);
        end;
    //    BlockWrite(localFile, buffer, bytesRead);
      until bytesRead = 0;

    finally
      InternetCloseHandle(hFile);
    end;
  finally
    InternetCloseHandle(hInet);
  end;
end;


end.

单位wininetUtils；
接口
使用Windows、WinInet
{$IFDEF KOL}
，KOL
{$ELSE}
，班级
{$ENDIF}
;
类型
{$IFDEF KOL}
_流=流间流；
_STRLIST=PStrList；
{$ELSE}
_溪流=TStream；
_STRLIST=t字符串；
{$ENDIF}
TProgressCallback=函数（ATotalSize、ATotalRead、AStartTime:DWORD）：布尔值；
函数下载文件（const AURL:String；const AFilename:String；
const-AAgent:String=''；
const AHeaders:_STRLIST=nil；
const ACallback:TProgressCallback=nil
)：LongInt；
函数DownloadToStream（AURL:String；AStream:\u STREAM；
const-AAgent:String=''；
const AHeaders:_STRLIST=nil；
const ACallback:TProgressCallback=nil
)：LongInt；
实施
函数下载文件（const AURL:String；const AFilename:String；
const-AAgent:String=''；
const AHeaders:_STRLIST=nil；
const ACallback:TProgressCallback=nil
)：LongInt；
变量
FStream:_STREAM；
开始
{$IFDEF KOL}
//fStream:=NewFileStream（文件名，用于CreateNew或OpenWrite）；
//fStream:=NewWriteFileStream（文件名）；
fStream:=新内存流；
{$ELSE}
fStream:=TFileStream.Create（AFilename，fmCreate）；
//_STRLIST=t字符串；
{$ENDIF}
尝试
结果：=下载到流（AURL、FStream、AAgent、AHeaders、ACallback）；
SaveToFile（文件名，0，fStream.Size）；
最后
fStream.Free；
结束；
结束；
函数strotintdef（常量S:string；默认值：Integer）：Integer；
变量
E：整数；
开始
Val（S，Result，E）；
如果E 0，则结果：=默认值；
结束；
函数DownloadToStream（AURL:String；AStream:\u STREAM；
const-AAgent:String=''；
const AHeaders:_STRLIST=nil；
const ACallback:TProgressCallback=nil
)：LongInt；
函数_HttpQueryInfo（AFile:HINTERNET；AInfo:DWORD）：字符串；
变量
信息缓冲区：PChar；
假人：德沃德；
呃，布弗伦：德沃德；
研究：朗布尔；
开始
结果：=''；
bufLen:=0；
虚拟：=0；
infoBuffer:=nil；
res:=HttpQueryInfo（AFile、AInfo、infoBuffer、bufLen、dummy）；
如果不是，那么
开始
//可能是脱机工作，或者没有互联网连接。
err:=GetLastError；
如果err=ERROR\u HTTP\u头\u未找到，则
开始
//无标题
如果err=ERROR\u缓冲区不足，则结束else
开始
GetMem（infoBuffer，bufLen）；
尝试
HttpQueryInfo（AFile、AInfo、infoBuffer、bufLen、dummy）；
结果：=信息缓冲区；
最后
FreeMem（infoBuffer）；
结束；
结束；
结束；
结束；
程序解析头；
开始
结束；
常数
缓冲区大小=16184；
变量
缓冲区：字节的数组[1..buffer\u SIZE]；
Totalbytes、Totalread、ByteRead、StartTime:DWORD；
海内网:；
答复：字符串；
hFile:HINTERNET；
开始
Totalread:=0；
结果：=0；
hInet:=互联网开放（PChar（AAgent），互联网开放类型，无，无，0）；
如果hInet=nil，则退出；
尝试
hFile:=互联网开放URL（hInet，PChar（AURL），无，0，0，0）；
如果hFile=nil，则退出；
StartTime:=GetTickCount；
尝试
如果领先者为零，那么
开始
AHeaders.Text:=\u HttpQueryInfo（hFile，HTTP\u QUERY\u RAW\u HEADERS\u CRLF）；
解析标题；
结束；
Totalbytes:=StrToIntDef（_HttpQueryInfo（hFile，
HTTP_查询_内容_长度），0）；
回复：=\u HttpQueryInfo（hFile，HTTP\u查询\u状态\u代码）；
如果回复=200，则
//文件存在，一切正常。
结果：=200
否则，如果回复='401'，则
//未经授权。假设页面存在，
//但是我们不能检查它。
结果：=401
否则，如果回复='404'，则
//没有这样的文件。
结果：=404
否则，如果回复=500，则
//内部服务器错误。
结果：=500
其他的
结果：=StrToIntDef（回复，0）；
重复
InternetReadFile（hFile、@buffer、SizeOf（buffer）、bytesRead）；
如果字节读取>0，则
开始
AStream.Write（缓冲区、字节读取）；
Inc（Totalread，bytesRead）；
如果已分配（ACallback），则
开始
如果不是ACallback（TotalBytes、Totalread、StartTime），则中断；
结束；
睡眠（10）；
结束；
//块写入（本地文件、缓冲区、字节读取）；
直到bytesRead=0；
最后
InternetCloseHandle（hFile）；
结束；
最后
国际互联网（hInet）；
结束；
结束；
结束。
向我们展示您迄今为止的尝试。你为什么不想使用Indy呢？如果你想让你的生活变得艰难的话，可以选择ICS，或者使用原始tcp套接字。但是印地有什么问题？印地可以用不到50行代码完成，我想你有很好的理由避免它。这可能是什么原因呢？我很好奇，为什么你不想使用像印第这样的成熟/完整的西装？你为什么要重新发明轮子？太大了？您仍然使用20MB硬盘吗？：-）+1对于好的ol'KOL:-）顺便说一句，HTTP状态代码的分支还有改进的余地（所有4xx、5xx都是错误）为什么你在那里有睡眠（10）？我通常把睡眠放在线程循环中，这样就不会引起太多的注意。我认为不睡觉会导致CPU使用量的激增