L
linuxping
Unregistered / Unconfirmed
GUEST, unregistred user!
今天写了个下载的程序,因为找不到服务器去测试,加上这东西又不值钱,就贴在这儿.如果高手愿意指点一二,我的目的就达到了.
{********************************************}
{ }
{ 使用idHttp检测升级文件信息并下载. }
{ copyright 2006.12.9 }
{ by wp }
{********************************************}
{需要更新的文件放在UpdateFiles目录下,需要更新的文件的信息保存在UpdateInfo.ini中,
这2个文件都必须放到服务器上去.
本程序从服务器的UpdateInfo.ini中获得文件更新时间,和本地文件TimeStamp比较,
如果文件要新的话,就下载到本地的Temp/Update目录.下载完成后,
拷贝Temp/Update目录下的文件覆盖程序目录下的文件}
unit HttpDownload;
interface
uses Windows, SysUtils,StrUtils, Variants, Classes, Controls, IdBaseComponent,
IdComponent, IdTCPConnection, IdTCPClient, IdHTTP, IniFiles;
type
{TReason=(rsGetDownLoadInfo,rsDownloadNewFile); }
TErrorEvent=procedure (Sender:TObject;{Reason:TReason;}ErrMsg:string); //产生错误时触发
TOnProgress=procedure (Sender:TObject;ACount:Cardinal); //完成进度,有数据到来时触发
TOnBeginDownLoad= procedure(Sender:TObject;FileName:string); // 开始下载某一个文件
TOnEndDownload= procedure(Sender:TObject;FileName:string); //一个文件下载完毕
type TBaseHttpDownload=class(TThread)
private
FHttp:TIdHTTP;
FExistNewFile:Boolean;
FIsBeginDownload:Boolean;
FStop:Boolean; //中断下载
FOnError:TErrorEvent;
FOnProgress:TOnProgress;
FOnBeginDownLoad:TOnBeginDownLoad;
FOnEndDownload:TOnEndDownload;
function GetHost:string;
procedure SetHost(AUrl:string);
procedure SetStop(AStop:Boolean);
protected
property RequireDownload:Boolean read FExistNewFile; //是否需要升级
property OnError:TErrorEvent read FOnError write FOnError;
property OnProgress:TOnProgress read FOnProgress write FOnProgress;
property OnBeginDownLoad:TOnBeginDownLoad read FOnBeginDownLoad write FOnBeginDownLoad;
property OnEndDownload:TOnEndDownload read FOnEndDownload write FOnEndDownload;
property Stop:Boolean read FStop write SetStop;
property Host:string read GetHost write SetHost;
function GetFileLength(AFileURL:string):Cardinal; //文件长度
function GetDownloadInfo(AInfoURL:string;var FileLen:Cardinal;var Content:string):Boolean; //获得升级文件信息
procedure Progress(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCount: Integer);
public
constructor Create;
destructor Destroy;override;
procedure GetNewFile(ANewFileURL:string;
var FileLen:Cardinal); //下载升级文件
end;
type THttpDownload=class(TBaseHttpDownload)
private
FInfoUrl:string; //升级文件信息的URL
FServerAddr, //服务器列表
FNewFiles:TStringList; //要下载的文件列表
public
procedure Execute;override;
function ExtractDownloadInfo(Info:string;
NewFilePaths:TStringList):Boolean; //分析升级文件信息,
//确定是否需要下载.
property OnProgress; //将需要下载的文件的
property OnError; //信息存于NewFilePaths
property OnBeginDownLoad;
property OnEndDownload;
published
property RequireDownload;
end;
type TMemIni=class(TMemIniFile) //真正的在内存中操作Ini----不需要ini文件,直接从字符串载入
private
procedure Load(str:string);
public
constructor Create(sValue:string);override;
//destructor Destroy;override;
end;
function ExtractFileNameFormURL(AUrl:string):string; //Http://163.com/XXX.exe--->xxx.exe
function ExtractFileDirFormURL(AUrl:string):string; //Http://163.com/XXX.exe--->Http://163.com/
implementation
uses u_InetState,untCommon;
{ TBaseHttpDownload }
constructor TBaseHttpDownload.Create;
var
Conn:TInetState;
begin
inherited Create(True);
Conn:=TInetState.Create; //TInetState这个类用来判断是否联网
if not Conn.IsConnected then
begin
if Assigned(FOnError) then FOnError(Self,'网络连接断开!');
Conn.Free;
Halt;
end;
Conn.Free;
FIsBeginDownload:=False;
FExistNewFile:=False;
FStop:=False;
FHttp:=TIdHTTP.Create(nil);
FHttp.OnWork:=Progress;
end;
destructor TBaseHttpDownload.Destroy;
begin
FHttp.Free;
inherited;
end;
function TBaseHttpDownload.GetDownloadInfo(
AInfoURL: string;var FileLen:Cardinal;var Content:String):Boolean ; //产生错误则返回false
const
http='Http://';
var
str:string;
begin
FileLen:=GetFileLength(AInfoURL);
if FileLen=0 then Exit;
try
if Assigned(OnBeginDownLoad) then FOnBeginDownLoad(Self,AInfoURL);
FIsBeginDownload:=True;
Content:=FHttp.Get(AInfoURL);
except
if Assigned(FOnError) then FOnError(Self,'获取升级信息出错!');
FIsBeginDownload:=False;
Exit;
end;
FIsBeginDownload:=False;
if Assigned(OnEndDownLoad) then FOnEndDownLoad(Self,AInfoURL);
Result:=True;
end;
function TBaseHttpDownload.GetFileLength(AFileURL: string): Cardinal;
const
http='Http://';
var
str:string;
begin
if Length(Host)=0 then
begin
str:=IfThen(Pos(http,AInfoURL)=0,AInfoURL,Copy(AInfoURL,8,Length(AInfoURL)-7));
host:=http+Copy(str,1,Pos('/',str)-1);
end;
Result:=0;
try
FHttp.Head(AInfoURL);
Result:=FHttp.Response.ContentLength;
except
if Assigned(FOnError) then FOnError(Self,'获取文件长度信息出错!');
end;
end;
function TBaseHttpDownload.GetHost: string;
begin
Host:=FHttp.Host;
end;
procedure TBaseHttpDownload.GetNewFile(ANewFileURL: string;
var FileLen:Cardinal);
const
PARTLEN=1024*2; //每次下载PARTLEN长度
var
str:string;
HaveDownload:Cardinal; //已经下载的大小
hFile:Integer;
begin
//---------创建一个临时文件夹-----------
if not DirectoryExists(ExeDir+'temp/Update') then CreateDir(ExeDir+'temp/Update'); //ExeDir为当前程序所在目录
//------获取文件长度------
FileLen:=GetFileLength(AInfoURL);
if FileLen=0 then Exit;
//------------------------
if Assigned(FOnBeginDownLoad) then FOnBeginDownLoad(Self,AInfoURL);
FIsBeginDownload:=True; //开始下载
//-------下载文件---------
HaveDownload:=0;
str:=ExeDir+'temp/'+ExtractFileNameFormURL(ANewFileURL);
hFile:=FileOpen(str,fmCreate or fmOpenWrite);
try
while (HaveDownload<FileLen) do
begin
if Stop then Break; //下载被中断
try
FHttp.Request.ContentRangeStart:=HaveDownload;
if HaveDownload+PARTLEN<=FileLen then
FHttp.Request.ContentRangeEnd:=HaveDownload+PARTLEN
else
FHttp.Request.ContentRangeEnd:=FileLen;
str:=FHttp.Get(ANewFileURL);
except
if Assigned(FOnError) then FOnError(Self,'下载文件出错!');
Continue;
end;
HaveDownload:=HaveDownload+PARTLEN;
FileWrite(hFile,str[1],Length(str));
end;
finally
FileClose(hFile);
FIsBeginDownload:=False;
end;
end;
procedure TBaseHttpDownload.Progress(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCount: Integer);
begin
if (FIsBeginDownload) and Assigned(FOnProgress) and (AWorkMode=wmRead) then
FOnProgress(Self,AWorkCount);
end;
procedure TBaseHttpDownload.SetHost(AUrl:string);
begin
FHttp.Host:=AUrl;
end;
procedure TBaseHttpDownload.SetStop(AStop: Boolean);
begin
Stop:=True;
Self.Terminate;
end;
{ THttpDownload }
procedure THttpDownload.Execute;
var
FileLen:Cardinal;
Text,URL,cmd:string;
NewFiles:TStringList;
Count:Integer;
begin
inherited;
if Self.Terminated then Exit;
if not GetDownloadInfo(FInfoUrl,FileLen,Text) then Exit;
if Self.Terminated then Terminate;
NewFiles:=TStringList.Create;
if not ExtractDownloadInfo(Text,NewFiles) then //不需要升级
begin
NewFiles.Free;
Exit;
end;
NewFiles.Free;
//----------下载所有文件-------------
URL:=ExtractFileDirFormURL+'UpdateFiles/';
for Count:=0 to FNewFiles.Count-1 do
begin
if Self.Terminated then break;
if GetFileLength(FNewFiles.Strings[Count])=0 then Continue;
GetNewFile(URL+FNewFiles.Strings[Count],FileLen);
end;
//---------------更新----------------
Text:=ExeDir+'temp/Update/*.*';
cmd:='XCopy /E/I/Y/H/C/K/D '+text+#32+ExeDir;
if WinExec(PChar(cmd),SW_HIDE)<32 then
if Assigned(FonError) then FOnError(Self,'拷贝文件出错!');
end;
function THttpDownload.ExtractDownloadInfo(Info:string;
NewFilePaths:TStringList):Boolean;
var
Ini:TMemIni;
List:TStringList;
I:Integer;
begin
List:=TStringList.Create;
Ini:=TMemIni.Create(Info);
Ini.ReadSectionValues('NewFiles',List);
List.NameValueSeparator:='=';
for I:=0 to List.Count-1 do
begin
if FileAge(ExeDir+List.Names)<>-1 then //文件不存在
if StrToDateTime(List.Values)<FileDateToDateTime(FileAge(ExeDir+List.Names)) then
Continue; //比较更新日期
FNewFiles.Add(List.Names); //保存需要更新的文件
end;
Result:=FNewFiles.Count=0;
List.Clear;
Ini.ReadSectionValues('ServerAddr',List);
List.Text:='[ServerAddr]'+#13#10+list.Text;
List.SaveToFile(ExeDir+'Users/UpdateInfo.ini'); //保存下载地址列表到本地
Ini.Free;
List.Free;
end;
{ TMemIni }
constructor TMemIni.Create(sValue:string);
begin
FSections := THashedStringList.Create;
Load(sValue);
end;
procedure TMemIni.Load(str:string);
var
List: TStringList;
begin
List := TStringList.Create;
try
List.Text:=str;
SetStrings(List);
finally
List.Free;
end;
end;
//================================================================
function ExtractFileNameFormURL(AUrl:string):string;
var
I:Integer;
begin
I:=LastDelimiter('/',AUrl);
Result:=Copy(AUrl,I+1,Length(AUrl)-I);
//Result:=ChangeFileExt(Result,'.tmp');
end;
function ExtractFileDirFormURL(AUrl:string):string; //Http://163.com/XXX.exe--->Http://163.com/
var
I:Integer;
begin
I:=LastDelimiter('/',AUrl);
Result:=Copy(AUrl,1,I);
end;
end.
{********************************************}
{ }
{ 使用idHttp检测升级文件信息并下载. }
{ copyright 2006.12.9 }
{ by wp }
{********************************************}
{需要更新的文件放在UpdateFiles目录下,需要更新的文件的信息保存在UpdateInfo.ini中,
这2个文件都必须放到服务器上去.
本程序从服务器的UpdateInfo.ini中获得文件更新时间,和本地文件TimeStamp比较,
如果文件要新的话,就下载到本地的Temp/Update目录.下载完成后,
拷贝Temp/Update目录下的文件覆盖程序目录下的文件}
unit HttpDownload;
interface
uses Windows, SysUtils,StrUtils, Variants, Classes, Controls, IdBaseComponent,
IdComponent, IdTCPConnection, IdTCPClient, IdHTTP, IniFiles;
type
{TReason=(rsGetDownLoadInfo,rsDownloadNewFile); }
TErrorEvent=procedure (Sender:TObject;{Reason:TReason;}ErrMsg:string); //产生错误时触发
TOnProgress=procedure (Sender:TObject;ACount:Cardinal); //完成进度,有数据到来时触发
TOnBeginDownLoad= procedure(Sender:TObject;FileName:string); // 开始下载某一个文件
TOnEndDownload= procedure(Sender:TObject;FileName:string); //一个文件下载完毕
type TBaseHttpDownload=class(TThread)
private
FHttp:TIdHTTP;
FExistNewFile:Boolean;
FIsBeginDownload:Boolean;
FStop:Boolean; //中断下载
FOnError:TErrorEvent;
FOnProgress:TOnProgress;
FOnBeginDownLoad:TOnBeginDownLoad;
FOnEndDownload:TOnEndDownload;
function GetHost:string;
procedure SetHost(AUrl:string);
procedure SetStop(AStop:Boolean);
protected
property RequireDownload:Boolean read FExistNewFile; //是否需要升级
property OnError:TErrorEvent read FOnError write FOnError;
property OnProgress:TOnProgress read FOnProgress write FOnProgress;
property OnBeginDownLoad:TOnBeginDownLoad read FOnBeginDownLoad write FOnBeginDownLoad;
property OnEndDownload:TOnEndDownload read FOnEndDownload write FOnEndDownload;
property Stop:Boolean read FStop write SetStop;
property Host:string read GetHost write SetHost;
function GetFileLength(AFileURL:string):Cardinal; //文件长度
function GetDownloadInfo(AInfoURL:string;var FileLen:Cardinal;var Content:string):Boolean; //获得升级文件信息
procedure Progress(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCount: Integer);
public
constructor Create;
destructor Destroy;override;
procedure GetNewFile(ANewFileURL:string;
var FileLen:Cardinal); //下载升级文件
end;
type THttpDownload=class(TBaseHttpDownload)
private
FInfoUrl:string; //升级文件信息的URL
FServerAddr, //服务器列表
FNewFiles:TStringList; //要下载的文件列表
public
procedure Execute;override;
function ExtractDownloadInfo(Info:string;
NewFilePaths:TStringList):Boolean; //分析升级文件信息,
//确定是否需要下载.
property OnProgress; //将需要下载的文件的
property OnError; //信息存于NewFilePaths
property OnBeginDownLoad;
property OnEndDownload;
published
property RequireDownload;
end;
type TMemIni=class(TMemIniFile) //真正的在内存中操作Ini----不需要ini文件,直接从字符串载入
private
procedure Load(str:string);
public
constructor Create(sValue:string);override;
//destructor Destroy;override;
end;
function ExtractFileNameFormURL(AUrl:string):string; //Http://163.com/XXX.exe--->xxx.exe
function ExtractFileDirFormURL(AUrl:string):string; //Http://163.com/XXX.exe--->Http://163.com/
implementation
uses u_InetState,untCommon;
{ TBaseHttpDownload }
constructor TBaseHttpDownload.Create;
var
Conn:TInetState;
begin
inherited Create(True);
Conn:=TInetState.Create; //TInetState这个类用来判断是否联网
if not Conn.IsConnected then
begin
if Assigned(FOnError) then FOnError(Self,'网络连接断开!');
Conn.Free;
Halt;
end;
Conn.Free;
FIsBeginDownload:=False;
FExistNewFile:=False;
FStop:=False;
FHttp:=TIdHTTP.Create(nil);
FHttp.OnWork:=Progress;
end;
destructor TBaseHttpDownload.Destroy;
begin
FHttp.Free;
inherited;
end;
function TBaseHttpDownload.GetDownloadInfo(
AInfoURL: string;var FileLen:Cardinal;var Content:String):Boolean ; //产生错误则返回false
const
http='Http://';
var
str:string;
begin
FileLen:=GetFileLength(AInfoURL);
if FileLen=0 then Exit;
try
if Assigned(OnBeginDownLoad) then FOnBeginDownLoad(Self,AInfoURL);
FIsBeginDownload:=True;
Content:=FHttp.Get(AInfoURL);
except
if Assigned(FOnError) then FOnError(Self,'获取升级信息出错!');
FIsBeginDownload:=False;
Exit;
end;
FIsBeginDownload:=False;
if Assigned(OnEndDownLoad) then FOnEndDownLoad(Self,AInfoURL);
Result:=True;
end;
function TBaseHttpDownload.GetFileLength(AFileURL: string): Cardinal;
const
http='Http://';
var
str:string;
begin
if Length(Host)=0 then
begin
str:=IfThen(Pos(http,AInfoURL)=0,AInfoURL,Copy(AInfoURL,8,Length(AInfoURL)-7));
host:=http+Copy(str,1,Pos('/',str)-1);
end;
Result:=0;
try
FHttp.Head(AInfoURL);
Result:=FHttp.Response.ContentLength;
except
if Assigned(FOnError) then FOnError(Self,'获取文件长度信息出错!');
end;
end;
function TBaseHttpDownload.GetHost: string;
begin
Host:=FHttp.Host;
end;
procedure TBaseHttpDownload.GetNewFile(ANewFileURL: string;
var FileLen:Cardinal);
const
PARTLEN=1024*2; //每次下载PARTLEN长度
var
str:string;
HaveDownload:Cardinal; //已经下载的大小
hFile:Integer;
begin
//---------创建一个临时文件夹-----------
if not DirectoryExists(ExeDir+'temp/Update') then CreateDir(ExeDir+'temp/Update'); //ExeDir为当前程序所在目录
//------获取文件长度------
FileLen:=GetFileLength(AInfoURL);
if FileLen=0 then Exit;
//------------------------
if Assigned(FOnBeginDownLoad) then FOnBeginDownLoad(Self,AInfoURL);
FIsBeginDownload:=True; //开始下载
//-------下载文件---------
HaveDownload:=0;
str:=ExeDir+'temp/'+ExtractFileNameFormURL(ANewFileURL);
hFile:=FileOpen(str,fmCreate or fmOpenWrite);
try
while (HaveDownload<FileLen) do
begin
if Stop then Break; //下载被中断
try
FHttp.Request.ContentRangeStart:=HaveDownload;
if HaveDownload+PARTLEN<=FileLen then
FHttp.Request.ContentRangeEnd:=HaveDownload+PARTLEN
else
FHttp.Request.ContentRangeEnd:=FileLen;
str:=FHttp.Get(ANewFileURL);
except
if Assigned(FOnError) then FOnError(Self,'下载文件出错!');
Continue;
end;
HaveDownload:=HaveDownload+PARTLEN;
FileWrite(hFile,str[1],Length(str));
end;
finally
FileClose(hFile);
FIsBeginDownload:=False;
end;
end;
procedure TBaseHttpDownload.Progress(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCount: Integer);
begin
if (FIsBeginDownload) and Assigned(FOnProgress) and (AWorkMode=wmRead) then
FOnProgress(Self,AWorkCount);
end;
procedure TBaseHttpDownload.SetHost(AUrl:string);
begin
FHttp.Host:=AUrl;
end;
procedure TBaseHttpDownload.SetStop(AStop: Boolean);
begin
Stop:=True;
Self.Terminate;
end;
{ THttpDownload }
procedure THttpDownload.Execute;
var
FileLen:Cardinal;
Text,URL,cmd:string;
NewFiles:TStringList;
Count:Integer;
begin
inherited;
if Self.Terminated then Exit;
if not GetDownloadInfo(FInfoUrl,FileLen,Text) then Exit;
if Self.Terminated then Terminate;
NewFiles:=TStringList.Create;
if not ExtractDownloadInfo(Text,NewFiles) then //不需要升级
begin
NewFiles.Free;
Exit;
end;
NewFiles.Free;
//----------下载所有文件-------------
URL:=ExtractFileDirFormURL+'UpdateFiles/';
for Count:=0 to FNewFiles.Count-1 do
begin
if Self.Terminated then break;
if GetFileLength(FNewFiles.Strings[Count])=0 then Continue;
GetNewFile(URL+FNewFiles.Strings[Count],FileLen);
end;
//---------------更新----------------
Text:=ExeDir+'temp/Update/*.*';
cmd:='XCopy /E/I/Y/H/C/K/D '+text+#32+ExeDir;
if WinExec(PChar(cmd),SW_HIDE)<32 then
if Assigned(FonError) then FOnError(Self,'拷贝文件出错!');
end;
function THttpDownload.ExtractDownloadInfo(Info:string;
NewFilePaths:TStringList):Boolean;
var
Ini:TMemIni;
List:TStringList;
I:Integer;
begin
List:=TStringList.Create;
Ini:=TMemIni.Create(Info);
Ini.ReadSectionValues('NewFiles',List);
List.NameValueSeparator:='=';
for I:=0 to List.Count-1 do
begin
if FileAge(ExeDir+List.Names)<>-1 then //文件不存在
if StrToDateTime(List.Values)<FileDateToDateTime(FileAge(ExeDir+List.Names)) then
Continue; //比较更新日期
FNewFiles.Add(List.Names); //保存需要更新的文件
end;
Result:=FNewFiles.Count=0;
List.Clear;
Ini.ReadSectionValues('ServerAddr',List);
List.Text:='[ServerAddr]'+#13#10+list.Text;
List.SaveToFile(ExeDir+'Users/UpdateInfo.ini'); //保存下载地址列表到本地
Ini.Free;
List.Free;
end;
{ TMemIni }
constructor TMemIni.Create(sValue:string);
begin
FSections := THashedStringList.Create;
Load(sValue);
end;
procedure TMemIni.Load(str:string);
var
List: TStringList;
begin
List := TStringList.Create;
try
List.Text:=str;
SetStrings(List);
finally
List.Free;
end;
end;
//================================================================
function ExtractFileNameFormURL(AUrl:string):string;
var
I:Integer;
begin
I:=LastDelimiter('/',AUrl);
Result:=Copy(AUrl,I+1,Length(AUrl)-I);
//Result:=ChangeFileExt(Result,'.tmp');
end;
function ExtractFileDirFormURL(AUrl:string):string; //Http://163.com/XXX.exe--->Http://163.com/
var
I:Integer;
begin
I:=LastDelimiter('/',AUrl);
Result:=Copy(AUrl,1,I);
end;
end.