Wednesday, May 6, 2009

class helper to get SourceFileName from an EAssertionFailed

In one of our applications, we have a default Config.xml file that is in our source tree, but it can be overridden by a Config.xml file relative to the application’s .EXE file.

So we have a two step process looking for the Config.xml, and we’d like to have the full path to the source file where the sources were build.

It seems the only way to get that, is by looking inside the Message of an EAssertionFailed exception.


So I wrote yet another class helper to get this code to work:




function GetConfigPathName(const Application: TApplication): string; overload;
var
TriedFileNames: IStringListWrapper;
SourceFileName: string;
begin
TriedFileNames := TStringListWrapper.Create();
Result := FindConfigPathName(Application, TriedFileNames);
try
AssertConfigFileNameExists(Result, Application.ExeName, TriedFileNames);
except
on E: EAssertionFailed do
begin
SourceFileName := E.GetSourceFileName();
Result := FindConfigPathName(SourceFileName, TriedFileNames);
AssertConfigFileNameExists(Result, Application.ExeName, SourceFileName, TriedFileNames);
end;
end;
end;

Note the IStringListWrapper; I’ll get back to that in a later blog-post.


The full code of the class helper is right below.

Just a few remarks:



  1. EAssertionFailed is in the SysUtils unit, and builds its Message by formatting a string using the SAssertError const in the SysConst unit as a mask.

  2. We use that mask to “parse” the Message from right to left. Parsing from left to right is virtually impossible, as the first string is the assertion message itself, and we don’t know how that looks like.

  3. If you are not using Delphi 2009, then replace the CharInSet call with a regular set check.




unit AssertionFailedHelperUnit;

interface

uses
SysUtils;

type
TAssertionFailedHelper = class helper for EAssertionFailed
public
function GetSourceFileName: string;
end;

implementation

uses
SysConst;

function TAssertionFailedHelper.GetSourceFileName: string;
var
Mask: string;
ExceptionMessage: string;
OpeningParenthesesPosition: Integer;
begin
//no valid configuration file found relative to C:\Program Files\CodeGear\RAD Studio\6.0\bin\bds.exe (C:\develop\ActiveMQDemo\common\src\ConfigHelperUnit.pas, line 84)
// SAssertError = '%s (%s, line %d)';
// now create this string " (, line 0)" and use it to parse from right to left
Mask := Format(SAssertError, ['', '', 0]);
ExceptionMessage := Self.Message;
// remove the closing ")"
if (ExceptionMessage <> '') then
begin
Delete(ExceptionMessage, Length(ExceptionMessage), 1);
Delete(Mask, Length(Mask), 1);
// remove the "0" from the Mask
Delete(Mask, Length(Mask), 1);
end;
while (ExceptionMessage <> '') and (CharInSet(ExceptionMessage[Length(ExceptionMessage)], ['0'..'9'])) do
Delete(ExceptionMessage, Length(ExceptionMessage), 1);
// from the right side, remove the ", line " portion
while (ExceptionMessage <> '') and (ExceptionMessage[Length(ExceptionMessage)] = Mask[Length(Mask)]) do
begin
Delete(ExceptionMessage, Length(ExceptionMessage), 1);
Delete(Mask, Length(Mask), 1);
end;
// now find the opening "("
OpeningParenthesesPosition := Length(ExceptionMessage);
while (ExceptionMessage <> '') and (ExceptionMessage[OpeningParenthesesPosition] <> '(') do
Dec(OpeningParenthesesPosition);
Delete(ExceptionMessage, 1, OpeningParenthesesPosition);
Result := ExceptionMessage;
end;

end.

Tuesday, May 5, 2009

Understanding Delphi Project Files

Since it is quite common for Delphi applications to share code or previously customized forms, Delphi organizes applications into what is called projects.

A project is made up of the visual interface along with the code that activates the interface. Each project can have multiple forms, allowing us to build applications that have multiple windows. The code that is needed for a form in our project is stored in a separate Unit file that Delphi automatically associates to the form. General code that we want to be shared by all the forms in our application is placed in unit files as well. Simply put, a Delphi project is a collection of files that make up an application.

