step2unit.pas

这是在磁疗用DELPHI编写一套安装软件的程序源码

unit Step2Unit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, BusinessSkinForm, ExtCtrls, StdCtrls, VCLUnZip, VCLZip,PublicUnit,
  DB, ADODB;

type
  TStep2Frm = class(TForm)
    Timer1: TTimer;
    VCLZip1: TVCLZip;
    GetADO: TADOQuery;
    ADOC: TADOConnection;
    Label1: TPanel;
   procedure SetUp(Step:Integer);
   procedure UnSetFile(SouceFile,DescPath:String);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Step2Frm: TStep2Frm;
  mOk:boolean;
  Step1:Integer;
implementation

uses Step1Unit;

{$R *.dfm}
function AddDirSuffix(Dir: string): string;
begin
  Result := Trim(Dir);
  if Result = '' then Exit;
  if Result[Length(Result)] <> '\' then Result := Result + '\';
end;
procedure TStep2Frm.UnSetFile(SouceFile,DescPath:String);
var
I:Integer;
begin
if FileExists(SouceFile) then
 begin
 with VclZip1 do//用VclZip1就可以了，VclZip已经包含VclUnZip的所有属性和方法了
  begin
    ZipName:=SouceFile;
    ReadZip;
 //   DESCPath:=AddDirSuffix(Step1Frm.Edit1.Text);
    For I:=0 to Count-1 do
      begin
      if FileExists(DESCPath+ Filename[i]) then
      begin
       SetFileAttributes(PCHAR(DESCPath+Filename[i]),FILE_ATTRIBUTE_NORMAL);
       deletefile(DESCPath+Filename[i]);
      end;
    end;   
    DoAll:=True;
    DestDir:=DESCPath;
    RecreateDirs := False;
    RetainAttributes := True;
    ReplaceReadOnly := True;
    UnZip;
  end;
  end;
end;
function ComputerName : String;
var
   CNameBuffer : PChar;
  fl_loaded : Boolean;
  CLen : ^DWord;
begin
    GetMem(CNameBuffer,255);
    New(CLen);
    CLen^:= 255;
    fl_loaded := GetComputerName(CNameBuffer,CLen^);
    if fl_loaded then
      ComputerName := StrPas(CNameBuffer)
    else
      ComputerName := 'Unkown';
    FreeMem(CNameBuffer,255);
    Dispose(CLen);
