nyuuzyou/wikis huggingface dataset:
Определение версии системных DLL

=== Определение версии системных DLL ===
{ **** UBPFD *********** by kladovka.net.ru ****
>> Определение версии системных DLL
Функция предназначена для определение версии системных DLL. Кодирование версии осуществляется вспомогательной функцией MakeVersion (см. код).
Зависимости: Windows
Copyright: Собственное написание Almaz
Дата: 12 мая 2002 г.
********************************************** }
function MakeVersion(Major, Minor: Word): Integer; // Функция кодирование версии
begin
 Result := MAKELONG(Minor, Major);
end;
function GetDllVersion(FileName: PChar): Integer;
type
 TDllVersionInfo = packed record
 cbSize: DWORD;
 dwMajorVersion: DWORD;
 dwMinorVersion: DWORD;
 dwBuildNumber: DWORD;
 dwPlatformID: DWORD;
 end;
 PDllVersionInfo = ^TDllVersionInfo;
var
 Lib: THandle;
 DllGetVersion: function (Info: PDllVersionInfo): HRESULT; stdcall;
 Info: TDllVersionInfo;
 WasLoaded: Boolean;
begin
 Result := 0;
 try
 // Получение ссылки на DLL, если она уже загружена
 Lib := GetModuleHandle(FileName); 
 if Lib = 0 then
 begin
 // Загрузка DLL, если она еще не загружена
 Lib := LoadLibrary('SHELL32.DLL');
 WasLoaded := True;
 end else WasLoaded := False;
 if Lib <> 0 then
 try
 // Получение адреса функции DllGetVersion
 DllGetVersion := GetProcAddress(Lib, 'DllGetVersion'); 
 if Assigned(DllGetVersion) then
 begin
 // Подготовка структуры для функции
 ZeroMemory(@Info, SizeOf(Info));
 Info.cbSize := SizeOf(Info);
 // Вызов функции DllGetVersion
 if DllGetVersion(@Info) = NOERROR then
 Result := MakeVersion(Info.dwMajorVersion, Info.dwMinorVersion);
 end;
 finally
 // Если DLL была загружена этой функцией - то выгружаем 
 if WasLoaded then FreeLibrary(Lib);
 end;
 except
 end;
end; 
Пример использования:
// Закодированные MakeVersion версии можно просто сравнивать
if GetDLLVersion('SHELL32.DLL') > MakeVersion(5, 0) then 
 //...
// Вот так можно вывести версию DLL
var
 V: Integer;
begin
 V := GetDLLVersion('SHLDOC32.DLL');
 ShowMessage(IntToStr(HIWORD(V)) + '.' + IntToStr(LOWORD(V)));
end; 
ID: 02005
Определение видеокарты

=== Определение видеокарты ===
{ **** UBPFD *********** by kladovka.net.ru ****
>> Определение видеокарты
Зависимости: Windows
Copyright: Gua
Дата: 18 июля 2002 г.
********************************************** }
function GetDisplayDevice: string;
var
 lpDisplayDevice: TDisplayDevice;
begin
 lpDisplayDevice.cb := SizeOf(lpDisplayDevice);
 EnumDisplayDevices(nil, 0, lpDisplayDevice , 0);
 Result := lpDisplayDevice.DeviceString;
end;
ID: 01337
Определение и использование курсора

=== Определение и использование курсора ===
Сначала (поскольку многие попадаются в эту ловушку) убедитесь в том, что имя .RES-файла, в котором вы храните ваш курсор, отличается от имени .RES-файла вашего проекта, т.е., если ваш проект имеет имя MyApp.DPR, то не используйте для хранения новых ресурсов файл MyApp.RES. Вы должны создать отдельный .RES-файл с другим именем (например, MyApp01.RES) и включить его в ваш проект, например так:
 implementation
 {$R MyApp01.Res}
