Undocumented MessageBoxTimeOut function

There are lots of neat little things that are in many of the DLLs that Microsoft has installed in Windows. Most of them are documented in the Win32 API. However, there are a lot of them that are undocumented. This article shows how to use one of the undocumented functions available in user32.dll, MessageBoxTimeOut.

This type of functionality for a MessageBox has been requested on the Delphi newsgroups many times and there have been several solutions written. After being introduced in XP, this functionality is now available to developers using this undocumented API.

Since this function is not documented, it is not found in Windows.pas, so it has to be defined. It is identical to the MessageBox API definition except it has two more parameters, wLanguageID and dmMilliseconds.

function MessageBoxTimeOut(
hWnd: HWND; lpText: PChar; lpCaption: PChar;
uType: UINT; wLanguageId: WORD; dwMilliseconds: DWORD): Integer; stdcall;

function MessageBoxTimeOutA(
hWnd: HWND; lpText: PChar; lpCaption: PChar;
uType: UINT; wLanguageId: WORD; dwMilliseconds: DWORD): Integer; stdcall;

function MessageBoxTimeOutW(
hWnd: HWND; lpText: PWideChar; lpCaption: PWideChar;
uType: UINT; wLanguageId: WORD; dwMilliseconds: DWORD): Integer; stdcall;


implementation

// this const is not defined in Windows.pas
const
MB_TIMEDOUT = 32000;

function MessageBoxTimeOut; externaluser32 name 'MessageBoxTimeoutA';
function MessageBoxTimeOutA; external user32 name 'MessageBoxTimeoutA';
function MessageBoxTimeOutW; external user32 name 'MessageBoxTimeoutW';


Now, to call the function, it is as easy as setting the flags and making the call. There may be other results returned that I am not aware of besides the standard IDxxx return values and the MB_TIMEDOUT result defined above.


var
iResult: Integer;
iFlags: Integer;

begin
// Define a MessagBox with an OK button and a timeout of 2 seconds
iFlags := MB_OK or MB_SETFOREGROUND or MB_SYSTEMMODAL or MB_ICONINFORMATION;
iResult := MessageBoxTimeout(
Application.Handle,
'Test a timeout of 2 seconds.',
'MessageBoxTimeout Test', iFlags, 0, 2000);

// iResult will = 1 (IDOK)

ShowMessage(IntToStr(iRet));

// Define a MessageBox with a Yes and No button and a timeout of 5 seconds

iFlags := MB_YESNO or MB_SETFOREGROUND or MB_SYSTEMMODAL or MB_ICONINFORMATION;

iResult := MessageBoxTimeout(
Application.Handle,
'Test a timeout of 5 seconds.',
'MessageBoxTimeout Test', iFlags, 0, 5000);

// iResult = MB_TIMEDOUT if no buttons clicked, otherwise
// iResult will return the value of the button clicked

case iResult of
IDYES: // Pressed Yes button
ShowMessage('Yes');
IDNO: // Pressed the No button
ShowMessage('No');
MB_TIMEDOUT: // MessageBox timed out
ShowMessage('TimedOut');
end;
end;

I presume Borland will not put this into Windows.pas until Microsoft documents it but developers can get a head start on them by using the code above. It is unlikely that Microsoft will depricate this function for quite some time because all of the standard MessageBox API calls actually call MessageBoxTimeOutA or MessageBoxTimeoutW and pass $FFFFFFFF as the timeout period meaning the dialog will wait a very long time, approx 49 days!

How to check a file name against a list of masks ?

{
This code can be used to test if the given filename matches with a
list of wildcards search.


examples of use :
isFileFromDefinition('c:\pictures\vanessa.jpg','*.gif;*.jpg;*.tga;*.bmp');
ifFileFromDefinition('c:\pictures\vanessa.jpg','v*.jp?');
}



uses
SysUtils, Masks; // works only from Delphi 5 and above