What this means is that each project is made of one or more Form files (files with the .dfm extension) and one or more Unit files (.pas extension). We can also add resource files, and they are compiled into .RES files and linked when we compile the project.

Project File

Each project is made up of a single project file (.dpr). Project files contain directions for building an application. This is normally a set of simple routines which open the main form and any other forms that are set to be opened automatically and then starts the program by calling the Initialize, CreateForm and Run methods of the global Application object (which is actually a form of zero width and height, so it never actually appears on the screen).

Note: The global variable Application, of type TApplication, is in every Delphi Windows application. Application encapsulates your application as well as provides many functions that occur in the background of the program. For instance, Application would handle how you would call a help file from the menu of your program.

Project Unit

Use Project - View Source to display the project file for the current project.

Althogh you can look and edit the Project File, in most cases, you'll let Delphi maintain the DPR file. The main reason to view the project file is so we can see the units and forms that make up the project, and which form is specified as the application's main form.

Another reason to work with the project file is when we are creating a DLL rather than a stand-alone application or need some start-up code, such as a splash screen before the main form is created by Delphi.

Here is the default project file for a new application (containing one form: "Form1"):

program Project1;
uses
Forms,
Unit1 in 'Unit1.pas' {Form1};
{$R *.RES}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1) ;
Application.Run;
end.
The program keyword identifies this unit as a program's main source unit. You can see that the unit name, Project1, follows the program keyword (Delphi gives the project a default name until you save the project with a more meaningful name). When we run a project file from the IDE, Delphi uses the name of the Project file for the name of the EXE file that it creates.

Delphi reads the uses clause of the project file to determine which units are part of a project.

The .dpr file is linked with the .pas file with the compile directive {$R *.RES} (in this case ‘*’ represents the root of the .pas filename rather than "any file"). This compiler directive tells Delphi to include this project's resource file. The project's resource file contains such items as the project's icon image.

The begin..end block is the main source-code block for the project.

Although Initialize is the first method called in the main project source code, it is not the first code that is executed in an application. The application first executes the "initialization" section of all the units used by the application.

The Application.CreateForm statement loads the form specified in its argument. Delphi adds an Application.CreateForm statement to the project file for each form you add to the project. This code's job is to first allocate memory for the form. The statements are listed in the order the forms are added to the project. This is the order that the forms will be created in memory at runtime. If you want to change this order, do not edit the project source code. Use the ProjectOptions menu command.

The Application.Run statement starts your application. This instruction tells the predeclared object called Application to begin processing the events that occur during the run of a program.

An Example: Hide Main Form / Hide Taskbar Button

The Application object's ShowMainForm property determines whether or not a form will show at startup. The only condition of setting this property is that it has to be called before the Application.Run line.
//Presume: Form1 is the MAIN FORM
Application.CreateForm(TForm1, Form1) ;
Application.ShowMainForm := False;
Application.Run;

Design Your Delphi Program in a Way That it Keeps its Memory Usage in Check

When writing long running applications - the kind of programs that will spend most of the day minimized to the task bar or system tray, it can become important not to let the program 'run away' with memory usage.

Learn how to clean up the memory used by your Delphi program using the SetProcessWorkingSetSize Windows API function.

Memory Usage of a Program / Application / Process

Take a look at the screen shot of the Windows Task Manager...

The two rightmost columns indicate CPU (time) usage and memory usage. If a process impacts on either of these severely, your system will slow down.

The kind of thing that frequently impacts on CPU usage is a program that is looping (ask any programmer that has forgotten to put a "read next" statement in a file processing loop). Those sorts of problems are usually quite easily corrected.

Memory usage on the other hand is not always apparent, and needs to be managed more than corrected. Assume for example that a capture type program is running.

This program is used right throughout the day, possibly for telephonic capture at a help desk, or for some other reason. It just doesn’t make sense to shut it down every twenty minutes and then start it up again. It’ll be used throughout the day, although at infrequent intervals.

If that program relies on some heavy internal processing, or has lots of art work on its forms, sooner or later its memory usage is going to grow, leaving less memory for other more frequent processes, pushing up the paging activity, and ultimately slowing down the computer.