Вы не можете назначить курсор свойству компонента Cursor или DragCursor из .RES-файла напрямую, необходимо выполнить несколько промежуточных шагов. В каждом проекте Delphi определяет глобальный объект с именем Screen (тип TScreen), который, между прочим, определяет массив курсоров, называемый, как ни странно, Cursors. Когда вы щелкаете на свойстве Cursor/DragCursor в Инспекторе объектов, выпадающий список и есть список элементов указанного массива.
Для предустановленных курсоров Delphi использует элементы массива с индексами начиная с -1 и ниже (т.е. только отрицательные числа), поэтому собственные курсоры вы можете размещать с порядковым номером, начинающимся с нуля и выше.
Для начала определите константу, допустим так:
 Const
 MyCursor = 1;
Далее необходимо загрузить курсор. Сделать это можно в обработчике события формы OnCreate:
 Screen.Cursors[MyCursor] := LoadCursor(HInstance, 'MYCURSOR');
Затем просто установите в свойстве DragCursor любого элемента управления:
 MyListbox.DragCursor := MyCursor;
Примечание: имя вашего курсора всегда должно писаться в ВЕРХНЕМ регистре, как при вызове LoadCursor, так и в его названии в .RES-файле.
Source: http://delphiworld.narod.ru/
ID: 02335
Определение количества заданий в спулере печати

Spooler печати Windows посылает WM_SPOOLERSTATUS каждый раз при добавлении и удалении заданий в очереди печати. В следующем примере показано как перехватить это сообщение:
type
 TForm1 = class(TForm)
 Label1: TLabel;
 private
 { Private declarations }
 procedure WM_SpoolerStatus(var Msg : TWMSPOOLERSTATUS); message WM_SPOOLERSTATUS;
 public
 { Public declarations }
 end;
var
 Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.WM_SpoolerStatus(var Msg: TWMSPOOLERSTATUS);
begin
 Lable1.Caption := IntToStr(Msg.JobsLeft) + ' Jobs currenly in spooler';
 Msg.Result := 0;
end;
Author: Song
Source: Взято из http://forum.sources.ru
ID: 03216
Category:Принтер
Определение координат расположения TaskBar

=== Определение координат расположения TaskBar ===
uses ShellApi;
var
 AppBarData: TAppBarData;
 bAlwaysOnTop: Boolean; { Поверх окон }
 bAutoHide: Boolean; { Авт. убирать с экрана }
 ClRect: TRect; { Клиентские области }
 Rect: TRect;
 Edge: UInt; { Местоположение TaskBar }
procedure DetectTaskBar;
begin
 AppBarData.hWnd := FindWindow('Shell_TrayWnd', nil);
 AppBarData.cbSize := SizeOf(AppBarData);
 bAlwaysOnTop := (SHAppBarMessage(ABM_GETSTATE, AppBardata) and ABS_ALWAYSONTOP) < > 0;
 bAutoHide := (SHAppBarMessage(ABM_GETSTATE, AppBardata) and ABS_AUTOHIDE) < > 0;
 GetClientRect(AppBarData.hWnd, ClRect.rc);
 GetWindowRect(AppBarData.hwnd, rect);
 if (Rect.top > 0) then
 Edge := ABE_BOTTOM
 else if (Rect.Bottom < Screen.Height) then
 Edge := ABE_TOP
 else if Rect.Right < Screen.Width then
 Edge := ABE_LEFT
 else
 Edge := ABE_RIGHT;
end;
Source: Взято с http://delphiworld.narod.ru
ID: 01771
----
=== With SHAppBarMessage ===
uses
 ShellAPI;
procedure TForm1.Button1Click(Sender: TObject);
var
 tabd: TAppBarData;
 PosString: string;