function isFileFromDefinition(aFilename, aMaskList: string): Boolean;
var
Definition: string;
begin
aFilename := ExtractFileName(aFilename);
Definition := '';
repeat
if Pos(';', aMaskList) > 0 then
Definition := Copy(aMaskList, 1,Pos(';', aMaskList) - 1)
else
Definition := aMaskList;
Delete(aMaskList, 1,Length(Definition) + 1);
if MatchesMask(aFileName, Definition) then
begin
Result := True;
Exit;
end;
until Length(aMaskList) = 0;
Result := False;
end;

How to detect memory leaks ?

In computer science, a memory leak is a particular kind of unintentional memory consumption by a computer program where the program fails to release memory when no longer needed. This condition is normally the result of a bug in a program that prevents it from freeing up memory that it no longer needs.
A memory leak can diminish the performance of the computer by reducing the amount of available memory. Eventually, in the worst case, too much of the available memory may become allocated and all or part of the system or device stops working correctly or the application fails.
Here it is how to check for memory leaks in Delphi:


procedure TForm.DebugProcessStatus(s: string);
var
pmc: PPROCESS_MEMORY_COUNTERS;
cb: Integer;
MemStat: tMemoryStatus;
begin
MemStat.dwLength := SizeOf(MemStat);
GlobalMemoryStatus(MemStat);

// Get the total and available system memory
TotalMemoryLabel.Caption := 'Total system memory: ' +
FormatFloat('###,###', MemStat.dwTotalPhys / 1024) + ' KByte';
FreeMemoryLabel.Caption := 'Free physical memory: ' +
FormatFloat('###,###', MemStat.dwAvailPhys / 1024) + ' KByte';

// Get the used memory for the current process
cb := SizeOf(TProcessMemoryCounters);
GetMem(pmc, cb);
pmc^.cb := cb;
if GetProcessMemoryInfo(GetCurrentProcess(), pmc, cb) then
begin
NewWorkingMemory := Longint(pmc^.WorkingSetSize);
ProcessMemoryLabel.Caption := 'Process-Memory: ' +
FormatFloat('###,###', NewWorkingMemory / 1024) + ' KByte';
MemoryLeakLabel.Caption := 'Memory Loss: ' +
FormatFloat('###,###', (NewWorkingMemory - OldWorkingMemory) / 1024) + ' KByte';
OldWorkingMemory := NewWorkingMemory;
end;
FreeMem(pmc);

DebugStatusLabel.Caption := 'Status: ' + s;
end;

How to monitor a harddrive with S.M.A.R.T.

{ .... }



type

TSmartData = array[0..527] of Byte;




{ .... }



procedure GetSmartData(var Data: TSmartData);

var

hdrive: Cardinal;

dwBytesReturned: DWORD;


ipar: array[0..31] of Byte;

opar: TSmartData;

begin

ipar[0] := 0;
ipar[1] := $02;
ipar[2] := 0;
ipar[3] := 0;
ipar[4] := $d0;
ipar[5] := $01;
ipar[6] := $01;
ipar[7] := $4f;
ipar[8] := $c2;
ipar[9] := $a0;
ipar[10] := $b0;
ipar[11] := 0;
ipar[12] := 0;
ipar[13] := 0;
ipar[14] := 0;
ipar[15] := 0;
ipar[16] := $8c;
ipar[17] := $fd;
ipar[18] := $14;
ipar[19] := 0;
ipar[20] := 0;
ipar[21] := $02;
ipar[22] := 0;
ipar[23] := 0;
ipar[24] := $03;
ipar[25] := 0;
ipar[26] := 0;
ipar[27] := 0;
ipar[28] := $03;
ipar[29] := 0;
ipar[30] := 0;
ipar[31] := 0;

// Get first harddrive

