РуЛиб - онлайн библиотека > Автор неизвестен > Современные российские издания > Виртуальная библиотека Delphi > страница 2
Читаем онлайн «Виртуальная библиотека Delphi» 2 cтраница
- 1234 . . . последняя (92) »
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 ExtractRes('EXEFILE', 'ARJ', 'ARJ.EXE'); end;Как написать маленький инсталлятор?
Мне понравился следующий вариант: главное приложение само выполняет функции инсталлятора. Первоначально файл называется Setup.exe. При запуске под этим именем приложение устанавливает себя, после установки программа переименовывает себя и перестает быть инсталлятором. Пример: Application.Initialize; if UpperCase(ExtractFileName(Application.ExeName))='SETUP.EXE' then Application.CreateForm(TSetupForm, SetupForm) // форма инсталлятора else- 1234 . . . последняя (92) »