Monday, May 4, 2009

How can I implement threads in my programs without using the VCL TThread object?

I've done extensive work in multi-threaded applications. And in my experience, there
have been times when a particular program I'm writing should be written as a
multi-threaded application, but using the TThread object just seems like overkill.
For instance, I write a lot of single function programs; that is, the entire functionality
(beside the user interface portion) of the program is contained in one single execution
procedure or function. Usually, this procedure contains a looping mechanism (e.g. FOR,
WHILE, REPEAT) that operates on a table or an incredibly large text file (for me, that's
on the order of 500MB-plus!). Since it's just a single procedure, using a TThread
is just too much work for my preferences.


For those experienced Delphi programmers, you know what happens to the user interface
when you run a procedure with a loop in it: The application stops receiving messages.
The most simple way of dealing with this situation is to make a call to Application.ProcessMessages
within the body of the loop so that the application can still receive messages from
external sources. And in many, if not most, cases, this is a perfectly valid thing to do.
However, if some or perhaps even one of the steps within the loop take more than a couple
of seconds to complete processing — as in the case of a query — Application.ProcessMessages
is practically useless because the application will only receive messages at the time the
call is made. So what you ultimately achieve is intermittent response at best. Using a
thread, on the other hand, frees up the interface because the process is running
completely separate from the main thread of the program where the interface resides. So
regardless of what you execute within a loop that is running in a separate thread, your
interface will never get locked up.


Don't confuse the discussion above with multi-threaded user interfaces. What I'm
talking about is executing long background threads that won't lock up your user interface
while they run. This is an important distinction to make because it's not really
recommended to write multi-user interfaces, because each thread that is created in the
system has its own message queue. Thus, a message loop must be created to fetch messages
out of the queue so they can be dispatched appropriately. The TApplication object that
controls the UI would be the natural place to set up message loops for background threads,
but it's not set up to detect when other threads are executed. The gist of all this is
that the sole reason you create threads is to distribute processing of independent
tasks. Since the UI and controls are fairly integrated, threads just don't make sense here
because in order to make the separate threads work together, you have to synchronize them
to work in tandem, which practically defeats threading altogether!


I mentioned above that the TThread object is overkill for really simple threaded
stuff. This is strictly an opinion, but experience has made me lean that way. In any case,
what is the alternative to TThread in Delphi?


The solution isn't so much an alternative as it is going a bit more low-level into the
Windows API. I've said this several times before: The VCL is essentially one giant wrapper
around the Windows API and all its complexities. But fortunately for us, Delphi provides a
very easy way to access lower-level functionality beyond the wrapper interface with
which it comes. And even more fortunate for us, we can create threads using a simple
Windows API function called CreateThread to bypass the TThread object
altogether. As you'll see below, creating threads in this fashion is incredibly easy to
do.


Setting Yourself Up


There are two distinct steps for creating a thread: 1)Create the thread itself, then 2)
Provide a function that will act as the thread entry point. The thread function or thread
entry point
is the function (actually the address of the function) that tells your
thread where to start.


Unlike a regular function, there are some specific requirements regarding the thread
function that you have to obey:


  1. You can give the function any name you want, but it must be a function name (ie.
    function MyThreadFunc)

  2. The function must have a single formal parameter of type Pointer (I'll discuss
    this below)

  3. The function return type is always LongInt

  4. Its declaration must always be preceded by the stdcall directive. This tells the
    compiler that the function will be passing parameters in the standard Windows convention.


Whew! That seems like a lot but it's really not as complicated as it might seem from
the description above. Here's an example declaration:


function MyThreadFunc(Ptr : Pointer) : LongInt; stdcall;

That's it! Hope I didn't get you worried. The CreateThread call is a bit more
involved, but it too is not very complicated once you understand how to call it. Here's
its declaration, straight out of the help file:


function CreateThread
(lpThreadAttributes: Pointer; //Address of thread security attributes
dwStackSize: DWORD; //Thread stack size
lpStartAddress: TFNThreadStartRoutine;//Address of the thread function
lpParameter: Pointer; //Input parameter for the thread
dwCreationFlags: DWORD; //Creation flags
var lpThreadId: DWORD): //ThreadID reference
THandle; stdcall; //Function returns a handle to the thread

