nyuuzyou/wikis huggingface dataset:
Как обрабатывать ошибки в COM-объектах

type
 TCustomBasePlugObject = class(TAutoObject, IUnknown, IDispatch)
 protected
 function SafeCallException(ExceptObject: TObject; ExceptAddr: Pointer): {$IFDEF _D4_}HResult{$ELSE}Integer{$ENDIF}; override;
 end;
implementation
function TCustomBasePlugObject.SafeCallException;
var
 ExMsg: string;
begin
 Result := inherited SafeCallException(ExceptObject, ExceptAddr);
 try
 if ExceptObject is EAbort then
 exit;
 ExMsg := 'Exception: PlugObject="' if ExceptObject is Exception then
 begin
 ExMsg := ExMsg + #13' Message: '#13' ' +
 Exception(ExceptObject).Message +
 #13' Module:' + GetModuleFileName +
 #13' Adress:' + Format('%p', [ExceptAddr]);
 if (ExceptObject is EOleSysError) and
 (EOleSysError(ExceptObject).ErrorCode < 0) then
 ExMsg := ExMsg + #13'OleSysError.ErrorCode = ' + IntToStr(EOleSysError(ExceptObject).ErrorCode);
 end;
 toLog(ExMsg);
 except
 end;
end;
Source: http://delphiworld.narod.ru
ID: 04319
Category:COM
Как обрабатывать сообщения

=== Как обрабатывать сообщения ===
Обработка сообщений означает, что приложение будет тем или иным образом реагировать на полученные от операционной системы сообщения. В стандартном приложении Windows обработка сообщений сосредотачивается в процедурах окна. Delphi, частично обрабатывая сообщения, упрощает работу программиста, позволяя вместо одной процедуры для обработки всех типов сообщений создавать независимые процедуры для обработки сообщений различных типов.
Все процедуры обработки сообщений должны отвечать следующим требованиям:
* Процедура должна быть методом объекта 
* Процедуре должен передаваться один передаваемый по ссылке параметр, т.е. с помощью описания var. Тип параметра должен быть TMessage или другой, зависящий от типа специализированного сообщения 
* Описание процедуры должно включать ключевое слово message, за которым должна следовать константа, задающая тип обрабатываемого сообщения
Вот пример объявления процедуры, обрабатывающей сообщение WM_Paint
procedure WMPaint(var Msg: TWMPaint); message wm_Paint;
[соглашение по присвоению имён требует присваивать обработчику сообщения то же имя, что и имя обрабатываемого сообщения, но без символа подчёркивания и указанием первым знаков имени прописными буквами]
В качестве примера напишем процедуру обработки сообщения WM_Paint, которая вместо перерисовки будет выдавать звуковой сигнал:
Для этого сначала нужно объявить процедуру в частных объявлениях (в области Private объекта TForm1):
procedure WMPaint(var Msg: TWMPaint); message wm_Paint;
Теперь в разделе implementation модуля добавляем определение процедуры (в этом случае указание ключевого слова message не требуется):
procedure TForm1.WMPaint(var Msg: TWMPaint);
begin
 beep;
 inherited;
end;
Обратите внимание на ключевое слово inherited, которое позволяет передать сообщение обработчику этого сообщения, принадлежащему классу-предку, т.е. если бы мы в нашем случае не указали бы это слово, перерисовка окна не осуществлялась бы, а выполнялось бы только только то, что было описано в области реализации нашего приложения, т.е. только бы подавался звуковой сигнал.
Source: Взято с http://delphiworld.narod.ru
ID: 02318
Как обрезать форму по рисунку?

Вот пример, правда для Bitmap, хотя преобразовать PNG в BMP не составит труда.
unit Unit1;
interface
uses
 Windows, Classes, SysUtils, Graphics, Forms;
type
 TRGBArray = array[0..32767] of TRGBTriple;
 PRGBArray = ^TRGBArray;
type
 TForm1 = class(TForm)
 procedure FormCreate(Sender: TObject);
 procedure FormDestroy(Sender: TObject);
 private
 { Private declarations }
 FRegion: THandle;
 function CreateRegion(Bmp: TBitmap): THandle;
 end;