begin
 FillChar(tabd, SizeOf(TAppBarData), 0);
 tabd.cbSize := SizeOf(TAppBarData);
 if SHAppBarMessage(ABM_GETTASKBARPOS, Tabd) = 0 then Exit;
 with Tabd.rc do
 PosString := Format(' (%d, %d);(%d, %d) ', [Left, Top, Right, Bottom]);
 case tabd.uEdge of
 ABE_LEFT: ShowMessage('Left Position' + PosString);
 ABE_TOP: ShowMessage('Top Position' + PosString);
 ABE_RIGHT: ShowMessage('Right Position' + PosString);
 ABE_BOTTOM: ShowMessage('Bottom Position' + PosString);
 end;
end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 01772
----
=== With FindWindow, GetWindowRect ===
type
 TTaskBarPos = (_TOP, _BOTTOM, _LEFT, _RIGHT, _NONE);
function GetTaskBarPos: TTaskBarPos;
var
 hTaskbar: HWND;
 T: TRect;
 scrW, scrH: integer;
begin
 hTaskBar := FindWindow('Shell_TrayWnd', nil);
 if hTaskbar <> 0 then
 begin
 GetWindowRect(hTaskBar, T);
 ScrW := Screen.Width;
 ScrH := Screen.Height;
 if (T.Top > scrH div 2) and (T.Right >= scrW) then
 Result := _BOTTOM
 else if (T.Top < scrH div 2) and (T.Bottom <= scrW div 2) then
 Result := _TOP
 else if (T.Left < scrW div 2) and (T.Top <= 0) then
 Result := _LEFT
 else // the last "if" is not really needed
 if T.Left >= ScrW div 2 then
 Result := _RIGHT;
 end;
end;
procedure TForm1.Button5Click(Sender: TObject);
var
 TaskBarPos: TTaskBarPos;
begin
 TaskBarPos := GetTaskBarPos;
 case TaskBarPos of
 _LEFT: ShowMessage('Left Position');
 _TOP: ShowMessage('Top Position');
 _RIGHT: ShowMessage('Right Position');
 _BOTTOM: ShowMessage('Bottom Position');
 end;
end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 01773
Определение нажатия определенной клавиши во время загрузки приложения

=== Определение нажатия определенной клавиши во время загрузки приложения ===
program Project1;
uses
 Windows,
 Forms,
 Unit1 in 'Unit1.pas' {Form1};
{$R *.RES}
begin
 if GetKeyState(vk_F8) < 1 then
 MessageBox(0, 'F8 was pressed during startup', 'MyApp', mb_ok);
 Application.Initialize;
 Application.CreateForm(TForm1, Form1);
 Application.Run;
end.
Source: http://delphiworld.narod.ru/
ID: 01554
----
program Project1; 
uses 
 Forms, 
 Windows, 
 Dialogs, 
 Unit1 in 'Unit1.pas' {Form1}; 
var 
 KeyState: TKeyBoardState; 
{$R *.RES} 
begin 
 Application.Initialize; 
 GetKeyboardState(KeyState); 
 if ((KeyState[vk_Shift] and 128) <> 0) then 
 begin 
 { here you could put some code to show the app as tray icon, ie 
 hier kann z.B ein Code eingefugt werden, um die Applikation als 
 Tray Icon anzuzeigen} 
 end; 
 Application.CreateForm(TForm1, Form1); 
 Application.Run; 
end.
Source: http://delphiworld.narod.ru/
ID: 01555
Определение параметров принтера через API

