我的学习生涯（Delphi篇） - 15

    很多时候，我们需要升级程序。那么怎么使用Delphi来完成这个任务呢？

    -------------------------------------------------------------------------------------------------美丽分割线---------------------------

   年代：2006

   文件：MY1010.7z

   首先，制作CAB文件

   我们使用iexpress.exe来完成。

   注意iexpress只是一个向导，主要的执行程序为makecab.exe

    是否使用SED文件（向导文件），我们选择新建SED文件

   

    仅建立CAB文件

    

   添加文件到CAB

    

    保存CAB文件

    

   保存SED文件

    

    建立cab文件

    

    执行makecab

    

    

   完成后，生成的CAB文件和SED文件

    

   最后，使用我们编写的程序释放CAB文件

   程序如下图：

   

  单元文件：

  Uupgrade1.pas

unit Uupgrade1;interfaceuses  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  Dialogs, ExtCtrls, Gauges, ComCtrls, StdCtrls, ShellApi, StrUtils, Inifiles,  Buttons, Tlhelp32;type  Tfrm_upgrade = class(TForm)    Image1: TImage;    Panel1: TPanel;    Label_point: TLabel;    Animate1: TAnimate;    Gauge1: TGauge;    Timer1: TTimer;    Timer2: TTimer;    btn_stop: TButton;    procedure FormShow(Sender: TObject);    procedure Timer1Timer(Sender: TObject);    procedure Timer2Timer(Sender: TObject);    procedure FormCreate(Sender: TObject);    procedure btn_stopClick(Sender: TObject);    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);  private    int22,int11,int12,int13:integer;    start_bool:Boolean;    //O:OLD,N:NEW    major_verO1,minor_verO1,rlease_numO1,build_numO1:integer;    major_verO2,minor_verO2,rlease_numO2,build_numO2:integer;    major_verN1,minor_verN1,rlease_numN1,build_numN1:integer;    major_verN2,minor_verN2,rlease_numN2,build_numN2:integer;        major_verO1Str,minor_verO1Str,rlease_numO1Str,build_numO1Str:string;    major_verO2Str,minor_verO2Str,rlease_numO2Str,build_numO2Str:string;    major_verN1Str,minor_verN1Str,rlease_numN1Str,build_numN1Str:string;    major_verN2Str,minor_verN2Str,rlease_numN2Str,build_numN2Str:string;    function CheckVerCPS:integer;    { Private declarations }  public    syspath:PCHAR;    temppath:Pchar;    countFile:integer;    file1,file2:WideString;    ApplicationName:WideString;    CPS_file1,CPS_file2:string;    //    h3:THandle;    procedure set_CPSfile;    procedure ReadIniFiles;    procedure AdjustToken;    { Public declarations }  end;type  Tfun_stop=function(sMachine, sService: String):DWORD;stdcall;var  frm_upgrade: Tfrm_upgrade;  applINI:TIniFile;  tempfile1,tempfile2:string;  //  svc_stop:Tfun_stop;  procedure del_tempfile;  function GetCPSFileVersion(FileName:String):String;  procedure FinishedUP(msgSTR:string);  procedure CloseExecCPS(ExeFileName:string);implementation{function FDICreate(//参数与FCI相应参数差不多PFNALLOC pfnalloc,PFNFREE pfnfree,PFNOPEN pfnopen,PFNREAD pfnread,PFNWRITE pfnwrite,PFNCLOSEpfnclose,pfnseek,intcpuType,// CPU类型，32位FDI忽略此参数PERFperf):DWORD stdcall;external 'cabinet.dll';function FDICopy(HFDI          hfdi,char FAR     *pszCabinet, //待解压文件名char FAR     *pszCabPath, //待解压文件的路径int           flags,      //保留，现在必须为0PFNFDINOTIFY  pfnfdin,    //回调函数，用来处理FDI的通知PFNFDIDECRYPT pfnfdid,    //保留，现在必须为NULLvoid FAR     *pvUser      //作为参数传给回调函数pfnfdin，这里设为NULL):DWORD stdcall;external 'cabinet.dll';}{$R *.dfm}function GetCPSFileVersion(FileName:String):String;var  InfoSize,Wnd:DWORD;  VerBuf:Pointer;  VerInfo:^VS_FIXEDFILEINFO;begin    Result:='1.0,0;0';    InfoSize:=GetFileVersionInfoSize(PChar(FileName),Wnd);    if InfoSize<>0 then    begin      GetMem(VerBuf,InfoSize);      try        if GetFileVersionInfo(PChar(FileName),Wnd,InfoSize,VerBuf) then        begin          VerInfo:=nil;          VerQueryValue(VerBuf,'\',Pointer(VerInfo),Wnd);          if VerInfo<>nil then Result:=Format('%d.%d,%d;%d',[VerInfo^.dwFileVersionMS shr 16,                                                             VerInfo^.dwFileVersionMS and $0000ffff,                                                             VerInfo^.dwFileVersionLS shr 16,                                                             VerInfo^.dwFileVersionLS and $0000ffff]);        end;      finally        FreeMem(VerBuf,InfoSize);      end;    end;end;procedure del_tempfile;begin  DeleteFile(tempfile1);  DeleteFile(tempfile2);end;procedure FinishedUP(msgSTR:string);begin  frm_upgrade.Timer2.Interval:=0;  frm_upgrade.Timer1.Interval:=0;  frm_upgrade.Panel1.Caption:=msgSTR;  frm_upgrade.Animate1.Active:=False;  frm_upgrade.Label_point.Caption:='';  frm_upgrade.btn_stop.Visible:=False;end;procedure CloseExecCPS(ExeFileName:string);const  PROCESS_TERMINATE=$0001;var  ContinueLoop: BOOL;  FSnapshotHandle: THandle;  FProcessEntry32: TProcessEntry32;begin  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      TerminateProcess(OpenProcess(PROCESS_TERMINATE, BOOL(0),                       FProcessEntry32.th32ProcessID), 0);      ContinueLoop := Process32Next(FSnapshotHandle,FProcessEntry32);   end;end;procedure Tfrm_upgrade.ReadIniFiles;begin  applINI:=TIniFile.Create(ExtractFilePath(ParamStr(0))+Application.Title+'.ini');  ApplicationName:=applINI.ReadString('Application','Title','why');  countFile:=applINI.ReadInteger('FileCount','count',2);  case countFile of    1:      begin        file1:=applINI.ReadString('FileList','1','XBFGenerate.dll');      end;    2:      begin        file1:=applINI.ReadString('FileList','1','XBFGenerate.dll');        file2:=applINI.ReadString('FileList','2','CPS_service.exe');      end;  end;end;procedure Tfrm_upgrade.AdjustToken;var  hdlProcessHandle : Cardinal;  hdlTokenHandle : Cardinal;  tmpLuid : Int64;  tkpPrivilegeCount : Int64;  tkp : TOKEN_PRIVILEGES;  tkpNewButIgnored : TOKEN_PRIVILEGES;  lBufferNeeded : Cardinal;  Privilege : array[0..0] of _LUID_AND_ATTRIBUTES;begin         hdlProcessHandle := GetCurrentProcess;         OpenProcessToken(hdlProcessHandle,                         (TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY),                          hdlTokenHandle);         // Get the LUID for shutdown privilege.         LookupPrivilegeValue('', 'SeShutdownPrivilege', tmpLuid);         Privilege[0].Luid := tmpLuid;         Privilege[0].Attributes := SE_PRIVILEGE_ENABLED;         tkp.PrivilegeCount := 1;   // One privilege to set         tkp.Privileges[0] := Privilege[0];         // Enable the shutdown privilege in the access token of this         // process.         AdjustTokenPrivileges(hdlTokenHandle,                               False,                               tkp,                               Sizeof(tkpNewButIgnored),                               tkpNewButIgnored,                               lBufferNeeded); end;procedure Tfrm_upgrade.FormCreate(Sender: TObject);begin  int11:=0;  int12:=0;  int13:=5;  GetMem(syspath,255);  GetSystemDirectory(syspath,255);  GetMem(temppath,255);  GetTempPath(255,temppath);  //  ReadIniFiles;  CPS_file1:=syspath+'\'+file1;  CPS_file2:=syspath+'\'+file2;  tempfile1:=temppath+file1;  tempfile2:=temppath+file2;end;procedure Tfrm_upgrade.FormShow(Sender: TObject);begin  Gauge1.Visible:=True;  Panel1.Visible:=True;  Animate1.Active:=True;  Timer1.Interval:=1000;  start_bool:=True;end;procedure Tfrm_upgrade.Timer1Timer(Sender: TObject);beginif Gauge1.Progress=99 then  begin    Timer1.Interval:=0;  end;    int22:=int11+int12+int13;  case int22 of      5:    begin      Label_point.Caption:='.';      int11:=2;      int12:=0;      int13:=0;      Gauge1.Progress:=Gauge1.Progress+1;      Exit;    end;    2:    begin      Label_point.Caption:='..';      int11:=0;      int12:=3;      int13:=0;      Gauge1.Progress:=Gauge1.Progress+1;      Exit;    end;    3:    begin      Label_point.Caption:='...';      int11:=0;      int12:=0;      int13:=5;      Gauge1.Progress:=Gauge1.Progress+1;      Exit;    end;  end;end;procedure Tfrm_upgrade.Timer2Timer(Sender: TObject);var  dosexec_str:string;  cur_path:string;  progress_int:integer;  //  checkINT:integer;begin  cur_path:=ExtractFilePath(ParamStr(0));  dosexec_str:=cur_path+'extract.exe /e /l '+temppath+' '+cur_path+'CAB\upfile.CAB';  progress_int:=Gauge1.Progress;  case progress_int of    8:      begin        //你要结束的程序名称！        CloseExecCPS(ApplicationName);        try          h3:=0;          try            h3:=LoadLibrary('XBFGenerate.dll');            if h3<>0 then              @svc_stop:=GetprocAddress(h3,'svcStop');            if (@svc_stop<>nil)then            begin              svc_stop('','data_abstract');            end            else            begin              //Application.MessageBox('此版本"XBFGenerate.dll"不支持本功能！','提示',MB_OK);              //Exit;            end;          finally            FreeLibrary(h3);          end;        except        end;      end;    15:      begin        set_CPSfile;      end;    20:      begin        WinExec(pchar(dosexec_str),SW_HIDE);        // ShellExecute(Application.Handle,'open','extract.exe',' /e /l ','F:\tools\w2ktools\cabsdk\BIN',SW_SHOWNORMAL);      end;    27:      begin        checkINT:=CheckVerCPS;        case checkINT of          1:            begin              FinishedUP('升级停止');              del_tempfile;              Application.MessageBox('CPS系统文件是最新的，此时不需要升级！','升级提示',MB_OK+MB_ICONINFORMATION);              Application.Terminate;            end;          2:            begin              FinishedUP('升级中止');              if Application.MessageBox('更新文件比原文件更旧，是否保留原文件？','升级提示',MB_YESNO+MB_ICONQUESTION)=mryes then              begin                del_tempfile;                Application.Terminate;              end;              Panel1.Caption:= '正在进行文件检查';              Timer1.Interval:=1000;              Timer2.Interval:=1000;              Animate1.Visible:=True;              Animate1.Active:=True;            end;        end;//casi innor        Gauge1.Progress:=45;      end;    50:      begin        Panel1.Caption:='正在进行升级';        Animate1.CommonAVI:=aviFindComputer;        Animate1.Active:=True;        btn_stop.Visible:=True;      end;    55:      begin        Sleep(2000);        frm_upgrade.ActiveControl:=btn_stop;        Gauge1.Progress:=65;      end;    71:      begin        btn_stop.Visible:=False;        CopyFile(pchar(tempfile1),pchar(CPS_file1),False);        CopyFile(pchar(tempfile2),pchar(CPS_file2),False);        Gauge1.Progress:=95;      end;    100:      begin        FinishedUP('升级完成!');        del_tempfile;        Application.MessageBox('CPS升级程序需要重新启动计算机。请按“确定”，立即重新启动。','CPS升级程序',MB_OK+MB_ICONINFORMATION);        AdjustToken;        ExitWindowsEx((EWX_SHUTDOWN or EWX_FORCE or EWX_REBOOT),$FFFF);      end;    end;//case end;end;procedure Tfrm_upgrade.btn_stopClick(Sender: TObject);begin  Timer1.Interval:=0;  Panel1.Caption:='升级停止';  Animate1.Visible:=False;  Label_point.Caption:='';  del_tempfile;  Application.Terminate;end;procedure Tfrm_upgrade.set_CPSfile;begin  SetFileAttributes(pchar(CPS_file1),32);  SetFileAttributes(pchar(CPS_file2),32);end;function Tfrm_upgrade.CheckVerCPS:Integer;var  version_strO1,version_strO2,version_strN1,version_strN2:string;  majCompareO1,minCompareO1,rleaCompareO1,buildCompareO1:integer;  majCompareO2,minCompareO2,rleaCompareO2,buildCompareO2:integer;  majCompareN1,minCompareN1,rleaCompareN1,buildCompareN1:integer;  majCompareN2,minCompareN2,rleaCompareN2,buildCompareN2:integer;begin  version_strO1:= GetCPSFileVersion(CPS_file1);  version_strO2:= GetCPSFileVersion(CPS_file2);  version_strN1:= GetCPSFileVersion(tempfile1);  version_strN2:= GetCPSFileVersion(tempfile2);  major_verO1:=pos('.',version_strO1);  major_verO2:=pos('.',version_strO2);  major_verN1:=pos('.',version_strN1);  major_verN2:=pos('.',version_strN2);  major_verO1Str:=LeftStr(version_strO1,major_verO1-1);  major_verO2Str:=LeftStr(version_strO2,major_verO2-1);  major_verN1Str:=LeftStr(version_strN1,major_verN1-1);  major_verN2Str:=LeftStr(version_strN2,major_verN2-1);  minor_verO1:=pos(',',version_strO1);  minor_verO2:=pos(',',version_strO2);  minor_verN1:=pos(',',version_strN1);  minor_verN2:=pos(',',version_strN2);  rlease_numO1:=pos(';',version_strO1);  rlease_numO2:=pos(';',version_strO2);  rlease_numN1:=pos(';',version_strN1);  rlease_numN2:=pos(';',version_strN2);  minor_verO1Str:=copy(version_strO1,major_verO1+1,minor_verO1-major_verO1-1);  minor_verO2Str:=copy(version_strO2,major_verO2+1,minor_verO2-major_verO2-1);  minor_verN1Str:=copy(version_strN1,major_verN1+1,minor_verN1-major_verN1-1);  minor_verN2Str:=copy(version_strN2,major_verN2+1,minor_verN2-major_verN2-1);  rlease_numO1Str:=copy(version_strO1,minor_verO1+1,rlease_numO1-minor_verO1-1);  rlease_numO2Str:=copy(version_strO2,minor_verO2+1,rlease_numO2-minor_verO2-1);  rlease_numN1Str:=copy(version_strN1,minor_verN1+1,rlease_numN1-minor_verN1-1);  rlease_numN2Str:=copy(version_strN2,minor_verN2+1,rlease_numN2-minor_verN2-1);  build_numO1:=length(version_strO1)- rlease_numO1;  build_numO2:=length(version_strO2)- rlease_numO2;  build_numN1:=length(version_strN1)- rlease_numN1;  build_numN2:=length(version_strN2)- rlease_numN2;  build_numO1Str:=RightStr(version_strO1,build_numO1);  build_numO2Str:=RightStr(version_strO2,build_numO2);  build_numN1Str:=RightStr(version_strN1,build_numN1);  build_numN2Str:=RightStr(version_strN2,build_numN2);  try    majCompareO1:=StrToInt(major_verO1Str);    majCompareN1:=StrToInt(major_verN1Str);    minCompareO1:=StrToInt(minor_verO1Str);    minCompareN1:=StrToInt(minor_verN1Str);    rleaCompareO1:=StrToInt(rlease_numO1Str);    rleaCompareN1:=StrToInt(rlease_numN1Str);    buildCompareO1:=StrToInt(build_numO1Str);    buildCompareN1:=StrToInt(build_numN1Str);    majCompareO2:=StrToInt(major_verO2Str);    majCompareN2:=StrToInt(major_verN2Str);    minCompareO2:=StrToInt(minor_verO2Str);    minCompareN2:=StrToInt(minor_verN2Str);    rleaCompareO2:=StrToInt(rlease_numO2Str);    rleaCompareN2:=StrToInt(rlease_numN2Str);    buildCompareO2:=StrToInt(build_numO2Str);    buildCompareN2:=StrToInt(build_numN2Str);  except    Result:=3;    Exit;  end;  if majCompareO1<majCompareN1 then  begin    Result:=3;    Exit;  end  else if majCompareO1>majCompareN1 then  begin    Result:=2;    Exit;  end  else  begin//maj=相等情况    if minCompareO1<minCompareN1 then    begin      Result:=3;      Exit;    end    else if minCompareO1>minCompareN1 then    begin      Result:=2;      Exit;    end    else//min=相等情况    begin      if rleaCompareO1<rleaCompareN1 then      begin        Result:=3;        Exit;      end      else if rleaCompareO1>rleaCompareN1 then      begin        Result:=2;        Exit;      end      else//rlea=相等情况      begin        if buildCompareO1<buildCompareN1 then        begin          Result:=3;          Exit;        end        else if buildCompareO1>buildCompareN1 then        begin          Result:=2;          Exit;        end        else        begin//two file all sameness          Result:=1;        end;      end;    end;  end;//file2  if majCompareO2<majCompareN2 then  begin    Result:=3;    Exit;  end  else if majCompareO2>majCompareN2 then  begin    Result:=2;    Exit;  end  else  begin//maj=相等情况    if minCompareO2<minCompareN2 then    begin      Result:=3;      Exit;    end    else if minCompareO2>minCompareN2 then    begin      Result:=2;      Exit;    end    else//min=相等情况    begin      if rleaCompareO2<rleaCompareN2 then      begin        Result:=3;        Exit;      end      else if rleaCompareO2>rleaCompareN2 then      begin        Result:=2;        Exit;      end      else//rlea=相等情况      begin        if buildCompareO2<buildCompareN2 then        begin          Result:=3;          Exit;        end        else if buildCompareO2>buildCompareN2 then        begin          Result:=2;          Exit;        end        else        begin//two file all sameness          Result:=1;        end;      end;    end;  end;end;procedure Tfrm_upgrade.FormCloseQuery(Sender: TObject;  var CanClose: Boolean);begin  Timer1.Interval:=0;  if Gauge1.Progress=100 then  begin    Exit;  end;  if Application.MessageBox('停止升级吗？','升级提示',MB_YESNO)=MrNo then  begin    CanClose:=False;    Timer1.Interval:= 1000;    Exit;  end;  del_tempfile;end;end.

    此程序在解压缩CAB文件时，调用EXTRACT.EXE程序。

    解压的文件放置在windows临时目录。

    备注：

    关于MY1010.7z中文件夹

   1. CAB - cab文件存放目录

   2. cabfile - cab准备添加的文件

   3. Microsoft IEXPRESS(HAN) - 微软的cab sdk

   4. vcDEMO_cab - VC使用cab的例子