unit u_update; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, DB, ADODB,inifiles, ComCtrls, ExtCtrls,ShellApi, StdCtrls,Registry, VCLUnZip, kpSFXCfg,tlhelp32; type Tfrm_update = class(TForm) t_sys_soft: TADOQuery; SFXConfig1: TSFXConfig; VCLUnZip1: TVCLUnZip; Button1: TButton; t_sys_softfzipname: TStringField; t_sys_softfsoftname: TStringField; t_sys_softfversion: TStringField; t_sys_softfsoft: TBlobField; t_sys_softfnotes: TStringField; Animate1: TAnimate; Timer1: TTimer; procedure Timer1Timer(Sender: TObject); private { Private declarations } fileversion,Back,face,Images,pic:String; dbfileversion,dbBack,dbface,dbImages,dbpic:String; downfileversion,downBack,downface,downImages,downpic:Boolean; dsrfilename,dsrfilepath:string; function connect_string(f:string):string; procedure downloadfile ; function initdownload :boolean; function getfilename(fname:string):string ; procedure unzipfile ; function DownLoadPro(fzipname:string):boolean ; procedure delzipfile ; procedure saveregistry ; function KillTask(ExeFileName:string):integer; public { Public declarations } end; var frm_update: Tfrm_update; implementation uses u_sys_login; {$R *.dfm} function Tfrm_update.KillTask(ExeFileName:string):integer; //杀进程函数KillTask const PROCESS_TERMINATE = $0001; var ContinueLoop: BOOLean; FSnapshotHandle: THandle; FProcessEntry32: TProcessEntry32; begin Result :=0; FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); FProcessEntry32.dwSize := SizeOf(FProcessEntry32); ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32); while Integer(ContinueLoop) <> 0 do begin if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) = UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) = UpperCase(ExeFileName))) then Result := Integer(TerminateProcess( OpenProcess(PROCESS_TERMINATE, BOOL(0), FProcessEntry32.th32ProcessID),0)); ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32); end; CloseHandle(FSnapshotHandle); end; function Tfrm_update.connect_string(f:string):string; var str:string; inifile1:Tinifile; begin inifile1:=Tinifile.Create(ExtractFilePath(application.ExeName)+f); str:=''; str:='Provider='+inifile1.ReadString('database','Provider',''); str:=str+'Password='+inifile1.ReadString('database','Password',''); str:=str+'Persist Security Info='+inifile1.ReadString('database','Persist Security Info',''); str:=str+'User ID='+inifile1.ReadString('database','User ID',''); str:=str+'Initial Catalog='+inifile1.ReadString('database','Initial Catalog',''); str:=str+'Data Source='+inifile1.ReadString('database','Data Source',''); result:=str; inifile1.Free; end; function Tfrm_update.initdownload:boolean; const AppKey ='\Software\dswake\im'; var TempReg :TRegistry; filename:string; begin result:=false; dbfileversion:='0' ; dbBack:='0' ; dbface:='0' ; dbImages:='0'; dbpic:='0'; fileversion:='0'; Back:='0'; face:='0'; Images:='0'; pic:='0'; downfileversion:=false ; downBack:=false ; downface:=false ; downImages:=false; downpic:=false; dsrfilename:='DsrClient.exe'; dsrfilepath:=ExtractFilePath(Application.ExeName)+'DsrClient'; TempReg := TRegistry.Create; try TempReg.RootKey := HKEY_LOCAL_MACHINE; if TempReg.OpenKey(AppKey + '\FileInfo', True) then begin if trim(TempReg.ReadString('fileversion')) <> '' then fileversion := TempReg.ReadString('fileversion') else fileversion :='0'; if trim(TempReg.ReadString('Back')) <> '' then Back := TempReg.ReadString('Back') else Back:='0' ; if trim(TempReg.ReadString('face')) <> '' then face := TempReg.ReadString('face') else face:='0'; if trim(TempReg.ReadString('pic')) <> '' then pic := TempReg.ReadString('pic') else pic:='0' ; if trim(TempReg.ReadString('Images')) <> '' then Images:= TempReg.ReadString('Images') else Images:='0' ; if trim(TempReg.ReadString('filename')) <> '' then dsrfilename:= TempReg.ReadString('filename') else dsrfilename:='DsrClient.exe' ; if trim(TempReg.ReadString('filepath')) <> '' then dsrfilepath:= TempReg.ReadString('filepath') else dsrfilepath:=extractfilepath(application.ExeName)+'DsrClient'+'\' ; end; finally TempReg.Free ; end ; ////招数据库 版本 with t_sys_soft,sql do begin Close ; clear; add('select * from t_dsrclient_soft '); open ; first ; while not eof do begin if uppercase(fieldbyname('fzipname').asstring)=uppercase('DsrClient.zip') then dbfileversion:=fieldbyname('fversion').AsString else if uppercase(fieldbyname('fzipname').asstring)=uppercase('back.zip') then dbback:=fieldbyname('fversion').AsString else if uppercase(fieldbyname('fzipname').asstring)=uppercase('face.zip') then dbface:=fieldbyname('fversion').AsString else if uppercase(fieldbyname('fzipname').asstring)=uppercase('pic.zip') then dbpic:=fieldbyname('fversion').AsString else if uppercase(fieldbyname('fzipname').asstring)=uppercase('images.zip') then dbImages:=fieldbyname('fversion').AsString ; next; end ; end ; //////是否下载 if fileversion'DsrClient.exe' then renamefile(dsrfilepath+'DsrClient.exe',dsrfilepath+dsrfilename); except showmessage('downfileversion unzip faile'); end; end; if downBack then begin try ffile:=getfilename('downBack'); if not DirectoryExists(dsrfilepath+'Back\') then CreateDir(dsrfilepath+'Back\'); with VCLUnZip1 do begin ZipName:=filepath+ffile ; ReadZip; FilesList.Add('*.*'); DoAll :=false; DestDir :=dsrfilepath+'Back\'; RecreateDirs :=false; RetainAttributes:=true; numunzipped:=UnZip; end; except showmessage('down back unzip faile'); end; end; if downface then begin try ffile:=getfilename('downface'); if not DirectoryExists(dsrfilepath+'face\') then CreateDir(dsrfilepath+'face\'); with VCLUnZip1 do begin ZipName:=filepath+ffile ; ReadZip; FilesList.Add('*.*'); DoAll :=false; DestDir :=dsrfilepath+'face\'; RecreateDirs :=false; RetainAttributes:=true; numunzipped:=UnZip; end; except showmessage('down face unzip faile'); end; end; if downImages then begin try ffile:=getfilename('downImages'); if not DirectoryExists(dsrfilepath+'Images\') then CreateDir(dsrfilepath+'Images\'); with VCLUnZip1 do begin ZipName:=filepath+ffile ; ReadZip; FilesList.Add('*.*'); DoAll :=false; DestDir :=dsrfilepath+'Images\'; RecreateDirs :=false; RetainAttributes:=true; numunzipped:=UnZip; end; except showmessage('down Images unzip faile'); end; end; if downpic then begin try ffile:=getfilename('downpic'); if not DirectoryExists(dsrfilepath+'pic\') then CreateDir(dsrfilepath+'pic\'); with VCLUnZip1 do begin ZipName:=filepath+ffile ; ReadZip; FilesList.Add('*.*'); DoAll :=false; DestDir :=dsrfilepath+'pic\'; RecreateDirs :=false; RetainAttributes:=true; numunzipped:=UnZip; end; except showmessage('down Images unzip faile'); end; end; if not FileExists(dsrfilepath+'dsclient.ini') then begin try ffile:=getfilename('downini'); with VCLUnZip1 do begin ZipName:=filepath+ffile ; ReadZip; FilesList.Add('*.*'); DoAll :=false; DestDir :=dsrfilepath; RecreateDirs :=false; RetainAttributes:=true; numunzipped:=UnZip; end; except showmessage('downini unzip faile'); end; end; end; function Tfrm_update.DownLoadPro(fzipname:string):boolean ; const MaxBufSize=$F000; var myfilename:string;//保存文件的路径和文件名 myfileStream,exeBlobStream:TStream; MCount,BufSize,N: Integer; Buffer:PChar; begin result:=false; myfilename:=ExtractFilePath(Application.ExeName)+FzipName ; with t_sys_soft,sql do begin close ; clear ; add('select * from t_dsrclient_soft'); add('where fzipname=:fname'); parameters.ParamByName('fname').Value:=fzipname ; open ;first; myfileStream :=TFileStream.Create(myfilename,fmCreate);//创建文件 try ExeBlobStream:=CreateBlobStream(FieldByName('fsoft'),bmRead); //从数据库中取得记录 MCount:=0; try if MCount=0 then begin ExeBlobStream.Position:=0; MCount:=ExeBlobStream.Size; end; if MCount>MaxBufSize then BufSize:=MaxBufSize else BufSize:=MCount; GetMem(Buffer,BufSize); try while MCount<>0 do begin if MCount>BufSize then N:=BufSize else N:=MCount; ExeBlobStream.ReadBuffer(Buffer^,N);//从数据库表中取数据流 MyFileStream.WriteBuffer(Buffer^,N);//将数据流写入文件 Dec(MCount,N); end; finally FreeMem(Buffer,BufSize); end; finally ExeBlobStream.Free; end; finally myfileStream.Free; end; end; result:=true ; end; procedure Tfrm_update.downloadfile; var numunzipped:integer; filename:string ; filepath:string ; begin filepath:=ExtractFilePath(Application.ExeName) ; if downfileversion then begin try filename:=getfilename('downfileversion'); if FileExists(filepath+filename) then DeleteFile(filepath+filename); with t_sys_soft,sql do begin close;clear; add('select * from t_dsrclient_soft where fzipname=:fzipname'); parameters.ParamByName('fzipname').Value:=filename ; open ; if recordcount=1 then DownLoadPro(filename); end; except showmessage('downfileversion fail'); end; end ; if downBack then begin try filename:=getfilename('downBack'); if FileExists(filepath+filename) then DeleteFile(filepath+filename); with t_sys_soft,sql do begin close;clear; add('select * from t_dsrclient_soft where fzipname=:fzipname'); parameters.ParamByName('fzipname').Value:=filename ; open ; if recordcount=1 then DownLoadPro(filename); end; except showmessage('downBack fail'); end; end ; if downface then begin try filename:=getfilename('downface'); if FileExists(filepath+filename) then DeleteFile(filepath+filename); with t_sys_soft,sql do begin close;clear; add('select * from t_dsrclient_soft where fzipname=:fzipname'); parameters.ParamByName('fzipname').Value:=filename ; open ; if recordcount=1 then DownLoadPro(filename); end; except showmessage('downface fail'); end; end; if downImages then begin try filename:=getfilename('downImages'); if FileExists(filepath+filename) then DeleteFile(filepath+filename); with t_sys_soft,sql do begin close;clear; add('select * from t_dsrclient_soft where fzipname=:fzipname'); parameters.ParamByName('fzipname').Value:=filename ; open ; if recordcount=1 then DownLoadPro(filename); end; except showmessage('downImages fail'); end; end; if downpic then begin try filename:=getfilename('downpic'); if FileExists(filepath+filename) then DeleteFile(filepath+filename); with t_sys_soft,sql do begin close;clear; add('select * from t_dsrclient_soft where fzipname=:fzipname'); parameters.ParamByName('fzipname').Value:=filename ; open ; if recordcount=1 then DownLoadPro(filename); end; except showmessage('downPic fail'); end; end; if not FileExists(dsrfilepath+'dsclient.ini') then begin try filename:=getfilename('downini'); if FileExists(filepath+filename) then DeleteFile(filepath+filename); with t_sys_soft,sql do begin close;clear; add('select * from t_dsrclient_soft where fzipname=:fzipname'); parameters.ParamByName('fzipname').Value:=filename ; open ; if recordcount=1 then DownLoadPro(filename); end; except showmessage('downini fail'); end; end; end; procedure Tfrm_update.delzipfile; var filepath,filename:string ; begin filepath:=ExtractFilePath(Application.ExeName) ; if downfileversion then begin filename:=getfilename('downfileversion'); if FileExists(filepath+filename) then DeleteFile(filepath+filename); end; if downBack then begin filename:=getfilename('downBack'); if FileExists(filepath+filename) then DeleteFile(filepath+filename); end ; if downface then begin filename:=getfilename('downface'); if FileExists(filepath+filename) then DeleteFile(filepath+filename); end; if downImages then begin filename:=getfilename('downImages'); if FileExists(filepath+filename) then DeleteFile(filepath+filename); end ; if downpic then begin filename:=getfilename('downpic'); if FileExists(filepath+filename) then DeleteFile(filepath+filename); end ; filename:=getfilename('downini'); if FileExists(filepath+filename) then DeleteFile(filepath+filename); end; procedure Tfrm_update.saveregistry; const AppKey ='\Software\dswake\im'; var TempReg :TRegistry; begin TempReg := TRegistry.Create; try TempReg.RootKey := HKEY_LOCAL_MACHINE; if TempReg.OpenKey(AppKey + '\FileInfo', True) then begin TempReg.WriteString('filepath',dsrfilepath); TempReg.WriteString('filename',dsrfilename); end; finally TempReg.Free ; end ; end; procedure Tfrm_update.Timer1Timer(Sender: TObject); begin Timer1.Enabled:=false; if initdownload then begin downloadfile; unzipfile; delzipfile ; saveregistry; end; close; end; end.