This is not as complicated as it seems. First of all, you rarely have to set security
attributes, so that can be set to nil. Secondly, in most cases, your stack size can
be 0 (actually, I've never found an instance where I have to set this to a value higher
than zero). You can optionally pass a parameter through the lpParameter argument as
a pointer to a structure or address of a variable, but I've usually opted to use global
variables instead (I know, this breaking a cardinal rule of structured programming, but it
sure eases things). Lastly, I've rarely had to set creation flags unless I want my thread
to start in a suspended state so I can do some preprocessing. For the most part, I set
this value as zero.


Now that I've thoroughly confused you, let's look at an example function that creates a
thread:



procedure TForm1.Button1Click(Sender: TObject);
var
thr : THandle;
thrID : DWORD;
begin
FldName := ListBox1.Items[ListBox1.ItemIndex];
thr := CreateThread(nil, 0, @CreateRecID, nil, 0, thrID);
if (thr = 0) then
ShowMessage('Thread not created');
end;

Embarrassingly simple, right? It is. To make the thread in the function above, I
declared two variables, thr and thrID, which stand for the handle of the
thread and its identifier, respectively. I set a global variable that the thread function
will access immediately before the call to CreateThread, then make the declaration,
assigning the return value of the function to thr and inputting the address of my
thread function, and the thread ID variable. The rest of the parameters I set to nil or 0.
Not much to it.


Notice that the procedure that actually makes the call is an OnClick handler for a
button on a form. You can pretty much create a thread anywhere in your code as long as you
set up properly. Here's the entire unit code for my program; you can use it for a
template. This program is actually fairly simple. It adds an incremental numeric key value
to a table called RecID, based on the record number (which makes things really easy).
Browse the code; we'll discuss it below:



unit main;

interface

uses
Windows, Messages, SysUtils, Classes,
Graphics, Controls, Forms, Dialogs, DB, DBTables, StdCtrls, ComCtrls,
Buttons;

type
TForm1 = class(TForm)
Edit1: TEdit;
Label1: TLabel;
OpenDialog1: TOpenDialog;
SpeedButton1: TSpeedButton;
Label2: TLabel;
StatusBar1: TStatusBar;
Button1: TButton;
ListBox1: TListBox;
procedure SpeedButton1Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
end;

var
Form1: TForm1;
TblName : String;
FldName : String;

implementation

{$R *.DFM}

function CreateRecID(P : Pointer) : LongInt; stdcall;
var
tbl : TTable;
I : Integer;
ses : TSession;
msg : String;
begin
Randomize; //Initialize random number generator
I := 0;
{Disable the Execute button so another thread can't be executed
while this one is running}
EnableWindow(Form1.Button1.Handle, False);

{If you're going to access any data in a thread, you have to create a
separate }
ses := TSession.Create(Application);
ses.SessionName := 'MyRHSRecIDSession' + IntToStr(Random(1000));

tbl := TTable.Create(Application);
with tbl do begin
Active := False;
SessionName := ses.SessionName;
DatabaseName := ExtractFilePath(TblName); //TblName is a global variable set
TableName := ExtractFileName(TblName); //in the SpeedButton's OnClick handler
Open;
First;
try
{Start looping structure}
while NOT EOF do begin
if (State <> dsEdit) then
Edit;
msg := 'Record ' + IntToStr(RecNo) + ' of ' + IntToStr(RecordCount);
{Display message in status bar}
SendMessage(Form1.StatusBar1.Handle, WM_SETTEXT, 0, LongInt(PChar(msg)));
FieldByName(FldName).AsInteger := RecNo;
Next;
end;
finally
Free;
ses.Free;
EnableWindow(Form1.Button1.Handle, True);
end;
end;
msg := 'Operation Complete!';
SendMessage(Form1.StatusBar1.Handle, WM_SETTEXT, 0, LongInt(PChar(msg)));
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
var
tbl : TTable;
I : Integer;
begin
with OpenDialog1 do
if Execute then begin
Edit1.Text := FileName;
TblName := FileName;
tbl := TTable.Create(Application);
with tbl do begin
Active := False;
DatabaseName := ExtractFilePath(TblName);
TableName := ExtractFileName(TblName);
Open;
LockWindowUpdate(Self.Handle);
for I := 0 to FieldCount - 1 do begin
ListBox1.Items.Add(Fields[I].FieldName);
end;
LockWindowUpdate(0);
Free;
end;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
thr : THandle;
thrID : DWORD;
begin
FldName := ListBox1.Items[ListBox1.ItemIndex];
thr := CreateThread(nil, 0, @CreateRecID, nil, 0, thrID);
if (thr = 0) then
ShowMessage('Thread not created');
end;

