nyuuzyou/wikis huggingface dataset:
Как выделить файлы в Проводнике?

=== Как выделить файлы в Проводнике? ===
Просто открыть окно, и выделить в нём файлы|папки
Да в принципе путь то нам известен? Известен, посему делаем финт хвостом:
uses SHDocVw;
function OpenExplorerAndSelectFile(Path: String): Boolean;
 function ParceURLName(const Value: String): String;
 const
 scFilePath: array [0..7] of Char = ('f', 'i', 'l', 'e', ':', '/', '/', '/');
 begin
 if CompareMem(@scFilePath[0], @Value[1], 8) then
 begin
 Result := Copy(Value, 9, Length(Value));
 Result := StringReplace(Result, '/', '\', [rfReplaceAll]);
 Result := StringReplace(Result, '%20', ' ', [rfReplaceAll]);
 Result := IncludeTrailingBackslash(Result);
 end
 else
 Result := Value;
 end;
var
 iShellWindow: IShellWindows;
 iWB: IWebBrowserApp;
 spDisp: IDispatch;
 I: Integer;
 S, FilePath, FileName: String;
begin
 Result := FileExists(Path);
 if not Result then Exit;
 FilePath := AnsiUpperCase(ExtractFilePath(Path));
 FileName := ExtractFileName(Path);
 iShellWindow := CoShellWindows.Create;
 for I := 0 to iShellWindow.Count - 1 do
 begin
 spDisp := iShellWindow.Item(I);
 if spDisp = nil then Continue;
 spDisp.QueryInterface(IWebBrowserApp, iWB);
 if iWB <> nil then
 begin
 S := ParceURLName(iWB.LocationURL);
 if AnsiUpperCase(S) = FilePath then
 begin
 SendMessage(iWB.HWnd, WM_SYSCOMMAND, SC_CLOSE, 0);
 Break;
 end;
 end;
 end;
 ShellExecute(0, 'open', 'explorer.exe',
 PChar('/select, ' + FileName), PChar(FilePath), SW_SHOWNORMAL);
end;
procedure TForm18.Button4Click(Sender: TObject);
begin
 if not OpenExplorerAndSelectFile('c:\windows\notepad.exe') then
 ShowMessage('Файл не найден.');
end;
Это проще чем искать по заголовку.
Author: Rouse_
Source: Взято из http://forum.sources.ru
ID: 02390
Как выделить цветом текущую строку в TDBGrid

=== Как выделить цветом текущую строку в TDBGrid ===
procedure TForm1.DBGrid1DrawDataCell(Sender: TObject; const Rect: TRect;
 Field: TField; State: TGridDrawState);
begin
 if gdFocused in State then
 with (Sender as TDBGrid).Canvas do
 begin
 Brush.Color := clRed;
 FillRect(Rect);
 TextOut(Rect.Left, Rect.Top, Field.AsString);
 end;
end;
Source: Взято с http://delphiworld.narod.ru
ID: 03051
Category:Базы данных
Category:DBGrid
Как вызвать Shutdown Windows dialog?

=== Как вызвать Shutdown Windows dialog? ===
uses ComObj;
procedure TForm1.Button1Click(Sender: TObject);
var
 shell: Variant;
begin
 shell := CreateOleObject('Shell.Application');
 shell.ShutdownWindows;
end;
Source: Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 01211
----
{ **** UBPFD *********** by kladovka.net.ru ****
>> Открытие диалогового окна "Завершение работы Windows"
Зависимости: Windows, Messages
Copyright: Gua
Дата: 18 июля 2002 г.
********************************************** }
procedure ShutDownWindow;
begin
 SendMessage(FindWindow('Progman', 'Program Manager'), WM_CLOSE, 0, 0);
end;
Source: kladovka.net.ru
ID: 01212
Как вызвать диалог 'Найти файлы и паки' проводника?

=== Как вызвать диалог 'Найти файлы и паки' проводника? ===
Приведенный пример показывает использование DDE для вызова диалога 'Найти файлы и папки' Explorerа. Диалог открывается на каталоге "C:\Download". 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
 with TDDEClientConv.Create(Self) do
 begin 
 ConnectMode := ddeManual; 
 ServiceApplication := 'explorer.exe'; 
 SetLink('Folders', 'AppProperties'); 
 OpenLink; 
 ExecuteMacro('[FindFolder(, C:\DOWNLOAD)]', False); 
 CloseLink; 
 Free; 
 end; 
end;
ID: 01217
Как вызвать диалог свойств файла?

=== Как вызвать диалог свойств файла? ===
procedure ShowFileProperties(const filename: string);
var
 sei: TShellExecuteInfo;
begin
 FillChar(sei, SizeOf(sei),0);
 sei.cbSize := SizeOf(sei);
 sei.lpFile := PChar(filename);
 sei.lpVerb := 'properties';
 sei.fMask := SEE_MASK_INVOKEIDLIST;
 ShellExecuteEx(@sei);
end;
ID: 03148
Category:Файловая система
Как вызвать команды Find, Option или View Source?

Перевод материала с сайта members.home.com/hfournier/webbrowser.htm
Вот пример вызова диалога
const
 HTMLID_FIND = 1;
 HTMLID_VIEWSOURCE = 2;
 HTMLID_OPTIONS = 3;
//...
procedure TForm1.FindIE;
const
 CGID_WebBrowser: TGUID = '{ED016940-BD5B-11cf-BA4E-00C04FD70816}';
var
 CmdTarget : IOleCommandTarget;
 vaIn, vaOut: OleVariant;
 PtrGUID: PGUID;
begin
 New(PtrGUID);
 PtrGUID^ := CGID_WebBrowser;
 if WebBrowser1.Document <> nil then
 try
 WebBrowser1.Document.QueryInterface(IOleCommandTarget, CmdTarget);
 if CmdTarget <> nil then
 try
 CmdTarget.Exec(PtrGUID, HTMLID_FIND, 0, vaIn, vaOut);
 finally
 CmdTarget._Release;
 end;
 except
 // Ничего
 end;
 Dispose(PtrGUID);
end;
Source: http://blackman.km.ru/myfaq/cont4.phtml
ID: 03446
Category:Связь
Category:WebBrowser
Как вызвать метод предка?

=== Как вызвать метод предка? ===
1) Есть Class1, с методом Mtd.
2) Есть Class2 унаследованный от Class1, метод Mtd перезаписан
3) В программе используется переменная типа Class2
Можно ли из программы вызвать Mtd от Class1, Другими словами, можно ли вызвать перезаписанный метод класса-предка?
----
Способ 1 (только для не виртуальных методов)
var
 a: Class2;
