unit u_main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient, IdFTP, ComCtrls, ExtCtrls,IniFiles,
ShellApi,Math;
type
TFrMain = class(TForm)
idftp2: TIdFTP;
btnUpgrade: TBitBtn;
btnExit: TBitBtn;
pnl1: TPanel;
lblVer: TLabel;
lbl1: TLabel;
lv1: TListView;
mmo1: TMemo;
pb1: TProgressBar;
procedure btnUpgradeClick(Sender: TObject);
procedure btnExitClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure idftp2Work(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCount: Integer);
private
AppPath,HostIp,User,UserPwd,DownLoadPath:string;
HostPort,pIdx:Integer;
procedure ReadIni; //读取FTP配置文件
procedure FtpConnection; //连接FTP
procedure FtpDisConnection; //断开FTP
procedure DownloadFiles(Source,Target: string); //下载文件
procedure DownLoadFilesList(Ver:string); //下载文件列表
procedure DonwLoadVerInfo; //下载版本信息
function DetectVer:string; //检测版本
procedure ReadPEVer; //读取当前程序版本
function GetFileSize(filename:string):string; //获取文件的大小
procedure StartDownload; //开始下载
procedure writever; //保存更新后的版本号
procedure AfterRun; //下载后完成运行
procedure AddShowInfo(act:string); //显示详细 操作
procedure BtState; //按钮状态
procedure PrgShow(Pos,Max:Integer); //进度条
procedure WriteError(Err:string);
{ Private declarations }
public
{ Public declarations }
end;
var
FrMain: TFrMain;
const
VerFile='DVerInfo.dat';
DFileList='FList.dat';
implementation
{$R *.dfm}
{ TFrMain }
procedure TFrMain.FtpConnection;
begin
FtpDisConnection;
try
with idftp2 do
begin
Host:=HostIp;
Port:=HostPort;
Username:=User;
Password:=UserPwd;
Connect();
end
except
on E:Exception do
begin
WriteError(e.Message);
ShowMessage('Connection Error!');
Application.Terminate;
end;
end;
end;
procedure TFrMain.FtpDisConnection;
begin
idftp2.Disconnect;
end;
procedure TFrMain.btnUpgradeClick(Sender: TObject);
begin
StartDownload;
end;
procedure TFrMain.btnExitClick(Sender: TObject);
begin
Close;
end;
procedure TFrMain.DonwLoadVerInfo;
begin
AddShowInfo('verify the Version,please wait...');
try
DownloadFiles(VerFile,DownLoadPath+VerFile);
except
on E:Exception do
begin
WriteError(e.Message);
ShowMessage('Failed:download version.');
end;
end;
end;
procedure TFrMain.ReadIni;
var
Ini:TIniFile;
begin
Ini:=TIniFile.Create(AppPath+'\ftpSvr.ini');
try
HostIp:=Ini.ReadString('Ftpinfo','HostIp','');
HostPort:=Ini.ReadInteger('Ftpinfo','HostPort',0);
User:=Ini.ReadString('Ftpinfo','User','');
UserPwd:=Ini.ReadString('Ftpinfo','UserPwd','');
DownLoadPath:=Ini.ReadString('Ftpinfo','DownLoadPath','');
finally
Ini.Free;
end;
end;
procedure TFrMain.FormCreate(Sender: TObject);
begin
AppPath:=ExtractFilePath(Application.ExeName);
ReadPEVer;
ReadIni;
Application.Title:=Caption;
end;
procedure TFrMain.ReadPEVer;
var
VerData:TStringList;
Vertxt:string;
begin
Vertxt:=AppPath+'\Ver.txt';
if not FileExists(Vertxt) then
begin
ShowMessage('Failed:Read the version.');
Close;
end;
VerData:=TStringList.Create;
try
VerData.LoadFromFile(Vertxt);
lblVer.Caption:=VerData.Strings[0];
finally
VerData.Free;
end;
end;
procedure TFrMain.DownloadFiles(Source,Target: string);
begin
try
try
FtpConnection;
idftp2.ChangeDir('/');
idftp2.ChangeDirUp;
idftp2.Get(Source,Target,True);
except
on E:Exception do
WriteError(e.Message);
end;
finally
FtpDisConnection;
end;
end;
function TFrMain.DetectVer: string;
var
DataList:TStringList;
begin
if not FileExists(DownLoadPath+VerFile) then
begin
// ShowMessage('');
Exit;
end;
DataList:=TStringList.Create;
try
DataList.LoadFromFile(DownLoadPath+VerFile);
Result:=DataList.Values[lblVer.Caption]
finally
DataList.Free;
end;
end;
procedure TFrMain.DownLoadFilesList(Ver:string);
begin
try
AddShowInfo('Downloading file list.');
DownloadFiles(Ver+'\'+DFileList,DownLoadPath+DFileList);
AddShowInfo('OK:Downloading file list.');
except
on E:Exception do
WriteError(e.Message);
end;
end;
procedure TFrMain.StartDownload;
var
Ver,SourceFilename,TargerFilename,AfterRp:string;
DataList:TStringList;
Idx,FileCount:Integer;
begin
lv1.Clear;
mmo1.Clear;
DonwLoadVerInfo;
Ver:=Trim(DetectVer);
if Ver='' then
begin
if not DeleteFile(AppPath+DownLoadPath+VerFile) then
ShowMessage('VerFile is not exsist.')
else
ShowMessage('No update.');
Close;
Exit;
end;
AddShowInfo('Old Version:'+lblVer.Caption+',New Version:'+Ver);
DownLoadFilesList(Ver); //下载对应版本的文件列表
DataList:=TStringList.Create;
AddShowInfo('Download files,please wait...');
try
BtState;
DataList.LoadFromFile(AppPath+DownLoadPath+DFileList);
FileCount:=StrToInt(DataList.Values['FileCount']);
AfterRp:=DataList.Values['AfterRun'];
pb1.Position:=0;
FtpConnection;
for Idx:=0 to FileCount-1 do
begin
SourceFilename:=DataList.Values['File'+InttoStr(Idx)];
TargerFilename:=DownLoadPath+SourceFilename;
pIdx:=Idx;
if AfterRp<>SourceFilename then
begin
with lv1 do
begin
Items.Add;
Items.Item[Idx].Caption:=SourceFilename;
Items.Item[Idx].SubItems.Add(GetFileSize(Ver+'\'+SourceFilename));
Items.Item[Idx].SubItems.Add('Downloading...');
PrgShow(Idx+1,FileCount);
Application.ProcessMessages;
end;
end;
try
idftp2.Get(Ver+'\'+SourceFilename,TargerFilename,True);
if AfterRp<>SourceFilename then
lv1.Items.Item[Idx].SubItems.Strings[1]:='OK';
Application.ProcessMessages;
except
lv1.Items.Item[Idx].SubItems.Strings[1]:='Failed';
end;
end;
writever;
AddShowInfo('OK:Download files.');
AfterRun;
finally
DataList.Free;
FtpDisConnection;
BtState;
end;
end;
procedure TFrMain.writever;
var
DataList:TStringList;
Ver:string;
begin
if not idftp2.Connected then Exit;
DataList:=TStringList.Create;
Ver:=DetectVer;
try
DataList.LoadFromFile(AppPath+'Ver.txt');
DataList.Clear;
DataList.Add(Ver);
DataList.SaveToFile(AppPath+'Ver.txt');
lblVer.Caption:=Ver;
finally
DataList.Free;
end;
end;
procedure TFrMain.AfterRun;
var
DataList:TStringList;
strExe:string;
begin
DataList:=TStringList.Create;
try
DataList.LoadFromFile(AppPath+DownLoadPath+DFileList);
strExe:=Downloadpath+DataList.Values['AfterRun'];
ShellExecute(Handle,'',PChar(strExe),'','',SW_NORMAL);
Close;
finally
DataList.Free;
end;
end;
function TFrMain.GetFileSize(filename:string): string;
var
size1:Double;
begin
size1:=idftp2.Size(filename)/1024;
Result:=VarToStr(size1);
end;
procedure TFrMain.idftp2Work(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCount: Integer);
begin
lv1.Items.Item[pIdx].SubItems.Strings[1]:=
VarToStr(AWorkCount/1024);
Application.ProcessMessages;
end;
procedure TFrMain.AddShowInfo(act: string);
begin
mmo1.Lines.Add('Time:'+DateTimeToStr(Now)+',operation:'+act);
Application.ProcessMessages;
end;
procedure TFrMain.BtState;
begin
btnUpgrade.Enabled:=not btnUpgrade.Enabled;
btnExit.Enabled:=not btnExit.Enabled;
end;
procedure TFrMain.PrgShow(Pos, Max: Integer);
begin
pb1.Position:=Floor(Pos*100/Max);
Application.ProcessMessages;
end;
procedure TFrMain.WriteError(Err: string);
var
MyFile:TextFile;
ErrFile:string;
begin
ErrFile:=AppPath+'err.log';
try
AssignFile(MyFile,ErrFile);
if FileExists(ErrFile) then
Append(MyFile)
else
Rewrite(MyFile);
writeln(MyFile,'Time:'+DateTimeToStr(Now)+',ErrorMsg:'+err);
finally
CloseFile(MyFile);
end;
end;
end.
