Виртуальная библиотека Delphi - [2]

   CloseFile(ToFile);
  end;
 finally
  CloseFile(FromFile);
 end;
end;

Копирование методами Windows

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