Для определения информации о принтере (плоттере, экране) необходимо знать Handle этого принтера, а его можно узнать объекта TPrinter - Printer.Handle. Далее вызывается функция API (unit WinProcs):
GetDevice(Handle: HDC; Index: Integer): Integer;
Index - код параметра, который необходимо вернуть. Для Index существует ряд констант :
* DriverVersion - вернуть версию драйвера
* Texnology - Технология вывода, их много, основные
** dt_Plotter - плоттер
** dt_RasPrinter - растровый принтер
** dt_Display - дисплей
* HorzSize - Горизонтальный размер листа (в мм)
* VertSize - Вертикальный размер листа (в мм)
* HorzRes - Горизонтальный размер листа (в пикселах)
* VertRes - Вертикальный размер листа (в пикселах)
* LogPixelX - Разрешение по оси Х в dpi (пиксел /дюйм)
* LogPixelY - Разрешение по оси Y в dpi (пиксел /дюйм)
Кроме перечисленных еще около сотни, они позволяют узнать о принтере практически все.
Параметры, возвращаемые по LogPixelX и LogPixelY очень важны - они позволяют произвести пересчет координат из миллиметров в пиксели для текущего разрешения принтера. Пример таких функций:
{ Получить информацию о принтере }
procedure TForm1.GetPrinterInfo;
begin
 PixelsX := GetDeviceCaps(Printer.Handle, LogPixelsX);
 PixelsY := GetDeviceCaps(Printer.Handle, LogPixelsY);
end;
{ переводит координаты из мм в пиксели }
function TForm1.PrinterCoordX(x: Integer): Integer;
begin
 PrinterCoordX := Round(PixelsX / 25.4 * x);
end;
{ переводит координаты из мм в пиксели }
function TForm1.PrinterCoordY(Y: Integer): Integer;
begin
 PrinterCoordY := Round(PixelsY / 25.4 * Y);
end;
begin
 GetPrinterInfo;
 Printer.Canvas.TextOut(PrinterCoordX(30), PrinterCoordY(55),
 'Этот текст печатается с отступом 30 мм от левого края и ' +
 '55 мм от верха при любом разрешении принтера');
end;
Данную методику можно с успехом применять для печати картинок - зная размер картинки можно пересчитать ее размеры в пикселах для текущего разрешения принтера, масштабировать, и затем уже распечатать. Иначе на матричном принтере (180 dpi) картинка будет огромной, а на качественном струйнике (720 dpi) - микроскопической.
Source: Взято с http://delphiworld.narod.ru
ID: 03218
Category:Принтер
Определение поддержки SSE

=== Определение поддержки SSE ===
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Определение поддержки SSE
Зависимости: Types
Copyright: Unknown
Дата: 17 июля 2002 г.
***************************************************** }
function CheckSSE: Boolean;
var
 TempCheck: dword;
begin
 TempCheck := 1;
 asm
 push ebx
 mov eax,1
 db $0F,$A2
 test edx,$2000000
 jz @NOSSE
 mov edx,0
 mov TempCheck,edx
 @NOSSE:
 pop ebx
 end;
 CheckSSE := (TempCheck = 0);
end;
Source: http://delphibase.endimus.com
ID: 01441
Определение поддержки SSE2

=== Определение поддержки SSE2 ===
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Определение поддержки SSE2
Зависимости: Types
Copyright: Unknown
Дата: 17 июля 2002 г.
***************************************************** }
function CheckSSE2: Boolean;
var
 TempCheck: dword;
begin
 TempCheck := 1;
 asm
 push ebx
 mov eax,1
 db $0F,$A2
 test edx,$4000000
 jz @NOSSE2
 mov edx,0
 mov TempCheck,edx
 @NOSSE2:
 pop ebx
 end;
 CheckSSE2 := (TempCheck = 0);
end;
Source: http://delphibase.endimus.com
ID: 01442
Определение подключения - отключения нового устройства

=== Определение подключения - отключения нового устройства ===
Маленький коментарий:
unit Unit1;
interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
 Dialogs, MMSystem;
type
 TForm1 = class(TForm)
 public
 procedure CD(var Msg: TMessage); message WM_DEVICECHANGE;
 end;
const
 DBT_DEVICEARRIVAL = $8000;
 DBT_DEVICEREMOVECOMPLETE = $8004;
 DBT_DEVNODES_CHANGED = $7;
var
 Form1: TForm1;