begin
 a := Class2.Create;
 Class1(a).mtd;
 //....
end;
Author: Fantasist
Source: http://forum.vingrad.ru
ID: 00102
----
Способ со статическим приведением годится только для не виртуальных методов, имеющих одно имя. Вызов же виртуальных методов от статического типа не зависит. В твоём простейшем случае достаточно написать inherited Mtd; (ты его можешь вызвать из любого метода TClass2, не только из Mtd). Трудности возникнут, когда нужно вызвать метод "дедушки" или "прадедушки" и т.д.
Один из способов, описанных в литературе, - временная замена VMT объекта на "дедушку" и обратно. Но если у дедушки такого метода не было - будет облом.
Я предпочитаю такой способ:
type
 TProc = procedure of object;
procedure TClassN.SomeMethod;
var
 Proc: TProc;
begin
 TMethod(Proc).Code := @TClass1.Mtd; // Статический адрес
 TMethod(Proc).Data := Self;
 Proc();
end;
Author: Le Taon
Source: http://forum.vingrad.ru
ID: 00103
Как вызвать скрытые команды TWebBrowser?

// The following codes demonstrates an innovative way to invoke hidden
// commands to show modal dialogs such as "Add To Favorite" dialog,
// "Import/Export Wizard" dialog in your WebBrowser-based application
// Command IDs Handled by 'Shell DocObject View'
const ID_IE_FILE_PAGESETUP = 259;
const ID_IE_FILE_PRINT = 260;
const ID_IE_FILE_NEWWINDOW = 275;
const ID_IE_FILE_PRINTPREVIEW = 277;
const ID_IE_FILE_NEWMAIL = 279;
const ID_IE_FILE_SENDPAGE = 282;
const ID_IE_FILE_SENDLINK = 283;
const ID_IE_FILE_SENDDESKTOPSHORTCUT = 284;
const ID_IE_HELP_VERSIONINFO = 336;
const ID_IE_HELP_HELPINDEX = 337;
const ID_IE_HELP_WEBTUTORIAL = 338;
const ID_IE_HELP_FREESTUFF = 341;
const ID_IE_HELP_PRODUCTUPDATE = 342;
const ID_IE_HELP_FAQ = 343;
const ID_IE_HELP_ONLINESUPPORT = 344;
const ID_IE_HELP_FEEDBACK = 345;
const ID_IE_HELP_BESTPAGE = 346;
const ID_IE_HELP_SEARCHWEB = 347;
const ID_IE_HELP_MSHOME = 348;
const ID_IE_HELP_VISITINTERNET = 349;
const ID_IE_HELP_STARTPAGE = 350;
const ID_IE_HELP_NETSCAPEUSER = 351;
const ID_IE_FILE_IMPORTEXPORT = 374;
const ID_IE_HELP_ENHANCEDSECURITY = 375;
const ID_IE_FILE_ADDTRUST = 376;
const ID_IE_FILE_ADDLOCAL = 377;
const ID_IE_FILE_NEWPUBLISHINFO = 387;
const ID_IE_FILE_NEWPEOPLE = 390;
const ID_IE_FILE_NEWCALL =395;
// Command IDs Handled by 'Internet Explorer_Server'
const ID_IE_CONTEXTMENU_NEWWINDOW = 2137;
const ID_IE_CONTEXTMENU_ADDFAV = 2261;
const ID_IE_CONTEXTMENU_REFRESH = 6042;
function GetIEHandle(WebBrowser: TWebbrowser; ClassName: string): HWND;
var
 hwndChild, hwndTmp: HWND;
 oleCtrl: TOleControl;
 szClass: array [0..255] of char;
