delphi CS构架下的客户端自动更新程序 |笨鱼技术网

做CS程序的兄弟们一定为部署伤透了脑筋吧？几十个点跑下来，人刚休息一阵子，噩耗传来：程序有升级，怎么办？再跑一次？靠，我宁肯辞职都不干了。

我原来写了一个自动更新程序，思路也很简单：客户端就一个Update.Exe，这个程序自动连接指定的FTP服务器，检查服务器上指定FTP目录中文件的版本（或日期），与本地的文件进行对比，如果本地没有文件，或与服务器上的文件日期不一致，则自动下载服务器上的文件到本地。最后把这个Update.exe程序做一个快捷到“启动组”中，一开机就检查一遍，程序简单，但效果很好，我们项目里的几十台终端，都是通过这样的方式自动更新，已经运行了二年了，我们只要在晚上把新开发的程序EXE和DLL及其他文件放在服务器上就可以了，第二天所有终端机一开机，就是最新的程序。

下面是最主要的一个程序函数：比较服务器上文件和本地文件和版本，网络访问用的是Wininet包。

function UpdateByFTP : Boolean;
var
Reg : TRegistry;
sLocalPath : string;
sUpdateFtp : string;
nCount, I : integer;
sFrom, sTo : string;
fStruct: _OFSTRUCT;
hlf : THandle;
CreateFT, LastAccessFT,LocalLastWriteFT : TFileTime;
sBuf : string;
hConn : HInternet;
hSession, hFindHandle : HInternet;
FindData: TWin32FindData;
ST, ST1 : SystemTime;
DT : TDateTime;
sSysFontPath : string;
begin
//检查服务器上的文件与本地文件的日期
Reg := TRegistry.Create;
Reg.RootKey := HKEY_CURRENT_USER;
if Reg.OpenKey('Software\Dist\UrumchiInstall',false) then begin
sLocalPath := reg.ReadString('InstallPath');
sUpdateFtp := Reg.ReadString('UpdateFtp');
if (sLocalPath <> '') and (sUpdateFtp <> '') then begin
if not DirectoryExists(sLocalPath) then CreateDir(sLocalPath);

hSession := InternetOpen('WinINet1', 0, nil, 0, 0);
hConn := InternetConnect(hSession, PChar(sUpdateFtp), 0, 'anonymous', 'sadfds2@dist.com', INTERNET_SERVICE_FTP,0 ,255);
If hConn <> nil Then begin
FTPSetCurrentDirectory(hConn, 'DAP');
hFindHandle := FtpFindFirstFile(hConn, '*.*', FindData, 0, 0);

if hFindHandle <> nil then begin
repeat
if FindData.dwFileAttributes <> FILE_ATTRIBUTE_DIRECTORY then begin
if Pos('DISTUPDATE.EXE', UpperCase(FindData.cFileName)) > 0 then begin
Continue;
end;

sTo := CheckDir(sLocalPath) + FindData.cFileName;
if FileExists(sTo) then begin
hlf := OpenFile(PChar(sTo), fStruct,OF_READ);
GetFileTime(hlf, @CreateFT, @LastAccessFT, @LocalLastWriteFT);
end;
//如果文件不存在，或日期与不上，则下载新的
if (not FileExists(sTo)) or (CompareFileTime(FindData.ftLastWriteTime, LocalLastWriteFT) <> 0) then begin
if Pos('INSTALL.INI', UpperCase(FindData.cFileName)) > 0 then begin
FTPGetFile(hConn, FindData.cFileName, PChar(sTo), false,File_Attribute_Normal,Ftp_Transfer_Type_Binary, 0 );
hlf := OpenFile(PChar(sTo), fStruct, OF_WRITE);
SetFileTime(hlf, nil, nil, Addr(FindData.ftLastWriteTime));
CloseHandle(hlf);
//设置注册表
SetRegistryFromInstallIniFile(sTo);
end
else begin
if Form1 = nil then Form1 := TForm1.Create(nil);
Form1.Show;
Form1.Trace('从 ' + CheckDir(sUpdateFTP) + 'dap\'+ FindData.cFileName + ' 复制到 ' + sTo);
FTPGetFile(hConn, FindData.cFileName, PChar(sTo), false,File_Attribute_Normal,Ftp_Transfer_Type_Binary, 0 );
hlf := OpenFile(PChar(sTo), fStruct, OF_WRITE);
SetFileTime(hlf, nil, nil, Addr(FindData.ftLastWriteTime));
CloseHandle(hlf);

//自动注册ocx
if UpperCase(ExtractFileExt(sTo)) = '.OCX' then begin
Form1.Trace('注册 ' + sTo + ' ... ');
ShellExecute(Application.Handle,'open', 'regsvr32.exe /s', PChar(sTo),nil, SW_HIDE );
end;
end;
end;
end;
until not InternetFindnextFile(hFindHandle, @FindData);
InternetCloseHandle(hFindhandle);
end;

//deal with Module
if not DirectoryExists(CheckDir(sLocalPath) + 'Module') then CreateDir(CheckDir(sLocalPath) + 'Module');

FTPSetCurrentDirectory(hConn, 'Module');
hFindHandle := FtpFindFirstFile(hConn, '*.*', FindData, 0, 0);

if hFindHandle <> nil then begin
repeat
if FindData.dwFileAttributes <> FILE_ATTRIBUTE_DIRECTORY then begin
sTo := CheckDir(sLocalPath) + 'Module\'+FindData.cFileName;
if FileExists(sTo) then begin
hlf := OpenFile(PChar(sTo), fStruct,OF_READ);
GetFileTime(hlf, @CreateFT, @LastAccessFT, @LocalLastWriteFT);
CloseHandle(hlf);
end;
//如果文件不存在，或日期与不上，则下载新的
if (not FileExists(sTo)) or (FindData.ftLastWriteTime.dwLowDateTime <> LocalLastWriteFT.dwLowDateTime) or (FindData.ftLastWriteTime.dwHighDateTime <> LocalLastWriteFT.dwHighDateTime) then begin
if Form1 = nil then Form1 := TForm1.Create(nil);
Form1.Show;
Form1.Trace('从 ' + CheckDir(sUpdateFTP) + 'dap\module\'+ FindData.cFileName + ' 复制到 ' + sTo);
FTPGetFile(hConn, FindData.cFileName, PChar(sTo), false,File_Attribute_Normal,Ftp_Transfer_Type_Binary, 0 );
hlf := OpenFile(PChar(sTo), fStruct, OF_WRITE);
SetFileTime(hlf, nil, nil, Addr(FindData.ftLastWriteTime));
CloseHandle(hlf);

//如果是ttf则安装
if UpperCase(ExtractFileExt(sTo)) = '.TTF' then begin
SetLength(sSysFontPath, MAX_PATH);
SHGetSpecialFolderPath(Application.Handle, PChar(sSysFontPath), CSIDL_FONTS , False);

sSysFontPath := Copy(sSysFontPath, 1, Pos(#0, sSysFontPath) - 1);

CopyFile(PChar(sTo), PChar(CheckDir(sSysFontPath) + 'fuhao.ttf'), false);
end;
end;
end;
until not InternetFindnextFile(hFindHandle, @FindData);
InternetCloseHandle(hFindhandle);
end;
InternetCloseHandle(hSession);
InternetCloseHandle(hConn);
end;

if Form1 <> nil then Form1.Free;
end;
end;
end;