implementation
{$R *.dfm}
{ TForm1 }
procedure TForm1.CD(var Msg: TMessage);
begin
 case Msg.WParam of
 DBT_DEVNODES_CHANGED: Caption := 'Flash change';
 DBT_DEVICEARRIVAL: Caption := 'CD close with new disk';
 DBT_DEVICEREMOVECOMPLETE: Caption := 'CD open';
 //DBT_DEVICEARRIVAL: Caption := 'New network disk maped';
 //DBT_DEVICEREMOVECOMPLETE: Caption := 'Network disk unmaped';
 else
 Caption := 'Unknown';
 end;
end;
end.
Author: Александр (Rouse_) Багель
Source: Взято из http://forum.sources.ru
ID: 01622
Определение полного пути и имени файла DLL

=== Определение полного пути и имени файла DLL ===
Следующий пример демонстрирует функцию, которая позволяет определить полный путь откуда была загружена dll:
uses Windows;
procedure ShowDllPath stdcall;
var
 TheFileName: array[0..MAX_PATH] of Char;
begin
 FillChar(TheFileName, SizeOf(TheFileName), #0);
 GetModuleFileName(hInstance, TheFileName, SizeOf(TheFileName));
 MessageBox(0, TheFileName, 'The DLL file name is:', MB_OK);
end;
Source: Взято из http://forum.sources.ru
ID: 01989
Определение текущего времени(отдельно часы, минуты, секунды)

=== Определение текущего времени(отдельно часы, минуты, секунды) ===
 DecodeTime(Time, Hour, Minute, Second);
Устаревший вариант:
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Определение текущего времени(часы, минуты, секунды)
Зависимости: SysUtils, Classes
Автор: Eagle, ICQ:160702560
Copyright: MegaSoft
Дата: 2 ноября 2002 г.
***************************************************** }
unit gettime;
interface
uses SysUtils, Classes;
function gethours: integer;
function getmins: integer;
function getsecs: integer;
implementation
function gethours: integer;
var
 s: string;
 h: integer;
begin
 s := timetostr(time);
 h := strtoint(s[1] + s[2]);
 Result := h;
end;
function getmins: integer;
var
 s: string;
 h: integer;
begin
 s := timetostr(time);
 h := strtoint(s[4] + s[5]);
 Result := h;
end;
function getsecs: integer;
var
 s: string;
 h: integer;
begin
 s := timetostr(time);
 h := strtoint(s[7] + s[8]);
 Result := h;
end;
end.
Source: http://delphibase.endimus.com
ID: 01647
Определение типа базы данных

=== Определение типа базы данных ===
uses 
 db, dbitypes, dbiprocs;
procedure TForm1.FormCreate(Sender: TObject);
var
 rDB: DBDesc;
begin
 { Первый аргумент DbiGetDatabaseDesc - имя псевдонима базы данных типа PChar }
 Check(DbiGetDatabaseDesc('IBLOCAL', @rDB));
 { член szDbType структуры DBDesc содержит информацию о типе базы данных и имеет тип PChar }
 ShowMessage('Database имеет тип: ' + StrPas(rDB.szDbType));
 { Совет: Если вам просто необходимо узнать - SQL server это или нет, используйте свойство TDatabase.IsSQLBased }
end;
Сборник Kuliba
Author: OAmiry/Borland
Source: Взято из Советов по Delphi от Валентина Озерова
ID: 02543
Определение типов логических дисков

=== Определение типов логических дисков ===
unit Unit1;
interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls;
type
 TForm1 = class(TForm)
 Memo1: TMemo;
 Button1: TButton;
 procedure Button1Click(Sender: TObject);
 end;
var
 Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
const
 NameSize = 4;
 VolumeCount = 26;
 TotalSize = NameSize * VolumeCount;
 Report = 'Volume: %s %s';
var
 Buff, Volume: String;
 lpQuery: array [0..MAXCHAR - 1] of Char;
 I, Count: Integer;