var
 Form1: TForm1;
implementation
{$R *.dfm}
function TForm1.CreateRegion(Bmp: TBitmap): THandle;
var
 X, Y, StartX: Integer;
 Excl: THandle;
 Row: PRGBArray;
 TransparentColor: TRGBTriple;
begin
 Bmp.PixelFormat := pf24Bit;
 Result := CreateRectRGN(0, 0, Bmp.Width, Bmp.Height);
 for Y := 0 to Bmp.Height - 1 do
 begin
 Row := Bmp.Scanline[Y];
 StartX := -1;
 if Y = 0 then
 TransparentColor := Row[0];
 for X := 0 to Bmp.Width - 1 do
 begin
 if (Row[X].rgbtRed = TransparentColor.rgbtRed)
 and (Row[X].rgbtGreen = TransparentColor.rgbtGreen)
 and (Row[X].rgbtBlue = TransparentColor.rgbtBlue) then
 begin
 if StartX = -1 then StartX := X;
 end
 else
 begin
 if StartX > -1 then
 begin
 Excl := CreateRectRGN(StartX, Y, X + 1, Y + 1);
 try
 CombineRGN(Result, Result, Excl, RGN_DIFF);
 StartX := -1;
 finally
 DeleteObject(Excl);
 end;
 end;
 end;
 end;
 if StartX > -1 then
 begin
 Excl := CreateRectRGN(StartX, Y, Bmp.Width, Y + 1);
 try
 CombineRGN(Result, Result, Excl, RGN_DIFF);
 finally
 DeleteObject(Excl);
 end;
 end;
 end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
 Bmp: TBitmap;
begin
 Bmp := TBitmap.Create;
 try
 Bmp.LoadFromFile('C:\YourBitmap.bmp');
 FRegion := CreateRegion(Bmp);
 SetWindowRGN(Handle, FRegion, True);
 finally
 Bmp.Free;
 end;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
 DeleteObject(FRegion);
end;
end.
Author: Smike
Source: http://forum.sources.ru
ID: 03634
Category:Графика
Как ограничить движения мышки определённой областью?

=== Как ограничить движения мышки определённой областью? ===
Для этого можно воспользоваться API функцией ClipCursor(). Например, можно вставить следующий код в обработчик события формы OnMouseDown:
 ClipCursor(&BoundsRect); 
а следующий код в обработчик события формы OnMouseUp:
 ClipCursor(NULL); 
Если нажать кнопку мыши на форме и удерживать её, то курсор мышки не сможет покинуть пределы формы.
Сначала определяете ограничивающий прямоугольник, затем используете функцию ClipCursor(), передав ей в качестве параметра указатель на этот прямоугольник. Например, вот так можно по 100 пикселей скостить по краям экрана: 
procedure TForm1.Button1Click(Sender: TObject);
var
 r: TRect;
 pr: PRect;
begin
 r.Left := 100;
 r.Top := 100;
 r.Right := Screen.Width - 100;
 r.Bottom := Screen.Height - 100;
 pr := @r;
 ClipCursor(pr);
end;
Чтобы восстановить: 
ClipCursor(NULL);
Source: http://delphiworld.narod.ru
ID: 01589
Как ограничить длину вводимого текста шириной TEdit'а?

=== Как ограничить длинну вводимого текста шириной TEdit'а? ===
Как ограничить длинну текста, вводимого в TEdit, так чтобы ширина текста не превышала ширину TEdit'а?
В примере приведено два способа ограничить длинну текста в TEdit так чтобы она не превышала ширину клиентской области окна TEdit'а и не появлялась прокрутка текста. Первый способ устанавливает свойство TEdit'а MaxLength равным числу букв "W", которые поместятся в TEdit. "W" выбрана потому, что является, наверное, самой широкой буквой в любом шрифте. Этот метод сносно работает для шрифтов с фиксированной шириной букв, но для шрифтов с переменной шириной букв вряд ли сгодится. Второй способ перехватывает событие KeyPress TEdit'а и измеряет ширину уже введенного текста и ширину нового символа. Если ширина больше чем клиентская область TEdit'а новый символ отбрасывается и вызывается MessageBeep. 
procedure TForm1.FormCreate(Sender: TObject);
var
 cRect: TRect;
 bm: TBitmap;
 s: string;
