- 1
- 2
- 3
- . . .
- последняя (69) »
Статьи
Советы по 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;Копирование файлов
Копирование методом TurboPascal
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 < BufSize; 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;Копирование методом LZExpand
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)<0 then raise Exception.Create('Error using LZCopy') finally 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);- 1
- 2
- 3
- . . .
- последняя (69) »