setupunit.pas

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

unit SetUpUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, VCLUnZip, VCLZip, jpeg, ExtCtrls,PublicUnit, FileCtrl, StdCtrls,
  XaudioPlayer, Buttons, DB, ADODB, bsSkinCtrls, bsSkinBoxCtrls, ComCtrls,ShellApi;

type
  TSetUpFrm = class(TForm)
    Image1: TImage;
    Dir1: TDirectoryListBox;
    File1: TFileListBox;
    MP3Play: TXaudioPlayer;
    Timer1: TTimer;
    Label1: TLabel;
    Shape1: TShape;
    Shape2: TShape;
    Label2: TLabel;
    Shape3: TShape;
    Label3: TLabel;
    Label4: TLabel;
    RichEdit1: TRichEdit;
    Shape4: TShape;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Shape5: TShape;
    Label8: TLabel;
    Label9: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure MP3PlayNotifyInputTimecode(Sender: TXaudioPlayer; Hours,
      Minutes, Seconds, Fractions: Byte);
    procedure MP3PlayNotifyStreamDuration(Sender: TXaudioPlayer;
      Duration: Cardinal);
    procedure Timer1Timer(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Label1Click(Sender: TObject);
    procedure Label3Click(Sender: TObject);
    procedure Label2Click(Sender: TObject);
    procedure Label5Click(Sender: TObject);
    procedure Label8Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  SetUpFrm: TSetUpFrm;
  PosStr,EndStr,OldStr:String;
  PlayFile,LongInt:Integer;
  StopPlay:Boolean;
implementation

uses Step1Unit;

{$R *.dfm}
{

SqlStr:='EXEC sp_attach_db @dbname = N'+''''+'huangxing'+'''';
SqlStr:=SqlStr+',@filename1 = N'+''''+'D:\huangxing_Data.MDF'+'''';
SqlStr:=SqlStr+',@filename2 = N'+''''+'d:\huangxing_Log.LDF'+'''';


if FileExists(GetPath+'Temp.zip') then
 begin
 with VclZip1 do//用VclZip1就可以了，VclZip已经包含VclUnZip的所有属性和方法了
  begin
    ZipName:=GetPath+'Temp.zip';
    ReadZip;
  For I:=0 to Count-1 do
    begin
    if FileExists(GetPath+ Filename[i]) then
      begin
       SetFileAttributes(PCHAR(GetPath+Filename[i]),FILE_ATTRIBUTE_NORMAL);
       deletefile(GetPath+Filename[i]);
      end;
    end;
     
    DoAll:=True;
    DestDir:=GetPath;
    RecreateDirs := False;
    RetainAttributes := True;
    ReplaceReadOnly := True;
    UnZip;
  //  redtLog.Lines.Add('文件解压完毕'); 
  //  ShowMessage('OK');
  end;
  end;
     with VclZip1 do
      begin
        FilesList.Clear;
       For I:=0 to Memo2.Lines.Count-1 do
        FilesList.Add(Memo2.Lines.Strings[i]);
        ZipName:=GetPath+'Temp.zip';
        Zip;
      //  ShowMessage('OK');
      end;
  }
procedure TSetUpFrm.FormCreate(Sender: TObject);
var
GetStr:String;
begin
PosStr:='1';
PlayFile:=0;
LongInt:=1;
RichEdit1.SelStart:=0; 
Dir1.Directory:=GetPath+'mp3\';
if File1.Items.Count>=1 then
    begin
      GetStr:=GetPath+'mp3\'+File1.Items.Strings[PlayFile];
      MP3Play.InputOpen(GetStr);
      MP3Play.Play;
   end;   
end;

procedure TSetUpFrm.MP3PlayNotifyInputTimecode(Sender: TXaudioPlayer;
  Hours, Minutes, Seconds, Fractions: Byte);
begin
PosStr:=format('%.2d:%.2d',[minutes,seconds]);
Label6.Caption:=PosStr;
end;

procedure TSetUpFrm.MP3PlayNotifyStreamDuration(Sender: TXaudioPlayer;
  Duration: Cardinal);
var
  minutes,seconds:integer;
begin
  minutes:=duration div 60;
  duration:=duration-minutes*60;
  seconds:=duration;
  EndStr:=format('%.2d:%.2d',[minutes,seconds]);
  Label7.Caption:=EndStr;
end;

procedure TSetUpFrm.Timer1Timer(Sender: TObject);
var
GetStr:String;

begin
  Label9.Caption:=format('%.2d',[PlayFile+1])+'/'+format('%.2d',[File1.Items.Count]);
  LongInt:=LongInt+1;
  if LongInt>=5 then
   begin
    LongInt:=1;
    StopPlay:=False;
    if OldStr<>Label6.Caption then
       OldStr:=Label6.Caption
    else
     StopPlay:=True;
   end; 
 // MP3Play.
  if (PosStr=EndStr) or (StopPlay) then
    begin
      LongInt:=1;
      StopPlay:=False;
      OldStr:='';
      PosStr:='';
      EndStr:='2';
      PlayFile:=PlayFile+1;
     if PlayFile>=File1.Items.Count then
        PlayFile:=0;
      GetStr:=GetPath+'mp3\'+File1.Items.Strings[PlayFile];
     if not FileExists(GetStr) then
      begin
       PlayFile:=0;
       PosStr:='1';
       EndStr:='1';
      end;
      MP3Play.InputOpen(GetStr);
      MP3Play.Play;
    end;

end;

procedure TSetUpFrm.SpeedButton1Click(Sender: TObject);
begin
close;
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 TSetUpFrm.FormShow(Sender: TObject);
var
ConnectStr:String;
GetBuf:Array[0..200] of char;
GetStr,ServerName,UserName,PassWord,DataName:String;
begin
{    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
    Exit;
  end; }
end;

procedure TSetUpFrm.Label1Click(Sender: TObject);
begin
Step1Frm.ShowModal;
end;

procedure TSetUpFrm.Label3Click(Sender: TObject);
var
  BmpBuf:Pchar;
begin
//GetMem(BmpBuf,200);
 if FileExists(GetPath+'SQL2KSP4\x86\setup\setupsql.exe') then
   begin
 //    StrPcopy(BmpBuf,GetPath+'SQL2KSP4\setup.bat');
 //   ShellExecute(0, nil, BmpBuf, nil, nil, SW_NORMAL);
    Winexec(PChar(GetPath+'SQL2KSP4\x86\setup\setupsql.exe'),SW_SHOW);
   end;
// FreeMem(BmpBuf,200);
end;

procedure TSetUpFrm.Label2Click(Sender: TObject);
var
  BmpBuf:Pchar;
begin
GetMem(BmpBuf,200);
 if FileExists(GetPath+'ADO28\MDAC.EXE') then
   begin
    StrPcopy(BmpBuf,GetPath+'ADO28\MDAC.EXE');
    ShellExecute(0, nil, BmpBuf, nil, nil, SW_NORMAL);
  //  (PChar(GetPath+'ADO28\MDAC.EXE'),SW_SHOW);
   end;
 FreeMem(BmpBuf,200);  
end;

procedure TSetUpFrm.Label5Click(Sender: TObject);
begin
if FileExists(GetPath+'\AdbeRdr708\AdbeRdr708_zh_CN.exe') then
   begin
 //    StrPcopy(BmpBuf,GetPath+'SQL2KSP4\setup.bat');
 //   ShellExecute(0, nil, BmpBuf, nil, nil, SW_NORMAL);
    Winexec(PChar(GetPath+'\AdbeRdr708\AdbeRdr708_zh_CN.exe'),SW_SHOW);
   end;
end;

procedure TSetUpFrm.Label8Click(Sender: TObject);
begin
close;
end;

end.