(495) 925-0049, ITShop интернет-магазин 229-0436, Учебный Центр 925-0049
  Главная страница Карта сайта Контакты
Поиск
Вход
Регистрация
Рассылки сайта
 
 
 
 
 

Установить и умереть (исходники)

Источник: codingclub

Сегодня мы средствами Делфи напишем инсталлятор для 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 и запускаем…

Ссылки по теме


 Распечатать »
 Правила публикации »
  Написать редактору 
 Рекомендовать » Дата публикации: 10.01.2007 
 

Магазин программного обеспечения   WWW.ITSHOP.RU
VMware Horizon 7 Standard : 10 Pack (CCU)
The BAT! Professional - 1 компьютер
Allround Automation PL/SQL Developer - Annual Service Contract - 5 users
SmartBear AQtime Pro - Node-Locked License (Includes 1 Year Maintenance)
IBM RATIONAL Rose Enterprise Floating User License + Sw Subscription & Support 12 Months
 
Другие предложения...
 
Курсы обучения   WWW.ITSHOP.RU
 
Другие предложения...
 
Магазин сертификационных экзаменов   WWW.ITSHOP.RU
 
Другие предложения...
 
3D Принтеры | 3D Печать   WWW.ITSHOP.RU
 
Другие предложения...
 
Новости по теме
 
Рассылки Subscribe.ru
Информационные технологии: CASE, RAD, ERP, OLAP
Новости ITShop.ru - ПО, книги, документация, курсы обучения
Программирование на Microsoft Access
CASE-технологии
Реестр Windows. Секреты работы на компьютере
СУБД Oracle "с нуля"
eManual - электронные книги и техническая документация
 
Статьи по теме
 
Новинки каталога Download
 
Исходники
 
Документация
 
 



    
rambler's top100 Rambler's Top100