begin
 SetLength(Buff, TotalSize);
 Count := GetLogicalDriveStrings(TotalSize, @Buff[1]) div NameSize;
 if Count = 0 then
 Memo1.Lines.Add(SysErrorMessage(GetLastError))
 else
 begin
 for I := 0 to Count - 1 do
 begin
 Volume := PChar(@Buff[(I * NameSize) + 1]);
 case GetDriveType(PChar(Volume)) of
 DRIVE_UNKNOWN: Memo1.Lines.Add(Format(Report, [Volume,
 'The drive type cannot be determined.']));
 DRIVE_NO_ROOT_DIR: Memo1.Lines.Add(Format(Report, [Volume,
 'The root path is invalid. For example, no volume is mounted at the path.']));
 DRIVE_REMOVABLE:
 begin
 Volume[3] := #0;
 QueryDosDevice(PChar(Volume), @lpQuery[0], MAXCHAR);
 Volume[3] := '\';
 if String(lpQuery) = '\Device\Floppy0' then
 Memo1.Lines.Add(Format(Report, [Volume, 'The drive is a Floppy disk A:.']))
 else
 if String(lpQuery) = '\Device\Floppy1' then
 Memo1.Lines.Add(Format(Report, [Volume, 'The drive is a Floppy disk B:.']))
 else
 Memo1.Lines.Add(Format(Report, [Volume, 'The drive is a Flash Drive.']));
 end;
 DRIVE_FIXED:
 begin
 Volume[3] := #0;
 QueryDosDevice(PChar(Volume), @lpQuery[0], MAXCHAR);
 Volume[3] := '\';
 if Copy(String(lpQuery), 1, 22) = '\Device\HarddiskVolume' then
 Memo1.Lines.Add(Format(Report, [Volume,
 'The disk cannot be removed from the drive.']))
 else
 Memo1.Lines.Add(Format(Report, [Volume,
 'The drive is a SUBST disk on path: "' +
 Copy(String(lpQuery), 5, Length(String(lpQuery))) + '"']));
 end;
 DRIVE_REMOTE: Memo1.Lines.Add(Format(Report, [Volume,
 'The drive is a remote (network) drive.']));
 DRIVE_CDROM: Memo1.Lines.Add(Format(Report, [Volume,
 'The drive is a CD-ROM drive.']));
 DRIVE_RAMDISK: Memo1.Lines.Add(Format(Report, [Volume,
 'The drive is a RAM disk.']));
 else
 Memo1.Lines.Add(Format(Report, [Volume, 'Xpen znaet chto :)']));
 end;
 end;
 end;
end;
end.
Author: Александр (Rouse_) Багель
Source: Взято из http://forum.sources.ru
ID: 01385
Определение фирмы производителя CPU

=== Определение фирмы производителя CPU ===
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Определение фирмы производителя CPU
Зависимости: нет
Copyright:
Дата: 03 мая 2002 г.
***************************************************** }
type
 TVendor = array[0..11] of char;
function GetCPUVendor: TVendor; assembler; register;
asm
 PUSH EBX { Save affected register }
 PUSH EDI
 MOV EDI,EAX { @Result (TVendor) }
 MOV EAX,0
 DW $A20F { CPUID Command }
 MOV EAX,EBX
 XCHG EBX,ECX { save ECX result }
 MOV ECX,4
@1:
 STOSB
 SHR EAX,8
 LOOP @1
 MOV EAX,EDX
 MOV ECX,4
@2:
 STOSB
 SHR EAX,8
 LOOP @2
 MOV EAX,EBX
 MOV ECX,4
@3:
 STOSB
 SHR EAX,8
 LOOP @3
 POP EDI { Restore registers }
 POP EBX
end;
Source: http://delphibase.endimus.com
ID: 01443
Определение функции в DLL

=== Определение функции в DLL ===
Данная функция определяет присутствие нужной функции в библиотеке (dll) и, в случае нахождения искомой функции возвращает True, иначе False. 
function FuncAvail(VLibraryName, VFunctionName: string; var VPointer: Pointer): Boolean; 
var 
 Vlib: THandle; 