begin
 Windows.GetClientRect(Edit1.Handle, cRect);
 bm := TBitmap.Create;
 bm.Width := cRect.Right;
 bm.Height := cRect.Bottom;
 bm.Canvas.Font := Edit1.Font;
 s := 'W';
 while bm.Canvas.TextWidth(s) < CRect.Right do
 s := s + 'W';
 if length(s) > 1 then
 begin
 Delete(s, 1, 1);
 Edit1.MaxLength := Length(s);
 end;
end;
Другой вариант
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
var
 cRect: TRect;
 bm: TBitmap;
begin
 if ((Ord(Key) <> VK_TAB) and (Ord(Key) <> VK_RETURN) and
 (Ord(Key) <> VK_LEFT) and (Ord(Key) <> VK_BACK)) then
 begin
 Windows.GetClientRect(Edit1.Handle, cRect);
 bm := TBitmap.Create;
 bm.Width := cRect.Right;
 bm.Height := cRect.Bottom;
 bm.Canvas.Font := Edit1.Font;
 if bm.Canvas.TextWidth(Edit1.Text + Key) > CRect.Right then
 begin
 Key := #0;
 MessageBeep(-1);
 end;
 bm.Free;
 end;
end;
ID: 00539
Как ограничить перемещение курсора?

=== Как ограничить перемещение курсора? ===
Как ограничить перемещение курсора мыши какой-либо областью экрана?
 ClipCursor()
Учтите, что использование этой функции - плохой тон.
Copyright (C) Alexey Mahotkin 1997-1999
ID: 02329
Как округлять до сотых в большую сторону?

=== Как округлять до сотых в большую сторону? ===
Прибавляешь 0.5 затем отбрасываешь дробную часть:
uses Math; 
function RoundMax(num: Real; prec: Integer): Real; 
begin 
 Result := RoundTo(num + Power(10, prec-1) * 5, prec); 
end;
До сотых соответственно будет:
function RoundMax100(num: Real): Real; 
begin 
 Result := Round(num * 100 + 0.5) / 100; 
end; 
Author: Vit (www.delphist.com, www.drkb.ru, www.unihighlighter.com, www.nevzorov.org)
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 00205
Как определение нажатия определенной клавиши во время загрузки приложения?

=== Как определение нажатия определенной клавиши во время загрузки приложения? ===
Используйте WinAPI функцию GetKeyState() для определения нажатия клавиши в тексте проекта. Для того чтобы увидеть текст файла проекта в главном меню Delphi 3 выберите "View">>"ProjectSource" в Delphi 4 "Project">>"View Source". 
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.
ID: 01530
Как определить, включено ли автоскрытие у панели задач?

=== Как определить, включено ли автоскрытие у панели задач? ===
uses ShellAPI; 
function IsTaskbarAutoHideOn : boolean; 
var ABData: TAppBarData; 
begin 
 ABData.cbSize := SizeOf(ABData); 
 Result :=(SHAppBarMessage(ABM_GETSTATE, ABData) and ABS_AUTOHIDE) > 0; 
end; 
Source: Взято из http://forum.sources.ru
ID: 01768
Как определить, запущена ли Delphi

Иногда, особенно при создании компонент, бывает необходимо получить доступ к компоненту только когда запущена Delphi IDE.
if FindWindow('TAppBuilder', nil) <= 0 then
 ShowMessage('Delphi is not running !')
else
 ShowWindow('Delphi is running !');
Source: http://forum.sources.ru
ID: 04512
Category:Разработка приложений
Category:Защита и взлом
Как определить, запущено ли приложение в Windows NT?