end;
procedure TStep2Frm.SetUp(Step:Integer);
var
I:integer;
GetStr:String;
ConnectStr:String;
GetBuf:Array[0..200] of char;
ServerName,UserName,PassWord,DataName,SqlStr:String;
begin
    Case Step of
     0:
      begin
      if Not DirectoryExists(Step1Frm.Edit1.Text) then
        begin
          Try
           Label1.Caption:='正在建立安装目录....';
           Label1.Refresh;
           ForceDirectories(Step1Frm.Edit1.Text);
           mOk:=True;
           Step1:=Step1+1;
           Step2Frm.Timer1.Enabled:=True;
          except
           Label1.Caption:='创建安装目录失败，不能安装程序。';
           Label1.Refresh;
           Step2Frm.Timer1.Enabled:=False;

           mOk:=False;
           Close;
          end;
        end;
      end;
    1:
     begin
     if Step1Frm.SetupList.Checked[0] then
      begin
      Label1.Caption:='正在安装叫号设置软件....';
      Label1.Refresh;
      UnSetFile(GetPath+'Queue\SyS_Set.ex_',AddDirSuffix(Step1Frm.Edit1.Text));
      GetStr:=GetSpecialFolderDir(0);
      CreateShortCut(AddDirSuffix(Step1Frm.Edit1.Text)+'SyS_Set.exe', GetStr+'\叫号设置.lnk');
     end
     else
      Step2Frm.Timer1.Interval:=500;
      mOk:=True;
      Step2Frm.Timer1.Enabled:=True;
      
     end;
    2:
     begin
     if Step1Frm.SetupList.Checked[1] then
      begin
      Label1.Caption:='正在安装控制后台软件....';
      Label1.Refresh;
      UnSetFile(GetPath+'Queue\SySCortrol.ex_',AddDirSuffix(Step1Frm.Edit1.Text));
      GetStr:=GetSpecialFolderDir(0);
      CreateShortCut(AddDirSuffix(Step1Frm.Edit1.Text)+'SySCortrol.exe', GetStr+'\控制后台.lnk');
     end
     else
      Step2Frm.Timer1.Interval:=500;
      mOk:=True;
      Step2Frm.Timer1.Enabled:=True;
      
     end;
    3:
     begin
     if Step1Frm.SetupList.Checked[2] then
      begin
      Label1.Caption:='正在安装号票取号软件....';
      Label1.Refresh;
      UnSetFile(GetPath+'Queue\Print.ex_',AddDirSuffix(Step1Frm.Edit1.Text));
      GetStr:=GetSpecialFolderDir(0);
      CreateShortCut(AddDirSuffix(Step1Frm.Edit1.Text)+'Print.exe', GetStr+'\取票软件.lnk');
     end
     else
      Step2Frm.Timer1.Interval:=500;
      mOk:=True;
      Step2Frm.Timer1.Enabled:=True;
      
     end;
    4:
     begin
     if Step1Frm.SetupList.Checked[3] then
      begin
      Label1.Caption:='正在安装虚拟呼叫软件....';
      Label1.Refresh;
      UnSetFile(GetPath+'Queue\CallQueue.ex_',AddDirSuffix(Step1Frm.Edit1.Text));
      GetStr:=GetSpecialFolderDir(0);
      CreateShortCut(AddDirSuffix(Step1Frm.Edit1.Text)+'CallQueue.exe', GetStr+'\虚拟呼叫.lnk');

     end
     else
      Step2Frm.Timer1.Interval:=500;
      mOk:=True;
      Step2Frm.Timer1.Enabled:=True;
      
     end;
    5:
     begin
      UnSetFile(GetPath+'Queue\Connect.ex_',AddDirSuffix(Step1Frm.Edit1.Text));
      UnSetFile(GetPath+'Queue\叫号系统.ex_',AddDirSuffix(Step1Frm.Edit1.Text));
      GetStr:=GetSpecialFolderDir(0);
      CreateShortCut(AddDirSuffix(Step1Frm.Edit1.Text)+'叫号系统.pdf', GetStr+'\叫号说明书.lnk');
      Step2Frm.Timer1.Interval:=500;
      mOk:=True;
      Step2Frm.Timer1.Enabled:=True;
     end;
    6:
     begin
     Step2Frm.Timer1.Enabled:=False;
     if Step1Frm.SetupList.Checked[4] then
      begin
      Label1.Caption:='正在连接数据库....';
      Label1.Refresh;
      UserName:='';
      DataName:='northwind';
      ServerName:=ComPuterName;
      ConnectStr:='Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;User ID=';
      ConnectStr:=ConnectStr+UserName+';Initial Catalog='+DataName+';Data Source='+ServerName;
    try
      ADOC.Connected := False;
      ADOC.ConnectionString:=ConnectStr;
      ADOC.Connected := True;

      except
      Label1.Caption:='连接数据库数据失败';
      Label1.Refresh;
      Application.MessageBox('连接数据库数据失败。','提示',mb_ok);
      Step2Frm.Timer1.Enabled:=False;
      close;
        Exit;
      end;
      try
      if Not DirectoryExists(Step1Frm.Edit1.Text+'\data') then
        begin
          Try
           Label1.Caption:='正在建立安装目录....';
           Label1.Refresh;
           ForceDirectories(Step1Frm.Edit1.Text+'\data');
          except
          end; 

        end;
      UnSetFile(GetPath+'Data\huangxing_Data.ex_',AddDirSuffix(Step1Frm.Edit1.Text+'\data'));
      UnSetFile(GetPath+'Data\huangxing_Log.ex_',AddDirSuffix(Step1Frm.Edit1.Text+'\data'));
      SqlStr:='EXEC sp_attach_db @dbname = N'+''''+'huangxing'+'''';
      SqlStr:=SqlStr+',@filename1 = N'+''''+AddDirSuffix(Step1Frm.Edit1.Text+'\data')+'huangxing_Data.MDF'+'''';
      SqlStr:=SqlStr+',@filename2 = N'+''''+AddDirSuffix(Step1Frm.Edit1.Text+'\data')+'huangxing_Log.LDF'+'''';
      GetADO.Close;
      GetADO.SQL.Clear;
      GetADO.SQL.Add(SqlStr);
      GetADO.ExecSQL;
      except
      Step2Frm.Timer1.Enabled:=False;
      Application.MessageBox('无法自动建立数据库，可能数据库已经存在。','提示',mb_ok);
      Step2Frm.Timer1.Enabled:=False;
      close;
        Exit;

      end;
     end
     else
      Step2Frm.Timer1.Interval:=500;
       Timer1.Enabled:=False;
       Step1Frm.Close;
       Close;
     end;
    end;  
end;
procedure TStep2Frm.Timer1Timer(Sender: TObject);
begin
Step2Frm.Timer1.Interval:=4000;
if mOK=False then
  begin
    Timer1.Enabled:=False;
    Exit;
  end;
if Step1=0 then
  begin
    if Not DirectoryExists(Step1Frm.Edit1.Text) then
      begin
      Timer1.Enabled:=False;
       SetUp(Step1);

 //      Exit;
     end
    else
      begin
       Step1:=Step1+1;
    //   Exit;
      end;
  end;
 Timer1.Enabled:=False;
 SetUp(Step1);
 Step1:=Step1+1;
 if Step1>=7 then
  begin
   Timer1.Enabled:=False;
   Application.MessageBox('所有程序都已安装完成。','提示',mb_ok);
   Step1Frm.Close;
   Close;

  end;
 Exit;
end;

end.