begin 
 Result := False; 
 VPointer := nil; 
 if LoadLibrary(PChar(VLibraryName)) = 0 then
 exit; 
 VPointer := GetModuleHandle(PChar(VLibraryName)); 
 if Vlib <> 0 then 
 begin 
 VPointer := GetProcAddress(Vlib, PChar(VFunctionName)); 
 if VPointer <> nil then 
 Result := True; 
 end; 
end; 
Source: Взято из http://forum.sources.ru
ID: 01986
Определить, занят ли порт сокета

var
 SockAddrIn: TSockAddrIn;
 FSocket: TSocket;
begin
 if bind(FSocket, SockAddrIn, SizeOf(SockAddrIn)) <> 0 then
 begin
 // обрабатываем WSAGetLastError
 end;
end;
Source: Взято с http://delphiworld.narod.ru
ID: 03554
Category:Связь
Category:Сокеты
Определить, когда TMediaPlayer закончил проигрывание

=== Определить, когда TMediaPlayer закончил проигрывание ===
procedure TForm1.FormCreate(Sender: TObject);
begin
 MediaPlayer1.Notify := True;
 MediaPlayer1.OnNotify := NotifyProc;
end;
procedure TForm1.NotifyProc(Sender: TObject);
begin
 with Sender as TMediaPlayer do
 begin
 case Mode of
 mpStopped: { do something here };
 end;
 // must set to true to enable next-time notification 
 Notify := True;
 end;
end;
 { 
 NOTE that the Notify property resets back to False when a 
 notify event is triggered, so inorder for you to recieve 
 further notify events, you have to set it back to True as in the code. 
 for the MODES available, see the helpfile for MediaPlayer.Mode; 
}
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 01318
Определить, установлен ли Macromedia Flash

program SeekFlash;
uses
 Forms, Windows, INIFiles, SysUtils, Dialogs, ShellApi;
{$R *.RES}
type
 TVersionInfo = record
 dwSignature,
 dwStrucVersion,
 dwFileVersionMS,
 dwFileVersionLS,
 dwProductVersionMS,
 dwProductVersionLS,
 dwFileFlagsMask,
 dwFileFlags,
 dwFileOS,
 dwFileType,
 dwFileSubtype,
 dwFileDateMS,
 dwFileDateLS: DWORD;
 end;
var
 //Reg:TRegistry;
 Ini: TIniFile;
 Text: array[1..4] of string;
 AppPath, IniFile, MySec: string;
 SetupFile, RunFile, SetupClass: string;
 VersionStr, BrowserStr: string;
 {RegSubKey,} OpenBrowser, PlugInName, UseExt: string;
 MainVersion: Word;
 // FoundOne :Boolean;
 PVer, DPchar, POpenBrowser: PChar;
 MyPoint: Pointer;
 PLen: Cardinal;
 version: ^TVersionInfo;
 DumD: DWORD;
 LWord, HWord: Word;
 CheckHandle: Hwnd;