=== Как определить, запущено ли приложение в Windows NT? ===
Следующий код компилируется как на 16-ти, так и на 32-битных платформах.
{$IFNDEF WIN32}
 const WF_WINNT = $4000;
{$ENDIF}
function IsNT: bool;
{$IFDEF WIN32}
var
 osv: TOSVERSIONINFO;
{$ENDIF}
begin
 Result := True;
{$IFDEF WIN32}
 GetVersionEx(osv);
 if osv.dwPlatformId = VER_PLATFORM_WIN32_NT then exit;
{$ELSE}
 if ((GetWinFlags and WF_WINNT) = WF_WINNT) then exit;
{$ENDIF}
 Result := False;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 if IsNt then
 ShowMessage('Running on NT')
 else
 ShowMessage('Not Running on NT');
end;
Source: Взято из http://forum.sources.ru
ID: 02083
----
function IsNT: bool;
var
 osv: TOSVERSIONINFO;
begin
 Result := True;
 GetVersionEx(osv);
 if osv.dwPlatformId = VER_PLATFORM_WIN32_NT then exit;
 Result := False;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 if IsNt then
 ShowMessage('Running on NT')
 else
 ShowMessage('Not Running on NT');
Source: Взято с сайта http://blackman.wp-club.net/
ID: 02084
Как определить, изменилось ли системное время?

=== Как определить, изменилось ли системное время? ===
Следующий пример демонстрирует обработку сообщения WM_TIMECHANGE. Приложение, которое изменяет системное время, посылает сообщение WM_TIMECHANGE всем окнам верхнего уровня.
type 
 TForm1 = class(TForm) 
 private 
 { Private declarations } 
 procedure WMTIMECHANGE(var Message: TWMTIMECHANGE); message WM_TIMECHANGE; 
 public 
 { Public declarations } 
 end; 
var 
 Form1: TForm1; 
implementation 
{$R *.DFM} 
procedure TForm1.WMTIMECHANGE(var Message: TWMTIMECHANGE); 
begin 
 Form1.Caption := 'Time Changed'; 
end;
Source: Взято из http://forum.sources.ru
ID: 01645
Как определить, имеет ли файл ASCII-формат

=== Как определить, имеет ли файл ASCII-формат ===
function isAscii(NomeFile: string): Boolean;
const
 SETT = 2048;
var
 i: Integer;
 F: file;
 a: Boolean;
 TotSize, IncSize, ReadSize: Integer;
 c: array[0..Sett] of Byte;
begin
 if FileExists(NomeFile) then
 begin
 {$I-}
 AssignFile(F, NomeFile);
 Reset(F, 1);
 TotSize := FileSize(F);
 IncSize := 0;
 a := True;
 while (IncSize < TotSize) and (a = True) do
 begin
 ReadSize := SETT;
 if IncSize + ReadSize > TotSize then ReadSize := TotSize - IncSize;
 IncSize := IncSize + ReadSize;
 BlockRead(F, c, ReadSize);
 // Iterate
 for i := 0 to ReadSize - 1 do
 if (c[i] < 32) and (not (c[i] in [9, 10, 13, 26])) then a := False;
 end; { while }
 CloseFile(F);
 {$I+}
 if IOResult <> 0 then Result := False
 else
 Result := a;
 end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 if OpenDialog1.Execute then
 if isAscii(OpenDialog1.FileName) then
 ShowMessage('ASCII File');
end;
Source: http://www.swissdelphicenter.ch
ID: 02974
Category:Базы данных
Category:CSV
Как определить, нажал ли пользователь клавишу PrintScreen?

=== Как определить, нажал ли пользователь клавишу PrintScreen? ===
В событиях, обрабатывающих нажатия клавиш в TForm, клавиша PrintScreen не обрабатывается. Однако проблему можно решить при помощи 'GetAsyncKeyState'. Функция GetAsyncKeyState определяет, когда клавиша была нажата или отпущена каждый раз, когда функция вызвана, а так же, когда клавиша была нажата после предыдущего вызова GetAsyncKeyState.
Событие OnIdle в TApplication как раз подходит для вызова этой API функции:
procedure TForm1.FormCreate(Sender: TObject); 
begin 
 Application.OnIdle := AppIdle; 
end; 
procedure TForm1.AppIdle(Sender: TObject; var Done: Boolean); 
begin 
 if GetAsyncKeyState(VK_SNAPSHOT) <> 0 then 
 Form1.Caption := 'PrintScreen нажата !'; 
 Done := True; 