begin
 oleCtrl :=WebBrowser;
 hwndTmp := oleCtrl.Handle;
 while (true) do
 begin
 hwndChild := GetWindow(hwndTmp, GW_CHILD);
 GetClassName(hwndChild, szClass, SizeOf(szClass));
 if (string(szClass)=ClassName) then
 begin
 Result :=hwndChild;
 Exit;
 end;
 hwndTmp := hwndChild;
 end;
 Result := 0;
end;
procedure TForm1.ToolButton2Click(Sender: TObject);
begin
 // Invoke "Add To Favorite" Dialog
 SendMessage(GetIEHandle(web, 'Internet Explorer_Server'), WM_COMMAND, ID_IE_CONTEXTMENU_ADDFAV, 0);
end;
procedure TForm1.ToolButton3Click(Sender: TObject);
begin
 // Invoke "Import/Export Wizard" Dialog
 SendMessage(GetIEHandle(web, 'Shell DocObject View'), WM_COMMAND, ID_IE_FILE_IMPORTEXPORT, 0);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
 web.Go('http://http://www.swissdelphicenter.ch/en');
end;
Source: http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 03466
Category:Связь
Category:WebBrowser
Как выключить master volume в звуковой карте?

=== Как выключить master volume в звуковой карте? ===
uses
 MMSystem;
function GetMasterMute(Mixer: hMixerObj; var Control: TMixerControl): MMResult; // Returns True on success
var
 Line: TMixerLine;
 Controls: TMixerLineControls;
begin
 ZeroMemory(@Line, SizeOf(Line));
 Line.cbStruct := SizeOf(Line);
 Line.dwComponentType := MIXERLINE_COMPONENTTYPE_DST_SPEAKERS;
 Result := mixerGetLineInfo(Mixer, @Line, MIXER_GETLINEINFOF_COMPONENTTYPE);
 if Result = MMSYSERR_NOERROR then
 begin
 ZeroMemory(@Controls, SizeOf(Controls));
 Controls.cbStruct := SizeOf(Controls);
 Controls.dwLineID := Line.dwLineID;
 Controls.cControls := 1;
 Controls.dwControlType := MIXERCONTROL_CONTROLTYPE_MUTE;
 Controls.cbmxctrl := SizeOf(Control);
 Controls.pamxctrl := @Control;
 Result := mixerGetLineControls(Mixer, @Controls, MIXER_GETLINECONTROLSF_ONEBYTYPE);
 end;
