Compile DPK files using DCC32

Using Delphi command lines compiler DCC32 to compile programs allow us to set some switches to get various kind of output. The most common usage is compile a debugged or non-debugged release. For example, we may use dcc32 -B -$O-,D+,L+,YD to compile dcu/dcp with debug information and dcc32 -B -$O-,D-,L-,Y- to compile dcu/dcp without debug information. However, you may notice that using such switches has no effect on DPK (Delphi package) files. The reason is simple but yet difficult to discover. If you study DPK files, you may see the following:

package MyPackage;

{$R *.res}
{$ALIGN 8}
{$ASSERTIONS ON}
{$BOOLEVAL OFF}
{$DEBUGINFO ON}
{$EXTENDEDSYNTAX ON}
{$IMPORTEDDATA ON}
{$IOCHECKS ON}
{$LOCALSYMBOLS ON}
{$LONGSTRINGS ON}
{$OPENSTRINGS ON}
{$OPTIMIZATION OFF}
{$OVERFLOWCHECKS OFF}
{$RANGECHECKS OFF}
{$REFERENCEINFO ON}
{$SAFEDIVIDE OFF}
{$STACKFRAMES OFF}
{$TYPEDADDRESS OFF}
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST OFF}
{$MINENUMSIZE 1}
{$IMAGEBASE $400000}
{$DESCRIPTION 'E Stream Software - Runtime Library'}
{$LIBPREFIX 'SQL.'}
{$RUNONLY}
{$IMPLICITBUILD OFF}
{$DEFINE DEBUG}

The DPK files already has built in compiler directives. It has priority over the switches you specified in command lines. As stated by Allen Bauer in the post:

