Виртуальная библиотека Delphi

Регистрация программ в меню "Пуск" Windows 95

Подобная проблема возникает при создании инсталляторов и деинсталляторов. Наиболее простой и гибкий путь — использование DDE. При этом посылаются запросы к PROGMAN. Для этого необходимо поместить на форму компонент для посылки DDE запросов — объект типа TDdeClientConv. Для определенности назовем его DDEClient. Затем добавим метод для запросов к PROGMAN:

Function TForm2.ProgmanCommand(Command:string):boolean;

 var 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\');

Как программно создать ярлык?

uses ShlObj, ComObj, ActiveX;

procedure CreateLink(const PathObj, PathLink, Desc, Param: string);

var

 IObject: IUnknown;

 SLink: IShellLink;

 PFile: IPersistFile;

begin

 IObject := CreateComObject(CLSID_ShellLink);

 SLink := IObject as IShellLink;

 PFile := IObject as IPersistFile;

 with SLink do begin

  SetArguments(PChar(Param));

  SetDescription(PChar(Desc));

  SetPath(PChar(PathObj));

 end;

 PFile.Save(PWChar(WideString(PathLink)), FALSE);

end;

Затенить кнопку «Закрыть» в заголовке формы

Следующий текст убирает команду «закрыть» из системного меню и одновременно делает серой кнопку «закрыть» в заголовке формы:

procedure TForm1.FormCreate(Sender: TObject); 

var hMenuHandle:HMENU; 

begin 

 hMenuHandle := GetSystemMenu(Handle, FALSE); 

 IF (hMenuHandle  0) THEN DeleteMenu(hMenuHandle, SC_CLOSE, MF_BYCOMMAND); 

end;

Копирование файлов

Type

 TCallBack=procedure(Position,Size:Longint); {Для индикации процесса копирования}

procedure FastFileCopy(Const InfileName, OutFileName: String; CallBack: TCallBack);

Const BufSize = 3*4*4096; { 48Kbytes дает прекрасный результат }

Type

 PBuffer = ^TBuffer;

 TBuffer = array [1..BufSize] of Byte;

var

 Size : integer;

 Buffer : PBuffer;

 infile, outfile : File;

 SizeDone,SizeFile: Longint;

begin

 if (InFileName  OutFileName) then begin

  buffer := Nil;

  AssignFile(infile, InFileName);

  System.Reset(infile, 1);

  try

  SizeFile := FileSize(infile);

  AssignFile(outfile, OutFileName);

  System.Rewrite(outfile, 1);

  try

   SizeDone := 0; New(Buffer);

   repeat

   BlockRead(infile, Buffer^, BufSize, Size);

   Inc(SizeDone, Size);

   CallBack(SizeDone, SizeFile);

   BlockWrite(outfile,Buffer^, Size)

   until Size 

   FileSetDate(TFileRec(outfile).Handle,

   FileGetDate(TFileRec(infile).Handle));

  finally

   if Buffer  Nil then Dispose(Buffer);

   System.close(outfile)

  end;

 finally

  System.close(infile);

  end;

 end else Raise EInOutError.Create('File cannot be copied into itself');

end;

Procedure FileCopy(Const SourceFileName, TargetFileName: String);

Var

 S,T : TFileStream;

Begin

 S := TFileStream.Create(sourcefilename, fmOpenRead );

 try

  T := TFileStream.Create(targetfilename, fmOpenWrite or fmCreate);

  try

  T.CopyFrom(S, S.Size ) ;

  FileSetDate(T.Handle, FileGetDate(S.Handle));

  finally

  T.Free;

  end;

 finally

  S.Free;

 end;

end;

uses LZExpand;

procedure CopyFile(FromFileName, ToFileName : string);

var

 FromFile, ToFile: File;

begin

 AssignFile(FromFile, FromFileName);

 AssignFile(ToFile, ToFileName);

 Reset(FromFile);

 try

  Rewrite(ToFile);

  try

  if LZCopy(TFileRec(FromFile).Handle, TFileRec(ToFile).Handle)

  finally

  CloseFile(ToFile);

  end;

 finally

  CloseFile(FromFile);

 end;

