Delphi tips
Often programmers stumble across the same problems, sometimes depending on the programming environment. To prevent myself from doing it more than once with the same problem, I decided to start this page with some code snippets. Delphi is my "mother tongue" when it comes to development languages, but even so the samples may be outdated by now, since Delphi made progress in the last years and I hadn't the opportunity to keep pace.
If you should have problems, questions or suggestions about the functions below, or if you simply find them useful, don't hesitate to send me an email to .
Overview
Application functions
Filename of the application (exe/dll)
To get the filename of the application, most of the time you can call:
sFileName := Application.ExeName;
// or
sFileName := ParamStr(0);
Perhaps you are working on a DLL and are interested in the filename of the DLL rather than the filename of the application, then you can use this function:
uses SysUtils;
sFileName := GetModuleName(HInstance); // returns the Dll name
sFileName := GetModuleName(0); // returns the Exe name
Version of the application
With this function you can get the version of a file, which contains a version resource. This way you can display the version number of your application in an information dialog. To include a version resource to your Delphi application, set the "Versioninfo" in the project options.
uses Windows, SysUtils;
/// <summary>
/// This function reads the file resource of "FileName" and returns
/// the version number as formatted text.</summary>
/// <example>
/// Sto_GetFmtFileVersion() = '4.13.128.0'
/// Sto_GetFmtFileVersion('', '%.2d-%.2d-%.2d') = '04-13-128'
/// </example>
/// <remarks>If "Fmt" is invalid, the function may raise an
/// EConvertError exception.</remarks>
/// <param name="FileName">Full path to exe or dll. If an empty
/// string is passed, the function uses the filename of the
/// running exe or dll.</param>
/// <param name="Fmt">Format string, you can use at most four integer
/// values.</param>
/// <returns>Formatted version number of file, '' if no version
/// resource found.</returns>
function Sto_GetFmtFileVersion(const FileName: String = '';
const Fmt: String = '%d.%d.%d.%d'): String;
var
sFileName: String;
iBufferSize: DWORD;
iDummy: DWORD;
pBuffer: Pointer;
pFileInfo: Pointer;
iVer: array[1..4] of Word;
begin
// set default value
Result := '';
// get filename of exe/dll if no filename is specified
sFileName := FileName;
if (sFileName = '') then
begin
// prepare buffer for path and terminating #0
SetLength(sFileName, MAX_PATH + 1);
SetLength(sFileName,
GetModuleFileName(hInstance, PChar(sFileName), MAX_PATH + 1));
end;
// get size of version info (0 if no version info exists)
iBufferSize := GetFileVersionInfoSize(PChar(sFileName), iDummy);
if (iBufferSize > 0) then
begin
GetMem(pBuffer, iBufferSize);
try
// get fixed file info (language independent)
GetFileVersionInfo(PChar(sFileName), 0, iBufferSize, pBuffer);
VerQueryValue(pBuffer, '\', pFileInfo, iDummy);
// read version blocks
iVer[1] := HiWord(PVSFixedFileInfo(pFileInfo)^.dwFileVersionMS);
iVer[2] := LoWord(PVSFixedFileInfo(pFileInfo)^.dwFileVersionMS);
iVer[3] := HiWord(PVSFixedFileInfo(pFileInfo)^.dwFileVersionLS);
iVer[4] := LoWord(PVSFixedFileInfo(pFileInfo)^.dwFileVersionLS);
finally
FreeMem(pBuffer);
end;
// format result string
Result := Format(Fmt, [iVer[1], iVer[2], iVer[3], iVer[4]]);
end;
end;
Starting an external application
For starting an external application, you can use the WindowsAPI function ShellExecute.
Often it is better to pass nil (instead of 'open') as the operation keyword, Windows will then use the default keyword, or 'open' if the default keyword is not defined. With nil it works like a doubleclick in the explorer.
uses ShellApi;
ShellExecute(0, nil, 'calc.exe', '', '', SW_SHOWNORMAL);
Sometimes you need more control over the starting process, perhaps you want to wait until the process has finished or you need the exit code of the application.
uses Windows, ShellApi;
/// <summary>
/// Executes an external program or opens a document with its
/// standard application.</summary>
/// <param name="FileName">Full path of application or document.</param>
/// <param name="Parameters">Command line arguments.</param>
/// <param name="ExitCode">Exitcode of application (only avaiable
/// if Wait > 0).</param>
/// <param name="Wait">[milliseconds] Maximum of time to wait,
/// until application has finished. After reaching this timeout,
/// the application will be terminated and False is returned as
/// result. 0 = don't wait on application, return immediately.</param>
/// <param name="Hide">If True, application runs invisible in the
/// background.</param>
/// <returns>True if application could be started successfully, False
/// if app could not be started or timeout was reached.</returns>
function Sto_ShellExecute(const FileName, Parameters: String;
var ExitCode: DWORD; const Wait: DWORD = 0;
const Hide: Boolean = False): Boolean;
var
myInfo: SHELLEXECUTEINFO;
iWaitRes: DWORD;
begin
// prepare SHELLEXECUTEINFO structure
ZeroMemory(@myInfo, SizeOf(SHELLEXECUTEINFO));
myInfo.cbSize := SizeOf(SHELLEXECUTEINFO);
myInfo.fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_NO_UI;
myInfo.lpFile := PChar(FileName);
myInfo.lpParameters := PChar(Parameters);
if Hide then
myInfo.nShow := SW_HIDE
else
myInfo.nShow := SW_SHOWNORMAL;
// start file
ExitCode := 0;
Result := ShellExecuteEx(@myInfo);
// if process could be started
if Result then
begin
// wait on process ?
if (Wait > 0) then
begin
iWaitRes := WaitForSingleObject(myInfo.hProcess, Wait);
// timeout reached ?
if (iWaitRes = WAIT_TIMEOUT) then
begin
Result := False;
TerminateProcess(myInfo.hProcess, 0);
end;
// get the exitcode
GetExitCodeProcess(myInfo.hProcess, ExitCode);
end;
// close handle, because SEE_MASK_NOCLOSEPROCESS was set
CloseHandle(myInfo.hProcess);
end;
end;
To wait until the application has been started (instead of finished), replace "WaitForSingleObject" with "WaitForInputIdle".
Starting console application and redirect stdoutput
Most console applications send their output to the stdoutput and stderror devices and these are normally connected to the display. You can start such an application and capture its output, to read and interpret it in your own application. To avoid the disadvantages of the filesystem and permission problems, it's best to redirect to pipes and read from them.
For a full example, of how to start the "cmd.exe" and using input pipe as well as output pipes, you can download this small example project StoRedirectedExecute.zip.
uses Windows, Classes;
type
TStoReadPipeThread = class(TThread)
protected
FPipe: THandle;
FContent: TStringStream;
function Get_Content: String;
procedure Execute; override;
public
constructor Create(const Pipe: THandle);
destructor Destroy; override;
property Content: String read Get_Content;
end;
constructor TStoReadPipeThread.Create(const Pipe: THandle);
begin
FPipe := Pipe;
FContent := TStringStream.Create('');
inherited Create(False); // start immediately
end;
destructor TStoReadPipeThread.Destroy;
begin
FContent.Free;
inherited Destroy;
end;
procedure TStoReadPipeThread.Execute;
const
BLOCK_SIZE = 4096;
var
iBytesRead: DWORD;
myBuffer: array[0..BLOCK_SIZE-1] of Byte;
begin
repeat
// try to read from pipe
if ReadFile(FPipe, myBuffer, BLOCK_SIZE, iBytesRead, nil) then
FContent.Write(myBuffer, iBytesRead);
// a process may write less than BLOCK_SIZE, even if not at the end
// of the output, so checking for < BLOCK_SIZE would block the pipe.
until (iBytesRead = 0);
end;
function TStoReadPipeThread.Get_Content: String;
begin
Result := FContent.DataString;
end;
/// <summary>
/// Runs a console application and captures the stdoutput and
/// stderror.</summary>
/// <param name="CmdLine">The commandline contains the full path to
/// the executable and the necessary parameters.
/// <param name="Output">Receives the console stdoutput.</param>
/// <param name="Error">Receives the console stderror.</param>
/// <param name="Wait">[milliseconds] Maximum of time to wait,
/// until application has finished. After reaching this timeout,
/// the application will be terminated and False is returned as
/// result.</param>
/// <returns>True if process could be started and did not reach the
/// timeout.</returns>
function Sto_RedirectedExecute(CmdLine: String;
var Output, Error: String; const Wait: DWORD = 3600000): Boolean;
var
mySecurityAttributes: SECURITY_ATTRIBUTES;
myStartupInfo: STARTUPINFO;
myProcessInfo: PROCESS_INFORMATION;
hPipeOutputRead, hPipeOutputWrite: THandle;
hPipeErrorRead, hPipeErrorWrite: THandle;
myReadOutputThread: TStoReadPipeThread;
myReadErrorThread: TStoReadPipeThread;
iWaitRes: Integer;
begin
// prepare security structure
ZeroMemory(@mySecurityAttributes, SizeOf(SECURITY_ATTRIBUTES));
mySecurityAttributes.nLength := SizeOf(SECURITY_ATTRIBUTES);
mySecurityAttributes.bInheritHandle := TRUE;
// create pipes to get stdoutput and stderror
CreatePipe(hPipeOutputRead, hPipeOutputWrite, @mySecurityAttributes, 0);
CreatePipe(hPipeErrorRead, hPipeErrorWrite, @mySecurityAttributes, 0);
// prepare startupinfo structure
ZeroMemory(@myStartupInfo, SizeOf(STARTUPINFO));
myStartupInfo.cb := Sizeof(STARTUPINFO);
// hide application
myStartupInfo.dwFlags := STARTF_USESHOWWINDOW;
myStartupInfo.wShowWindow := SW_HIDE;
// assign pipes
myStartupInfo.dwFlags := myStartupInfo.dwFlags or STARTF_USESTDHANDLES;
myStartupInfo.hStdInput := 0;
myStartupInfo.hStdOutput := hPipeOutputWrite;
myStartupInfo.hStdError := hPipeErrorWrite;
// since Delphi calls CreateProcessW, literal strings cannot be used anymore
UniqueString(CmdLine);
// start the process
Result := CreateProcess(nil, PChar(CmdLine), nil, nil, True,
CREATE_NEW_CONSOLE, nil, nil, myStartupInfo, myProcessInfo);
// close the ends of the pipes, now used by the process
CloseHandle(hPipeOutputWrite);
CloseHandle(hPipeErrorWrite);
// could process be started ?
if Result then
begin
myReadOutputThread := TStoReadPipeThread.Create(hPipeOutputRead);
myReadErrorThread := TStoReadPipeThread.Create(hPipeErrorRead);
try
// wait unitl there is no more data to receive, or the timeout is reached
iWaitRes := WaitForSingleObject(myProcessInfo.hProcess, Wait);
// timeout reached ?
if (iWaitRes = WAIT_TIMEOUT) then
begin
Result := False;
TerminateProcess(myProcessInfo.hProcess, UINT(ERROR_CANCELLED));
end;
// return output
myReadOutputThread.WaitFor;
Output := myReadOutputThread.Content;
myReadErrorThread.WaitFor;
Error := myReadErrorThread.Content;
finally
myReadOutputThread.Free;
myReadErrorThread.Free;
CloseHandle(myProcessInfo.hThread);
CloseHandle(myProcessInfo.hProcess);
end;
end;
// close our ends of the pipes
CloseHandle(hPipeOutputRead);
CloseHandle(hPipeErrorRead);
end;
Each "ReadFile" operation on a pipe will block, until there is either data to read, or the handle of the pipe is closed (no more data). An application who sends data to the pipe will fill up the buffer and block until someone reads the data at the other end of the pipe. This means, if we read more than one pipe, each pipe can block the others, so for a safe implementation we have to use threads to read the pipes.
Links to email and website
For creating a link in your application, e.g. on the info dialog, you can use the following procedures.
uses ShellApi, SysUtils;
function Sto_UrlEncode(const Text: String): String;
var
iPos: Integer;
cCharacter: Char;
begin
Result := Text;
// search for not web save characters
for iPos := Length(Result) downto 1 do
begin
cCharacter := Result[iPos];
if (not (cCharacter in ['A'..'Z', 'a'..'z', '0'..'9'])) then
begin
Delete(Result, iPos, 1);
Insert('%' + IntToHex(Ord(cCharacter), 2), Result, iPos);
end;
end;
end;
procedure Sto_OpenMail(const Address: String; const Subject: String = '';
const Body: String = ''; const Cc: String = ''; const Bcc: String = '');
var
slParameters: TStrings;
sMailCommand: String;
iParameter: Integer;
begin
slParameters := TStringList.Create;
try
if (Subject <> '') then
slParameters.Add('subject=' + Sto_UrlEncode(Subject));
if (Body <> '') then
slParameters.Add('body=' + Sto_UrlEncode(Body));
if (Cc <> '') then
slParameters.Add('cc=' + Cc);
if (Bcc <> '') then
slParameters.Add('bcc=' + Bcc);
// bring parameters into a form like:
// mailto:<address>?subject=<subjectline>&body=<mailtext>&cc=<address>&bcc=<address>
sMailCommand := 'mailto:' + Address;
for iParameter := 0 to slParameters.Count - 1 do
begin
if (iParameter = 0) then
sMailCommand := sMailCommand + '?'
else
sMailCommand := sMailCommand + '&';
sMailCommand := sMailCommand + slParameters.Strings[iParameter];
end;
ShellExecute(0, 'open', PChar(sMailCommand), nil, nil, SW_SHOWNORMAL);
finally
slParameters.Free;
end;
end;
procedure Sto_OpenWebSite(const Site: String);
begin
ShellExecute(0, 'open', PChar(Site), nil, nil, SW_SHOWNORMAL);
end;
Command line parameters
To get the command line parameters passed at the application start, you can use the functions "ParamCount" and "ParamStr". The first parameter 0 contains the application filename, the same as you can get with "Application.ExeName".
////////////////////////////////////////////////////////////////
// in this example, the application was started with 3
// parameters ('Good', 'evening' and 'Delphi').
procedure Sto_CommandLineDemo;
var
iParamCount: Integer;
sApplication: String;
sParam1, sParam2, sParam3: String;
begin
iParamCount := ParamCount; // iParamCount = 3
sApplication := ParamStr(0); // sApplication = filename of application
sParam1 := ParamStr(1); // sParam1 = 'Good'
sParam2 := ParamStr(2); // sParam2 = 'evening'
sParam3 := ParamStr(3); // sParam3 = 'Delphi'
end;
If you need the complete command line (e.g. for a special parsing), then you can use the global variable "CmdLine" or the Windows API function "GetCommandLine" and get all parameters in one string.
Including external resources like a cursor
There are several ways to load resources into your project, you could for example generate a compiled resource file (*.res) and include it to your project or you could load the ressource at runtime from a file. Both cases have drawbacks: to create a (*.res) file you need a tool like Delphi's image editor which is very limited, and loading the resource at runtime you have to deliver the resource file and make sure it exists when needed.
Fortunately there is an other method which can include resources from external files to your exe at compiletime. This example shows, how to include a cursor (sto_cursor.cur) to your project, in the example all files are placed in the Delphi project directory.
- First you need a cursor file (sto_cursor.cur), copy it to your Delphi project directory.
- In the next step, create a resource script file. It's a simple text file with the extension (*.rc), name it (sto_cursor.rc).
- Now add the resource script file to your Delphi project, that way you can edit the file within the IDE and, more important, Delphi will know it has to compile this resources by building the project. Delphi will place a compiler directive into the project file (*.dpr).
Now we have to fill the resource script, the example shows an include of the file (sto_cursor.cur). At the begin of the line has to be the id of the resource (my_cursor), it is defined by yourself. The id is followed by a keyword (CURSOR), which describes the type of the resource, and the third parameter is the filename.
my_cursor CURSOR "sto_cursor.cur"
After this is done, you can build your project and the resource will be compiled
(sto_cursor.res) and added to the exe. To display the new cursor, you first have to load the
resource. In the example, the unused cursor "crSqlWait" will be replaced by our cursor.
Normally you would have to unload a resource loaded with "LoadImage" but in this case
"Screen.Cursor" will handle this for you.
Note: the function "LoadCursor" has been superseded by "LoadImage".
const
crMyCursor = crSqlWait; // replace an unneeded cursor
procedure TForm1.FormCreate(Sender: TObject);
begin
// load the own cursor with id "my_cursor" and replace one of the existing cursors
Screen.Cursors[crMyCursor] := LoadImage(HInstance, 'my_cursor', IMAGE_CURSOR, 0, 0, 0);
end;
In a last step, you can show your cursor.
procedure TForm1.Button1Click(Sender: TObject);
begin
Screen.Cursor := crMyCursor;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Screen.Cursor := crDefault;
end;
File & path functions
Often used file functions
You don't remember exactly the functionname, but you know there was a function...?
- ExtractFileDrive, ExtractFilePath, ExtractFileName, ExtractFileExt (uses SysUtils)
- ExtractShortPathName, ExpandUNCFileName (uses SysUtils)
- FileExists, DirectoryExists (uses SysUtils, FileCtrl)
- ForceDirectories (uses FileCtrl)
- SelectDirectory (uses FileCtrl)
- IncludeTrailingPathDelimiter, ExcludeTrailingPathDelimiter (uses SysUtils Delphi6)
IncludeTrailingBackslash, ExcludeTrailingBackslash (uses SysUtils Delphi5) - LastDelimiter (uses SysUtils)
- MatchesMask (uses Masks)
Get long filename from a short DOS filename
To get the short DOS filename, Delphi offers the function "ExtractShortPathName", to get the long filename from a DOS filename you can use the following function:
uses Windows, ShlObj, ActiveX;
////////////////////////////////////////////////////////////////
// this function returns the long path from a short 8.3 DOS path.
// if it was not possible to get the long path, the function gives
// back "ShortPathName" as the result.
function Sto_ExtractLongPathName(const ShortPathName: String): String;
var
bSuccess: Boolean;
fncGetLongPathName: function (lpszShortPath: LPCTSTR;
lpszLongPath: LPTSTR; cchBuffer: DWORD): DWORD stdcall;
szBuffer: array[0..MAX_PATH] of Char;
pDesktop: IShellFolder;
swShortPath: WideString;
iEaten: ULONG;
pItemList: PItemIDList;
iAttributes: ULONG;
begin
bSuccess := False;
// try to use the function "GetLongPathNameA" (Win98/2000 and up)
@fncGetLongPathName := GetProcAddress(
GetModuleHandle('Kernel32.dll'), 'GetLongPathNameA');
if (Assigned(fncGetLongPathName)) then
begin
bSuccess := fncGetLongPathName(PChar(ShortPathName), szBuffer,
SizeOf(szBuffer)) <> 0;
if bSuccess then
Result := szBuffer;
end;
// use an alternative way of getting the path (Win95/NT). the function
// "SHGetFileInfo" (as often seen in examples) only converts the
// filename without the path.
if (not bSuccess) and Succeeded(SHGetDesktopFolder(pDesktop)) then
begin
swShortPath := ShortPathName;
iAttributes := 0;
if Succeeded(pDesktop.ParseDisplayName(0, nil, POLESTR(swShortPath),
iEaten, pItemList, iAttributes)) then
begin
bSuccess := SHGetPathFromIDList(pItemList, szBuffer);
if bSuccess then
Result := szBuffer;
// release ItemIdList (SHGetMalloc is superseded)
CoTaskMemFree(pItemList);
end;
end;
// give back the original path if unsuccessful
if (not bSuccess) then
Result := ShortPathName;
end;
Get the size of a file (more than 2 GB)
With this function you can receive the size of a file, it still works correctly with sizes larger than 2 GB.
uses SysUtils;
////////////////////////////////////////////////////////////////
// this function determines the size of a file in bytes, the size
// can be more than 2 GB.
function Sto_GetFileSize(const FileName: String): Int64;
var
myFile: THandle;
myFindData: TWin32FindData;
begin
// set default value
Result := 0;
// get the file handle.
myFile := FindFirstFile(PChar(FileName), myFindData);
if (myFile <> INVALID_HANDLE_VALUE) then
begin
Windows.FindClose(myFile);
Int64Rec(Result).Lo := myFindData.nFileSizeLow;
Int64Rec(Result).Hi := myFindData.nFileSizeHigh;
end;
end;
Directory browse dialog
To browse for a file you can use the TOpenFile dialog, to browse for a directory there is a function "SelectDirectory". If you want to pre-select a node in the tree, don't use the "RootNode", use the "Directory" parameter instead. (Delphi6)
uses FileCtrl;
////////////////////////////////////////////////////////////////
// opens the directory browse dialog with a pre-selected node.
procedure TForm1.Button1Click(Sender: TObject);
var
sDirectory: String;
begin
sDirectory := 'C:\Program Files';
if SelectDirectory('Text above the tree', '', sDirectory) then
ShowMessage(sDirectory);
end;
Moving files and directories to the recyclebin
"SHFileOperation" is a multipurpose function and can be used to copy, move, rename and delete files and directories. You can make use of the standard confirmation messages and the progress dialog of Windows.
uses SysUtils, ShellApi;
////////////////////////////////////////////////////////////////
// - "Filenames" is a list of files and directories you want to delete.
// the user will be asked for confirmation and the progress dialog will
// be displayed if necessary.
// - "ParentWindow" is the parent window for message boxes, you can pass "0".
// after executing, you have to check, which files where really deleted,
// because the user can cancel the deleting procedure.
procedure Sto_DeleteFiles(const ParentWindow: HWND; const Filenames: TStrings;
const ToRecycleBin: Boolean = True);
var
iFile: Integer;
sFilenames: String;
myFileOp: SHFILEOPSTRUCT;
begin
if (Filenames.Count = 0) then Exit;
// create a #0 delimited string with two trailing #0
sFilenames := '';
for iFile := 0 to Filenames.Count - 1 do
sFilenames := sFilenames + ExcludeTrailingPathDelimiter(Filenames.Strings[iFile]) + #0;
sFilenames := sFilenames + #0;
// prepare the SHFILEOPSTRUCT
FillChar(myFileOp, SizeOf(myFileOp), 0);
myFileOp.Wnd := ParentWindow;
myFileOp.wFunc := FO_DELETE;
myFileOp.pFrom := PChar(sFilenames);
// could be moved to the recyclebin, even if "ToRecycleBin" is false.
if ToRecycleBin then
myFileOp.fFlags := myFileOp.fFlags or FOF_ALLOWUNDO;
SHFileOperation(myFileOp);
end;
Searching a directory
You can use this code as a base to your own procedure, the procedure lists the content of a direcotry.
uses Classes, SysUtils;
////////////////////////////////////////////////////////////////
// "Directory": will be searched for files and directories, the results will
// be added with the full path to "List". directories are written with a
// trailing "\" at the end.
// "Mask": can contain one or several masks, delimited with a semikolon. to
// ignore directory names, add an extension to the mask. for more detailed
// information see the delphi function "FindFirst".
// "Recursive": if true, subdirectories will be searched too.
// "Append": if true, existing entries remain in "List".
procedure Sto_SearchDirectory(List: TStrings; const Directory: String;
const Mask: String = '*.*'; Recursive: Boolean = True;
Append: Boolean = False);
procedure _SearchDirectory(List: TStrings; const DelimitedDirectory: String;
Masks: TStrings; Recursive: Boolean);
var
iMaskIndex: Integer;
bFoundFile: Boolean;
mySearchRec: TSearchRec;
sFile, sDirectory: String;
begin
// list files and directories
for iMaskIndex := 0 to Masks.Count - 1 do
begin
bFoundFile := FindFirst(DelimitedDirectory + Masks[iMaskIndex],
faAnyFile, mySearchRec) = 0;
while (bFoundFile) do
begin
// skip "." and ".."
if (mySearchRec.Name <> '.') and (mySearchRec.Name <> '..') then
begin
sFile := DelimitedDirectory + mySearchRec.Name;
// add delimiter to directories
if ((mySearchRec.Attr and faDirectory) <> 0) then
sFile := IncludeTrailingPathDelimiter(sFile);
// add to list
List.Add(sFile);
end;
// find next file
bFoundFile := FindNext(mySearchRec) = 0;
end;
FindClose(mySearchRec);
end;
// recursive call for directories
if (Recursive) then
begin
bFoundFile := FindFirst(DelimitedDirectory + '*', faDirectory,
mySearchRec) = 0;
while (bFoundFile) do
begin
// skip "." and ".."
if (mySearchRec.Name <> '.') and (mySearchRec.Name <> '..') then
begin
sDirectory := IncludeTrailingPathDelimiter(DelimitedDirectory +
mySearchRec.Name);
_SearchDirectory(List, sDirectory, Masks, Recursive);
end;
// find next directory
bFoundFile := FindNext(mySearchRec) = 0;
end;
FindClose(mySearchRec);
end;
end;
var
slMasks: TStringList;
begin
// prepare list
if (not Append) then
List.Clear;
List.BeginUpdate;
slMasks := TStringList.Create;
try
// prepare masks
if (Mask = '') then
slMasks.Add('*')
else
begin
slMasks.Delimiter := ';';
slMasks.DelimitedText := Mask;
end;
// start recursive loop
_SearchDirectory(List, IncludeTrailingPathDelimiter(Directory),
slMasks, Recursive);
finally
slMasks.Free;
List.EndUpdate;
end;
end;
How to copy filenames from/to the clipboard
When you use the copy function in the explorer, you don't really copy the files to the clipboard, instead you pass the filenames. Reading the filenames is easily done, writing the filenames to the clipboard is a bit more tricky, but let's see.
uses Clipbrd, ShellApi, ShlObj, Windows, SysUtils;
////////////////////////////////////////////////////////////////
// copies filenames from the clipboard to "Filenames" if there
// are any. the clipboard can contain file- and directory names.
procedure Sto_PasteFilenamesFromClipboard(Filenames: TStrings);
var
hDropHandle: HDROP;
szBuffer: PChar;
iCount, iIndex: Integer;
iLength: Integer;
begin
// check entry conditions
if (Filenames = nil) then Exit;
Filenames.Clear;
// lock clipboard
Clipboard.Open;
try
// does clipboard contain filenames?
if (Clipboard.HasFormat(CF_HDROP)) then
begin
// get drop handle from the clipboard
hDropHandle := Clipboard.GetAsHandle(CF_HDROP);
// enumerate filenames
iCount := DragQueryFile(hDropHandle, $FFFFFFFF, nil, 0);
for iIndex := 0 to iCount - 1 do
begin
// get length of filename
iLength := DragQueryFile(hDropHandle, iIndex, nil, 0);
// allocate the memory, the #0 is not included in "iLength"
szBuffer := StrAlloc(iLength + 1);
try
// get filename
DragQueryFile(hDropHandle, iIndex, szBuffer, iLength + 1);
Filenames.Add(szBuffer);
finally // free the memory
StrDispose(szBuffer);
end;
end;
end;
finally
// unlock clipboard
Clipboard.Close;
end;
end;
////////////////////////////////////////////////////////////////
// copies filenames from "Filenames" to the clipboard.
// "Filenames" can contain file- and directory names.
function Sto_CopyFilenamesToClipboard(Filenames: TStrings): Boolean;
var
sFilenames: String;
iIndex: Integer;
hBuffer: HGLOBAL;
pBuffer: PDropFiles;
begin
// check entry conditions
Result := (Filenames <> nil) and (Filenames.Count > 0);
if (not Result) then Exit;
// bring the filenames in a form,
// separated by #0 and ending with a double #0#0
sFilenames := '';
for iIndex := 0 to Filenames.Count - 1 do
sFilenames := sFilenames +
ExcludeTrailingPathDelimiter(Filenames.Strings[iIndex]) + #0;
sFilenames := sFilenames + #0;
// allocate memory with the size of the "DropFiles" structure plus the
// length of the filename buffer.
hBuffer := GlobalAlloc(GMEM_MOVEABLE or GMEM_ZEROINIT,
SizeOf(DROPFILES) + Length(sFilenames));
try
Result := (hBuffer <> 0);
if (Result) then
begin
pBuffer := GlobalLock(hBuffer);
try
// prepare the "DROPFILES" structure
pBuffer^.pFiles := SizeOf(DROPFILES);
// behind the "DROPFILES" structure we place the filenames
pBuffer := Pointer(Integer(pBuffer) + SizeOf(DROPFILES));
CopyMemory(pBuffer, PChar(sFilenames), Length(sFilenames));
finally
GlobalUnlock(hBuffer);
end;
// copy buffer to the clipboard
Clipboard.Open;
try
Clipboard.SetAsHandle(CF_HDROP, hBuffer);
finally
Clipboard.Close;
end;
end;
except
Result := False;
// free only if handle could not be passed to the clipboard
GlobalFree(hBuffer);
end;
end;
String functions
Often used string functions
You don't remember exactly the functionname, but you know there was a function...? (uses SysUtils, StrUtils, Classes).
| Functionames | Category |
|---|---|
| Length, Delete, Insert, Copy, StringReplace | Standard procedures |
| Pos, PosEx, LastDelimiter | Find substring |
| ExtractStrings, TStrings.CommaText, TStrings.DelimitedText | Splitting strings |
| SameText, CompareStr, CompareText | Compare strings |
| Trim, TrimLeft, TrimRight | Remove whitespaces |
| UpperCase, LowerCase | |
| Format, FormatFloat, FormatDateTime | Formatting |
| IntToStr, StrToInt, StrToIntDef, TryStrToInt, FloatToStr, StrToFloat, StrToFloatDef, TryStrToFloat | Datatype conversion |
| StringOfChar, FillChar |
Working with PChar
Seldom you will have to use the string type PChar, though if you are working with the WindowsAPI or with C- Libraries you will have to. In contrast to the Delphi type "String", PChar is actually a pointer and you have to take care of the memory allocation.
If a function expects a variable of type PChar but does only read the variable (const parameter) you can work with normal strings and constant strings. In the example the windows function "MessageBox" expects two PChar arguments.
procedure SayHello;
var
sNormalString: String;
begin
sNormalString:= 'hello';
MessageBox(0, PChar(sNormalString), 'ConstantString', MB_OK);
end;
If a function expects a PChar to place a result in it, then you have to allocate the memory yourself. After the function call it's very easy to convert the PChar to a String, you can simply assign the PChar to a String. In Delphi, the variable szBuffer (array of char) is compatible to PChar but with allocated memory.
function Sto_GetTempPathStatic: String;
var
szBuffer: array[0..MAX_PATH] of Char;
begin
GetTempPath(MAX_PATH + 1, szBuffer);
Result := szBuffer; // copy all characters until first 0#
end;
The method above has two major drawbacks, first you have to know the necessary buffersize, and then you can run into an unpredictable situation, if a next version of the function accepts a bigger buffer. In this case the buffer would contain random data (although a missing #0 character wouldn't lead to a buffer overrun).
Of course there is a better way, and you can even work with normal strings. If you later have to switch to unicode, the code works the same way with WideStrings. Most Windows API functions will return the needed size shouldn't there be enough allocated memory, otherwise they return the length of the resulting string.
function Sto_GetTempPath: String;
var
iAssumedSize, iSize: DWORD;
begin
// try with a reasonable buffer size
iAssumedSize := 80;
SetLength(Result, iAssumedSize);
iSize := GetTempPath(iAssumedSize, PChar(Result));
// reserve more buffer if necessary
if (iSize > iAssumedSize) then
begin
// in this case the terminating #0 is included in iSize.
SetLength(Result, iSize);
iSize := GetTempPath(iSize, PChar(Result));
end;
// reduce buffer to the effectively used size. if the api call
// was successful, the terminating #0 is not included in iSize.
SetLength(Result, iSize);
end;
Using text resources of Windows
Did you already write a small useful function for your library, but then it became difficult to share it, because you needed to deliver translated text resources? Maybe you can borrow the textes from the Windows environment, at least some of the most common textes. An overview of existing textes can give you a resource editor.
/// <summary>
/// Searches for a text resource in a Windows library.
/// Sometimes, using the existing Windows resources, you can
/// make your code language independent and you don't have to
/// care about translation problems.
/// </summary>
/// <example>
/// btnCancel.Caption := Sto_LoadWindowsStr('user32.dll', 801, 'Cancel');
/// btnYes.Caption := Sto_LoadWindowsStr('user32.dll', 805, 'Yes');
/// </example>
/// <param name="LibraryName">Name of the windows library like
/// 'user32.dll' or 'shell32.dll'</param>
/// <param name="Ident">Id of the string resource.</param>
/// <param name="DefaultText">Return this text, if the resource
/// string could not be found.</param>
/// <returns>Desired string if the resource was found, otherwise
/// the DefaultText</returns>
function Sto_LoadWindowsStr(const LibraryName: String; const Ident: Integer;
const DefaultText: String = ''): String;
const
BUF_SIZE = 1024;
var
hLibrary: THandle;
iSize: Integer;
begin
hLibrary := GetModuleHandle(PChar(LibraryName));
if (hLibrary <> 0) then
begin
SetLength(Result, BUF_SIZE);
iSize := LoadString(hLibrary, Ident, PChar(Result), BUF_SIZE);
if (iSize > 0) then
SetLength(Result, iSize)
else
Result := DefaultText;
end
else
Result := DefaultText;
end;
ColorToHtml / HtmlToColor
In HTML, colors are stored as text in the RGB (red green blue) format. Each part of the color has a hex value with two digits. With the following functions you can convert a TColor value to an HTML-color-string and reverse.
uses SysUtils, Graphics;
////////////////////////////////////////////////////////////////
// converts a color to an html color string
// clRed => #FF0000
function Sto_ColorToHtml(const Color: TColor): String;
var
iRgb: Longint;
iHtml: Longint;
begin
// convert system colors to rgb colors
iRgb := ColorToRGB(Color);
// change BBGGRR to RRGGBB
iHtml := ((iRgb and $0000FF) shl 16) or // shift red to the left
( iRgb and $00FF00) or // green keeps the place
((iRgb and $FF0000) shr 16); // shift blue to the right
// create the html string
Result := '#' + IntToHex(iHtml, 6);
end;
////////////////////////////////////////////////////////////////
// converts an html color string to a color,
// can raise an EConvertError exception
// #0000FF -> clBlue
function Sto_HtmlToColor(Color: String): TColor;
var
iHtml: Longint;
begin
// remove the preceding '#'
if (Length(Color) > 0) and (Color[1] = '#') then
Delete(Color, 1, 1);
// convert html string to integer
iHtml := StrToInt('$' + Color);
// change RRGGBB to BBGGRR
Result := ((iHtml and $FF0000) shr 16) or // shift red to the right
( iHtml and $00FF00) or // green keeps the place
((iHtml and $0000FF) shl 16); // shift blue to the left
end;
Classes and objects
Writing events
You can write your own events in your classes. As soon as you place the event property in the "published" part of the class declaration, the Delphi IDE will show the event in the objectinspector by adding the component. It's a common practice to write a virtual method for calling the event, often it's called like the event with "Do" at the begin. In this example, the object passes a boolean parameter to the event, which can be altered in the event procedure. If you don't have to pass parameters you can use the predefined type "TNotifyEvent" instead of your own event declaration ("TOnEvent").
interface
type
TOnEvent = procedure(Sender: TObject; var Continue: Boolean) of object;
TEventDemo = class(TObject)
protected
FOnEvent: TOnEvent;
procedure DoEvent; virtual;
published
property OnEvent: TOnEvent read FOnEvent write FOnEvent;
end;
implementation
procedure TEventDemo.DoEvent;
var
bContinue: Boolean;
begin
// set default values
bContinue := True;
// call the event
if Assigned(FOnEvent) then
FOnEvent(Self, bContinue);
// do other things
if bContinue then
begin
// ...
end;
end;
Index properties
A special kind of properties are the indexed properties, they act like an array and can be used in the same fashion. However, the class has to take care of the memory management and the performed actions by implementing the methods ("GetIndexProperty" and "SetIndexProperty").
interface
type
TIndexPropertyDemo = class(TObject)
protected
function GetIndexProperty(Index: Integer): String; virtual;
procedure SetIndexProperty(Index: Integer; const Value: String); virtual;
public
property IndexProperty[Index: Integer]: String read GetIndexProperty write SetIndexProperty;
end;
implementation
procedure IndexPropertyDemo(ExistingDemoObject: TIndexPropertyDemo);
var
sText: String;
begin
sText := ExistingDemoObject.IndexProperty[0];
ExistingDemoObject.IndexProperty[1] := sText;
end;
Using windows messages
In Delphi classes, you can catch windows messages directly and use them for your own purposes. To do this, write a method and add the keyword "message" with the message id. It's normally not a virtual method because a child class can implement it in the same manner. To pass the message to an ancestor class, you can use the keyword "inherited".
In the example you can see a small class which implements a transparent panel. There are two methods implemented "WMEraseBkgnd" and "CreateParams", they show the difference between a normal virtual method (CreateParams) and a message handler (WMEraseBkgnd).
interface
uses Windows, Messages;
type
TStoTransparentPanel = class(TWinControl)
private
procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND;
protected
procedure CreateParams(var Params: TCreateParams); override;
end;
implementation
procedure TStoTransparentPanel.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.ExStyle:= Params.ExStyle or WS_EX_TRANSPARENT;
end;
procedure TStoTransparentPanel.WMEraseBkgnd(var Message: TWmEraseBkgnd);
begin
// in this case, we want to intercept the windows message. if we would want to
// pass the message to the ancestor classes, we could use the keyword
// "inherited" without the procedure name. example:
// inherited;
Message.Result := 1;
end;
Delphi VCL
Coloring a StringGrid
You can bring colors to your grids with a small amount of work. A comfortable way to do this is, to write your own "OnDrawCell" event and paint the text manually. The example works with a TStringGrid, though it's not very different for TDrawGrid's.
////////////////////////////////////////////////////////////////
// draws the text for one single cell in a grid
procedure Sto_DrawCellText(const Canvas: TCanvas; const Rect: TRect;
const Text: String; const BackColor, TextColor: TColor;
const Alignment: TAlignment);
const
BORDER_WIDTH = 2;
var
iLeftBorder: Integer;
begin
// calculate the left border
iLeftBorder := 0;
case Alignment of
taLeftJustify : iLeftBorder := Rect.Left + BORDER_WIDTH;
taRightJustify: iLeftBorder := Rect.Right - BORDER_WIDTH - Canvas.TextWidth(Text) -1;
taCenter : iLeftBorder := Rect.Left + (Rect.Right - Rect.Left - Canvas.TextWidth(Text)) div 2;
end;
// set colors
Canvas.Font.Color := TextColor;
Canvas.Brush.Color := BackColor;
// paint the text
ExtTextOut(Canvas.Handle, iLeftBorder, Rect.Top + BORDER_WIDTH, ETO_CLIPPED or ETO_OPAQUE,
@Rect, PChar(Text), Length(Text), nil);
end;
////////////////////////////////////////////////////////////////
// the OnDrawCell event of the grid
procedure TForm1.grdColoredStringGridDrawCell(Sender: TObject; ACol,
ARow: Integer; Rect: TRect; State: TGridDrawState);
var
grdColored: TStringGrid;
sText: String;
myBackColor: TColor;
myTextColor: TColor;
myAlignment: TAlignment;
begin
grdColored := TStringGrid(Sender);
// set default values for the parameters,
// get the values depending on the grid settings.
sText := grdColored.Cells[ACol, ARow];
if (ARow < grdColored.FixedRows) or (ACol < grdColored.FixedCols) then
myBackColor := grdColored.FixedColor
else
myBackColor := grdColored.Color;
myTextColor := grdColored.Font.Color;
myAlignment := taLeftJustify;
// set your own values...
myTextColor := clGreen;
// draw the text in the cell
Sto_DrawCellText(grdColored.Canvas, Rect, sText, myBackColor, myTextColor, myAlignment);
end;
Hiding tabs in a PageControl
To write a wizard, it would be nice to use a PageControl with invisible Tabs. You can hide the tabs with the TabVisible property of TTabSheet and select the TabSheets in code.
////////////////////////////////////////////////////////////////
// hides all tabs (not the tabsheet itself) in the pagecontrol,
// and selects the first tabsheet as the active displayed.
procedure Sto_HideTabsInPageCtrl(PageControl: TPageControl);
var iPage: Integer;
begin
// hide the tabs
for iPage := 0 to PageControl.PageCount - 1 do
PageControl.Pages[iPage].TabVisible := False;
// set the active tabsheet
if (PageControl.PageCount > 0) then
PageControl.ActivePage := PageControl.Pages[0];
// hide the border of the pagecontrol
PageControl.Style := tsButtons;
end;
Creating special menu shortcuts
Adding shortcuts like <ctrl><c> to a menu item is very easy, since you can chose a lot of combinations in Delphi's property editor. What if you need another shortcut, not offered by the property editor? Special shortcuts like <ESC> or <alt><KeyDown> you can add at runtime in all possible combinations.
procedure TForm1.FormCreate(Sender: TObject);
begin
// shortcut definition, not offered by the property editor
mnuExit.ShortCut := ShortCut(VK_ESCAPE, []);
mnuFindNext.ShortCut := ShortCut(VK_DOWN, [ssAlt]);
end;
Shortcuts of the form <alt><?> are normally generated with the caption property of the menu item. Insert a "&" character to generate an <alt> shortcut with the next letter, "Hello &world" would generate the shortcut <alt><w>.
Autosizing dropdown of a combobox
If the dropdown content exceeds the width of a combobox, then the text is hidden from the user. With the following small procedure you can fit the dropdown width automatically to the necessary size.
uses Windows, Messages, StdCtrls;
////////////////////////////////////////////////////////////////
// this procedure sets the with of the dropdown box, if the
// content is to large for the standard width.
procedure Sto_AutoWidthCombobox(Combobox: TCombobox);
const
HORIZONTAL_PADDING = 4;
var
iWidth: Integer;
iIndex: Integer;
iLineWidth: Integer;
begin
iWidth := 0;
// calculate the width of the drop down content
for iIndex := 0 to Combobox.Items.Count - 1 do
begin
iLineWidth := Combobox.Canvas.TextWidth(Combobox.Items[iIndex]);
Inc(iLineWidth, 2 * HORIZONTAL_PADDING);
if (iLineWidth > iWidth) then
iWidth := iLineWidth;
end;
// set the calculated width if necessary
if (iWidth > Combobox.Width) then
SendMessage(Combobox.Handle, CB_SETDROPPEDWIDTH, iWidth, 0);
end;
Delphi IDE
IDE keyboard shortcuts
In the standard configuration of the Delphi IDE, a lot of useful keyboard shortcuts are available, some of them are not very known. It's even possible to record and play simple keyboard macros.
| Shortcut | Description |
|---|---|
|
<ctrl><shift><0..9> <ctrl><0..9> |
Set or remove the bookmark 0..9 . Jump to the bookmark 0..9 in the currently opened file. |
|
<ctrl><shift><i> <ctrl><shift><u> |
Indent the selected rows. Unindent the selected rows. |
|
<ctrl><shift><up> <ctrl><shift><down> |
Switch between declaration and implementation. |
|
<alt><up> <ctrl><left_mouse_button> |
Find the implementation of a procedure or function. |
| <ctrl><e> | Incremental search mode. |
|
<ctrl><shift><r> <ctrl><shift><p> |
Start and stop the recording of a simple keyboard macro (record). Replays the macro (play). |
| <ctrl><shift><g> | Create a new GUID. |
Output directories
In the project options you can set an output path for the executable and one for the compiled units (*.dcu). It's very useful to have the dcu's in a separate directory, but every programmer has to have this directory, otherwise he can't compile the project.
Since Delphi6 (?) it's possible to have global variables and relative paths in the output directories. Because all programmers will have at least a global temp path, you can set this variable as the dcu output directory. If you set a relative path as the executable directory, it's easier to move or copy the project.
| Path | Setting |
|---|---|
| ..\bin | Output path for the executable in a relative directory |
| $(TEMP) | Output path for units (*.dcu) |
Variants and COM
Empty and Null
Variants can handle several datatypes and some special states as EMPTY and NULL. Before you assign a value to a variant, it has the state EMPTY. There are a lot of functions to check the state or type of a variant and there are predefined variants you can use.
uses Variants;
procedure VariantDemo;
var
vDemo: Variant;
bTest: Boolean;
begin
// EMPTY
vDemo := Unassigned; // assign EMPTY to variant
bTest := VarIsEmpty(vDemo); // check if variant is EMPTY
// NULL
vDemo := NULL; // assign NULL to variant
bTest := VarIsNull(vDemo); // check if variant is NULL
// numeric
vDemo := 8.8; // assign a float to variant
bTest := VarIsNumeric(vDemo); // check if variant is numeric
// text
vDemo := 'demo'; // assign a string to variant
bTest := VarIsStr(vDemo); // check if variant contains text
// COM methods can define obtional parameters. if you are
// working with typelibraries you have to pass a parameter
// nevertheless, then you can pass "EmptyParam"
vDemo := EmptyParam;
bTest := VarIsEmptyParam(vDemo);
end;
How to register a COM server
Before you can use and test your new created COM server, you have to register it. You can do this with the Delphi menu Start\Register ActiveX-Server or you can register it by yourself. It depends on the kind of server you have (in-process *.dll or out-of-process *.exe) how to register the server.
| Register | Unregister | |
|---|---|---|
| in-process (MyServer.dll) | regsvr32 MyServer.dll | regsvr32 /u MyServer.dll |
| out-of-process (MyServer.exe) | MyServer.exe /regserver | MyServer.exe /unregserver |
Default property in a COM object
In COM you can define a default property, this is useful especially for lists. Assuming you have an implementation of a list with an "Items" property, the code could look like this:
// normal reading of an item
aItem := aList.Items[iIndex];
// with a default property defined
aItem := aList[iIndex];
Defining a default property is very easy, provided that you know where to look. In the typelibrary editor you go to the page "Attributes" and set the "ID" field to 0, done.
Modal forms in COM
When you are using modal forms in a COM server, you will miss the support of the menu shortcuts and the automatic navigation between the controls with the TAB key. this is because the "Application" object doesn't handle the windows messages, it is the window of the client application.
////////////////////////////////////////////////////////////////
// if you display a form from inside a COM server, you will miss the
// automatic navigation between the controls with the "TAB" key.
// the "KeyPreview" property of the form has to be set to "True".
procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
var
bShift: Boolean;
begin
// check for tab key and switch focus to next or previous control.
// handle this in the KeyPress event, to avoid a messagebeep.
if (Ord(Key) = VK_TAB) then
begin
bShift := Hi(GetKeyState(VK_SHIFT)) <> 0;
SelectNext(ActiveControl, not(bShift), True);
Key := #0; // mark as handled
end;
end;
////////////////////////////////////////////////////////////////
// if you display a form from inside a COM server, you will miss the
// support of the menu- and action- shortcuts like "<Ctrl><S>".
// the "KeyPreview" property of the form has to be set to "True".
procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
const
AltMask = $20000000;
var
myMessage: TWMKey;
begin
// recreate the original "KeyUp" message
FillChar(myMessage, SizeOf(TWMKey), 0);
myMessage.Msg := WM_KEYUP;
myMessage.CharCode := Key;
if (ssAlt in Shift) then
myMessage.KeyData := AltMask;
// find and execute matching shortcut
if IsShortCut(myMessage) then
Key := 0; // mark as handled
end;
Using interfaces without COM
Normally you will use interfaces in combination with COM objects. In contrast to conventional objects, a COM object supports reference counting and will free itself when the last reference is released.
You can use interfaces for your conventional objects too, without supporting reference counting and automatically freeing. Doing this, you have to pay attention to some special facts.
ITest = interface(IInterface)
// press <ctrl><shift><g> to create your own GUID for each interface.
// this is necessary to implement the "QueryInterface" method.
['{CA51B752-0DF5-40D2-945C-A5CF2EAA3B31}']
procedure ShowText;
end;
TTest = class(TObject, ITest)
protected
FText: String;
// IInterface
function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
function _AddRef: Integer; stdcall;
function _Release: Integer; stdcall;
// ITest
procedure ShowText;
end;
Because every interface inherites from the parent interface "IInterface" (same as windows specific "IUnknown"), you have to support at least the three methods of "IInterface". This example shows a standard implementation.
function TTest._AddRef: Integer;
begin
Result := -1; // no reference counting supported
end;
function TTest._Release: Integer;
begin
Result := -1; // no reference counting supported
end;
function TTest.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
if GetInterface(IID, Obj) then
Result := S_OK
else
Result := E_NOINTERFACE;
end;
procedure TTest.ShowText;
begin
ShowMessage(FText);
end;
When you later use the object, you have to be careful, that at the moment of destruction, no reference to the interface remains.
procedure WellUsed;
var
myTestObject: TTest;
pTestInterface: ITest;
begin
// creating the object
myTestObject := TTest.Create;
// get a reference to the interface of the object, this will implicitly call "_AddRef"
pTestInterface := myTestObject;
// ...
// release the reference to the interface, this will implicitly call "_Release"
pTestInterface := nil;
// freeing the object itself
myTestObject.Free;
end;
If you free the object, before the last reference to the interface is released, then the implicit call to "_Release" will call to a not existing object (Delphi will release the interface automatically, if you don't do it yourself).
procedure WrongUsed;
var
myTestObject: TTest;
pTestInterface: ITest;
begin
myTestObject := TTest.Create;
pTestInterface := myTestObject;
// ...
// freeing the object with an existing reference
myTestObject.Free;
// this releasing of the interface will implicitly call "_Release", but there
// is no living object anymore.
pTestInterface := nil;
end;
Normally, calling a method of a not existing object will cause a runtime error, not in our example. That's because no member of the object is used inside "_Release", as soon as you access a member, you will get the expected error. So, first make sure you don't call a "_Release" on a not existing object, then don't access members inside of "_Release".
function TTest._Release: Integer;
begin
// this will cause an error, if the reference is released after the object was freed.
FText := '';
Result := -1; // no reference counting supported
end;