The IDE supports a very little know feature where you can continue to control these options while in the IDE, yet allow the command-line be able to also control the options. In a package file, all the options listed there are propagated to all the contained units. This is different than a normal .dpr program/library file. In order to do this, all you need to do is replace the '$' with a ' ' (that's a ). Then when you open the dpk in the IDE, you can toggle those options as much as you like, but when you compile on the command-line, you can still control them. This is how we build all our packages for the product itself. All of the Borland built packages have DEBUGINFO, STACKFRAMES, ASSERTIONS, OPTIMIZATION, LOCALSYMBOLS setup this way because like you, we wan't to be able to control those options from the command-line. The developers will typically do a complete "debug" build, whereas the integration team will not. $DEFINES will sort of work the same way, in that if you replace the '$' with a ' ', the IDE will still recognize the defines and apply them, but any other modifications to the dpk source will re-insert the '$' character.

The solution is replace $ with a space character (' ') for all compiler directives only:

package MyPackage;

{$R *.res}
{$ALIGN 8}
{ ASSERTIONS ON}
{ BOOLEVAL OFF}
{ DEBUGINFO ON}
{ EXTENDEDSYNTAX ON}
{ IMPORTEDDATA ON}
{ IOCHECKS ON}
{ LOCALSYMBOLS ON}
{ LONGSTRINGS ON}
{ OPENSTRINGS ON}
{ OPTIMIZATION OFF}
{ OVERFLOWCHECKS OFF}
{ RANGECHECKS OFF}
{ REFERENCEINFO ON}
{ SAFEDIVIDE OFF}
{ STACKFRAMES OFF}
{ TYPEDADDRESS OFF}
{ VARSTRINGCHECKS ON}
{ WRITEABLECONST OFF}
{ MINENUMSIZE 1}
{$IMAGEBASE $400000}
{$DESCRIPTION 'E Stream Software - Runtime Library'}
{$LIBPREFIX 'SQL.'}
{$RUNONLY}
{$IMPLICITBUILD OFF}
{$DEFINE DEBUG}

By doing so, both the IDE and DCC32 will respect the switches and yield expected results and. The output files (DLL, BPL or EXE) do not contain any debugging information even if you turn on the debugging switches. Those debugging information are stored in DCU or DCP files. To keep the debug information in DLL, BPL or EXE, turn on the Include TD32 debug info or use -V switch with DCC32.

Retrieve Shell Folders

Windows has some special folders like My Documents, SendTo, Desktop or Favorites. The location of this folders are keep in the following registry key: HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders However, it is not encourage to retrieve the location of special folders using registry. The recommended way to retrieve is via windows API function SHGetFolderPath:

uses SHFolder;

var sDir: string;
begin
  SetLength(sDir, MAX_PATH);
  ZeroMemory(@sDir[1], MAX_PATH);
  if Succeeded(SHGetFolderPath(0, CSIDL_PERSONAL, 0, 0, PAnsiChar(sDir))) then
    ShowMessage(sDir);
end;

Beware of XML Content contain CRLF always cause problem with Google API

We may consume the Google API to post entry of event kind. Those entry are mostly encoded in XML content. It is a common habit for windows user to create the XML content in windows notepad. If we pass the XML content from notepad directly to the Google API, we will mostly encounter error such as HTTP 400 Bad Request. The reason is simple but yet difficult to discover. CRLF (0x0D 0x0A) is default line separator in windows operating system. The Google API or perhaps the content type we specify in the HTTP request header is application/atom+xml may not recognize the CRLF and cause the HTTP 400 Bad request error. Always remember to well form the XML content before consume the API services. For example, replace all CRLF to a space character:

NewXMLText := StringReplace(XMLText, #13#10, ' ', [rfReplaceAll, rfIgnoreCase]);

Using Indy HTTPS client to consume Google API service

Indy VCL 10 distribution supports SSL via OpenSSL but it didn't bundle the DLL library. We have to download the Win32 OpenDDL from here. After install the Win32 OpenSSL library, there are 2 .DLL files we are interested may be found in %windir%\system32: libssl32.dll and libeay32.dll. However, the Indy Open SSL unit IdSSLOpenSSLHeaders.pas are coding as: SSL_DLL_name = 'ssleay32.dll'; {Do not localize} SSLCLIB_DLL_name = 'libeay32.dll'; {Do not localize} To make the Indy works with OpenSSL, we have to rename one of the DLL file libssl32.dll to ssleay32.dll. Here is a sample code using Indy VCL to authenticate with Google Calendar service:

var S: TStringList;
   M: TStream;
begin
 S := TStringList.Create;
 M := TMemoryStream.Create;
 try
   S.Values['Email'] := 'your google account';
   S.Values['Passwd'] := 'your password';
   S.Values['source'] := 'estream-sqloffice-1.1.1.1';
   S.Values['service'] := 'cl';

   IdHTTP1.IOHandler := IdSSLIOHandlerSocketOpenSSL1;
   IdHTTP1.Request.ContentType := 'application/x-www-form-urlencoded';
   IdHTTP1.Post('https://www.google.com/accounts/ClientLogin', S, M);
   Memo1.Lines.Add(Format('Response Code: %d', [IdHTTP1.ResponseCode]));
   Memo1.Lines.Add(Format('Response Text: %s', [IdHTTP1.ResponseText]));

   M.Position := 0;
   S.LoadFromStream(M);
   Memo1.Lines.AddStrings(S);
 finally
   S.Free;
   M.Free;
 end;
end;

Resize Form even if it is borderless

We may make a form without borders to show some additional information using some popup windows. However, a borderless form will no longer resizable. Use the following code to make a borderless form resizable:

type
 TForm1 = class(TForm)
 protected
   procedure CreateParams(var Params: TCreateParams); override;
 end;

procedure TForm1.CreateParams(var Params: TCreateParams);
begin
 BorderStyle := bsNone;
 inherited;
 Params.ExStyle := Params.ExStyle or WS_EX_STATICEDGE;
 Params.Style := Params.Style or WS_SIZEBOX;
end;

Move a form without dragging on the title bar

We usually use mouse to drag the windows form title bar to move the window on our desktop. There is a new way to move the form by just dragging on any point in the form itself. This is ideally suitable for those form that don't have title bar. For example, FormStyle := bsNone; Use the following code to drag on window content and you able to move the form just as you drag on title bar:

type
  TForm1 = class(TForm)
  private
    procedure WMNCHitTest(var Msg: TWMNCHitTest); message WM_NCHitTest;
  end;

procedure TForm1.WMNCHitTest(var Msg: TWMNCHitTest);
begin
  inherited;
  if Msg.Result = htClient then
    Msg.Result := htCaption;
end;

The above code attempt to hijack the mouse event to tell the system to treat the mouse click action on windows client area as mouse click on windows title bar. There is a drawback using the message handler. All form's customize mouse events will no longer function as the mouse event has been hijacked by WM_NCHitTest handler. What if there are controls on the forma and you still wish to drag on the window to move the form around? The above above will only function if you drag on the empty area in the form. To make the dragging more sensible, write a MouseMove event for the control:

procedure TForm12.ListBox1MouseMove(Sender: TObject; Shift: TShiftState; X, Y:
  Integer);
begin
  ReleaseCapture;
  SendMessage(Self.Handle, WM_SYSCOMMAND, 61458, 0);
end;

TListBox review

TListBox is a simple visual component that always use for display a list of items but it has some nice features that we always neglected. Using TListBox to show column-like data

procedure TForm1.FormCreate(Sender: TObject);
var L: TListBox;
begin
 L := TListBox.Create(Self);
 L.Parent := Self;
 L.Align := alClient;
 L.TabWidth := 20;
 with L.Items do begin
   Add('Item 01'^I'This is Item 01'^I'3.00');
   Add('Item 02'^I'This is Item 02'^I'5.00');
   Add('Item 03'^I'This is Item 03'^I'23.00');
   Add('Item 04'^I'This is Item 04'^I'33.00');
   Add('Item 05'^I'This is Item 05'^I'43.00');
 end;
end;

Custom Draw items in TListBox #1

procedure TForm1.FormCreate(Sender: TObject);
var L: TListBox;
begin
 L := TListBox.Create(Self);
 L.Parent := Self;
 L.Align := alClient;
 L.Style := lbOwnerDrawFixed;
 L.OnDrawItem := OnDrawItem;
 with L.Items do begin
   Add('Item 01');
   Add('Item 02');
   Add('Item 03');
   Add('Item 04');
   Add('Item 05');
 end;
end;

procedure TForm1.OnDrawItem(Control: TWinControl; Index: Integer;
 Rect: TRect; State: TOwnerDrawState);
var C: TColor;
begin
 with Control as TListBox do begin
   Canvas.FillRect(Rect);

   if odSelected in State then
     C := Canvas.Font.Color
   else if Index mod 2 = 0 then
     C := clGreen
   else
     C := clBlue;
   Canvas.Font.Color := C;

   Canvas.TextOut(Rect.Left, Rect.Top, Items[Index]);
 end;
end;

Custom Draw items in TListBox #2

procedure TForm1.FormCreate(Sender: TObject);
var L: TListBox;
begin
 L := TListBox.Create(Self);
 L.Parent := Self;
 L.Align := alClient;
 L.Style := lbOwnerDrawVariable;
 L.OnDrawItem := OnDrawItem;
 L.OnMeasureItem := OnMeasureItem;
 with L.Items do begin
   Add('Item 01');
   Add('Item 02');
   Add('Item 03');
   Add('Item 04');
   Add('Item 05');
 end;
end;

procedure TForm11.OnDrawItem(Control: TWinControl; Index: Integer;
 Rect: TRect; State: TOwnerDrawState);
var iSize: integer;
begin
 with Control as TListBox do begin
   Canvas.FillRect(Rect);

   if Index mod 2 = 0 then
     iSize := 12
   else
     iSize := 20;
   Canvas.Font.Size := iSize;

   Canvas.TextOut(Rect.Left, Rect.Top, Items[Index]);
 end;
end;

procedure TForm11.OnMeasureItem(Control: TWinControl; Index: Integer; var
 Height: Integer);
var iSize: integer;
   L: TListBox;
begin
 L := Control as TListBox;
 if Index mod 2 = 0 then
   iSize := 12
 else
   iSize := 20;
 L.Canvas.Font.Size := iSize;
 Height := L.Canvas.TextHeight(L.Items[Index]);
end;

Custom Draw items in TListBox #3 Due to the design of windows list box control, the OnMeasure event is trigger once only if an item is added. The following code shows example of how to draw item with custom item height.

procedure TForm1.BeforeDestruction;
begin
 inherited;
 Font1.Free;
 Font2.Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
var L: TListBox;
begin
 L := TListBox.Create(Self);
 L.Parent := Self;
 L.Align := alClient;
 L.Style := lbOwnerDrawVariable;
 L.OnDrawItem := OnDrawItem;

 Font1 := TFont.Create;
 Font1.Name := 'Tahoma';
 Font1.Size := 25;
 Font1.Color := clGreen;

 Font2 := TFont.Create;
 Font2.Name := 'Arial';
 Font2.Size := 15;
 Font2.Color := clNavy;
 Font2.Style := [fsBold];

 with L.Items do begin
   AddObject('Item 01', Font1);
   AddObject('Item 02', Font2);
   AddObject('Item 03', Font1);
   AddObject('Item 04', Font2);
   AddObject('Item 05', Font1);
 end;
end;

procedure TForm1.OnDrawItem(Control: TWinControl; Index: Integer;
 Rect: TRect; State: TOwnerDrawState);
var C: TColor;
 L: TListBox;
begin
 L := Control as TListBox;
 L.Canvas.FillRect(Rect);

 C := L.Canvas.Font.Color;
 L.Canvas.Font.Assign(L.Items.Objects[Index] as TFont);
 if odSelected in State then
   L.Canvas.Font.Color := C;

 SendMessage(L.Handle, LB_SETITEMHEIGHT, Index, L.Canvas.TextHeight(L.Items[Index]));
 L.Canvas.TextOut(Rect.Left, Rect.Top, L.Items[Index]);
end;

Create home directory manually

When we use /usr/sbin/useradd to create a user, it's home directory may contain some default files or folders (it is hidden usually). However, we may want to create a the home directory for user manually in certain situation, for example, use LDAP to manage user account: # mkdir /home/someuser # cp /etc/skel/.* /home/someuser # chown -R somebody.users /home/someuser # chmod 700 -R /home/someuser

Color MDI Form

If we want to change background color of a form: we usually do like this:

 Form1.Color := clYellow;

However, if a Form's FormStyle is fsMDIForm, change the color at runtime will not update immediately not until the form has been fully repaint or resize. Invoke TForm.Refresh, TForm.Update, TForm.Repaint will not update the color as well. To make the a MDI form update the background color immediately, we may do this:

 Form1.Color := clYellow;
 Windows.InvalidateRect(Form1.ClientHandle, nil, True);

How to avoid creation of ~BPL files in Delphi 2007

There is only one way to prevent creation of ~BPL in Delphi 2007 IDE: patch delphicoreide100.bpl in C:\Program Files\CodeGear\RAD Studio\5.0\bin. A good news is someone from http://www.liteapplications.com/ has wrote Delphi Distiller to patch the delphicoreide100.bpl. Hope CodeGear will provide an option in Delphi IDE to turn on and off the creation of ~BPL soon.

Setup Visual Studio 2005 to build Firebird source

Due to I/O redirector problem in GBAK.EXE (http://tech.groups.yahoo.com/group/firebird-support/message/90995), I download Firebird source to attempt compile it under Visual Studio 2005. Here are the steps:

1. Install Visual Studio 2005
2. Read the instruction in firebird source folder: doc/README.build.msvc
3. Install Firebird server
4. Setup these environment variables:
1. FIREBIRD=C:\Program Files\Firebird\Firebird_1_5
2. ISC_USER=SYSDBA
3. ISC_PASSWORD=masterkey
4. LIB=C:\Program Files\Microsoft Visual Studio 8\VC\lib
5. PATH=C:\Program Files\Microsoft Visual Studio 8\Common7\IDE;C:\Program Files\Microsoft Visual Studio 8\VC\bin
5. Open file "builds\win32\blrtable.BAT", add an include path: -I"C:\Program Files\Microsoft Visual Studio 8\VC\include" to the cl.exe clause
6. Open folder "builds\win32\msvc7", convert 2 solution files: Firebird2.sln and Firebird2Boot.sln to Visual Studio 2005 solution format.
7. Execute cmd.exe, and run Prepare.BAT, make_boot.BAT and make_all.BAT

Embed out of process windows into Delphi Control

We may easily embed a Delphi GUI control into another container control like TForm or TPanel:

var F: TForm;
  B: TButton;
begin
F := TForm.Create(nil);
F.Show;
B := TButton.Create(nil);
B.Parent := F;
end;

As TForm or TPanel is a Window GUI control too, we may embed a non-delphi out of process windows into TForm or TPanel control too:

var F: TForm;
   H: THandle;
   T: Cardinal;
begin
 F := TForm.Create(nil);
 F.Show;

 ShellExecute(0, 'open', 'calc', nil, nil, 0);

 // New window may not be created yet, find the window in a loop until it show out
 H := 0;
 T := GetTickCount;
 while H = 0 do begin
   H := FindWindow(nil, PChar('Calculator'));
   if GetTickCount - T > 5000 then
     Break;
 end;

 if H <> 0 then
   Windows.SetParent(H, F.Handle);
end;

Connect to Firebird 1.5 database on Windows Vista using Local Protocol

Using Local Protocol to connect to Firebird database no longer works in Windows Vista when we install firebird server using setup file's default configuration. Using local connection is convenient and fast if we perform GBAK, GFIX, QLI operation compare to TCP/IP connection. To configure Firebird 1.5 works with windows vista for local connection, install the firebird server to run as application instead of service: I haven't try using local connection for Firebird 2.x install on windows vista. Some suggest that changing IPCName in firebird.conf works even running firebird as service.

Create a I/O redirection console application

Typical DOS application that may perform great function are GREP, MORE, SORT. These functions chain together via command redirection operators may perform complex operations. Here is a simple application written by Delphi to show how to deal with I/O redirection:

program pipe;

{$APPTYPE CONSOLE}

var S: string;
   F: TextFile;

begin
 AssignFile(F, '');
 Reset(F);
 while not Eof(F) do begin
   Readln(F, s);
   Writeln(s);
   Flush(F);
 end;
 CloseFile(F);
end.

Scrolling TMemo and TRichEdit control at runtime

Here is the code to scroll TMemo control to bottom at runtime:

var M: TWMVScroll;
begin
 M.Msg := WM_VSCROLL;
 M.ScrollCode := SB_BOTTOM;
 Memo1.Dispatch(M);
end;

As such, we may use the code above to perform various kind scrolling operation during runtime:

{ Scroll Bar Commands }
{$EXTERNALSYM SB_LINEUP}
SB_LINEUP = 0;
{$EXTERNALSYM SB_LINELEFT}
SB_LINELEFT = 0;
{$EXTERNALSYM SB_LINEDOWN}
SB_LINEDOWN = 1;
{$EXTERNALSYM SB_LINERIGHT}
SB_LINERIGHT = 1;
{$EXTERNALSYM SB_PAGEUP}
SB_PAGEUP = 2;
{$EXTERNALSYM SB_PAGELEFT}
SB_PAGELEFT = 2;
{$EXTERNALSYM SB_PAGEDOWN}
SB_PAGEDOWN = 3;
{$EXTERNALSYM SB_PAGERIGHT}
SB_PAGERIGHT = 3;
{$EXTERNALSYM SB_THUMBPOSITION}
SB_THUMBPOSITION = 4;
{$EXTERNALSYM SB_THUMBTRACK}
SB_THUMBTRACK = 5;
{$EXTERNALSYM SB_TOP}
SB_TOP = 6;
{$EXTERNALSYM SB_LEFT}
SB_LEFT = 6;
{$EXTERNALSYM SB_BOTTOM}
SB_BOTTOM = 7;
{$EXTERNALSYM SB_RIGHT}
SB_RIGHT = 7;
{$EXTERNALSYM SB_ENDSCROLL}
SB_ENDSCROLL = 8;

Capture the output of console process and display on your GUI application

I use GBAK.EXE to perform backup and restore operation of Firebird database in my GUI application design. The reason I use GBAK instead of firebird service manager is I can perform remote backup and restore operation via TCP/IP network without transferring the backup file to firebird server first. However, as GBAK is a console utility, It display the output to STDOUT or STDERR. There is no easy way to capture the output while the console process is running. We need to invoke windows API to perform the task. We may use CreatePipe and CreateProcess to redirect the STDxxx handles and use ReadFile to capture the output in our GUI application. Here are some references that may helps:

1. Microsoft knowledge base: How to spawn console processes with redirected standard handles
2. Borland newsgroup: Catch console output in real time

There is a drawback using windows native API aproach. As stated in microsoft knowledge base:

Child processes that use such C run-time functions as printf() and fprintf() can behave poorly when redirected. The C run-time functions maintain separate IO buffers. When redirected, these buffers might not be flushed immediately after each IO call. As a result, the output to the redirection pipe of a printf() call or the input from a getch() call is not flushed immediately and delays, sometimes-infinite delays occur. This problem is avoided if the child process flushes the IO buffers after each call to a C run-time IO function. Only the child process can flush its C run-time IO buffers. A process can flush its C run-time IO buffers by calling the fflush() function.

I face this problem if I use GBAK to perform a lengthy backup and restore operation via this approach. The GUI application always stop half way in unforeseen point although it will finish the operation at last. There isn't any response from the ReadFile when it hang some where. I suspect it was due the GBAK utility written didn't perform flush as described.

Enumerate Optional Parameters of TClientDataSet instance

We may use GetOptionalParam and SetOptionalParam methods to access the optional parameters in TClientDataSet instance. However, if we do not know ahead of what parameters are available, these 2 methods serve no purpose to enumerate a list of available parameters. Unit DBClient.pas defines the following:

type
TCustomClientDataSet = class(TWideDataSet)
private
 FDSBase: IDSBase;
protected
 property DSBase: IDSBase read FDSBase write FDSBase;
end;

TClientDataSet = class(TCustomClientDataSet)
end;

Unit DSInst.pas defines the following:

  DSProps = packed  record
  szName           : MIDASPATH;      { Name, if any }
  iFields          : Integer;      { Number of columns }
  iRecBufSize      : Integer;      { Size of record buffer }
  iBookMarkSize    : Integer;      { Size of bookmark }
  bReadOnly        : LongBool;         { Dataset is not updateable }
  iIndexes         : Integer;      { Number of indexes on dataset }
  iOptParams       : Integer;      { Number of optional parameters }
  bDelta           : LongBool;         { This is a delta dataset }
  iLCID            : Integer;      { Language used }
  iUnused          : packed array[0..7] of Integer; { Reserved }
end;


  function GetOptParameter(       { Returns optional parameter (unknown to dataset) }
      iNo      : LongWord;           { Number 1..iOptAttr }
      iFldNo   : LongWord;           { 0 if not field attribute }
  var ppName   : Pointer;         { returns ptr to name }
  var piType   : LongWord;           { returns type }
  var piLen    : LongWord;           { returns length }
  var ppValue  : Pointer          { returns ptr to value }
  ): DBResult; stdcall;

We may attempt to use the above definition to enumerate a list of available optional parameters in TClientDataSet instance. Before we proceed, there is an obstacle to solve. The DSBase property is protected. To overcome it, we can define a class helper function to access the protected property.

type
TClientDataSetHelper = class helper for TClientDataSet
public
  function GetDSBase: IDSBase;
end;

function TClientDataSetHelper.GetDSBase: IDSBase;
begin
Result := DSBase;
end;

The following code shows how to retrieve available optional params.

var D: TClientDataSet;
 p: DSProps;
 pName, pValue: PChar;
 pType, pLen: LongWord;
 iResult: word;
begin
D := TClientDataSet.Create(nil);
try
 D.FieldDefs.Add('Name', ftString, 20);
 D.CreateDataSet;

 D.SetOptionalParam('Param1', 'FirstValue', True);
 D.SetOptionalParam('Param2', 'SecondValue', True);

 ZeroMemory(@p, SizeOf(p));
 D.GetDSBase.GetProps(p);
 Assert(p.iOptParams = 2);

 pName := nil;
 pValue := nil;
 iResult := D.GetDSBase.GetOptParameter(1, 0, pointer(pName), pType, pLen, pointer(pValue));
 Assert(iResult = 0);
 Assert(string(pName) = 'Param1');
 Assert((pType and dsTypeBitsMask) shr dsSizeBitsLen = dsfldZSTRING);
 Assert(pLen = 11);
 Assert(string(pValue) = 'FirstValue');

 pName := nil;
 pValue := nil;
 iResult := D.GetDSBase.GetOptParameter(2, 0, pointer(pName), pType, pLen, pointer(pValue));
 Assert(iResult = 0);
 Assert(string(pName) = 'Param2');
 Assert((pType and dsTypeBitsMask) shr dsSizeBitsLen = dsfldZSTRING);
 Assert(pLen = 12);
 Assert(string(pValue) = 'SecondValue');
finally
 D.Free;
end;
end;

Understand HANDLE allocated to Delphi Packages in Windows environment

We may seldom need to deal with Windows API when using Delphi VCL to develop a Win32 application. The most common information we may want to retrieve is the file name of the main executable in runtime. In this case, we use

MyExeFileName := ParamStr(0);

Delphi packages (.bpl) itself are a better windows .DLL. We may use it like normal windows .DLL file but it is more than that. Here are some useful tricks when work with dynamic packages. HINSTANCE HINSTANCE is a cardinal variable available at runtime. It will always return the module handle allocated by windows depends on where the current execution point is. For example, if current code is at the main .exe, the HINSTANCE will return handle of the .exe module. If current code is at .bpl package, the HINSTANCE will return handle of the .bpl package. GetModuleHandle You may use GetModuleHandle to retrieve the handle of known .exe or .bpl file name. For example,

hExe := GetModuleHandle(PAnsiChar('main.exe'))

will return the handle of main.exe module.

hBPL := GetModuleHandle(PAnsiChar('package.bpl'))

will return the handle of package.bpl package. If we pass a NULL parameter to the function,

hNULL := GetModuleHandle(nil)

It will always return the handle of main executable even if current execution point is in a package. Thus, hNULL and hEXE should have same value. You may now understand what is the value returned by LoadPackage and the value required by UnloadPackage. Both values are handle allocated by windows. So,

m := LoadPackage('package.dll');
hBPL := GetModuleHandle(PAnsiChar('package.dll'));
Assert(m = hBPL);  // must be equal
UnloadPackage(bBPL);

To test if current execution point is at main executable, you may use

if HINSTANCE = GetModuleHandle(nil) then
// in main executable
else
// in a package or dll module

GetModuleName GetModuleName(hEXE) will return the main executable file name. It should be same as ParamStr(0). GetModuleName(hBPL) will return the package file name. GetModuleName(HINSTANCE) will return the current module name (either Main executable or package) depends on where the current execution point is.

Make non TWinControl descendant response to windows messages

Although using SendMessage and PostMessage isn't a good practice in OO design. However, I do need it in some situation. All the while I wrote TWinControl descendant to handle the custom messages: W := TWinControl_Descendant.Create(nil); W.Parent := Application.MainForm; PostMessage(W.Handle, 10000, 0, 0); I got to set the Parent for the instance else the handle won't be allocated. It is troublesome if the application I wrote isn't a window form application. I raise a post in codegear newsgroup "borland.public.delphi.vcl.components.using.win32" of title "Is that possible to allocate windows handle to TObject direct descendant" and get some great replies. The TTimer component in Delphi VCL already is a good example of how to make a non TWinControl descendant response to windows messages. I then write a prototype to try out and it work as expected.

type
  TMyObject = class(TObject)
  private
    FHandle: THandle;
    procedure WndProc(var Message: TMessage);
  public
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;
    property Handle: THandle read FHandle;
  end;

procedure TMyObject.AfterConstruction;
begin
  inherited;
  FHandle := AllocateHWnd(WndProc);
end;

procedure TMyObject.BeforeDestruction;
begin
  inherited;
  DeallocateHWnd(FHandle);
end;

procedure TMyObject.WndProc(var Message: TMessage);
begin
  if Message.Msg = 10000 then
    ShowMessage('Message received')
  else
    Message.Result := DefWindowProc(FHandle, Message.Msg, Message.wParam, Message.lParam);
end;

var C: TMyObject;
begin
  C := TMyObject.Create;
  try
    SendMessage(C.Handle, 10000, 0, 0);
  finally
    C.Free;
  end;
end;

Improve the loading speed of Delphi application built with runtime package

I just come across with the article The ultimate Delphi IDE start-up hack When we use SysUtils.LoadPackage in Delphi, the following procedure will be invoked:

procedure InitializePackage(Module: HMODULE; AValidatePackage: TValidatePackageProc);
type
 TPackageLoad = procedure;
var
 PackageLoad: TPackageLoad;
begin
 CheckForDuplicateUnits(Module, AValidatePackage);
 @PackageLoad := GetProcAddress(Module, 'Initialize'); //Do not localize
 if Assigned(PackageLoad) then
   PackageLoad
 else
   raise EPackageError.CreateFmt(sInvalidPackageFile, [GetModuleName(Module)]);
end;

If we are very sure that our .bpl packages has no duplicate unit name, we may safely ignore the call to "CheckForDuplicateUnits" procedure. It should improve the loading speed of your Delphi application that built with runtime packages.