И наконец-то, мой фак, содержащий вопросы, которыми я задавался сам.
Как изменить внешний вид хинтов?
Курсор мыши только в форме
Вставка ресурсов в откомпилированные файлы
Извлечение ресурсов из EXE
Как удалить дерикторию, содержащую файлы и поддиректории?
Как правильно прописать новое расширение в реестр?
Как получить активный URL из браузера
Как заменить или переместить файл, используемый другим приложением.(NT/2000)
Отслеживаем изменения файловой системы
type TCustomHint = class (THintWindow) public constructor Create(AOwner: TComponent); override; end;Примечание 1. Этот способ не поможет изменить цвет шрифта: для этого надо перекрывать метод Paint;
constructor TCustomHint.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
with Canvas.Font do //изменяем вид фонта
begin
Name := 'Times New Roman Cyr';
Style := [fsBold, fsItalic];
Size := 40;
end;
end;
procedure TForm1.FormCreate(Sender: TObject); begin HintWindowClass := TMyHint; //Устанавливаем глобальную переменную Application.ShowHint := false; // Application.FHintWindow.Free сначала освобождаем Application.ShowHint := true; // Application.FHintWindow.Create потом создаем на основе нового end;
Сохранение и выдёргивание ресурсов в DLL или EXE. Иногда возникает необходимость вшить ресурсы в исполняемый файл Вашего приложения (например чтобы предотвратить их случайное удаление пользователем, либо, чтобы защитить их от изменений). Данный пример показывает как вшить любой файл как ресурс в EXE-шнике. Совместимость: Delphi 3.x (или выше) Далее рассмотрим, как создать файл ресурсов, содержащий корию какого-либо файла. После создания такого файла его можно легко прицепить к Вашему проекту директивой {$R}. Файл ресурсов, который мы будем создавать имеет следующий формат:
+ заголовок + заголовок для нашего RCDATA ресурса + собственно данные - RCDATA ресурсВ данном примере будет показано, как сохранить в файле ресурсов только один файл, но думаю, что так же легко Вы сможете сохранить и несколько файлов. Заголовок ресурса выглядит следующим образом:
TResHeader = record
DataSize: DWORD; // размер данных
HeaderSize: DWORD; // размер этой записи
ResType: DWORD; // нижнее слово = $FFFF => ordinal
ResId: DWORD; // нижнее слово = $FFFF => ordinal
DataVersion: DWORD; // *
MemoryFlags: WORD;
LanguageId: WORD; // *
Version: DWORD; // *
Characteristics: DWORD; // *
end;
Поля помеченны звёздочкой Мы не будем использовать.
Приведённый код создаёт файл ресурсов и копирует его в данный файл:
Листинг 1:
procedure CreateResourceFile(
DataFile, ResFile: string; // имена файлов
ResID: Integer // id ресурсов
);
var
FS, RS: TFileStream;
FileHeader, ResHeader: TResHeader;
Padding: array[0..SizeOf(DWORD)-1] of Byte;
begin
{ Open input file and create resource file }
FS := TFileStream.Create( // для чтения данных из файла
DataFile, fmOpenRead);
RS := TFileStream.Create( // для записи файла ресурсов
ResFile, fmCreate);
{ Создаём заголовок файла ресурсов - все нули, за исключением
HeaderSize, ResType и ResID }
FillChar(FileHeader, SizeOf(FileHeader), #0);
FileHeader.HeaderSize := SizeOf(FileHeader);
FileHeader.ResId := $0000FFFF;
FileHeader.ResType := $0000FFFF;
{ Создаём заголовок данных для RC_DATA файла
Внимание: для создания более одного ресурса необходимо
повторить следующий процесс, используя каждый раз различные
ID ресурсов }
FillChar(ResHeader, SizeOf(ResHeader), #0);
ResHeader.HeaderSize := SizeOf(ResHeader);
// id ресурса - FFFF означает "не строка!"
ResHeader.ResId := $0000FFFF or (ResId shl 16);
// тип ресурса - RT_RCDATA (from Windows unit)
ResHeader.ResType := $0000FFFF
or (WORD(RT_RCDATA) shl 16);
// размер данных - есть размер файла
ResHeader.DataSize := FS.Size;
// Устанавливаем необходимые флаги памяти
ResHeader.MemoryFlags := $0030;
{ Записываем заголовки в файл ресурсов }
RS.WriteBuffer(FileHeader, sizeof(FileHeader));
RS.WriteBuffer(ResHeader, sizeof(ResHeader));
{ Копируем файл в ресурс }
RS.CopyFrom(FS, FS.Size);
{ Pad data out to DWORD boundary - any old
rubbish will do!}
if FS.Size mod SizeOf(DWORD) <> 0 then
RS.WriteBuffer(Padding, SizeOf(DWORD) -
FS.Size mod SizeOf(DWORD));
{ закрываем файлы }
FS.Free;
RS.Free;
end;
Данный код не совсем красив, и отсутствует обработка ошибок. Правильнее
будет создать класс, включающий в себя данный пример.
procedure ExtractToFile(Instance:THandle; ResID:Integer; ResType,
FileName:String);
var
ResStream: TResourceStream;
FileStream: TFileStream;
begin
try
ResStream := TResourceStream.CreateFromID(Instance, ResID,
pChar(ResType));
try
//if FileExists(FileName) then
//DeleteFile(pChar(FileName));
FileStream := TFileStream.Create(FileName, fmCreate);
try
FileStream.CopyFrom(ResStream, 0);
finally
FileStream.Free;
end;
finally
ResStream.Free;
end;
except
on E:Exception do
begin
DeleteFile(FileName);
raise;
end;
end;
end;
Всё, что требуется, это получить Instance exe-шника или dll (у Вашего приложения это Application.Instance или Application.Handle, для dll Вам прийдётся получить его самостоятельно :)Автор: Abdulaziz Jasser
В Delphi есть функция RemoveDir которая удаляет пустые
директории. Но как быть, если директория
содержит файлы и поддиректории?
Для этой цели была создана функция, выполняющая
те же действия, что и RemoveDir, но обладающая
большими возможностями.
Function MyRemoveDir(sDir : String) :Boolean;
var iIndex: Integer;
SearchRec : TSearchRec;
sFileName : String;
begin
Result := False;
sDir:= sDir + '\*.*';
iIndex := FindFirst(sDir, faAnyFile,SearchRec);
while iIndex = 0 do begin
sFileName := ExtractFileDir(sDir)+'\'+SearchRec.Name;
if SearchRec.Attr = faDirectory then begin
if (SearchRec.Name <>'' )and(SearchRec.Name <> '.')and(SearchRec.Name <>'..')
then
MyRemoveDir(sFileName);
end
else begin
if SearchRec.Attr <> faArchive then
FileSetAttr(sFileName, faArchive);
if NOT DeleteFile(sFileName) then
ShowMessage('Could NOT delete ' + sFileName);
end;
iIndex := FindNext(SearchRec);
end;
FindClose(SearchRec);
RemoveDir(ExtractFileDir(sDir));
Result := True;
end;
как зарегистрировать:
1)в разделе HKEY_CLASSES_ROOT
создаем ключ -
\'.расширение\'
присваиваем ему в качестве значения по умолчанию псевданим типа файла
2)далее создаём в том же разделе HKEY_CLASSES_ROOT ключ с именнем псевданима \'типа файла\'
в качестве значения по умолчанию - описание типа файла
3)далее в \'HKEY_CLASSES_ROOT\\тип файла\' создаем еще один ключ
\'DefaultIcon\'
в качестве значения по умолчанию путь к иконке для этого типа файлов
4)далее в \'HKEY_CLASSES_ROOT\\тип файла\' cоздаём еще ключ
\'shell\'
5)в \'HKEY_CLASSES_ROOT\\тип файла\\shell\'
создаём ключи
\'open\'
\'edit\'
в качестве значений по умолчанию описание действия
далее в каждом из них создаем ключ
\'command\' , а в качестве значения - имя запускаемой программы и
- \'%1\'
Пример:
[HKEY_CLASSES_ROOT\\.map]
@=\"El_Map\"
[HKEY_CLASSES_ROOT\\El_Map]
@=\"Файл электронной карты\"
[HKEY_CLASSES_ROOT\\El_Map\\DefaultIcon]
@=\"C:\\\\Program Files\\\\Constructor\\\\constructor1.exe,1\"
[HKEY_CLASSES_ROOT\\El_Map\\shell]
[HKEY_CLASSES_ROOT\\El_Map\\shell\\open]
@=\"Открыть для редактирования\"
[HKEY_CLASSES_ROOT\\El_Map\\shell\\open\\command]
@=\"C:\\\\Program Files\\\\Constructor\\\\constructor1.exe %1\"
[HKEY_CLASSES_ROOT\\El_Map\\shell\\Edit]
@=\"Снятие координат\"
[HKEY_CLASSES_ROOT\\El_Map\\shell\\Edit\\command]
@=\"C:\\\\Program Files\\\\Constructor\\\\Nav2.exe %1\"
uses windows, ddeman, ......
function Get_URL(Servicio: string): String;
var
Cliente_DDE: TDDEClientConv;
temp:PChar; //<<-------------------------This is new
begin
Result := '';
Cliente_DDE:= TDDEClientConv.Create( nil );
with Cliente_DDE do
begin
SetLink( Servicio,'WWW_GetWindowInfo');
temp := RequestData('0xFFFFFFFF');
Result := StrPas(temp);
StrDispose(temp); //<<-Предотвращаем утечку памяти
CloseLink;
end;
Cliente_DDE.Free;
end;
procedure TForm1.Button1Click(Sender);
begin
showmessage(Get_URL('Netscape'));
или
showmessage(Get_URL('IExplore'));
end;
Пример:
* Перемещение файла:
MoveFileEx('c:\winnt\system32\kernel32.dll', 'd:\winnt.bak\system32\kernel32.dll',
MOVEFILE_REPLACE_EXISTING или MOVEFILE_DELAY_UNTIL_REBOOT )
* Удаление существующего файла:
MoveFileEx('c:\winnt\system32\kernel32.dll', nil,
MOVEFILE_REPLACE_EXISTING или MOVEFILE_DELAY_UNTIL_REBOOT)