end;
procedure SetMasterMuteValue(Mixer: hMixerObj; Value: Boolean);
var
 MasterMute: TMixerControl;
 Details: TMixerControlDetails;
 BoolDetails: TMixerControlDetailsBoolean;
 Code: MMResult;
begin
 Code := GetMasterMute(0, MasterMute);
 if Code = MMSYSERR_NOERROR then
 begin
 with Details do
 begin
 cbStruct := SizeOf(Details);
 dwControlID := MasterMute.dwControlID;
 cChannels := 1;
 cMultipleItems := 0;
 cbDetails := SizeOf(BoolDetails);
 paDetails := @BoolDetails;
 end;
 LongBool(BoolDetails.fValue) := Value;
 Code := mixerSetControlDetails(0, @Details, MIXER_SETCONTROLDETAILSF_VALUE);
 end;
 if Code <> MMSYSERR_NOERROR then
 raise Exception.CreateFmt('SetMasterMuteValue failure, '+
 'multimedia system error #%d', [Code]);
end;
// Example:
procedure TForm1.Button1Click(Sender: TObject);
begin
 SetMasterMuteValue(0, CheckBox1.Checked); // Mixer device #0 mute on/off
end;
Source: Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 02265
Как выключить звук?

uses
 MMSystem;
// Returns True on success
function GetMasterMute(Mixer: hMixerObj; var Control: TMixerControl): MMResult;
var
 Line: TMixerLine;
 Controls: TMixerLineControls;
begin
 ZeroMemory(@Line, SizeOf(Line));
 Line.cbStruct := SizeOf(Line);
 Line.dwComponentType := MIXERLINE_COMPONENTTYPE_DST_SPEAKERS;
 Result := mixerGetLineInfo(Mixer, @Line, MIXER_GETLINEINFOF_COMPONENTTYPE);
 if Result = MMSYSERR_NOERROR then
 begin
 ZeroMemory(@Controls, SizeOf(Controls));
 Controls.cbStruct := SizeOf(Controls);
 Controls.dwLineID := Line.dwLineID;
 Controls.cControls := 1;
 Controls.dwControlType := MIXERCONTROL_CONTROLTYPE_MUTE;
 Controls.cbmxctrl := SizeOf(Control);
 Controls.pamxctrl := @Control;
 Result := mixerGetLineControls(Mixer, @Controls, MIXER_GETLINECONTROLSF_ONEBYTYPE);
 end;
end;
procedure SetMasterMuteValue(Mixer: hMixerObj; Value: Boolean);
var
 MasterMute: TMixerControl;
 Details: TMixerControlDetails;
 BoolDetails: TMixerControlDetailsBoolean;
 Code: MMResult;
begin
 Code := GetMasterMute(0, MasterMute);
 if Code = MMSYSERR_NOERROR then
 begin
 with Details do
 begin
 cbStruct := SizeOf(Details);
 dwControlID := MasterMute.dwControlID;
 cChannels := 1;
 cMultipleItems := 0;
 cbDetails := SizeOf(BoolDetails);
 paDetails := @BoolDetails;
 end;
 LongBool(BoolDetails.fValue) := Value;
 Code := mixerSetControlDetails(0, @Details, MIXER_SETCONTROLDETAILSF_VALUE);
 end;
 if Code <> MMSYSERR_NOERROR then
 raise Exception.CreateFmt('SetMasterMuteValue failure, ' +
 'multimedia system error #%d', [Code]);
end;
// Example:
procedure TForm1.Button1Click(Sender: TObject);
begin
 SetMasterMuteValue(0, CheckBox1.Checked); // Mixer device #0 mute on/off
end;
Source: http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 03599
Category:Звук
Как выключить удалённый компьютер?