end;
Source: Взято из http://forum.sources.ru
ID: 01504
----
The PrintScreen system key is not processed during the TForm keydown event. The following example tests if the PrintScreen key has
been pressed by calling the Windows API function GetAsyncKeyState() during the Application.OnIdle event.
Example:
type
 TForm1 = class(TForm)
 Button1: TButton;
 procedure FormCreate(Sender: TObject);
 private
 { Private declarations }
 procedure AppIdle(Sender: TObject; var Done: Boolean);
 public
 { Public declarations }
 end;
var
 Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
 Application.OnIdle := AppIdle;
end;
procedure TForm1.AppIdle(Sender: TObject; var Done: Boolean);
begin
 if GetAsyncKeyState(VK_SNAPSHOT) <> 0 then
 Form1.Caption := 'SnapShot';
 Done := True;
end;
ID: 01505
Как определить, нажата ли в данный момент клавиша Shift, Ctrl или Alt?

=== Как определить, нажата ли в данный момент клавиша Shift, Ctrl или Alt? ===
Следующий пример демонстрирует проверку состояния клавиши Shift (нажата она или нет), в то время когда выделен пункт меню. А так же в примере содержатся функции, позволяющие определить состояние клавиш Alt, Ctrl, и shift:
function CtrlDown: Boolean;
var
 State: TKeyboardState;
begin
 GetKeyboardState(State);
 Result := ((State[vk_Control] And 128) <> 0);
end;
function ShiftDown: Boolean;
var
 State: TKeyboardState;
begin
 GetKeyboardState(State);
 Result := ((State[vk_Shift] and 128) <> 0);
end;
function AltDown: Boolean;
var
 State: TKeyboardState;
begin
 GetKeyboardState(State);
 Result := ((State[vk_Menu] and 128) <> 0);
end;
procedure TForm1.MenuItem12Click(Sender: TObject);
begin
 if ShiftDown then
 Form1.Caption := 'Shift'
 else
 Form1.Caption := ;
end;
Source: Взято из http://forum.sources.ru
ID: 01500
Как определить, работает ли программа в виртуальной машине Connectrix?

{
 This function can be used to determine whether your program is
 running from within Connectrix's Virtual PC
}
function running_inside_vpc: boolean; assembler;
asm
 push ebp
 mov ecx, offset @@exception_handler
 mov ebp, esp
 push ebx
 push ecx
 push dword ptr fs:[0]
 mov dword ptr fs:[0], esp
 mov ebx, 0 // flag
 mov eax, 1 // VPC function number
 // call VPC
 db 00Fh, 03Fh, 007h, 00Bh
 mov eax, dword ptr ss:[esp]
 mov dword ptr fs:[0], eax
 add esp, 8
 test ebx, ebx
 setz al
 lea esp, dword ptr ss:[ebp-4]
 mov ebx, dword ptr ss:[esp]
 mov ebp, dword ptr ss:[esp+4]
 add esp, 8
 jmp @@ret
@@exception_handler:
 mov ecx, [esp+0Ch]
 mov dword ptr [ecx+0A4h], -1 // EBX = -1 -> not running, ebx = 0 -> running
 add dword ptr [ecx+0B8h], 4 // -> skip past the detection code
 xor eax, eax // exception is handled
 ret
@@ret:
end;
Author: p0s0l
Source: Vingrad.ru http://forum.vingrad.ru
ID: 04519
Category:Разработка приложений
Category:Защита и взлом
Как определить, работает ли программа в виртуальной машине VMware?