end.

The most important function here, obviously, is the thread function, CreateRecID.
Let's take a look at it:



function CreateRecID(P : Pointer) : LongInt; stdcall;
var
tbl : TTable;
I : Integer;
ses : TSession;
msg : String;
begin
Randomize; //Initialize random number generator
I := 0;
{Disable the Execute button so another thread can't be executed
while this one is running}
EnableWindow(Form1.Button1.Handle, False);

{If you're going to access any data in a thread, you have to create a
separate }
ses := TSession.Create(Application);
ses.SessionName := 'MyRHSRecIDSession' + IntToStr(Random(1000));

tbl := TTable.Create(Application);
with tbl do begin
Active := False;
SessionName := ses.SessionName;
DatabaseName := ExtractFilePath(TblName); //TblName is a global variable set
TableName := ExtractFileName(TblName); //in the SpeedButton's OnClick handler
Open;
First;
try
{Start looping structure}
while NOT EOF do begin
if (State <> dsEdit) then
Edit;
msg := 'Record ' + IntToStr(RecNo) + ' of ' + IntToStr(RecordCount);
{Display message in status bar}
SendMessage(Form1.StatusBar1.Handle, WM_SETTEXT, 0, LongInt(PChar(msg)));
FieldByName(FldName).AsInteger := RecNo;
Next;
end;
finally
Free;
ses.Free;
EnableWindow(Form1.Button1.Handle, True);
end;
end;
msg := 'Operation Complete!';
SendMessage(Form1.StatusBar1.Handle, WM_SETTEXT, 0, LongInt(PChar(msg)));
end;

This is a pretty basic function. I'll leave it up to you to follow the flow of
execution. However, let's look at some very interesting things that are happening in the
thread function.


First of all, notice that I created a TSession object before I created the table I was
going to access. This is to ensure that the program will behave itself with the BDE. This
is required any time you access a table or other data source from within the context of a
thread. I've explained this in more detail in another article called How
Can I Run Queries in Threads?
Directly above that, I made a call to the Windows
API function EnableWindow to disable the button that executes the code. I had to do
this because since the VCL is not thread-safe, there's no guarantee I'd be able to
successfully access the button's Enabled property safely. So I had to disable it
using the Windows API call that performs enabling and disabling of controls.


Moving on, notice how I update the caption of a status bar that's on the bottom of the
my form. First, I set the value of a text variable to the message I want displayed:



msg := 'Record ' + IntToStr(RecNo) + ' of ' + IntToStr(RecordCount);

Then I do a SendMessage, sending the WM_SETTEXT message to the status bar:



SendMessage(Form1.StatusBar1.Handle, WM_SETTEXT, 0, LongInt(PChar(msg)));

SendMessage will send a message directly to a control and bypass the window
procedure of the form that owns it.


Why did I go to all this trouble? For the very same reason that I used EnableWindow
for the button that creates the thread. But unfortunately, unlike the single call to EnableWindow,
there's no other way to set the text of a control other than sending it the WM_SETTEXT
message.


The point to all this sneaking behind the VCL is that for the most part, it's not safe
to access VCL properties or procedures in threads. In fact, the objects that are
particularly dangerous to access from threads are those descended from TComponent. These
comprise a large part of the VCL, so in cases where you have to perform some interaction
with them from a thread, you'll have to use a roundabout method. But as you can see from
the code above, it's not all that difficult.