{-----------------------------------------------------------------------------
 Unit Name: formClient
 Creation Date: 27 February, 2002 (16:30)
 Documentation Date: 27 February, 2002 (16:30)
 Version 1.0
 -----------------------------------------------------------------------------
 Description:
 This is to demonstrate shutting down a machine over the network.
 ** Tobias R. requests the article "How to send a shutdown command in a network?" **
 This is not really what you want. I think you are looking for some kind
 of IPC or RPC command. But this will work. Each machine needs to run
 a copy of this server.
 It uses the standard delphi ServerSocket found in the "ScktComp" unit.
 Create a form (name frmClient) with a TServerSocket on it (name ServerSocket)
 set the Port property of ServerSocket to 5555. Add a TMemo called Memo1.
 It listens on port 5555 using TCP/IP.
 It has a very simple protocol.
 Z = Show message with "Z"
 B = Beep
 S = Shutdown windows
 Run the program.. Then from the command prompt type in
 "telnet localhost 5555". Type in one of the three commands above
 (all in uppercase) and the server will respond.
 Copyright 2002 by Stewart Moss. All rights reserved.
-----------------------------------------------------------------------------}
unit formClient;
interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 ScktComp, StdCtrls;
type
 TfrmClient = class(TForm)
 ServerSocket: TServerSocket;
 Memo1: TMemo;
 procedure ServerSocketClientRead(Sender: TObject;
 Socket: TCustomWinSocket);
 procedure FormCreate(Sender: TObject);
 procedure FormClose(Sender: TObject; var Action: TCloseAction);
 private
 { Private declarations }
 public
 { Public declarations }
 end;
var
 frmClient: TfrmClient;
implementation
{$R *.DFM}
procedure TfrmClient.ServerSocketClientRead(Sender: TObject; Socket: TCustomWinSocket);
var
 Incomming: string;
begin
 // read off the socket
 Incomming := Socket.ReceiveText;
 memo1.Lines.Add(incomming);
 if Incomming = 'S' then // Shutdown Protocol
 ExitWindowsEx(EWX_FORCE or EWX_SHUTDOWN, 0);
 if Incomming = 'B' then // Beep Protocol
 Beep;
 if Incomming = 'Z' then // Z protocol
 ShowMessage('Z');
end;
procedure TfrmClient.FormCreate(Sender: TObject);
begin
 ServerSocket.Active := True;
end;
procedure TfrmClient.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 ServerSocket.Active := False;
end;
end.
Author: Stewart Moss
Source: Delphi Knowledge Base: http://www.baltsoft.com/
ID: 03305
Category:Связь
Как выполнить create procedure/trigger при помощи TQuery?

=== Как выполнить create procedure/trigger при помощи TQuery? ===
Для этого у TQuery нужно установить property ParamCheck:=False. При этом текст запроса не будет проверяться на наличие параметров, которые предваряются двоеточием (:). Никаких других изменений не требуется.
Author: Дмитрий Кузьменко
Source: http://www.ibase.ru/
ID: 02920
Category:Базы данных
Category:Interbase
Как выполнить какой-то процесс тогда, когда пользователь не работает с моим приложением?

=== Как выполнить какой-то процесс тогда, когда пользователь не работает с моим приложением? ===
Создайте процедуру, которая будет вызываться при событии Application.OnIdle.
Объявим процедуру:
{ Private declarations }
procedure IdleEventHandler(Sender: TObject; var Done: Boolean);
// В разделе implementation опишем процедуру:
procedure TForm1.IdleEventHandler(Sender: TObject; var Done: Boolean);
begin
 { Do a small bit of work here } 
 Done := false;
end;
В методе Form'ы OnCreate укажем что наша процедура вызывается на событии Application.OnIdle:
 Application.OnIdle := IdleEventHandler;
Событие OnIdle возникает один раз - когда приложение переходит в режим "безделья" (idle).
 
Если в обработчике переменной Done присвоить False событие будет вызываться вновь и вновь, до тех пор пока приложение "бездельничает" и переменной Done не присвоено значение True. 
Author: p0s0l
Source: http://www.vlata.com/delphi/
ID: 00410
ID: 04571
Category:Разработка приложений
Как выполнить метод по его имени?

=== Как выполнить метод по его имени? ===
{ ... }
type
 PYourMethod = ^TYourMethod;
 TYourMethod = procedure(S: string) of Object;
procedure TMainForm.Button1Click(Sender: TObject);
begin
 ExecMethodByName('SomeMethod');
end;
procedure TMainForm.ExecMethodByName(AName: string);
var
 PAddr: PYourMethod;
 M: TMethod;
begin
 PAddr := MethodAddress(AName);
 if PAddr <> nil then
 begin
 M.Code := PAddr;
 M.Data := Self;
 TYourMethod(M)('hello');
 end;
end;
procedure TMainForm.SomeMethod(S: string);
begin
 ShowMessage(S);
