Сегодня мы средствами Делфи напишем инсталлятор для Windows. Напомню, инсталлятор - это программа, которая корректно (!) устанавливает на ваш компьютер все что угодно. Существуют специальные компиляторы - инсталляторы (Inno Setup, Install Shield), но они значительно усложняют жизнь программисту и существенно увеличивают размер конечного продукта. Предлагаемый инсталлятор очень удобен для установки маленьких программ, чьим достоинством является именно их размер.
Итак… Создадим проект Делфи. По умолчанию в проекте создается форма - Form1. Сразу же добавим еще одну форму и назовем одну из них Setup, а другой оставим «родное» название (у нас в примере - Form1).
Теперь откроем текст самого проекта (Project1.dpr) и существующий там текст заменим на следующий:
program Project1;
uses
Forms,
Unit2 in 'Unit2.pas' {setup},
Unit1 in 'Unit1.pas' {Form1},
SysUtils;
{$R *.res}
begin
Application.Initialize;
if UpperCase(ExtractFileName(Application.ExeName))='SETUP.EXE' then
//форма инсталлятора
begin
Application.CreateForm(TSetup, Setup);
end
else
//форма основной программы
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
Как видите, в отдел uses добавлен модуль SysUtils, в котором находятся функции для работы со строками, которые мы будем использовать дальше. После инициализации приложения мы извлекаем имя файла из пути к нашему приложению, переводим его в верхний регистр и сверяем: если он называется SETUP.EXE, то создаем форму инсталлятора, а в противном случае - форму основной программы.
Теперь приступим к оформлению окон программы… На главной форме программы (не инсталляторе!) вы можете разместить что угодно. В этом примере я «бросил» на форму один компонент TImage (вкладка Additional) и задал значение его свойства Align в alClient. А для самой формы в обработчике события OnShow написал следующий код:
procedure TForm1.FormShow(Sender: TObject);
begin
Image1.canvas.Font.Color:=clRed;
Image1.canvas.font.Size:=52;
Image1.canvas.brush.Style:=bsClear;
Image1.canvas.FillRect(ClientRect);
Image1.Canvas.TextOut(10,10,'HELLO UKRAINE!');
caption:='HELLO UKRAINE!';
end;
Этот код заполняет весь TImage белым цветом, а потом наносит красную надпись «HELLO UKRAINE!» и задает такой же заголовок формы. На рис. 1 видно, как это выглядит:
Ну а теперь форма инсталлятора… В отдел uses допишем модули fileCtrl, ShlObj, ActiveX, ComObj, registry, ShellApi, которые нам понадобятся в дальнейшем. Здесь можно дать разгуляться фантазии и творческому воображению, но важно, чтобы на форме было поле для указания папки, в которую будет копироваться программа. Поэтому бросаем на форму одно поле для ввода типа TEdit (с вкладки Standard), рядом поместим кнопку, отвечающую за вывод диалога выбора папки. При этом мы будем использовать собственную функцию, которую нужно предварительно прописать в разделе public declarations:
public
function GetPath(mes: string):string;
end;
Ставим курсор на GetPath, нажимаем клавиши Ctrl+Shift+C, и компилятор создает эту функцию. В созданной компилятором функции пишем следующий код:
function TSetup.GetPath(mes: string):string;
var
Root: string; //корневой каталог
pwRoot : PWideChar;
Dir: string;
begin
Root := ''; //корневой каталог - папка Рабочий стол
GetMem(pwRoot, (Length(Root)+1) * 2);
pwRoot := StringToWideChar(Root,pwRoot,MAX_PATH*2);
if SelectDirectory(mes, pwRoot, Dir)
then
if length(Dir) = 2 //пользователь выбрал корневой каталог
then result := Dir+''
else result := Dir
else
result := '';
end;
Наполняем содержанием объявленные переменные и функцией SelectDirectory выводим перед пользователем диалог выбора папки ( рис. 2).
Проверив, нужно ли добавлять наклонную черту, выводим результат.
Ну а теперь напишем обработчик события нажатия на кнопке выбора папки:
procedure Tsetup.openClick(Sender: TObject);
var
path:string;
begin
path := GetPath('Католог для установки...'); //вызываем функцию GetPath
if path <> emptystr then
edit1.Text:=path; //выводим данные функции в окно программы
end;
Кроме этого форму можно оснастить разными CheckBox`ами (вкладка Standard), которые будут отвечать за различные настройки установки. В этом примере я предлагаю добавить три CheckBox`а: один будет настраивать добавления ярлыка в меню «Пуск» (новое название компонента - Start), другой - на рабочий стол (новое название компонента - Desc), а третий - запускать программу (новое название компонента - Run). Кроме этого нужны две кнопки: Начало установки и Отмена. При желании можно добавить ProgressBar. Конечный вид программы представлен на рис. 3.
Верхнюю часть формы я сделал с помощью компонента TLabel (в котором поместил описание), компонента TShape (белый фон) и простой картинки TImage. Повторюсь: красота вашей программы зависит только от вашей фантазии.
Чтобы добавлять ярлыки, нам понадобится написать еще одну дополнительную процедуру, также прописав ее в отделе public declarations:
public
...
procedure CreateShotCut(SourceFile, ShortCutName, SourceParams: String);
end;
Как и раньше, нажимаем заветные клавиши Ctrl+Shift+C и пишем такой вот код:
procedure Tsetup.CreateShotCut(SourceFile, ShortCutName,
SourceParams: String);
var
IUnk: IUnknown;
ShellLink: IShellLink;
ShellFile: IPersistFile;
tmpShortCutName: string;
WideStr: WideString;
i: Integer;
begin
IUnk := CreateComObject(CLSID_ShellLink);
ShellLink := IUnk as IShellLink;
ShellFile := IUnk as IPersistFile;
ShellLink.SetPath(PChar(SourceFile));
ShellLink.SetArguments(PChar(SourceParams));
ShellLink.SetWorkingDirectory(PChar(ExtractFilePath(SourceFile)));
ShortCutName := ChangeFileExt(ShortCutName,'.lnk');
if fileexists(ShortCutName) then
begin
ShortCutName := copy(ShortCutName,1,length(ShortCutName)-4);
i := 1;
repeat
tmpShortCutName := ShortCutName +'(' + inttostr(i)+ ').lnk';
inc(i);
until not fileexists(tmpShortCutName);
WideStr := tmpShortCutName;
end
else
WideStr := ShortCutName;
ShellFile.Save(PWChar(WideStr),False);
end;
В самом начале мы инициализируем переменную IUnk как COM-объект с помощью функции CreateComObject. Затем инициализируются еще две переменные ShellLink (ссылка) и ShellFile (файл). В переменной ShortCutName сохраняется имя ярлыка + расширение .lnk (это имя будет использоваться при создании самого файла ссылки). Потом проверяется наличие файла с таким же именем в этой папке. Если файл существует - запускаем цикл, в котором к имени файла добавляется номер в скобочках, до тех пор, пока ни сгенерируется уникальное имя файла. В конце концов сохраняем файл ярлыка.
Теперь обработчик события для нажатия на кнопку Установить:
procedure Tsetup.goClick(Sender: TObject);
//переменные, которые понадобятся при создании ярлыка
var
WorkTable:String;
P:PItemIDList;
C:array [0..1000] of char;
begin
//Создаем папку, которую выбрал пользователь
createdir(edit1.Text);
//Сообщаем пользователю, что сейчас происходит
info.Caption:='Копируются файлы...';
//Копируем файл с новым именем
CopyFile(PChar(ParamStr(0)), PChar(edit1.Text + 'project1.exe'), True);
//Указываем значение индикатора выполнения
Progressbar1.Position:=60;
//Сообщаем пользователю, что сейчас происходит
info.Caption:='Создаются ярлыки...';
//Если пользователь хочет, чтобы у программы был ярлык на Рабочем столе, создаем ярлык
if desc.Checked then
begin
//Получаем путь к Рабочему столу
if SHGetSpecialFolderLocation(Handle,CSIDL_DESKTOP,p)=NOERROR then
begin
SHGetPathFromIDList(P,C);
WorkTable:=StrPas(C);
end;
//Если такой файл уже существует - удаляем
if FileExists(WorkTable+'project1.exe') then
DeleteFile(WorkTable+'project1.exe');
//Создаем ярлык
CreateShotCut(edit1.Text+'project1.exe', WorkTable+'project1.exe', '');
end;
Progressbar1.Position:=80;
//Если пользователь захотел ярлык программы в меню Пуск
if start.Checked then
begin
//Так же, как и при создании ярлыка на Рабочем столе
if SHGetSpecialFolderLocation(Handle,CSIDL_PROGRAMS,p)=NOERROR then
begin
SHGetPathFromIDList(P,C);
WorkTable:=StrPas(C)+'Project1';
end;
if not DirectoryExists(WorkTable) then
MkDir(WorkTable);
if FileExists(WorkTable+'Project1.exe') then
DeleteFile(WorkTable+'Project1.exe');
CreateShotCut(edit1.Text+'Project1.exe', WorkTable+'Project1.exe', '');
end;
Progressbar1.Position:=100;
//Если пользователь захотел запустить программу после установки
if run.Checked then
//Запускаем
shellExecute(0,'open',PChar(edit1.text+'project1.exe'),'','',SW_SHOW);
close;
end;
Еще хотелось бы, чтобы программа при загрузке сразу предлагала установиться в папку, откуда запущена:
procedure Tsetup.FormShow(Sender: TObject);
begin
edit1.Text:=extractFilePath(Application.ExeName);
end;
Осталось только сделать так, чтобы при нажатии на кнопку «Отмена» программа просто закрывалась.
procedure Tsetup.stopClick(Sender: TObject);
begin
close;
end;
Вот и все. Компилируем, переименовываем в Setup.exe и запускаем…