Of the thousands of functions in the Windows API, CreateThread is one of the
most simple and straightforward. I spent a lot of time explaining things here, but there's
a lot of ground I didn't cover. Use this example as a template for your thread
exploration. Once you get the hang of it, you'll use threads in practically everything you
do.

Sunday, May 3, 2009

Get the Url of a Hyperlink when the Mouse moves Over a TWebBrowser Document

The TWebBrowser Delphi component provides access to the Web browser functionality from your Delphi applications.

In most situations you use the TWebBrowser to display HTML documents to the user - thus creating your own version of the (Internet Explorer) Web browser. Note that the TWebBrowser can also display Word documents, for example.

A very nice feature of a Browser is to display link information, for example, in the status bar, when the mouse hovers over a link in a document.

The TWebBrowser does not expose an event like "OnMouseMove". Even if such an event would exist it would be fired for the TWebBrowser component - NOT for the document being displayed inside the TWebBrowser.

In order to provide such information (and much more, as you will see in a moment) in your Delphi application using the TWebBrowser component, a technique called "events sinking" must be implemeted.

WebBrowser Event Sink

To navigate to a web page using the TWebBrowser component you call the Navigate method. The Document property of the TWebBrowser returns an IHTMLDocument2 value (for web documents). This interface is used to retrieve information about a document, to examine and modify the HTML elements and text within the document, and to process related events.

To get the "href" attribute (link) of an "a" tag inside a document, while the mouse hovers over a document, you need to react on the "onmousemove" event of the IHTMLDocument2.

Here are the steps to sink events for the currently loaded document:


  1. Sink the WebBrowser control's events in the DocumentComplete event raised by the TWebBrowser. This event is fired when the document is fully loaded into the Web Browser.
  2. Inside DocumentComplete, retrieve the WebBrowser's document object and sink the HtmlDocumentEvents interface.
  3. Handle the event you are interested in.
  4. Clear the sink in the in BeforeNavigate2 - that is when the new document is loaded in the Web Browser.

HTML Document OnMouseMove

Since we are interested in the HREF attribute of an A element - in order to show the URL of a link the mouse is over, we will sink the "onmousemove" event.

The procedure to get the tag (and its attributes) "below" the mouse can be defined as:

var
htmlDoc : IHTMLDocument2;

...
procedure TForm1.Document_OnMouseOver;
var
element : IHTMLElement;
begin
if htmlDoc = nil then Exit;

element := htmlDoc.parentWindow.event.srcElement;

elementInfo.Clear;

if LowerCase(element.tagName) = 'a' then
begin
ShowMessage('Link, HREF : ' + element.getAttribute('href',0)]) ;
end
else if LowerCase(element.tagName) = 'img' then
begin
ShowMessage('IMAGE, SRC : ' + element.getAttribute('src',0)]) ;
end
else
begin
elementInfo.Lines.Add(Format('TAG : %s',[element.tagName])) ;
end;
end; (*Document_OnMouseOver*)

As explained above, we attach to the onmousemove event of a document in the OnDocumentComplete event of a TWebBrowser:

procedure TForm1.WebBrowser1DocumentComplete( ASender: TObject;
const pDisp: IDispatch;
var URL: OleVariant) ;
begin
if Assigned(WebBrowser1.Document) then
begin
htmlDoc := WebBrowser1.Document as IHTMLDocument2;

htmlDoc.onmouseover := (TEventObject.Create(Document_OnMouseOver) as IDispatch) ;
end;
end; (*WebBrowser1DocumentComplete*)

And this is where the problems arise! As you might guess the "onmousemove" event is *not* a usual event - as are those we are used to work with in Delphi.

The "onmousemove" expects a pointer to a variable of type VARIANT of type VT_DISPATCH that receives the IDispatch interface of an object with a default method that is invoked when the event occurs.

In order to attach a Delphi procedure to "onmousemove" you need to create a wrapper that implements IDispatch and raises your event in its Invoke method.

Here's the TEventObject interface:

TEventObject = class(TInterfacedObject, IDispatch)
private
FOnEvent: TObjectProcedure;
protected
function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
function GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
public
constructor Create(const OnEvent: TObjectProcedure) ;
property OnEvent: TObjectProcedure read FOnEvent write FOnEvent;
end;