////////////////////////////////////////////////////////////////////////////////
//
// Simple VMware check on i386
//
// Note: There are plenty ways to detect VMware. This short version bases
// on the fact that VMware intercepts IN instructions to port 0x5658 with
// an magic value of 0x564D5868 in EAX. However, this is *NOT* officially
// documented (used by VMware tools to communicate with the host via VM).
//
// Because this might change in future versions - you should look out for
// additional checks (e.g. hardware device IDs, BIOS informations, etc.).
// Newer VMware BIOS has valid SMBIOS informations (you might use my BIOS
// Helper unit to dump the ROM-BIOS (http://www.bendlins.de/nico/delphi).
//
function IsVMwarePresent(): LongBool; stdcall; // platform;
begin
 Result := False;
{$IFDEF CPU386}
 try
 asm
 mov eax, 564D5868h
 mov ebx, 00000000h
 mov ecx, 0000000Ah
 mov edx, 00005658h
 in eax, dx
 cmp ebx, 564D5868h
 jne @@exit
 mov Result, True
 @@exit:
 end;
 except
 Result := False;
 end;
{$ENDIF}
end;
Author: p0s0l
Source: Vingrad.ru http://forum.vingrad.ru
ID: 04518
Category:Разработка приложений
Category:Защита и взлом
Как определить, унаследовано ли свойство от определённого класса?

=== Как определить, насдледовано ли свойство от определённого класса? ===
function GetFontProp(anObj: TObject): TFont;
var
 PInfo: PPropInfo;
begin
 { Try to get a pointer to the property information for a property with the name 'Font'.
 TObject.ClassInfo returns a pointer to the RTTI table, which we need to pass to GetPropInfo }
 PInfo := GetPropInfo(anObj.ClassInfo, 'font');
 Result := nil;
 if PInfo <> nil then
 { found a property with this name, check if it has the correct type }
 if (PInfo^.Proptype^.Kind = tkClass)
 and GetTypeData(PInfo^.Proptype^)^.ClassType.InheritsFrom(TFont)
 then
 Result := TFont(GetOrdProp(anObj, PInfo));
end;
Author: Peter Below
Source: Взято из http://www.lmc-mediaagentur.de/dpool
ID: 00278
Как определить, что два слова имеют схожее произношение

=== Как определить, что два слова имеют схожее произношение ===
Функция Soundex определяет схожесть звучания двух слов. Алгоритм Soundex опубликован в одной из статей журнала PC Magazine и предназначен для работы с английским языком (может кто-нибудь портирует для работы с нашим могучим? Пишите). Функции передается строка. Возвращаемое Soundex значение также имеет тип строки. Эта величина может сохраняться в базе данных или сравниваться с другим значением Soundex. Если два слова имеют одинаковое значение Soundex, можно предположить, что звучат они одинаково (более или менее). 
Вы должны иметь в виду, что алгоритм Soundex игнорирует первую букву слова. Таким образом, "won" и "one" будут иметь различное значение Soundex, а "Won" и "Wunn" - одинаковое. 
Soundex будет особенно полезен в базах данных, когда пользователь затрудняется с правописанием имен и фамилий. 
function Soundex(OriginalWord: string): string;
var
 Tempstring1, Tempstring2: string;
 Count: integer;
begin
 Tempstring1 := ;
 Tempstring2 := ;
 OriginalWord := Uppercase(OriginalWord);
 { Переводим исходное слово в верхний регистр }
 Appendstr(Tempstring1, OriginalWord[1]); { Используем первую букву слова }
 for Count := 2 to length(OriginalWord) do
 { Назначаем числовое значение каждой букве, за исключением первой }
 case OriginalWord[Count] of
 'B', 'F', 'P', 'V': Appendstr(Tempstring1, '1');
 'C', 'G', 'J', 'K', 'Q', 'S', 'X', 'Z': Appendstr(Tempstring1, '2');
 'D', 'T': Appendstr(Tempstring1, '3');
 'L': Appendstr(Tempstring1, '4');
 'M', 'N': Appendstr(Tempstring1, '5');
 'R': Appendstr(Tempstring1, '6');
 { Все другие буквы, цифры и знаки пунктуации игнорируются }
 end;
 Appendstr(Tempstring2, OriginalWord[1]);
 { Удаляем из результата все последовательно повторяющиеся цифры. }
 for Count := 2 to length(Tempstring1) do
 if Tempstring1[Count - 1] <> Tempstring1[Count] then
 Appendstr(Tempstring2, Tempstring1[Count]);
 Soundex := Tempstring2; { Это - значение soundex }