end; 
Author: Sasan Adami
Source: Взято из http://www.lmc-mediaagentur.de/dpool
ID: 00284
Как выполнять другую команду по нажатию на кнопку, если зажата клавиша Shift

=== Как выполнять другую команду по нажатию на кнопку, если зажата клавиша Shift ===
procedure TForm1.Button1Click(Sender: TObject);
begin
 if GetKeyState(VK_SHIFT) < 0 then
 ShowMessage('Кнопка Shift нажата')
 else
 ShowMessage('Обычное нажатие кнопки');
end;
Source: http://delphiworld.narod.ru/
ID: 01556
Как выровнять иконки на рабочем столе к левому краю?

=== Как выровнять иконки на рабочем столе к левому краю? ===
Для начала необходимо получить дескриптор рабочего стола, который представляет из себя обычный ListView.
Пример:
function GetDesktopListViewHandle: THandle;
var
 S: String;
begin
 Result := FindWindow('ProgMan', nil);
 Result := GetWindow(Result, GW_CHILD);
 Result := GetWindow(Result, GW_CHILD);
 SetLength(S, 40);
 GetClassName(Result, PChar(S), 39);
 if PChar(S) <> 'SysListView32' then Result := 0;
end;
Как только дескриптор рабочего стола получен, можно с ним работать при помощи обычных API функций (через юнит CommCtrl). См. сообщения LVM_xxxx в хелпе по Win32.
Следующая строчка кода выравнивает иконки на рабочем столе к левому краю:
 SendMessage(GetDesktopListViewHandle, LVM_ALIGN, LVA_ALIGNLEFT, 0);
Source: Взято из http://forum.sources.ru
ID: 01827
Как вычислить IP-адрес по доменному имени

uses winsock
function IPAddrToName(IPAddr : String): String;
var
 SockAddrIn: TSockAddrIn;
 HostEnt: PHostEnt;
 WSAData: TWSAData;
begin
 WSAStartup($101, WSAData);
 SockAddrIn.sin_addr.s_addr:= inet_addr(PChar(IPAddr));
 HostEnt := GetHostByAddr(@SockAddrIn.sin_addr.S_addr, 4, AF_INET);
 if HostEnt <> nil then
 Result := StrPas(Hostent^.h_name)
 else
 Result := ;
end;
Пример использования:
procedure TForm1.Button1Click(Sender: TObject);
begin
 Label1.Caption := IPAddrToName(Edit1.Text);
end;
Source: http://forum.sources.ru
ID: 03347
Category:Связь
Как выяснить дату последнего доступа к файлу?

=== Как выяснить дату последнего доступа к файлу? ===
Данная процедура, позволяет узнать дату последнего доступа к файлу, код не проверял, но говорят работает. Для тех кто не знает что с этим делать намекну, можно использовать для создания триального периода или просто отслеживания доступа к компьютеру.
procedure TForm1.Button1Click(Sender: TObject);
var
 FileHandle: THandle;
 LocalFileTime: TFileTime;
 DosFileTime: DWORD;
 LastAccessedTime: TDateTime;
 FindData: TWin32FindData;
begin
 FileHandle := FindFirstFile('AnyFile.FIL', FindData);
 if FileHandle <> INVALID_HANDLE_VALUE then
 begin
 Windows.FindClose(Handle);
 if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
 begin
 FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime);
 FileTimeToDosDateTime(LocalFileTime,
 LongRec(DosFileTime).Hi, LongRec(DosFileTime).Lo);
 LastAccessedTime := FileDateToDateTime(DosFileTime);
 Label1.Caption := DateTimeToStr(LastAccessedTime);
 end;
 end;
end;
Source: http://delphiworld.narod.ru/
ID: 03142
Category:Файловая система
Как выяснить дату последнего изменения файла?

=== Как выяснить дату последнего изменения файла? ===
function GetFileDate(FileName: string): string;
var
 FHandle: Integer;
begin
 FHandle := FileOpen(FileName, 0);
 try
 Result := DateTimeToStr(FileDateToDateTime(FileGetDate(FHandle)));
 finally
 FileClose(FHandle);
 end;
end;
Source: Взято с сайта http://blackman.wp-club.net/
ID: 03141
Category:Файловая система
Как выяснить дату создания файла?