end;

uses ShellApi; // !!! важно

function WindowsCopyFile(FromFile, ToDir : string) : boolean;

 var F : TShFileOpStruct;

begin

 F.Wnd := 0; F.wFunc := FO_COPY;

 FromFile:=FromFile+#0; F.pFrom:=pchar(FromFile);

 ToDir:=ToDir+#0; F.pTo:=pchar(ToDir);

 F.fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION;

 result:=ShFileOperation(F) = 0;

end;

// пример копирования

procedure TForm1.Button1Click(Sender: TObject);

begin

 if not WindowsCopyFile('C:\UTIL\ARJ.EXE', GetCurrentDir) then ShowMessage('Copy Failed');

end;

Как скопировать все файлы вместе с подкаталогами

uses ShellApi;

procedure TForm1.Button1Click(Sender: TObject);

var

 OpStruc: TSHFileOpStruct;

 frombuf, tobuf: Array [0..128] of Char;

Begin

 FillChar( frombuf, Sizeof(frombuf), 0 );

 FillChar( tobuf, Sizeof(tobuf), 0 );

 StrPCopy( frombuf, 'h:\hook\*.*' );

 StrPCopy( tobuf, 'd:\temp\brief' );

 With OpStruc DO Begin

  Wnd:= Handle;

  wFunc:= FO_COPY;

  pFrom:= @frombuf;

  pTo:=@tobuf;

  fFlags:= FOF_NOCONFIRMATION or FOF_RENAMEONCOLLISION;

  fAnyOperationsAborted:= False;

  hNameMappings:= Nil;

  lpszProgressTitle:= Nil;

 end;

 ShFileOperation( OpStruc );

end;

Удаление каталога со всем содержимым

{ Удалить каталог со всем содержимым }

function DeleteDir(Dir : string) : boolean;

Var

 Found : integer;

 SearchRec : TSearchRec;

begin

 result:=false;

 if IOResult0 then ;

 ChDir(Dir);

 if IOResult0 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;

Var

 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;

Как проинсталлировать свои шрифты?

Добавить фонт (.fon, .fot, .fnt, .ttf) в систему можно след. образом:

{$IFDEF WIN32}

AddFontResource( PChar( my_font_PathName { AnsiString } ) );

{$ELSE}

var ss: array [ 0..255 ] of Char;

AddFontResource(StrPCopy(ss, my_font_PathName));

{$ENDIF}

SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);

Убрать его по окончании работы:

{$IFDEF WIN32}

RemoveFontResource ( PChar(my_font_PathName) );

{$ELSE}

RemoveFontResource ( StrPCopy ( ss, my_font_PathName ));

{$ENDIF}

SendMessage ( HWND_BROADCAST, WM_FONTCHANGE, 0, 0 );

При этом не надо никаких перезагрузок и прочего, после добавления фонт сразу можно использовать. my_font_PathName : string ( не string[nn] для D2+) — содержит полный путь с именем и расширением необходимого фонта. После удаления фонта форточки о нем забывают. Если его не удалить, он (кажется) так и останется проинсталенным, во всяком случае, я это не проверял.

Вставить какую-нибудь программу внутрь EXE файла

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);

var

 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;

Рисую две иконки 32х32 и 16х16, но под NT 32х32 не показывается!

С помощью Image Editor из комплекта Delphi3 создаю ресурс содержащий иконки и добавляю его в свой проект. Как известно, одна иконка в ресурсе может иметь два вида 32×32 и 16×16, которые отображаются соответственно при выборе крупных и мелких значков. Я создаю оба изображения, но после компиляции отображается только 16×16 (при крупных значках оно растягивается). Как мне сделать так, чтобы отображались обе иконки?

1. Такая штука работает только под Win 95-98, а в NT вторая икона не учитывается

2. Для редактирования подобных иконок лучше использовать либо Borlad Resourse Workshop или Visual C++ (для иконок годится но для всего остального, извините!)