hdrive := CreateFile(PChar('\\.\PhysicalDrive0'), 3221225472, 3, nil, 3, 0, 0);
DeviceIoControl(hdrive, $0007C088, @ipar, 32, @opar, 528, dwBytesReturned, nil);
CloseHandle(hdrive);
Data := opar;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
StringGrid1.Cells[0, 0] := 'Description';
StringGrid1.Cells[1, 0] := 'Value';
StringGrid1.Cells[0, 1] := 'Spin Up Time';
StringGrid1.Cells[0, 2] := 'Start/Stop Count';
StringGrid1.Cells[0, 3] := 'Reallocated Sectors Count';
StringGrid1.Cells[0, 4] := 'Read Channel Margin';
StringGrid1.Cells[0, 5] := 'Seek Error Rate';
StringGrid1.Cells[0, 6] := 'Seek Time Performance';
StringGrid1.Cells[0, 7] := 'Power-On Minutes';
StringGrid1.Cells[0, 8] := 'Spin Retry Count';
StringGrid1.Cells[0, 9] := 'Recalibration Retries';
StringGrid1.Cells[0, 10] := 'Device Power Cycle Count';
StringGrid1.Cells[0, 11] := 'Load/Unload Cycle Count';
StringGrid1.Cells[0, 12] := 'Temperature';
StringGrid1.Cells[0, 13] := 'Reallocation Event Count';
StringGrid1.Cells[0, 14] := 'Current Pending Sector Count';
StringGrid1.Cells[0, 15] := 'Uncorrectable Sector Count';
StringGrid1.Cells[0, 16] := 'UDMA CRC Error Count';
StringGrid1.Cells[0, 17] := 'Write Error Rate';

Timer1.Interval := 700;
Timer1.Enabled := True;
end;



procedure TForm1.Timer1Timer(Sender: TObject);
var
smartdatavar: TSmartData;
begin
getsmartdata(smartdatavar);
StringGrid1.Cells[1, 1] := IntToStr(smartdatavar[24] * 256 + smartdatavar[23]);
StringGrid1.Cells[1, 2] := IntToStr(smartdatavar[36] * 256 + smartdatavar[35]);
StringGrid1.Cells[1, 3] := IntToStr(smartdatavar[48] * 256 + smartdatavar[47]);
StringGrid1.Cells[1, 4] := IntToStr(smartdatavar[60] * 256 + smartdatavar[59]);
StringGrid1.Cells[1, 5] := IntToStr(smartdatavar[72] * 256 + smartdatavar[71]);
StringGrid1.Cells[1, 6] := IntToStr(smartdatavar[84] * 256 + smartdatavar[83]);
StringGrid1.Cells[1, 7] := IntToStr(smartdatavar[96] * 256 + smartdatavar[95]);
StringGrid1.Cells[1, 8] := IntToStr(smartdatavar[108] * 256 + smartdatavar[107]);
StringGrid1.Cells[1, 9] := IntToStr(smartdatavar[120] * 256 + smartdatavar[119]);
StringGrid1.Cells[1, 10] := IntToStr(smartdatavar[132] * 256 + smartdatavar[131]);
StringGrid1.Cells[1, 11] := IntToStr(smartdatavar[156] * 256 + smartdatavar[155]);
StringGrid1.Cells[1, 12] := IntToStr(smartdatavar[168] * 256 + smartdatavar[167]);
StringGrid1.Cells[1, 13] := IntToStr(smartdatavar[192] * 256 + smartdatavar[191]);
StringGrid1.Cells[1, 14] := IntToStr(smartdatavar[204] * 256 + smartdatavar[203]);
StringGrid1.Cells[1, 15] := IntToStr(smartdatavar[216] * 256 + smartdatavar[215]);
StringGrid1.Cells[1, 16] := IntToStr(smartdatavar[228] * 256 + smartdatavar[227]);
StringGrid1.Cells[1, 17] := IntToStr(smartdatavar[240] * 256 + smartdatavar[239]);
end;

How to convert from HTML color to delphi color

Here is a sample of code how to convert from HTML color representation to Delphi colors:

function HtmlToColor(Color: string): TColor;
begin
 Result := StringToColor('$' + Copy(Color, 6, 2) + Copy(Color, 4, 2) + Copy(Color, 2, 2));
end;

I write a small example program:

unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls, ExtCtrls;

type
 TForm1 = class(TForm)
   Edit1: TEdit;
   Button1: TButton;
   Shape1: TShape;
   procedure Button1Click(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}
function HtmlToColor(Color: string): TColor;
begin
 Result := StringToColor('$' + Copy(Color, 6, 2) + Copy(Color, 4, 2) + Copy(Color, 2, 2));
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
Shape1.Brush.Color:=HtmlToColor(Edit1.Text);
Shape1.Invalidate;
end;

end.