DONGSHENG6/公用模块/系统模块/u_update.pas

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<dbfileversion then downfileversion:=true ;
  if Back<DBback then downBack:=true ;
  if face<DBface then downface:=true ;
  if Images<DBimages then downImages:=true ;
  if pic<dbpic then downpic:=true ;
  if downfileversion then KillTask(dsrfilename);
  if downfileversion or downBack or downface or downImages or downpic then
    result:=true;
  if not FileExists(dsrfilepath+'dsclient.ini') then result:=true;
end;

function Tfrm_update.getfilename(fname: string): string;
begin
  if fname='downfileversion' then result:='dsrclient.zip'  else
  if fname='downBack' then result:='back.zip'  else
  if fname='downface' then result:='face.zip'  else
  if fname='downImages' then result:='images.zip'  else
  if fname='downpic' then result:='pic.zip'  else
  if fname='downini' then result:='inifile.zip'
  else result:='' ;
end;


procedure Tfrm_update.unzipfile;
var ffile:string ;
    filepath:string ;
    numunzipped:integer;
begin
  filepath:=ExtractFilePath(Application.ExeName) ;
  if downfileversion then
  begin
    try
      ffile:=getfilename('downfileversion');
      if FileExists(dsrfilepath+dsrfilename)then DeleteFile(dsrfilepath+dsrfilename);
      with VCLUnZip1 do
      begin
        ZipName:=filepath+ffile ;
        ReadZip;
        FilesList.Add('*.*');
        DoAll :=false;
        DestDir :=dsrfilepath;
        RecreateDirs :=false;
        RetainAttributes:=true;
        numunzipped:=UnZip;
      end;
      if dsrfilename<>'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.