Поиск текста в текстовом файле
Кто-нибудь знает быстрый способ поиска строки в текстовом файле?
|
unit BMSearch; (* ------------------------------------------------------------------- Поиск строки методом Boyer-Moore. Это - один из самых быстрых алгоритмов поиска строки. See a description in: R. Boyer и S. Moore. Быстрый алгоритм поиска строки. Communications of the ACM 20, 1977, страницы 762-772 ------------------------------------------------------------------- *) interface type {$ifdef WINDOWS} size_t = Word; {$else} size_t = LongInt; {$endif} type TTranslationTable = array[char] of char; { таблица перевода } TSearchBM = class(TObject) private FTranslate : TTranslationTable; { таблица перевода } FJumpTable : array[char] of Byte; { таблица переходов } FShift_1 : integer; FPattern : pchar; FPatternLen : size_t; public procedure Prepare( Pattern: pchar; PatternLen: size_t; IgnoreCase: Boolean ); procedure PrepareStr( const Pattern: string; IgnoreCase: Boolean ); function Search( Text: pchar; TextLen: size_t ): pchar; function Pos( const S: string ): integer; end; implementation uses SysUtils; (* ------------------------------------------------------------------- Игнорируем регистр таблицы перевода ------------------------------------------------------------------- *) procedure CreateTranslationTable( var T: TTranslationTable; IgnoreCase: Boolean ); var c: char; begin for c := #0 to #255 do T[c] := c; if not IgnoreCase then exit; for c := 'a' to 'z' do T[c] := UpCase(c); { Связываем все нижние символы с их эквивалентом верхнего регистра } T['Б'] := 'A'; T['А'] := 'A'; T['Д'] := 'A'; T['В'] := 'A'; T['б'] := 'A'; T['а'] := 'A'; T['д'] := 'A'; T['в'] := 'A'; T['Й'] := 'E'; T['И'] := 'E'; T['Л'] := 'E'; T['К'] := 'E'; T['й'] := 'E'; T['и'] := 'E'; T['л'] := 'E'; T['к'] := 'E'; T['Н'] := 'I'; T['М'] := 'I'; T['П'] := 'I'; T['О'] := 'I'; T['н'] := 'I'; T['м'] := 'I'; T['п'] := 'I'; T['о'] := 'I'; T['У'] := 'O'; T['Т'] := 'O'; T['Ц'] := 'O'; T['Ф'] := 'O'; T['у'] := 'O'; T['т'] := 'O'; T['ц'] := 'O'; T['ф'] := 'O'; T['Ъ'] := 'U'; T['Щ'] := 'U'; T['Ь'] := 'U'; T['Ы'] := 'U'; T['ъ'] := 'U'; T['щ'] := 'U'; T['ь'] := 'U'; T['ы'] := 'U'; T['с'] := 'С'; end; (* ------------------------------------------------------------------- Подготовка таблицы переходов ------------------------------------------------------------------- *) procedure TSearchBM.Prepare( Pattern: pchar; PatternLen: size_t; IgnoreCase: Boolean ); var i: integer; c, lastc: char; begin FPattern := Pattern; FPatternLen := PatternLen; if FPatternLen < 1 then FPatternLen := strlen(FPattern); { Данный алгоритм базируется на наборе из 256 символов } if FPatternLen > 256 then exit; { 1. Подготовка таблицы перевода } CreateTranslationTable( FTranslate, IgnoreCase); { 2. Подготовка таблицы переходов } for c := #0 to #255 do FJumpTable[c] := FPatternLen; for i := FPatternLen - 1 downto 0 do begin c := FTranslate[FPattern[i]]; if FJumpTable[c] >= FPatternLen - 1 then FJumpTable[c] := FPatternLen - 1 - i; end; FShift_1 := FPatternLen - 1; lastc := FTranslate[Pattern[FPatternLen - 1]]; for i := FPatternLen - 2 downto 0 do if FTranslate[FPattern[i]] = lastc then begin FShift_1 := FPatternLen - 1 - i; break; end; if FShift_1 = 0 then FShift_1 := 1; end; procedure TSearchBM.PrepareStr( const Pattern: string; IgnoreCase: Boolean ); var str: pchar; begin if Pattern <> '' then begin {$ifdef Windows} str := @Pattern[1]; {$else} str := pchar(Pattern); {$endif} Prepare( str, Length(Pattern), IgnoreCase); end; end; { Поиск последнего символа & просмотр справа налево } function TSearchBM.Search( Text: pchar; TextLen: size_t ): pchar; var shift, m1, j: integer; jumps: size_t; begin result := nil; if FPatternLen > 256 then exit; if TextLen < 1 then TextLen := strlen(Text); m1 := FPatternLen - 1; shift := 0; jumps := 0; { Поиск последнего символа } while jumps <= TextLen do begin Inc( Text, shift); shift := FJumpTable[FTranslate[Text^]]; while shift <> 0 do begin Inc( jumps, shift); if jumps > TextLen then exit; Inc( Text, shift); shift := FJumpTable[FTranslate[Text^]]; end; { Сравниваем справа налево FPatternLen - 1 символов } if jumps >= m1 then begin j := 0; while FTranslate[FPattern[m1 - j]] = FTranslate[(Text - j)^] do begin Inc(j); if j = FPatternLen then begin result := Text - m1; exit; end; end; end; shift := FShift_1; Inc( jumps, shift); end; end; function TSearchBM.Pos( const S: string ): integer; var str, p: pchar; begin result := 0; if S <> '' then begin {$ifdef Windows} str := @S[1]; {$else} str := pchar(S); {$endif} p := Search( str, Length(S)); if p <> nil then result := 1 + p - str; end; end; end. |
[000305]
Поиск загрузочного диска
Есть какая-либо функция или вызов API для поиска загрузочного диска?
Я нашел это в регистрах:
| HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Setup |
Значение "BootDir" и есть искомая величина. [000285]
Получение размера файла
Вот мой код, которым я пользуюсь для определения информации о группе файлов:
|
var Fhnd2 : File ; sPath : String; tpath : string; SearchRec: TSearchRec; tempsearch : string; tempfiles : Integer; tempbytes : LongInt; wBytes : Word; sTemp : String ; iLen : Integer ; szString: Array[0..128] Of Char; ec : integer; BEGIN {* Выбираем системный каталог *} MailManLogS('Запуск MailMan'); sTemp := ParamStr(0) ; iLen := Length(sTemp) ; WHILE sTemp[iLen] <> '\' DO DEC (iLen) ; StrPCopy(szString, sTemp) ; szString[iLen] := #0 ; SysDir := StrPas(szString) ; tempbytes := 0; tempfiles := 0; Files2bProc := 0; Bytes2bProc := 0; MailManLogS('Калькулируем файлы для обработки'); {* Подсчитываем, сколько файлов и байт должны быть обработаны *} tempsearch := SysDir + 'spool\witchcrf\d\*.*' ; ec := FindFirst(tempsearch, faSysFile, SearchRec); While ec = 0 do begin if ((SearchRec.Name <> '.') and (SearchRec.Name <> '..')) then begin tempfiles := tempfiles + 1; ----> tempbytes := tempbytes + SearchRec.Size; <------ TotalInBytes.Text := IntToStr(tempbytes); TotalInFiles.Text := IntToStr(tempfiles); MailManLogS('Файл-' + SearchRec.Name + ' Размер-' + IntToStr(SearchRec.Size)); end; ec := FindNext(SearchRec); end; MailManLogS('Всего файлов = ' + IntToStr(tempfiles) + ' Байт = ' + IntToStr(tempbytes)); end; |
В коде могут присутствовать синтаксические ошибки, т.к. я просто вырезал этот код из своей программы, чтобы показать как работает функция FindFirst. Она должна возвращать информацию о файле в SearchRec, который будет содержать любую необходимую вам информацию о файле. Я думаю это то, что вам нужно, при этом нет необходимости даже открывать файл.
Я все это делал с использованием FindFirst. Функция возвращает запись, имеющую тип TSearchRec. Данная запись содержит переменную Size, которая содержит размер файла в байтах. Это может быть не так красиво, но это работает:
|
function GetFileSize(FileName: string): Longint; var SearchRec: TSearchRec; begin if FindFirst(FileName, faAnyFile, SearchRec) = 0 then Result:=SearchRec.Size else Result:=-1; {возвращаем ошибку, это может быть число меньше нуля} end; |
В зависимости от предпочтений, можно выбрать одну из двух приведенных ниже функций. В первой реализуется идея временного изменения атрибутов файла, необходимого для его чтения. Вторая использует Windows API, но не содержит средств проверки наличия ошибок.
|
Function FileGetSize1(Filename : String) : LongInt; var F : File; OldFileAttr : Integer; begin if FileExists(Filename) then begin OldFileAttr := FileGetAttr(Filename); FileSetAttr(Filename,OldFileAttr and (faReadOnly xor $FFFF)); try AssignFile(F, Filename); Reset(F,1); Result := FileSize(F); CloseFile(F); finally FileSetAttr(Filename, OldFileAttr); end; end else Result := 0; end; Function FileGetSize2(Filename : String) : LongInt; var FileHandle : Integer; begin if FileExists(Filename) then begin FileName := FileName + chr(0); FileHandle := _lopen(@FileName[1], 0); Result := _llseek(FileHandle, 0, 2); _lclose(FileHandle); end else Result := 0; end; |
[Eric Nielsen, htrsoft@midwest.net]
Я не стал возиться с AssignFile.
|
Function FileSizeInBytes(YourFile : String) : LongInt; Var F : Integer; Begin F:=FileOpen(YourFile,0); { режим ReadOnly } FilesizeInBytes := FileSeek(F,0,2); FileClose(F) End; |
Примечание: Проверка ошибок отсутствует !!! [001688]
Проблема получения времени создания файла
Попробуйте следующую функцию, которая не требует вызова FindFirst:
| function GetFileDate(TheFileName: string): string; var FHandle: integer; begin FHandle := FileOpen(TheFileName, 0); result := DateTimeToStr(FileDateToDateTime(FileGetDate(FHandle))); FileClose(FHandle); end; |
Одно маленькое предупреждение: время, возвращаемое Win32-функцией, отсчитывается от Гринвича, поэтому вам необходимо привести полученный результат к локальному времени. Чтобы быть уверенным, проверьте документацию. (Я уверен, что FindNextFile делает это правильно). [000087]
Процедура форматирования
В Shell32.dll спрятана WinAPI функция SHFormatDrive, вызывающая стандартный диалог форматирования сменного накопителя. Я уже встречал этот вопрос в конференции borland.public.delphi.winapi.
|
{раздел реализации} .. .. const SHFMT_ID_DEFAULT = $FFFF; // Опции форматирования SHFMT_OPT_QUICKFORMAT = $0000; SHFMT_OPT_FULL = $0001; SHFMT_OPT_SYSONLY = $0002; // Коды ошибок SHFMT_ERROR = $FFFFFFFF; SHFMT_CANCEL = $FFFFFFFE; SHFMT_NOFORMAT = $FFFFFFFD; function SHFormatDrive(Handle: HWND; Drive, ID, Options: Word): LongInt; stdcall; external 'shell32.dll' name 'SHFormatDrive' procedure TForm1.btnFormatDiskClick(Sender: TObject); var retCode: LongInt; begin retCode:= SHFormatDrive(Handle, 0, SHFMT_ID_DEFAULT, SHFMT_OPT_QUICKFORMAT); if retCode < 0 then ShowMessage('Не могу отформатировать накопитель'); end; end. |
Как удалить все файлы из директории?
Попробуй это:
|
procedure TfrmMain.DelDir(DirName: string); var SearchRec: TSearchRec; GotOne: integer; begin GotOne:= FindFirst(DirName + '\*.*', faAnyFile, SearchRec); while GotOne = 0 do begin if ((SearchRec.Attr and faDirectory) = 0) then DeleteFile(DirName + '\' + SearchRec.Name) else if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then DelDir(DirName + '\' + SearchRec.Name); GotOne:= FindNext(SearchRec); end; FindClose(SearchRec); end; |
Если впоследствии Вы захотите директорию удалить, попробуйте сделать так:
|
//-------- DelDir('C:\WASTE'); {-I} RmDir('C:\WASTE'); {+I} if IOResult <> 0 then raise Exception.Create('Ошибка удаления каталога'); //------- |
Автор рекурсивного кода David Ullrich. [000079]
Путь/Имя папки 'My Computer'
Это довольно сложный материал, поэтому если это не актуально для вашего приложения, то предварительно предупрежу о том, чтобы вы не тратили ваше драгоценное время в дебрях сложной и запутанной информации. Тем не менее заинтересованных я направлю на путь истинный.
Операционная система windows 32 основывается на оболочке, которая использует виртуальные папки, такие, как 'my computer' (Мой компьютер), 'desktop' (Рабочий Стол) и 'recycle bin' (Корзина). Некоторые из них являются частью физической файловой системы. Другими словами, они имеют соответствующий реальный каталог в файловой системе. Это относится, например, к системным папкам 'desktop' и 'recycle bin'. Данные каталоги могут быть использованы как InitialDir в TOpenDialog, но сначала вы должны получить их физическое месторасположение, которое может различаться на других компьютерах. Чтобы узнать их реальное месторасположение на локальном диске, вы должны воспользоваться некоторыми специальными вызовами API (смотри пример ниже). Другие папки, типа 'my computer' и 'printers' не являются частью файловой системы, они чисто виртуальные. Обращаю ваше внимание на то, что такие папки можно использовать в TOpenDialog, но никак не в InitialDir.
Виртуальные папки (я немного упрощаю) имеют тип SHITEMID (идентификатор элемента). Получить к ним доступ можно используя pointers to item identifiers list (PIDL, указатель на элемент списка идентификаторов). Для того, чтобы получить PIDL специальной папки, вы должны использовать функцию SHGetSpecialFolder. Физическое месторасположение соответствующей директории можно получить, передавая PIDL в качестве входного параметра функции GetPathFromIDList. Если папка является частью файловой системы, функция возвращает путь к ней в виде строки (которая впоследствии может использоваться как InitialDir). Но если вы хотите использовать OpenDialog только с виртуальными папками (например, с 'my computer'), то в принципе вы должны использовать PIDL как InitialDir, но это работать не будет. Я думаю дело в том, что TOpenDialog использует PIDLs только для просмотра, а для InitialDir требуются только реальные (физические) каталоги.
Вот пример, показывающий как получить путь к 'recent documents' (последние документы) и использовать его в качестве InitialDir:
|
procedure TForm1.Button1Click(Sender: TObject); var PIDL: Pointer; Path: LPSTR; const CSIDL_RECENT = $0008; begin Path := StrAlloc(MAX_PATH); SHGetSpecialFolderLocation(Handle, CSIDL_RECENT, @PIDL); if SHGetPathFromIDList(PIDL, Path) then // возвращает False если папка не является частью файловой системы begin OpenDialog1.InitialDir := Path; OpenDialog1.Execute; end; StrDispose(Path); end; |
Я думаю вам необходимо создать класс-оболочку для этих вызовов API. Они располагаются в shell32.dll. Наилучший совет, который я могу дать при изучении этого вопроса - копнуть поглубже файл ShlObj.h. Я также не программирую в C, но почерпнул оттуда немало ценной информации.
Вот некоторые константы, которые вам могут понадобиться:
| CSIDL_DESKTOP = $0000; CSIDL_PROGRAMS = $0002; CSIDL_CONTROLS = $0003; CSIDL_PRINTERS = $0004; CSIDL_PERSONAL = $0005; CSIDL_STARTUP = $0007; CSIDL_RECENT = $0008; CSIDL_SENDTO = $0009; CSIDL_BITBUCKET = $000a; CSIDL_STARTMENU = $000b; CSIDL_DESKTOPDIRECTORY = $0010; CSIDL_DRIVES = $0011; // Мой компьютер CSIDL_NETWORK = $0012; CSIDL_NETHOOD = $0013; CSIDL_FONTS = $0014; CSIDL_TEMPLATES = $0015; |
[000280]
Разбиение и сборка файла
Не так сложно, вот как это может выглядеть:
|
inf: file;
outf: file;
size: longint;
outsize: longint;
amt: word;
amtRead: word;
assignfile (inf, 'входной файл'); reset (inf, 1); size := fileSize (inf); repeat showMessage ('Вставьте дискету в дисковод "A"') { или "B", а лучше позвольте их определять } assignFile (outf, 'A: выходной файл'); rewrite (outf, 1); outsize := diskFree (1); { или 2, если это дисковод "B" } while (outsize > 0) and (size > 0) do begin amt := sizeof(buf); if amt > outsize then amt := outsize; blockRead (inf, buf, amt, amtRead); blockWrite (outf, buf, amtRead); dec (outSize, amtRead); dec (size, amtRead); end; closeFile (outf); until size <= 0; closeFile (inf); |
Писалось все "от руки", поэтому синтаксис может быть с ошибками. Правильным было бы добавление кода, который позволит пользователю определить используемый дисковод ("A" или "B"), задание именной схемы для восстановления информации, если один из дисков испортится и пр.
Сборка происходит аналогично: открываем на диске выходной файл, просим пользователя вставить дискетту, blockRead/blockWrite с дискеты на жесткий диск, просим пользователя вставить другую дискету, пока куски файла не считаются полностью. [001684]
Readln для более чем 255 символов
Как мне воспользоваться функцией readln(), если файл содержит строки с более чем 255 символами?
ReadLn акцептует массив символов array [0..something] of Char и использует его в качестве буфера для чтения символов, замыкая цепочку терминирующим нулем. Единственное ограничение: компилятор должен иметь возможность вычисления размера буфера во время компиляции, что делает невозможным объявление переменой типа PChar и ее распределение во время выполнения программы.
Обходной путь:
|
Type
{используем самое большое количество символов в строке, с которым вы можете иметь дело}
TLine = Array [0..1024] of Char;
PLine = ^TLine; Var pBuf: PLine; ... New( pBuf ); ... ReadLn( F, pBuf^ ); |
Для передачи pBuf функциям, которым требуется параметр типа Pchar, используйте приведение типа подобно PChar( pBuf ).
Примечание: вы, конечно, можете использовать объявление переменной типа TLine или непосредственно массив символов, но я предпочитаю распределять из кучи нечто большее, чем 4 байта...
[000838]
Рекурсивное удаление файлов и подкаталогов
|
{ Здесь я привожу немного сокращенный код, который я создавал для Borland Pascal 5.5 под DOS (оригинальный код не делал rmDir, поэтому вы можете поэкспериментировать с этим, передав указатель на каталог функции rmDir в конце этого кода). Я подозреваю, что Delphi-версия может быть или идентичной, или иметь некоторые различии в написании имен функций (рекомендую ознакомиться с электронной документацией по Delphi, с темой, где описаны функции для работы с файлами). Данный код не предусматривает проверку атрибутов файлов, которые могут быть установлены для предотвращения удаления файла. (В Pascal 5.5 вам необходимо между парой {$I-} {$I+} поместить функцию, которая вызывает проблему, не знаю, делаете ли вы это в Delphi.) } procedure removeTree (DirName: string); var FileSearch: SearchRec; begin { для начала пробегаемся, и удаляем все файлы } chDir (DirName); FindFirst ('*.*', Directory, FileSearch); while (DosError = 0) do begin if (FileSearch.name <> '.') AND (FileSearch.name <> '..') AND ( (FileSearch.attr AND Directory) <> 0) then begin if DirName[length(DirName)] = '\' then removeTree (DirName+FileSearch.Name) else removeTree (DirName+'\'+FileSearch.Name); ChDir (DirName); end; FindNext (FileSearch) end; { затем пробегаемся, и удаляем все каталоги } FindFirst ('*.*', AnyFile, FileSearch); while (DosError = 0) do begin if (FileSearch.name <> '.') AND (FileSearch.name <> '..') then Remove (workdir); end; FindNext (FileSearch) end; rmDir (DirName) end; |
[001705]
Слияние двух бинарных файлов
Самым простым способом является открытие первого, перемещение в его конец, и копирование с этого места второго файла.
|
Var f1, f2 : File; xfer : Word; buf : PChar; Begin AssignFile(f1, name1); Reset(f1); Seek(f1, Filesize(f1)); AssignFile(f2, name2); Reset(f2); GetMem(buf, 65000); Repeat BlockRead(f1, buf^, 65000, xfer); BlockWrite(f2, buf^, xfer); Until xfer < 65000; CloseFile(f1); CloseFile(f2); End; |
[001675]
Сохранение в файле пятисот символов из массива
Следующий код может помочь вам начать.
|
Type TCharArray = Array[500] of Char; Procedure WriteToFile(Var aArray : TCharArray; sFileName : String); {Примечание: Объявление массива как параметр Var позволяет передавать только ссылку на массив, а не копировать его целиком в стек, если же вам нужна безопасная работа с массивом,} то вам не следует передавать его как Var-параметр.} Var nArrayIndex : Word; fFileHandle : TextFile; Begin AssignFile(fFileHandle, sFileName); Rewrite(fFileHandle); For nArrayIndex := 1 to 500 Do Begin Write(fFileHandle, aArray[nArrayIndex]); End; CloseFile(fFileHandle); End; {end Procedure, WriteToFile()} |
[001707]
Удаление непустого каталога
Пришло письмо от читателя:
Здравствуйте
Вот, понадобилась мне процедурка удаления непустого каталога. Нашел, не помню где. Включил в програму, работала, пока не стал использовать длинные имена каталогов (без пробелов, кстати). NT стала операцию выполнять, но криво (возбуждала исключение). Окончательно:
|
procedure TForm1.deletedirectory(dir:string); var sh:SHFILEOPSTRUCT; st:string; sr:tsearchrec; pst:pchar; begin if findfirst(dir,faDirectory,sr)=0 then begin //added by me dir:=longtoshortfilename(dir); //original code sh.Wnd:= Form1.handle; sh.wFunc:= FO_DELETE; Pst:=StrAlloc(Length(dir{sr.Name})+1); StrPLCopy(Pst,dir{sr.Name},Length(dir{sr.Name})+1); sh.pFrom:=pst; sh.pTo:= Nil; sh.fFlags:= FOF_NOCONFIRMATION or FOF_SILENT; sh.hNameMappings:= Nil; sh.lpszProgressTitle:= Nil; SHFileOperation(sh); StrDispose(Pst); end; findclose(sr); end; |
С уважением, Александр Рабцевич [000744]
Управление атрибутом файла date/time
"Могу ли я написать функцию, которая устанавливает дату одного файла, равную дате другого файла?"
Не проблема. Используйте следующую функцию, использующую в качестве параметров две строки с полными путями/именами файлов DOS. Файл, дату которого вы хотите установить идет вторым параметром, файл, чью дату вы хотите использовать - первым.
|
procedure CopyFileDate(const Source, Dest: String); var SourceHand, DestHand: word; begin SourceHand := FileOpen(Source, fmOutput); { открываем исходный файл } DestHand := FileOpen(Dest, fmInput); { открываем целевой файл } FileSetDate(DestHand, FileGetDate(SourceHand)); { получаем/устанавливаем дату } FileClose(SourceHand); { закрываем исходный файл } FileClose(DestHand); { закрываем целевой файл } end; |
[000534]
Управление каталогами и файлами
|
unit win95; { Копирование, перемещение и удаление файлов и каталогов наподобие Проводника (Explorer) в Windows 95. Дата : 06/04/97 Последнее обновление: 03/08/97 Просьба сообщать о всех найденных ошибках и недочетах на мой адрес электронной почты. Приветствуются пожелания и предложения по улучшению функциональности!!! ОБНОВЛЕНИЯ: (18/04/97) Множество небольших поправок после множества ваших писем. Спасибо всем. (31/08/97) Две новых процедуры: Win95AddToRecent и Win95ClearRecentDocs. } interface Uses Classes, ShellApi, ShlObj, Registry, Windows; type Str10 = String[10]; Const fpRootKey ='\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders'; fpDesktop : Str10 = 'DESKTOP'; fpFavorites : Str10 = 'FAVORITES'; fpFonts : Str10 = 'FONTS'; fpPersonal : Str10 = 'PERSONAL'; fpPrograms : Str10 = 'PROGRAMS'; fpRecent : Str10 = 'RECENT'; fpSendTo : Str10 = 'SENDTO'; fpStartMenu : Str10 = 'START MENU'; fpStartup : Str10 = 'STARTUP'; fpTemplates : Str10 = 'TEMPLATES'; {Пути к системным папкам} function GetFolderPath(Const FolderName: Str10): String; {Функции для работы с файлами} procedure Win95AddToRecentDocs(Const Filename: string); procedure Win95ClearRecentDocs; {Для манипулирования несколькими файлами разделите их имена символом "#0"} function Win95Copy(Owner: Integer; FromFile,ToFile: String; RenameOnCollision, Confirm: boolean): Boolean; function Win95Move(Owner: Integer; FromFile,ToFile: String; RenameOnCollision, Confirm: boolean): Boolean; {Если SendToRecycleBin = True, то файлы будут отправлены в Корзину (RecycleBin), в противном случае они будут стерты} function Win95Erase(Owner: Integer; WichFiles: String; SendToRecycleBin, Confirm: Boolean): Boolean; implementation function GetFolderPath(Const FolderName: Str10): String; begin with TRegistry.Create do Try RootKey:=HKEY_CURRENT_USER; OpenKey(fpRootKey,False); Result:=ReadString(FolderName); finally Free; end; end; procedure Win95AddToRecentDocs(Const Filename: string); begin SHAddToRecentDocs(SHARD_PATH, @Filename[1]); end; procedure Win95ClearRecentDocs; begin SHAddToRecentDocs(SHARD_PATH, nil); end; function Win95Copy(Owner: Integer; FromFile,ToFile: String; RenameOnCollision, Confirm: boolean): Boolean; const Aborted: Boolean = False; var Struct : TSHFileOpStructA; begin While pos(';',FromFile)>0 do FromFile[pos(';',FromFile)]:=#0; While pos(';',ToFile)>0 do ToFile[pos(';',ToFile)]:=#0; FromFile:=FromFile+#0#0; ToFile:=ToFile+#0#0; with Struct do begin wnd :=Owner; wFunc :=FO_Copy; pFrom :=PChar(FromFile); pTo :=PChar(ToFile); fFlags:=FOF_ALLOWUNDO or FOF_FILESONLY; If RenameOnCollision then fFLags:=fFlags or FOF_RENAMEONCOLLISION; If not Confirm then fFLags:=fFlags or FOF_NOCONFIRMATION; fAnyOperationsAborted:=Aborted; hNameMappings:=nil; lpszProgressTitle:=nil; end; result:=(SHFileOperationA(Struct)=0) and (not Aborted); end; function Win95Move(Owner: Integer; FromFile,ToFile: String; RenameOnCollision, Confirm: boolean): Boolean; const Aborted: Boolean = False; var Struct : TSHFileOpStructA; begin While pos(';',FromFile)>0 do FromFile[pos(';',FromFile)]:=#0; While pos(';',ToFile)>0 do ToFile[pos(';',ToFile)]:=#0; FromFile:=FromFile+#0#0; ToFile:=ToFile+#0#0; with Struct do begin wnd :=Owner; wFunc :=FO_Move; pFrom :=PChar(FromFile); pTo :=PChar(ToFile); fFlags:=FOF_ALLOWUNDO or FOF_FILESONLY; If RenameOnCollision then fFLags:=fFlags or FOF_RENAMEONCOLLISION; If Confirm then fFLags:=fFlags or FOF_NOCONFIRMATION; fAnyOperationsAborted:=Aborted; hNameMappings:=nil; lpszProgressTitle:=nil; end; result:=(SHFileOperationA(Struct)=0) and (not Aborted); end; function Win95Erase(Owner: Integer; WichFiles: String; SendToRecycleBin, Confirm: Boolean): Boolean; const Aborted: Boolean = False; var Struct : TSHFileOpStructA; begin While pos(';',WichFiles)>0 do WichFiles[pos(';',WichFiles)]:=#0; WichFiles:=WichFiles+#0#0; with Struct do begin wnd :=Owner; wFunc :=FO_Delete; pFrom :=PChar(WichFiles); pTo :=nil; If not Confirm then fFlags:=FOF_NOCONFIRMATION; If SendToRecycleBin then fFLags:=fFlags or FOF_ALLOWUNDO or FOF_FILESONLY else fFlags:=fFlags or 0 or FOF_FILESONLY; fAnyOperationsAborted:=Aborted; hNameMappings:=nil; lpszProgressTitle:=nil; end; result:=(SHFileOperationA(Struct)=0) and (not Aborted); end; end. |
[000268]
Установка режима бинарного файла
Попробуйте вызвать приведенную ниже процедуру немедленно после перезаписи выходного файла и перед началом записи в него:
|
procedure SetBinaryMode (var F: file); assembler;
asm mov ax,$4400 les di,F mov bx,word ptr es:[di] int $21 or dl,$20 xor dh,dh mov ax,$4401 int $21 end; |
-Steve [000603]
Установка времени и даты файла
...вы были на правильном пути, когда заговорили о функции SetFTime. Ниже несколько строчек кода, которые изменяют значения даты & времени файла:
|
var f: file; begin Assign(f, DirInfo.Name); Reset(f); SetFTime(f, Time); Close(f); end; |
[001710]
Установка времени компиляции программы в диалоговом окне "О программе".
Я подразумаваю, что проблема состоит в получении времени компиляции?
|
Var F : Integer; S : String; Begin F:=FileOpen(ExpandFileName(Application.ExeName), 0); S:=TimeToStr(FileDateToDateTime(FileGetDate(F))); FileClose(F); End; |
Взгляните на описание функции DateTime... в файле помощи. Вероятно, существует лучший способ получения времени без использования функции FileOpen.
Также можно использовать время файла (File Time) в качестве номера версии, так, время 6:02 обозначало бы версию 6.02, и устанавливать его чем-то типа Touch. [001712]
Вопросы разделяемого доступа к файлу
А вы пробовали использовать блок try ... except?
Недавно я решал аналогичную задачу.
Код на основе приведенного ниже скелета отлично справлятеся с поставленной задачей...
|
try {здесь размещается код работы с открытым файлом} ... except {здесь располагается код обработки исключений} {что-то типа MessageDlg('Не могу открыть файл', mtError, [mbOk], 0) или что-либо получше :) } ... end; |
Для EXE & COM файлов может использоваться так называемый сетевой Shareable-атрибут, который позволяет нескольким пользователям выполнять один файл. Для текстовых файлов это не работает.
Единственный метод должен проверять наличие атрибута DOS "READ-ONLY" (только для чтения). Множество DOS & Windows программ устанавливают этот флаг после того, как они откроют файл, чтобы таким образом предотвратить к нему доступ из других программ. В качестве альтернативы, можно проверять атрибут файла NETWARE "READ-ONLY". Проверку можно организовать с помощью компонентов NETWARE API, обеспечивающими работу с сетевыми функциями. Если ваша программа находит одно из этих двух условий истинным, следует подождать некоторое время, и проверить его снова, прежде чем пытаться получить доступ к файлу. [001682]
Восстанавление длинных имен файлов по известным коротким
boris советует:
|
//--------------------------------------------------------------------- // Восстанавливает длинные имена файлов по известным коротким (8.3) // В качестве аргумента принимает полный или неполный (в т.ч. относительный) // путь к файлу, например 'C:\WINDOWS\РАБОЧИ~1\ИТАКДА~1.LNK' или // '..\..\COMMON~1\BORLAN~1\BDE\BDEREA~1.TXT'. Понимает сетевые имена. // Возвращает полный(!) путь типа 'C:\Windows\Рабочий стол\и так далее.lnk', // 'C:\Program Files\Common Files\Borland Shared\BDE\bdereadme.txt', // '\\Computer\resource\Folder with long name\File with long name.ext' //--------------------------------------------------------------------- Function RestoreLongName(fn: string): string; function LookupLongName(const filename: string): string; var sr: TSearchRec; begin if FindFirst(filename, faAnyFile, sr)=0 then Result:=sr.Name else Result:=ExtractFileName(filename); SysUtils.FindClose(sr); end; function GetNextFN: string; var i: integer; begin Result:=''; if Pos('\\', fn)=1 then begin Result:='\\'; fn:=Copy(fn, 3, length(fn)-2); i:=Pos('\', fn); if i<>0 then begin Result:=Result+Copy(fn,1,i); fn:=Copy(fn, i+1, length(fn)-i); end; end; i:=Pos('\', fn); if i<>0 then begin Result:=Result+Copy(fn,1,i-1); fn:=Copy(fn, i+1, length(fn)-i); end else begin Result:=Result+fn; fn:=''; end; end; Var name: string; Begin fn:=ExpandFileName(fn); Result:=GetNextFN; Repeat name:=GetNextFN; Result:=Result+'\'+LookupLongName(Result+'\'+name); Until length(fn)=0; End; |
[001034]
Запись и чтение из файла массива записей
Это не очень Delphi-подобно (тем не менее, работа происходит с действительно паскалевскими записями), но вы можете писать и читать записи из/в файл, используя паскалевские процедуры для работы с файлами:
|
type TMyRec = record ; Field1 : integer ; Field2 : string ; end ; TMyRecArray = array [0..9] of TMyRec ; var MyArray : TMyRecArray ; MyRec : TMyRec ; RecFile : file of TMyRec ; begin {...здесь должен быть расположен код инициализации MyArray...} AssignFile( RecFile, 'MYREC.FIL' ) ; ReWrite( RecFile ) ; for i := 0 to 9 do begin Write( RecFile, MyRec[i] ) ; end ; CloseFile( RecFile ) ; |
Также, вы можете использовать Read() для чтения записи из вашего файла, и Seek() для перемещения на его конкретную запись (начиная с 0). Для получения дополнительной информации обратитесь к разделу "I/O Routines" электронной справки по Delphi.
Если вы хотите делать это с Data Aware компонентами (компонентами для работы с базами данных), вы должны создать базу данных, где база данных "records" должна отражать структуру ваших паскалевских записей, при этом необходимо создать механизмы трансляции данных из одной среды в другую. Я не готов сейчас сказать вам, как это можно сделать, но, во всяком случае, всю функциональность можно инкапсулировать в отдельном специализированном компоненте. [001721]
THeader как сплиттер
Компонент THeader может работать в качестве сплиттера. Для этого вы должны связать события OnSize с другими элементами управления, расположенными на форме. Если у вас есть исходный код компонента, вы можете это проверить. У него есть все необходимые для этого характеристики типа событий на перемещение мыши и т.п.
[000399]
Использование файла помощи
Вот код для трех стандартных пунктов меню "Help":
|
procedure TForm1.Contents1Click(Sender: TObject);
begin
Application.HelpCommand(HELP_CONTENTS, 0);
end;
procedure TForm1.SearchforHelpOn1Click(Sender: TObject); begin Application.HelpCommand(HELP_PARTIALKEY, 0); end; procedure TForm1.HowtoUseHelp1Click(Sender: TObject); begin Application.HelpCommand(HELP_HELPONHELP, 0); end; |
- Neil [000770]
Как мне привязать файлы помощи в Delphi 3?
Вот как это делаю я:
Сначала создайте файл помощи. Откройте меню "Project/Options...", щелкните на закладке "Application" и введите путь к файлу помощи в строке "Help File". Или же вы можете сделать это непосредственно во время выполнения приложения, указав соответственное значение свойству Application.HelpFile. Затем вам необходимо присвоить значения свойству "HelpContext" у необходимых элементов управления. В нашем случае необходимо задать значение свойству "HelpContext" у кнопки "Help", обычно расположенной на вспомогательных окнах или диалогах. Наконец, в обработчике события нажатия на кнопку вызовите метод Application.HelpContext. Для нашей кнопки "Help" обработчик события OnClick мог бы выглядеть примерно так:
| procedure TForm1.btnHelpClick(Sender: TObject); begin Application.HelpContext(TButton(Sender).HelpContext); end; |
Это все!
Вы также можете вызывать другие методы Application для вывода файлов помощи, такие, как Application.HelpCommand и Application.HelpJump.
[000128]
Как сделать так, чтобы в приложении вызывался хелп с окошечком для поиска раздела?
Nomadic советует:
|
unit {$IFDEF WIN32} Windows {$ELSE} WinProcs {$ENDIF}; function WinHelp(Wnd: HWnd; HelpFile: PChar; Command: Word; Data: LongInt): Bool; |
Здесь цитата из WinAPI Help: HELP_CONTEXTPOPUP An unsigned long integer containing the context number for a topic. Displays in a pop-up window a particular Help topic identified by a context number that has been defined in the [MAP] section of the .HPJ file. То же самое, что делает макрос "Search()" для WinHelp-а.
|
procedure TForm1.HelpSearchFor; var S: String; begin S := ''; Application.HelpFile := 'C:\MYAPPPATH\MYHELP.HLP'; Application.HelpCommand( HELP_PARTIALKEY, LongInt( @S ) ); end; |
[001206]
Как заставить Help-файлы нормально отображать русский текст под Windows 3.x?
Nomadic советует:
Удалось вылечить дописыванием в файл пpоекта в гpафу Options стpочки FORCEFONT=Arial Cyr, пpичем HC31 pугается что нет такого шpифта, но зато хелп потом ноpмально показывается пpактически под любой pуссифициpованной виндой.
Пpовеpял с [Win31+CyrWin], [Win311Rus], [Win95PE], [Win95Rus].
На NT не пpовеpял.
Пpичем шpифты в тексте ноpмально пеpеключаются и будут не только Arial.
Вот кусок котоpый надо вставить в HPJ файл пеpед компиляцией - [OPTIONS] FORCEFONT=Arial Cyr [001208]
Не могу открыть файл помощи...
Я создал файл помощи для моего приложения и назвал его KidsHelp.hlp
При запуске в системе, в которой файл был создан, программа находит его без проблем. Данная машина имеет конфигурацию Pentium 120 с установленной Windows 95. При запуске программы на второй системе, с Windows 3.1, при выборе пункта меню "Using Help" программа не может открыть файл. Я создал файл помощи с помощью программы "HC31.exe". В самом проекте я не указывал полный путь к файлу помощи, я указал только его имя.
Для решения этой проблемы я делаю две вещи: Всегда располагаю файл помощи в том же каталоге, что и приложение Назначаю файл помощи в обработчике события главной формы OnCreate таким образом:
| Application.HelpFile := ChangeFileExt(Application.ExeName, '.HLP'); |
- Neil Rubenking [001101]
Оглавление файлов помощи (Help Files Contents)
Используйте HELP_FINDER, если "текущая закладка" не является закладкой 'Index' или 'Find'. HELP_FINDER открывает окно Help Topics, но не меняет закладку с оглавлением (Contents), если текущая закладка - 'Index' или 'Find'.
Попробуйте следующий код:
|
Function L1InvokeHelpMacro(const i_strMacro: String; const i_bForceFile: Boolean): Boolean; Begin if i_bForceFile then Application.HelpCommand(HELP_FORCEFILE, 0); Result:=Application.HelpCommand(HELP_COMMAND, Longint(PChar(i_strMacro))); //Приведение типа PChar здесь необязательно. End; |
Ищем ассоциированный файл помощи, открываем его (если не открыт) и переходим на закладку 'Index':
| L1InvokeHelpMacro('Search()', True); |
Ищем ассоциированный файл помощи, открываем его (если не открыт) и переходим на закладку 'Contents':
| L1InvokeHelpMacro('Contents()', True); |
Ищем ассоциированный файл помощи, открываем его (если не открыт) и переходим на закладку 'Find' (только для WinHelp 4):
| L1InvokeHelpMacro('Find()', True); |
[000127]
Показ диалога "Help Search" I
| Application.HelpCommand(HELP_PARTIALKEY, 0); |
Если данная команда не находит идентификатор #0 файла помощи (естественно, мы его и задаем), то она выводит диалог "Help Search". [000524]
Показ диалога "Help Search" II
Следующий код демонстрирует способ вывода диалога WinHelp "Search" для электронной справки вашего приложения. Для этого следует послать системе электронной справки Windows (WinHelp) команду Help_PartialKey, что можно сделать с помощью метода объекта TApplication HelpCommand. Параметр для этой команды должен иметь тип PChar (можно привести к longint) и содержать строку, которую вам необходимо найти. Пример ниже использует для вызова диалога "Search" пустую строку, которую освобождает после его закрытия.
|
procedure TForm1.SearchHelp; var P: PChar; begin Application.HelpFile := 'c:\delphi\bin\delphi.hlp'; P := StrNew(''); Application.HelpCommand(Help_PartialKey, longint(P)); StrDispose(P); end; |
[000590]
Закрытие файла помощи
При закрытии моего приложения окно помощи (если оно в это время открыто) автоматически не закрывается! Как мне сделать так, чтобы оно также закрывалось автоматически?
Попробуйте так:
| Application.HelpCommand(HELP_QUIT, 0); |
- Nick Hodges [000879]
Delphi
| Сайты, посвященные DelphiАнглоязычные
|
| N | Сервер | Описание |
| 1 | http://sunsite.icm.edu.pl/delphi Delphi Super Page |
Самая большая в мире коллекция компонентов для всех продуктов фирмы Borland. |
Download
Рассылка
| B |
Вам необходимо:
| O |
и нажмите на соответствующую ссылку.
Home
| Домашние страницыРусскоязычные
|
| N | Сервер | Описание |
| 1 | http://www.ph.usmga.ru/lexa Delphi Russian Suite |
Сайт, посвященный программированию на Дельфи. Автор страницы Алексей Спицын. Можно скачать документацию по Дельфи (в том числе и на русском языке). Есть список ссылок на страницы в интернете, посвященные Дельфи, а также на адреса электронных версий компьютерных журналов. |
анный раздел содержит справочную информацию.
BODY {font-family:verdana,helvetica,georgia,sans-serif; color:#000; font-size=10pt} A:link, A:visited {text-decoration: none; color: #0000FF;} A:hover {text-decoration: underline; color: #FF0000;} HR {width=10%; color=red; text-align: left} Индексы
| Д |
| Д |
| [ Алгоритмы ][ Преобразования ] |
| [000001] HEX -> Integer [000002] Преобразование десятичного числа в шестнадцатиричное [000003] Преобразование ASCII в шестнадцатиричное представление [000004] Преобразование двоичного числа в десятичное [000005] Преобразование ICO в BMP [000006] Unix-строки (чтение и запись Unix-файлов) [000007] Преобразование BMP в JPEG в Delphi 3 [000008] Декомпилляция звукового файла формата Wave и получение звуковых данных |
| [ Алгоритмы ][ Даты ] |
| [000009] Вычисление даты Пасхи [000010] Дни недели [000011] Формат даты [000012] Функция DateSer |
| [ Алгоритмы ][ Разное ] |
| [000013] Ханойская башня [000014] Аглоритм (уравнение) для определения восхода/захода солнца и луны (BASIC) [000015] Автоматический формат даты в компоненте Edit |
| [ Win API ][ Переменные среды ] |
| [000016] Получение переменных DOS [000017] Изменение системного времени из Delphi |
| [ Win API ][ Завершение работы Windows ] |
| [000018] События, происходящие в приложениях Delphi при завершении работы Windows [000019] Завершение работы Windows |
| [ Win API ][ Режим энергосбережения (Power saving) ] |
| [000020] Управление монитором |
| [ Win API ][ Разное ] |
| [000021] Извлечение из EXE-файла иконки и рисование ее в TImage [000022] Как не допустить запуск второй копии программы? [000023] Получение имени модуля [000024] Каким образом, программным путем, можно узнать о завершении запущенной программы? |
| [ Паскаль ][ Массивы ] |
| [000025] Массив в Delphi [000026] Динамические массивы |
| [ Базы данных ][ Создание ] |
| [000027] Создание db-файла во время работы приложения |
| [ Базы данных ][ Доступ ] |
| [000028] Очень медленный доступ к таблице при первом обращении |
| [ Базы данных ][ Поиск ] |
| [000029] Поиск величины при вводе [000030] Быстрый поиск в базах данных |
| [ Базы данных ][ Калькуляция ] |
| [000031] Хитрость OnCalcFields |
| [ Базы данных ][ dBASE ] |
| [000063] Таблицы dBASE: Структура .DBF-файла |
| [ Базы данных ][ Разное ] |
| [000032] Сканирование версии структуры базы данных [000033] Перемещение таблиц [000034] Прокрутка таблицы: хитрость PeekMessage() |
| [ BDE ][ Псевдонимы ] |
| [000035] Задание псевдонима программным путем [000036] Информация о псевдонимах BDE |
| [ Мультимедиа ][ Аудио-компакт ] |
| [000037] Получение идентификатора диска |
| [ Аппаратное обеспечение ][ CD-ROM ] |
| [000038] Открытие и закрытие привода CD-ROM |
| [ Операционная система ][ Буфер обмена ] |
| [000039] Просмотр буфера обмена [000040] Копирование в буфер обмена [000041] Форма как графический объект |
| [ Компоненты ][ BitBtn ] |
| [000042] Смена иконки BitBtn во время работы приложения |
| [ Компоненты ][ DBGrid ] |
| [000064] Использование опции MultiSelect в DBGRID |
| [ Компоненты ][ Edit ] |
| [000043] Массив Edit-компонентов |
| [ Компоненты ][ Label ] |
| [000044] 3D-рамка для текстовых компонентов |
| [ Компоненты ][ ScrollBox ] |
| [000045] Синхронизация двух компонентов Scrollbox |
| [ Компоненты ][ Splitter ] |
| [000046] Конструирование Splitter |
| [ Компоненты ][ StatusBar ] |
| [000047] Обработчик события OwnerDraw в компоненте StatusBar |
| [ Компоненты ][ StringGrid ] |
| [000048] Установка атрибутов -=Только для чтения=- у столбцов компонента StringGrid [000049] Помещение изображения в ячейку StringGrid [000050] Сохранение и чтение Tstringgrid |
| [ Компоненты ][ TabbedNotebook ] |
| [000051] Добавление элементов управления в TTabbedNotebook и TNotebook [000052] Недоступная закладка в компоненте Tabbednotebook |
| [ Компоненты ][ Table ] |
| [000053] Создание компонента TTable без формы |
| [ Компоненты ][ TreeView ] |
| [000054] Ускорение работы TreeView |
| [ Компоненты ][ Разное ] |
| [000055] Массив компонентов... [000056] Получение индекса компонента в списке родителя [000057] Создание компонента во время работы приложения [000058] Дублирование компонентов и их потомков во время выполнения приложения |
| [ События ][ Создание ] |
| [000059] Создание события во время выполнения приложения |
| [ События ][ Задержка выполнения ] |
| [000060] Задержка выполнения OnChange (Delphi 2) |
| [ Миграция ][ Delphi3 ] |
| [000061] Получение констант с определением ошибки функцией LoadStr |
| [ Ошибки ][ Delphi2 ] |
| [000062] Ошибка в руководстве "Getting Started" на странице 42 |
Inprise
| Разработчик DelphiРусскоязычные
|
| N | Сервер | Описание |
| 1 | http://www.inprise.ru Российское представительство Inprise |
Фирма - разработчик Delphi |
Inprisea
| Разработчик DelphiАнглоязычные
|
| N | Сервер | Описание |
| 1 | http://www.inprise.com Inprise |
Фирма - разработчик Delphi |
Intro
BODY {font-family:verdana,helvetica,georgia,sans-serif; color:#000; font-size=10pt} A:link, A:visited {text-decoration: none; color: #0000FF;} A:hover {text-decoration: underline; color: #FF0000;} HR {width=10%; color=red; text-align: left} Что такое "Советы по Delphi"?
| " |
| A |
| У |
| Т |
| Ш |
Предупреждение
| Я |
| Т |
Объявление
| A |
License
Лицензионное соглашение
| И |
Предоставление лицензии
| B |
Особые условия
| Ограничение на обратное конструирование, декомпиляцию и дизассемблирование. |
| В |
| T |
| М |
Распространение
| В |
Помните
| В |
| E |
Price
| Цены
|
| Услуга | Стоимость |
| Справочная система "Советы по Delphi" | Бесплатно |
| Размещение монопольного банера на титульной странице в течение месяца | На правах обмена |
| Прием советов | Бесплатно |
Warez
| Пиратские сайтыРусскоязычные
|
| N | Сервер | Описание |
| 1 | http://delphi4.da.ru KiraSoft Warez Page |
Delphi distr, DB Aware, Communication, General, Reports, Experts, Misc, Tools, Links |
| 2 | www.audit.kharkov.com/barry/Delphi Barry's Delphi Page |
VCL's, VCL packs, Help Design, FAQ's, IB DataBase, Utilities, Forum |
Warezo
| Пиратские сайтыДругие
|
| N | Сервер | Описание |
| 1 | http://www.netease.com/~dce Delphi Components Crack (with Dr.Dai) |
Как там написано, "Following components ONLY for Delphi 3.0 ", остальное понять трудно, как и идентифицировать родной язык автора сайта, хотя по скриншотам разобраться что и где лежит вполне можно |
% Ресурсов, в режиме редактирования
Если у вас открыты все формы (показаны или минимизированы), а в редакторе кода открыты все модули, ресурсы очень быстро исчерпываются. Попробуйте закрыть все формы и модули, и открыть только те, которыми вы будете пользоваться. В противном случае при компиляции вы можете завесить Delphi и саму машину. [001432]
Активизация и использование в IDE окна CPU
Предупреждение: Окно CPU еще до конца не оттестировано и может иногда приводить к ошибкам. Если у вас есть проблемы с отладчиком, или при запуске вашей программы вы не можете им воспользоваться, окно CPU может помочь решить ваши проблемы. Обычно его не требуется включать, если только у вас не "особый случай".
В Delphi 2 эта характеристика встроена, но по умолчанию выключена, называется это окно CPU window, или DisassemblyView. Она легка в использовании, может быть полезной в отладке и сравнении кода при его оптимизации.
Для активизации этой характеристики, запустите REGEDIT и отредактируйте регистры описанным ниже образом. Найдите ключ HKEY_CURRENT_USER\Software\Borland\Delphi\2.0\Debugging. Создайте по этому пути строковый ключ с именем "ENABLECPU". Значение нового ключа должно быть строкой "1". Это все. Теперь в Delphi IDE появился новый пункт меню View|CPUWindow. При его активизации выводится новое окно.
Теперь, чтобы понять какое мощное средство оказалось в ваших руках, сделаем сравнительный анализ генерируемого кода для двух примеров, имеющих одинаковую функциональность, но достигающую ее разными путями.
Создайте 2 одинаковых обработчика события. В каждом обработчике события разместите приведенный ниже код. Установите точку прерывания на первой строчке каждого обработчика. Запустите приложение и активизируйте события. Сравните ассемблерный код обоих методов. Один короче? В этом случае он будет исполняться быстрее.
Достойными для такого рода анализа могут быть участки кода, многократно выполняемые в процессе работы программы, или критические ко времени выполнения.
Хорошим примером, где различный код выполняет одну и ту же работу, но делает это с разной скоростью, является использование конструкции "with object do". Исходный код с многократным использованием конструкции "with object do" будет длиннее, но ассемблерный код короче. Вспомните, сколько раз вы устанавливали свойства для динамически создаваемых объектов? Код:
|
with TObject.create do begin property1 := ; property2 := ; property3 := ; end; |
будет выполняться быстрее, чем
|
MyObj := TObject.create; MyObj.Property1 := ; MyObj.Property2 := ; MyObj.Property3 := ; |
[001434]
Дата компилляции
Очень удобно, когда в диалоговом окне "О программе" можно узнать номер версии программы. Было бы удобным также использование даты и времени компиляции.
Я догадываюсь, что нечто подобное вы уже пробовали сделать, но поковырявшись некоторое время с этой проблемой, я пришел к выводу, что корректней всего производить вывод данной информации при запуске программы из коммандной строки, для чего я создал файл "today.inc". Пример работы вы можете увидеть у большинства DOS-программ (вначале выводится информация о номере версии и дате компиляции).
Для этого я создал файл "today.inc", где я храню необходимую информацию о времени компиляции приложения:
|
const _day : string[10] = 'Понедельник'; _date : word = 12; _month : word = 8; _year : word = 1996; |
Затем просто вставьте строчку {$I c:\today.inc} в верхную части вашего кода.
Досадно, что компилятор не поддерживает директивы {$DATE}!
[000293]Попробуй сделать
Nomadic отвечает:
A: (AlPe): Попробуй сделать в [HKLM\Software\Microsoft\Windows NT\CurrentVersion\FontMapper] DEFAULT=0xcc (204) вместо 0x00 (Именно DEFAULT, а не (Default) :-)
получше маленько будет... [001488]
Где находится опция "Break on Exception" в Delphi 4?
Олегом Кулабухов отвечает:
Я тоже сначала искал. Нашел таки.
Tools->Debugger Options->Language Exceptions->Stop on Delphi Exceptions [001904]
IDE: шрифт по умолчанию
Если вы хотите использовать шрифт, оличный от шрифта Delphi "по умолчанию", добавьте строку типа:
DefaultFont=Arial, 9
в секцию FormDesign файла Delphi.ini. [000456]
Имитация Delphi IDE
Во-первых, необходимо проверить, загружена ли Delphi - используйте FindWindow для поиска окна с именем класса TAppBuilder. Если оно загружено, FindWindow вернет вам дескриптор. Если нет, выполняйте WinExec и снова используйте FindWindow для получения дескриптора.
Для получения доступа к главному меню Delphi используйте GetMenu. "Пробегитесь" по дереву меню до тех пор, пока не найдете желаемый пункт. После получения ID пункта меню, вы можете посылать сообщение WM_COMMAND, дающее тот же эффект, что и нажатие на этот пункт. Ниже приведен пример вышесказанного. Для его создания, расположите на новой форме панель, выровняйте ее по верху (свойство Align = alTop) и разместите на ней кнопку. Расположите на форме компонент outline и установите его свойство Align в alClient. Поместите на форме компонент OpenDialog и настройте его на открытие файлов с расширением .EXE. Затем используйте код, приведенный ниже. Данный пример запустит определенную вами программу и отобразит структуру ее меню в outline. Располагая идентификаторами пунктов (IDs) меню чужой программы (в нашем случае Delphi) в компоненте outline, вы запросто можете управлять этой программой. Или, что еще интереснее, вы можете "пробежаться" по меню, используя те же методы, и найти нужный ID во время выполнения программы. Кто знает, может новая версия Delphi будет содержать другие пункты (ID) меню.
|
...
private
{ Private declarations }
InstHandle : Word;
WndHandle : hWnd;
function EnumFunc(H : HWnd) : Word;
...
implementation
USES ShellApi; {$R *.DFM} function TForm1.EnumFunc(H : HWnd) : Word; BEGIN IF GetWindowWord(H, GWW_HINSTANCE) = InstHandle THEN BEGIN WndHandle := H; Result := 0; END ELSE Result := 1; END; procedure TForm1.Button1Click(Sender: TObject); VAR Cmd : ARRAY[0..255] OF Char; procedure AddChildMenus(Loc, Han : Integer); VAR MText : ARRAY[0..255] OF Char; N : Integer; ID : Word; NuLoc : Integer; BEGIN FOR N := 0 TO GetMenuItemCount(Han)-1 DO BEGIN Id := GetMenuItemID(Han, N); GetMenuString(Han, N, MText, 255, MF_BYPOSITION); IF ID = $FFFF THEN BEGIN NuLoc := Outline1.AddChild(Loc, StrPas(MText)); AddChildMenus(NuLoc, GetSubMenu(Han, N)); END ELSE Outline1.AddChild(Loc, StrPas(MText) + ' {' + IntToStr(Id) +'}'); END; END; begin WITH OpenDialog1 DO IF Execute THEN BEGIN StrPCopy(Cmd, Filename); InstHandle := WinExec(Cmd, SW_SHOW); WndHandle := 0; IF InstHandle >= 32 THEN EnumWindows(@TForm1.EnumFunc, LongInt(Self)); IF WndHandle <> 0 THEN BEGIN SetWindowText(WndHandle, 'Title changed by KNOWEXEC'); Outline1.Clear; Outline1.Add(0, 'menu'); AddChildMenus(1, GetMenu(WndHandle)); END; END; end; |
[000650]
Использование Tools Interface
...я все еще ищу *крутой* способ отрисовки содержимого окна редактирования IDE, и уже добрался до списка дескрипторов окон. Я так понял, что для этого нужно использовать инструментальный интерфейс (Tools Interface), только c помощью него, да? Ну и как этим чудом воспользоваться?
Приведенный ниже код может использоваться для включения заголовка исходного кода, представляющего собой шапку с информацией об авторских правах, авторе, версии и пр. при добавлении нового модуля или формы к вашему проекту. TIAddInNotifier - класс, реализованный в ToolIntf и позволяющий "захватывать" такие события, как открытие файлов, их закрытие, открытие и закрытие проекта и др. Я перекрыл процедуру FileNotification для захвата событий AddedToProject и RemovedFromProject. В обработчике события AddedToProject вы можете получить доступ к новому модулю проекта, особенно это касается процедуры InsertHeader. Я создал наследника класса TIEditorInterface, расположенного в файле EditIntf.pas, и создал собственную процедуру InsertHeader.
VCSNotifier создается в другом модуле и здесь не показан. Приведенный ниже код является частью моей программы, осуществляющей контроль версий dll. При создании код "живет" до тех пор, пока работает Delphi. При получении кода AddedToProject, я проверяю наличие файла (должен быть новым), и что он является .pas-файлом. Затем я создаю VCSEditorInterface, мой унаследованный интерфейс, и использую мою процедуру InsertHeader.
В самой процедуре InsertHeader я создаю экземпляр TIEditReader для чтения нового модуля и TIEditWriter для его изменения.
|
unit VCSNtfy; interface uses SysUtils, Dialogs, Controls, ToolIntf, EditIntf; type TIVCSNotifier = class( TIAddInNotifier ) public procedure FileNotification(NotifyCode: TFileNotification; const FileName: string; var Cancel: Boolean ); override; end; TIVCSEditorInterface = class( TIEditorInterface ) public procedure InsertHeader; end; var VCSNotifier : TIVCSNotifier; VCSModuleInterface : TIModuleInterface; VCSEditorInterface : TIVCSEditorInterface; implementation uses FITIntf, FITStr, Classes; { ************************* Начало VCSNotifier **************************** } procedure TIVCSNotifier.FileNotification( NotifyCode: TFileNotification; const FileName: string; var Cancel : Boolean ); var TmpFileName : string; begin case NotifyCode of fnRemovedFromProject: VCSProject.Remove( LowerCase( ExtractFileName( FileName ))); fnAddedToProject: begin if ( not FileExists( FileName ) ) and ( ExtractFileExt( FileName ) = '.pas' ) then begin { новый файл с исходным кодом } VCSModuleInterface := ToolServices.GetModuleInterface( FileName ); if VCSModuleInterface <> nil then begin VCSEditorInterface := TIVCSEditorInterface( VCSModuleInterface.GetEditorInterface ); VCSEditorInterface.InsertHeader; VCSEditorInterface.Free; end; VCSModuleInterface.Free; end; TmpFileName := LowerCase( ExtractFileName( FileName )); if VCSProject.RecycleExists( TmpFileName ) then begin if MessageDlg( 'Вы хотите извлечь текущие ' + ' записи из таблицы Recycle' + #13 + #10 + ' ' + VCSProject.ProjectName + '/' + TmpFileName + '?', mtConfirmation, [mbYes,mbNo], 0 ) = mrYes then begin VCSProject.Recycle( TmpFileName ); end; end; end; end; end; { ************************* Конец TIVCSNotifier *************************** } { ********************* Начало TIVCSEditorInterface ************************ } procedure TIVCSEditorInterface.InsertHeader; var Module, TmpFileName, UnitName, InsertText, Tmp : string; Reader : TIEditReader; Writer : TIEditWriter; APos : Integer; F : TextFile; begin TmpFileName := ExtractFileName( FileName ); UnitName := SwapStr( TmpFileName, '.pas', '' ); SetLength( Module, 255); Reader := CreateReader; try Reader.GetText( 0, PChar( Module ), Length( Module )); finally Reader.Free; end; APos := Pos( 'unit ' + UnitName, Module ); if APos > 0 then begin try InsertText := ''; AssignFile( F, VCSConfig.HeaderFileLocation ); Reset( F ); while not EOF(F) do begin Readln( F, Tmp ); InsertText := InsertText + #13 + #10 + Tmp; end; CloseFile(F); InsertText := InsertText + #13 + #10; Writer := CreateWriter; try Writer.CopyTo( APos - 1 ); Writer.Insert( PChar( InsertText )); finally Writer.Free; end; except On E : EStreamError do MessageDlg( 'Не могу создать шапку', mtInformation, [mbOK], 0 ); end; end; end; { ********************* Конец TIVCSModuleInterface ************************** } end. |
- Jim Poe [001061]
Как быстро открыть файл в IDE?
Олегом Кулабухов отвечает:
Просто наведите курсор на имя файла в редакторе и нажмите Ctrl-Enter. Это действует на все *.pas и *.h, включая находящиеся в uses и include. [001876]
