Регистрация программ в меню "Пуск" Windows 95.
Подобная проблема возникает при создании инсталляторов и деинсталляторов.
Наиболее простой и гибкий путь - использование DDE.
При этом посылаются запросы к PROGMAN.
Для этого необходимо поместить на форму компонент для посылки DDE запросов - объект
типа TDdeClientConv. Для определенности назовем его DDEClient.
Затем добавим метод для запросов к PROGMAN:
Function TForm2.ProgmanCommand(Command:string):boolean;
i
macrocmd:array[0..88] of char;
begin
DDEClient.SetLink('PROGMAN','PROGMAN');
DDEClient.OpenLink; { Устанавливаем связь по DDE }
strPCopy(macrocmd,'['+Command+']'); { Подготавливаем ASCIIZ строку }
ProgmanCommand :=DDEClient.ExecuteMacro(MacroCmd,false);
DDEClient.CloseLink; { Закрываем связь по DDE }
end;
При вызове ProgmanCommand возвращает true, если посылка
макроса была успешна. Система команд (основных)
приведена ниже: Create(Имя группы, путь к GRP файлу)
Создать группу с именем "Имя группы", причем
в нем могут быть пробелы и знаки препинания. Путь
к GRP файлу можно не указывать, тогда он создастся
в каталоге Windows. Delete(Имя группы)
Удалить группу с именем "Имя группы" ShowGroup(Имя группы, состояние)
Показать группу в окне, причем состояние - число,
определяющее параметры окна:
1-нормальное состояние + активация
2-миним.+ активация
3-макс. + активация
4-нормальное состояние
5-Активация AddItem(командная строка, имя раздела, путь к
иконке, индекс иконки (с 0), Xpos,Ypos, рабочий каталог,
HotKey, Mimimize)
Добавить раздел к активной группе. В командной
строке, имени размера и путях допустимы пробелы,
Xpos и Ypos - координаты иконки в окне, лучше их не
задавать, тогда PROGMAN использует значения по
умолчанию для свободного места. HotKey - виртуальный
код горячей клавиши. Mimimize - тип запуска, 0-в
обычном окне, <>0 - в минимизированном. DeleteItem(имя раздела)
Удалить раздел с указанным именем в активной
группе
Пример использования:
ProgmanCommand('CreateGroup(Комплекс программ для
каталогизации литературы,)');
ProgmanCommand('AddItem('+path+'vbase.hlp,Справка по VBase,'+ path +' vbase.hlp,
0, , , '+ path + ',,)');
где path - строка типа String, содержащая полный путь к
каталогу ('C:\Catalog\');
{ Удалить каталог со всем содержимым }
function DeleteDir(Dir : string) : boolean;
i
Found : integer;
SearchRec : TSearchRec;
begin
result:=false;
if IOResult<>0 then ;
ChDir(Dir);
if IOResult<>0 then begin
ShowMessage('Не могу войти в каталог: '+Dir); exit;
end;
Found :=FindFirst('*.*', faAnyFile, SearchRec);
while Found=0 do
begin
if (SearchRec.Name<>'.')and(SearchRec.Name<>'..') then
if (SearchRec.Attr and faDirectory)<>0 then begin
if not DeleteDir(SearchRec.Name) then exit;
end else
if not DeleteFile(SearchRec.Name) then begin
ShowMessage('Не могу удалить файл: '+SearchRec.Name); exit;
end;
Found :=FindNext(SearchRec);
end;
FindClose(SearchRec);
ChDir('..'); RmDir(Dir);
result:=IOResult=0;
end;
Часто при создании систем привязки программ к компьютеру или окон типа
System Info или About Box необходимо определить данные о пользователе и
о системе. Это можно сделать следующим образом (из примеров по Delphi -
программа COA):
Procedure GetInfo;
i
WinVer, WinFlags : LongInt; { Версия Windows и флаги }
hInstUser, Fmt : Word; { Дескриптор }
Buffer : ARRAY[0..30] OF Char; { Буфер под ASCIIZ строку }
begin
hInstUser :=LoadLibrary('USER'); { Открыли библиотеку User }
LoadString(hInstUser, 514, Buffer, 30);
LabelUserName.Caption :=StrPas(Buffer); { Имя пользователя }
LoadString(hInstUser, 515, Buffer, 30);
FreeLibrary(hInstUser);
LabelCompName.Caption :=StrPas(Buffer); { Компания }
WinVer :=GetVersion;
LabelWinVer.Caption :=Format('Windows %u.%.2u', { Версия Windows }
[LoByte(LoWord(WinVer)), HiByte(LoWord(WinVer))]);
LabelDosVer.Caption :=Format('DOS %u.%.2u', { Версия DOS }
[HiByte(HiWord(WinVer)), LoByte(HiWord(WinVer))]);
WinFlags :=GetWinFlags;
IF WinFlags AND WF_ENHANCED > 0 THEN
LabelWinMode.Caption :='386 Enhanced Mode' { Режим }
ELSE IF WinFlags AND WF_PMODE > 0 THEN
LabelWinMode.Caption :='Standard Mode'
ELSE LabelWinMode.Caption :='Real Mode';
IF WinFlags AND WF_80x87 > 0 THEN { Сопроцессор }
ValueMathCo.Caption :='Present'
ELSE ValueMathCo.Caption :='Absent';
Fmt :=GetFreeSystemResources(GFSR_SYSTEMRESOURCES);
ValueFSRs.Caption :=Format('%d%% Free', [Fmt1]); { Свободно ресурсов }
{ Свободно памяти}
ValueMemory.Caption :=FormatFloat(',#######', MemAvail DIV 1024) + ' KB Free';
end;
При этом не надо никаких перезагрузок и прочего, после добавления фонт
сразу можно использовать. my_font_PathName : string ( не string[nn] для
D2+) - содержит полный путь с именем и расширением необходимого фонта.
После удаления фонта форточки о нем забывают. Если его не удалить, он (кажется)
так и останется проинсталенным, во всяком случае, я это не проверял.
1. Пишем в блокноте RC-файл, куда прописываем все
нужные нам программы, например:
ARJ EXEFILE C:\UTIL\ARJ.EXE
2. Компилируем его в ресурс при помощи Brcc32.exe.
Получаем RES-файл.
3. Далее в тексте нашей программы:
implementation
{$R *.DFM}
{$R test.res} //Это наш RES-файл
procedure ExtractRes(ResType, ResName, ResNewName : String);
i
Res : TResourceStream;
begin
Res :=TResourceStream.Create(Hinstance, Resname, Pchar(ResType));
Res.SavetoFile(ResNewName);
Res.Free;
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
// Записывает в текущую папку arj.exe
ExtractRes('EXEFILE', 'ARJ', 'ARJ.EXE');
end;
Мне понравился следующий вариант: главное приложение само выполняет функции
инсталлятора. Первоначально файл называется Setup.exe. При запуске под
этим именем приложение устанавливает себя, после установки программа переименовывает
себя и перестает быть инсталлятором.
Пример:
Application.Initialize;
if UpperCase(ExtractFileName(Application.ExeName))='SETUP.EXE'
then Application.CreateForm(TSetupForm, SetupForm) // форма
инсталлятора
else Application.CreateForm(TMainForm, MainForm); // форма
основной программы
Application.Run;
Вопрос:
Как зарегистрировать расширение файла за своим приложением и контекстное
меню,
связанное с этим типом?
Ответ:
Пример регистрирует расширение файла(.myext) - файлы
этого типа будут открываться
приложением MyApp.Exe. Также регнстрируется одно
действие (action) по умолчанию
для файлов этого типа и два дополнительных
пункта контекстного меню, связанного с
этим типом файлов. Возможно, потребуется
перезайти в систему чтобы изменения
вступили в силу.
Пример:
uses
Registry;
procedure TForm1.Button1Click(Sender: TObject);
i
R : TRegIniFile;
begin
R :=TRegIniFile.Create('');
with R do
begin
RootKey :=HKEY_CLASSES_ROOT;
WriteString('.myext','','MyExt');
WriteString('MyExt','','Some description of MyExt files');
WriteString('MyExt\DefaultIcon','','C:\MyApp.Exe,0');
WriteString('MyExt\Shell','','This_Is_Our_Default_Action');
WriteString('MyExt\Shell\First_Action',
'','This is our first action');
WriteString('MyExt\Shell\First_Action\command','',
'C:\MyApp.Exe /LotsOfParamaters %1');
WriteString('MyExt\Shell\This_Is_Our_Default_Action','',
'This is our default action');
WriteString('MyExt\Shell\This_Is_Our_Default_Action\command',
'','C:\MyApp.Exe %1');
WriteString('MyExt\Shell\Second_Action',
'','This is our second action');
WriteString('MyExt\Shell\Second_Action\command',
'','C:\MyApp.Exe /TonsOfParameters %1');
Free;
end;
end;
sProgTitle: Название для программы
sCmdLine: Имя EXE файла с путем доступа
bRunOnce: Запустить только один раз или постоянно при загрузке Windows
procedure RunOnStartup(sProgTitle, sCmdLine : string; bRunOnce : boolean );
i
sKey : string;
reg : TRegIniFile;
begin
if( bRunOnce )then sKey :='Once'
else sKey :='';
reg :=TRegIniFile.Create( '' );
reg.RootKey :=HKEY_LOCAL_MACHINE;
reg.WriteString(
'Software\Microsoft'
+ '\Windows\CurrentVersion\Run'
+ sKey + #0,
sProgTitle,
sCmdLine );
reg.Free;
end;
// Например
RunOnStartup('Title of my program','MyProg.exe',False );
Примечание. Этот пример удобно использовать при написании деинсталляторов
- добавить однократный вызов деинсталлятора и запросить от пользователя
перезагрузку. Этот прием позволит безболезненно удалять DLL и им подобные
файлы, которые обычном способом удалить невозможно (они загружены в силу
того, что использовались деинсталлируемой программой или работают в момент
деинсталляции).
program wallpapr;
uses Registry, WinProcs;
procedure SetWallpaper(sWallpaperBMPPath : String; bTile : boolean );
i
reg : TRegIniFile;
begin
// Изменяем ключи реестра
// HKEY_CURRENT_USER
// Control Panel\Desktop
// TileWallpaper (REG_SZ)
// Wallpaper (REG_SZ)
reg :=TRegIniFile.Create('Control Panel\Desktop' );
with reg do begin
WriteString( '', 'Wallpaper',
sWallpaperBMPPath );
if( bTile )then
begin
WriteString('', 'TileWallpaper', '1' );
end else begin
WriteString('', 'TileWallpaper', '0' );
end;
end;
reg.Free;
// Оповещаем всех о том, что мы
// изменили системные настройки
SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, Nil, SPIF_SENDWININICHANGE );
end;
begin
// пример установки WallPaper по центру рабочего стола
SetWallpaper('c:\winnt\winnt.bmp', False );
end.