=== Как выяснить дату создания файла? ===
Попробуйте следующую функцию, которая не требует вызова FindFirst:
function GetFileDate(TheFileName: string): string;
var
 FHandle: integer;
begin
 FHandle := FileOpen(TheFileName, 0);
 result := DateTimeToStr(FileDateToDateTime(FileGetDate(FHandle)));
 FileClose(FHandle);
end;
Одно маленькое предупреждение: время, возвращаемое Win32-функцией, отсчитывается от Гринвича, поэтому вам необходимо привести полученный результат к локальному времени. Чтобы быть уверенным, проверьте документацию. (Я уверен, что FindNextFile делает это правильно).
; Примечание от Vit: Всё-таки лучше использовать FindFirst/FindNext/FindClose ибо приведенный выше способ требует открытия файла, а это не всегда возможно сделать (попробуйте например таким образом узнать дату создания файла подкачки!) и к тому же не всегда это желательно. В отличие от приведенного выше способа FindFirst не открывает файла, а лишь читает информацию с каталога диска, что и быстрее и надёжнее.
Source: http://delphiworld.narod.ru/
ID: 03144
Category:Файловая система
Как выяснить имеет ли объект определённое свойство?

=== Как выяснить имеет ли объект определённое свойство? ===
function hasprop(comp: TComponent; const prop: String): Boolean;
var
 proplist: PPropList;
 numprops, i: Integer;
begin
 result := false;
 getmem(proplist, getTypeData(comp.classinfo)^.propcount * Sizeof(Pointer));
 try
 NumProps := getproplist(comp.classInfo, tkProperties, proplist);
 for i := 0 to pred (NumProps) do
 begin
 if comparetext(proplist[i]^.Name, prop) = 0 then
 begin
 result := true;
 break;
 end;
 end;
 finally
 freemem(proplist, getTypeData(comp.classinfo)^.propcount * Sizeof(Pointer));
 end;
end;
procedure setcomppropstring(comp: TComponent; const prop, s: String);
var
 proplist: PPropList;
 numprops, i: Integer;
begin
 getmem(proplist, getTypeData(comp.classinfo)^.propcount * Sizeof(Pointer));
 try
 NumProps := getproplist(comp.classInfo, tkProperties, proplist);
 for i := 0 to pred (NumProps) do
 begin
 if (comparetext(proplist[i]^.Name, prop) = 0) and
 (comparetext(proplist[i]^.proptype^.name, 'string') = 0 then
 begin
 setStrProp(comp, proplist[i], s);
 break;
 end;
 end;
 finally
 freemem(proplist, getTypeData(comp.classinfo)^.propcount * Sizeof(Pointer));
 end;
end;
Source: Взято из http://www.lmc-mediaagentur.de/dpool
ID: 00272
----
function HasProperty(Obj: TObject; Prop: string): PPropInfo;
begin
 Result := GetPropInfo(Obj.ClassInfo, Prop);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
 p: pointer;
begin
 p := HasProperty(Button1, 'Color');
 if p <> nil then
 SetOrdProp(Button1, p, clRed)
 else
 ShowMessage('Button has no color property');
 p := HasProperty(Label1, 'Color');
 if p <> nil then
 SetOrdProp(Label1, p, clRed)
 else
 ShowMessage('Label has no color property');
 p := HasProperty(Label1.Font, 'Color');
 if p <> nil then
 SetOrdProp(Label1.Font.Color, p, clBlue)
 else
 ShowMessage('Label.Font has no color property');
end;
ID: 00273
----
TypInfo.GetPropInfo (My_Component.ClassInfo, 'Hint') <> nil 
Таким образом можно узнать наличие таковой published "прОперти". А вот если это не поможет, то можно и "ломиком" поковыряться посредством FieldAddress. Однако этот метод дает адрес полей, которые перечисляются сразу после объявления класса как в unit'ых форм. А вот ежели "прОперть" нигде не "засветилась" (published) то фиг ты ее достанешь. 
А модифицировать значение можно посредством прямой записи по адресу FieldAddress (крайне нежелательно!) либо используя цивилизованный способы, перечисленные в unit'е TypInfo. 
Модифицировать кучу объектов можно организовав цикл перебора оных с получением в цикле PropertyInfo объекта и записи в объект на основе PropInfo.
Author: Nomadic
Source: Взято с http://delphiworld.narod.ru
ID: 00274