//---------------------------
// Gets the Plugin (file-) Version
//---------------------------
procedure GetVersion(pluginName: string);
begin
 DPChar := StrAlloc(255);
 DPchar := PChar(PluginName);
 PVer := StrAlloc(getFileVersionInfoSize(DPchar, Plen));
 getFileVersionInfo(DPChar, 0, 255, PVer);
 VerQueryValue(Pver, '\', MyPoint, Plen);
 Version := myPoint;
 dumD := Version.dwFileVersionMS;
 hword := dumD shr 16;
 lword := dumD and 255;
 MainVersion := hword;
 VersionStr := IntToStr(Hword) + '.' + IntToStr(LWord);
 dumD := Version.dwFileVersionLs;
 hword := dumD shr 16;
 lword := dumD and 255;
 versionStr := versionStr + '.' + IntToStr(Hword) + '.' + IntToStr(lWord);
end;
begin
 appPath := extractFileDir(Application.exeName);
 // runFile:= 'test.htm';
 // runFile must be a html File to determin wich browser(NC or IE) is used
 POpenBrowser := StrAlloc(255);
 FindExecutable(PChar(extractFileName(runFile)),
 PChar(extractFileDir(runFile)), POpenBrowser);
 OpenBrowser := POpenBrowser;
 if not Fileexists(openBrowser) then
 begin
 MessageDlg(Text[4], mtInformation, [mbOK], 0);
 halt;
 end;
 // set the FileLocations for Netscape or IE
 if Pos('NETSCAPE.EXE', uppercase(trim(OpenBrowser))) <> 0 then
 begin //found Netscape
 BrowserStr := 'Netscape Comunicator';
 PlugInName := Copy(OpenBrowser, 1, Pos('NETSCAPE.EXE', UpperCase(Trim(OpenBrowser))) - 1);
 PluginName := PlugInName + 'Plugins\NPSWF32.dll';
 end
 else
 begin
 // found IEExplorer
 BrowserStr := 'Internet Explorer';
 DPChar := StrAlloc(255);
 GetSystemDirectory(DPChar, 255);
 PluginName := DPChar + '\Macromed\Flash\swflash.ocx';
 DPChar := nil;
 end;
 GetVersion(pluginName);
 // returned Version Number, may be checked
 while mainVersion < 4 do
 begin
 if MessageDlg(Text[2], mtInformation, [mbYes, mbNo], 0) = 6 then
 begin
 //installFlash;
 end
 else
 Halt;
 getVersion(pluginName);
 end; // while mainVer
end.
Source: http://www.swissdelphicenter.ch
ID: 04476
Category:COM
Определить, что текстовое поле для ввода пароля

// Determine, if a Edit Field has password characters
// Herausfinden, ob das Edit Feld Passwort Charakter hat
function HasPasswordChar(AHandle: HWND): Boolean;
var
 dwStyle: DWORD;
begin
 dwStyle := GetWindowLong(AHandle, GWL_STYLE);
 Result := (dwStyle and ES_PASSWORD) = ES_PASSWORD;
end;
// Set password characters for the Edit Field
// Passwort Charakter fur ein Edit Feld setzen
procedure SetPasswordChar(AHandle: HWND; Value: Char);
var
 S: String;
 len: Integer;
begin
 len := Sendmessage(AHandle, WM_GETTEXTLENGTH, 0, 0);
 SetLength(S, len);
 SendMessage(AHandle, WM_GETTEXT, len+1, lparam(@S[1]));
 SendMessage(AHandle, EM_SETPASSWORDCHAR, Ord(Value), 0);
 SendMessage(AHandle, WM_SETTEXT, 0, Integer(PChar(S)));
end;
// Cancel the password characters and reveal the text
// Password Charakter aufheben und den Text anzeigen
procedure CancelPasswordChar(AHandle: HWND);
var
 S: string;
 len: Integer;
begin
 len := SendMessage(AHandle, WM_GETTEXTLENGTH, 0, 0);
 SetLength(S, len);
 SendMessage(AHandle, WM_GETTEXT, len + 1, lParam(@S[1]));
 SendMessage(AHandle, EM_SETPASSWORDCHAR, 0, 0);
 SendMessage(AHandle, WM_SETTEXT, 0, Integer(PChar(S)));
end;
// Example:
procedure TForm1.Button1Click(Sender: TObject);
var
 wnd: HWND;
begin
 wnd := FindWindowEx(GetForeGroundWindow, 0, 'TEdit', nil);
 if wnd <> 0 then
 SetPasswordChar(wnd,'*');
end;
Source: http://www.swissdelphicenter.ch
ID: 04038
Category:WinAPI
Category:Edit
Category:Безопасность