sec.pas

一个用delphi写的安装程序. 涉及到的知识: 1.注册表的使用 2.资源文件的制作,使用 3.多线程中api播放wav 4.快捷方式

unit sec;

{+++++++++++++++++++++++++++++++++++++++
===   unit sec;
===   安装程序的主体部分---文件的安装;
===   在此主要的功能是释放文件到指定目录.
===   还有就是快捷方式的建立,
===   以及注册信息的写入.
===   欢迎指正;
+++++++++++++++++++++++++++++++++++++++}

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls,comobj,activex,shlobj, ExtCtrls, jpeg;

type
  Tfrmsec = class(TForm)
    ams: TAnimate;
    pgbs: TProgressBar;
    lbls: TLabel;
    btncel: TButton;
    Shape1: TShape;
    pnlok: TPanel;
    Image1: TImage;
    Label1: TLabel;
    btnok: TButton;
    procedure FormCreate(Sender: TObject);
    procedure btncelClick(Sender: TObject);
    procedure filetodisk;           //释放文件到硬盘中;
    procedure addlink;             //创建快捷方式;
    procedure btnokClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
  private
  public
    { Public declarations }
  end;

var
  frmsec: Tfrmsec;

implementation
uses main;

{$R *.dfm}
{$R setupres.res}         //使用资源文件;


//整个安装过程的主要部分;
procedure tfrmsec.filetodisk;
var
  myres:tresourcestream;
begin
  if not directoryexists(setupath) then
  begin
    lbls.caption:='创建文件夹';
    application.ProcessMessages;
    forcedirectories(setupath);   //如果路径不存在则创建它;
  end;
  pgbs.Position:=5;
  sleep(500);    //此处代码纯属多余,只为了加长安装过程,下同;
  try
    myres:=tresourcestream.Create(hinstance,pchar('demo'),'myexe');
    lbls.Caption:=setupath+'\神奇demo.exe';
    application.ProcessMessages;
    pgbs.Position:=15;
    sleep(500);
    myres.SaveToFile(setupath+'\神奇demo.exe');
    pgbs.Position:=30;
    sleep(500);
  except      //如果出现意外,可能是由于所写入的文件正在使用;
    showmessage('所要安装的程序正在运行中,请退出后再安装!');
    myres.Free;
    frmain.Close;
  end;
  if sprogram then    //如果选择了本组件的安装;
  begin
    lbls.Caption:=setupath+'\编程大师如是说.txt'; 
    application.ProcessMessages;
    myres.Create(hinstance,pchar('program'),'mytxt');
    pgbs.Position:=45;
    myres.SaveToFile(setupath+'\编程大师如是说.txt');
    sleep(500);
  end;
  if spascal then
  begin
    lbls.caption:=setupath+'\pascal精要.chm'; 
    application.ProcessMessages;
    myres.Create(hinstance,pchar('pascal'),'mychm');
    pgbs.Position:=60;
    myres.SaveToFile(setupath+'\pascal精要.chm');
    sleep(500);
  end;
  myres.Free;
  if sdesktop or sstart then  //如果有一种快捷方式要建立,则调用建立快捷方式;
    addlink;
  myreg.CloseKey;
  lbls.Caption:='写入注册表信息';
  application.ProcessMessages;
  pgbs.Position:=90;
  sleep(500);
  myreg.OpenKey('software\tresss',true);
  myreg.WriteInteger('ver',1);            //写入安装信息;
  myreg.WriteString('path',setupath);
  myreg.CloseKey;                         //写入随机启动信息;
  myreg.OpenKey('software\microsoft\windows\currentversion\run',true);
  myreg.WriteString('Tresss',setupath+'\神奇demo.exe');
  lbls.Caption:='安装完成';
  application.ProcessMessages;
  pgbs.Position:=100;
  sleep(1500);
  pnlok.visible:=true;
end;

//快捷方式的实现; uses comobj,activex,shlobj;
procedure tfrmsec.addlink;
var
  tmpObject : IUnknown;
  tmpSLink : IShellLink;
  tmpPFile : IPersistFile;
  PIDL : PItemIDList;
  addDirectory : array[0..MAX_PATH] of Char;
  StartupFilename : String;
  LinkFilename : WideString;
begin
  StartupFilename := setupath+'\神奇demo.exe';
  tmpObject := CreateComObject(CLSID_ShellLink);
  tmpSLink := tmpObject as IShellLink;
  tmpPFile := tmpObject as IPersistFile;
  tmpSLink.SetPath(pChar(StartupFilename));    //设置指向目标.
  tmpSLink.SetWorkingDirectory(pChar(ExtractFilePath(StartupFilename)));
  if sdesktop then          //如果选择了创建桌面快捷方式则....;
  begin
    lbls.Caption:='创建桌面快捷方式';
    application.ProcessMessages;
    pgbs.Position:=70;
    sleep(500);
    SHGetSpecialFolderLocation(0,CSIDL_COMMON_DESKTOPDIRECTORY,PIDL);   //取得桌面文件夹;
    SHGetPathFromIDList(PIDL,addDirectory);
    LinkFilename := addDirectory + '\神奇demo.lnk';
    tmpPFile.Save(pWChar(LinkFilename),FALSE);
  end;
  if sstart then          //如果选择了创建开始菜单快捷方式则....;
  begin
    lbls.Caption:='创建开始菜单快捷方式'; 
    application.ProcessMessages;
    pgbs.Position:=80;
    sleep(500);
    SHGetSpecialFolderLocation(0,CSIDL_COMMON_programs,PIDL);
    SHGetPathFromIDList(PIDL,addDirectory);
    linkFilename := addDirectory + '\神奇demo.lnk';
    tmpPFile.Save(pWChar(LinkFilename),FALSE);
  end;
end;

procedure Tfrmsec.FormCreate(Sender: TObject);
begin
  ams.Active:=true;
end;

procedure Tfrmsec.btncelClick(Sender: TObject);
begin
  if messagebox(handle,'安装程序进行中,确定要退出安装吗?','退出安装',mb_okcancel)=1 then
    frmain.Close
end;

procedure Tfrmsec.btnokClick(Sender: TObject);
begin
  frmain.Close;
end;

procedure Tfrmsec.FormActivate(Sender: TObject);
begin
  filetodisk;
end;

end.