end;
SoundAlike - функция, проверяющая схожесть звучания двух слов. При схожести звучания она возвратит значение True и значение False в противном случае. Она демонстрирует пример использования функции Soundex.
function SoundAlike(Word1, Word2: string): boolean;
begin
 if (Word1 = ) and (Word2 = ) then
 result := True
 else if (Word1 = ) or (Word2 = ) then
 result := False
 else if (Soundex(Word1) = Soundex(Word2)) then
 result := True
 else
 result := False;
end;
Дополнение 
Существует алгоритм ("параметрической корреляции", если я вообще правильно называю его), основанный на оценке схожести слов по количеству совпадающих букв идущих друг за другом. Примечание: буквы не обязательно идут *непосредственно* друг за другом, т.е. без других букв. 
Пример:
 Андрей vs. Андрей - 6
 ндрей vs. Андрей - 5
 Анрей vs. Андрей - 5
 Андрей vs. Александр - 4
 Андрей vs. Иннокентий - 2
 АнXрей vs. Андрей - 3, но в то же время с другими словами результат
будет на уровне 0..2
Source: http://delphiworld.narod.ru
ID: 00931
Как определить, является ли диск NTFS?

=== Как определить, является ли диск NTFS? ===
uses
 ComObj;
function IsNTFS(AFileName: string): Boolean;
var
 fso, drv: OleVariant;
begin
 IsNTFS := False;
 fso := CreateOleObject('Scripting.FileSystemObject');
 drv := fso.GetDrive(fso.GetDriveName(AFileName));
 IsNTFS := drv.FileSystem = 'NTFS'
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 if IsNTFS('X:\Temp\File.doc') then
 ShowMessage('File is on NTFS File System')
 else
 ShowMessage('File is not on NTFS File System')
end;
Source: Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 03118
Category:Файловая система
Как определить, является ли метод потомком TNotifyEvent?

=== Как определить, является ли метод потомком TNotifyEvent? ===
If I am given a TPersistent object, and a method name, is there a way to determine if the name is an event of TNotifyEvent type? For example, given a TPersistent lMyObj and an event name, "OnDataChanged", how can I determine if OnDataChanged is a TNotifyEvent?
function IsNotifyEvent(Sender: TObject; const Event: string): Boolean;
var
 PropInfo: PPropInfo;
 Method: TNotifyEvent;
begin
 Result := False;
 PropInfo := GetPropInfo(Sender.ClassInfo, Event);
 if not Assigned(PropInfo) then
 Exit;
 if PropInfo.PropType^.Kind <> tkMethod then
 Exit;
 Method := TNotifyEvent(GetMethodProp(Sender, PropInfo));
 Result := Assigned(Method);
end;
Language: en
Author: Jack Sudarev
Source: Взято из http://www.lmc-mediaagentur.de/dpool
ID: 00277
Как определить - находится ли Ваше приложение в режиме отладки ?

Обычно господа взломщики, для того, чтобы взломать защиту приложения, запускают его в режиме отладки и анализируют машинный код для определения точки перехвата ввода пароля с клавиатуры.
Обычно таким способом ломаются игрушки :)
Конечно данный способ не сможет полностью защитить Ваш программный продукт от взлома, но прекратить выполнение секретного кода - запросто. Для этого мы будем использовать API функцию IsDebuggerPresent. Единственный недостаток этой функции, заключается в том, что она не работает под Windows 95.
Теперь посмотрим как эту функцию реализовать в Delphi:
function DebuggerPresent: Boolean;
type
 TDebugProc = function: Boolean; stdcall;
var
 Kernel32: HMODULE;
 DebugProc: TDebugProc;
begin
 Result := False;
 Kernel32 := GetModuleHandle('kernel32.dll');
 if Kernel32 <> 0 then
 begin
 @DebugProc := GetProcAddress(Kernel32, 'IsDebuggerPresent');
 if Assigned(DebugProc) then
 Result := DebugProc;
 end;
end;
А это окончательный пример вызова нашей функции:
if DebuggerPresent then
 ShowMessage('debugging')
else
 ShowMessage('NOT debugging');
Author: Simon Carter
Source: http://forum.sources.ru
ID: 04510
Category:Разработка приложений
Category:Защита и взлом