Category: Delphi

It’s been a while since I used Environment Variables in Delphi and I had to look it up.

I have a loose rule that anything I have to look up, I want to share on my blog so that I can find it again easily later.

So here you have it: Enviromental Variable expansion ala Delphi.

It’s really not that complex, and it’s possible that this routine could be optimized some. But I think it works well enough as is and demonstrates the use of ExpandEnvironmentStrings quite nicely. If you need to get a list of the variables, you’ll need to do further research on GetEnvironmentStrings and FreeEnvironmentStrings to return the list to you for manipulation. A search for FreeEnvironmentStrings Delphi gives you pleanty of code examples.

Here is my example for ExpandEnvironmentStrings:

[delphi]
var
ImageFileName, FullFileName: string;
BufSize: Integer;
NewPath: String;
begin
// Retrieve the contents of the edit field into a local variable for ease of use.
ImageFileName := Edit1.Text;

// If it exists in the working path, use that as our retrieval point.
// Otherwise, look in the Application directory, then the My Pictures folder,
// then look in the Windows directory
if (FileExists(ImageFileName))
then FullFileName := ImageFileName // Working directory needs no path.
else if (FileExists(ExtractFilePath(Application.ExeName) + ImageFileName))
then FullFileName := ExtractFilePath(Application.ExeName) + ImageFileName // Grab the path from the application executible info
else begin

// Use environmental variables to locate two other possible places
// Allow 254 character paths to be returned.
SetLength(NewPath, 254);

// Call ExpandEnvironmentStrings with string containing environmental variables
BufSize := ExpandEnvironmentStrings(‘%userprofile%\My Documents\My Pictures\’, PChar(NewPath), 254);

// The returned BuffSize must be used to truncate off any extra garbage & injections.
SetLength(NewPath, BufSize – 1);

// Look for it and if it is found, assign the full name otherwise keep looking.
if (FileExists(NewPath + ImageFileName))
then FullFileName := NewPath + ImageFileName
else begin
// Repeat the above process for the Windows Directory.
SetLength(NewPath, 254);
BufSize := ExpandEnvironmentStrings(‘%windir%\’, PChar(NewPath), 254);
SetLength(NewPath, BufSize – 1);
if (FileExists(NewPath + ImageFileName))
then FullFileName := NewPath + ImageFileName
else FullFileName :=’NOT FOUND’;
end;
end;
[/delphi]

One problem with the TImage component is that it doesn’t natively support JPegs. JPeg just wasn’t as popular a format back in the early to mid nineties when the Delphi was first developed. Well, today that is a different story. Starting with Delphi 3 , if memory serves (I didn’t every use D2), the TJPegImage component was introduced and the TImage could be extended to allow JPegs to be loaded. Today’s TImage component can load a JPeg straight from the LoadFromFile command. However, you still cannot directly manipulated it as easily as you can a BitMap. This is clear if you look at the structure of a TImage’s Picture property.

A TPicture has a BitMap property and a MetaFile property and a Graphic property that stores everything that isn’t a BitMap or a metafile.

Yet you’ll quickly see that very few routines and example on the web deal with the Graphic property. They can’t! The structure of the information in the Graphic varies depending upon the type of image.

So, the trick of dealing with JPegs, or anything else like TIFFs, GIFS or Targa’s (oh my), is to get their data uncompressed and de-interlaced and back over to the bitmap property. A little known fact is that this is exactly what Windows has to do any time you choose a JPEG as a background. Windows will load the JPEG save it to a BMP and write the name of that BMP to the registry and then display that file instead of the original JPEG. So, we all should quit blaming Borland (DevCo) for a klunky control, they are doing it the right low level way. And that’s, after all, what we like about Delphi right?

So, what we must do is once we allow a user to load a file, we will check to see if the type is a TJPegImage. If it is, then we create a TJPegImage component. We then assign the JPegImage to the BitMap property and we are done! You can now access the image data in the BitMap.

In Delphi, that looks like this:
[delphi]
SourceImage.Picture.LoadFromFile(FullFileName);
if (SourceImage.Picture.Graphic is TJPegImage)
then begin
JpegImage := TJpegImage.Create;
try
JpegImage.Assign(SourceImage.Picture.Graphic);
SourceImage.Picture.Bitmap.Assign(JpegImage);
finally
end;
FreeAndNil(JpegImage);
end;
[/delphi]

Assign is a wonderful little black box function built into many objects. Assign is one of the neatest functions in Delphi. It basically accepts other types of objects as a parameter, and converts as much of that type of object as possible.

Let’s go abstract and say you have two object types TCar and TSuitCase.
C: TCar
S: TSuitcase

Obviously can’t say S := C; or C := S; because they are of different types.
However you can say
C.Assign(S)
and inside the TCar’s Assign method have a statement that looks like:

[delphi]

if (Source is TSuitcase)
then Self.Trunk.Contents := Self.Trunk.Contents + TSuitcase(Source).Contents
else if (Source is TGasolinePump)
then …

[/delphi]

OK, that sounds pretty non-exciting, but it gets better! What if the type of object is unknown? A the TCar routine may know how to assign a TFordPerfect to itself because a TFordPerfect inherits from TCar, but a TCar is NOT going to know how to assign a TFordPrefect to itself now is it? That’s where AssignTo comes in…
[delphi]

if (Source is TSuitcase)
then Self.Trunk.Contents := Self.Trunk.Contents + TSuitcase(Source).Contents
else if (Source is TGasolinePump)
then Self.Tank.Contents := Self.Tank.Contents + TGasolinePump(Source).Gallons[1]
else Source.AssignTo(Self);

[/delphi]

AssignTo goes exactly the OPPOSITE direction. The person writing the new component than then create a routine that will allow his new component to the most common components that already exist. So following our example, TFordPrefect’s AssignTo routine might include something like this:

[delphi]

if (Dest is TCar)
then TCar(Dest).PassengerCompartment := TCar(Dest).PassengerCompartment + TPassenger(Self);

.
[/delphi]

Or in the case of a TJPegImage, the AssignTo method checks to the see if the Dest var is a TBitmap, and if it is, it goes through a long decompression and conversion routine to finally produce a true Device Independant bit map and write those raw bits into the Dest.

And that my friends is how our TImage component, that knows nothing about JPEG to Bitmap conversions gets the job done. It asks the TJPegImage AssignTo method to do all if its work for it.

You can now use the Picture.BitMap image as normal. The neat thing is that you can put those routines in your FormCreate method. So, TImages can be made to contain JPEGs at design time, making your EXE significantly smaller. And then it converts them, if appropriate, to BMPs at Runtime. It’s nice to save 600,000 of image space at next to no cost.

Kinda nifty eh?

(BTW if you are really ambitious, I’m sure you could write that routine above so that it checks to make sure the graphic isn’t a BMP, WMF or empty and then uses the class info routines to request the type of object and instationate a TPersistent variable to contain an object of that type. Then your routine can handle as a bitmap ANY image type you’ve extended your TImage to contain. More on extending TImages later…)

Concepts demonstrated:
Registry Use (See procedure TfrmLoadHive.btnDisplayValueClick(Sender: TObject))
Hives & The Default User hive & .Default (See below)
Executing another program from within a Delphi program (See procedure TfrmLoadHive.btnExecRegEditClick)
Use of Process Token Privileges in Delphi (See below)

RE: Hives
The WinXP registry is divided into many different sections. Each major section is called a hive. Handling complete branches of the registry as separate hives allows Microsoft to perform several neat tricks. First of all, it allows hive to appear in several places in the registry with different names. The most obvious example of this is HKey_Current_User which of course points to the hive of the user that has logged in. A lesser known example is HKEY_CLASSES_ROOT which is simply a reloaded version of KEY_LOCAL_MACHINE\SOFTWARE\Classes. Those familiar with the DOS subst command and Linux symbolic links can draw comparisons there too.

An even lesser known use of windows hives is that Windows does not keep all of its hives active. It has separate hives to use as examples for creating local users, and other for creating user accounts when someone has logged into the machine remotely through a domain. I seem to remember there being a couple more examples but they elude me at the moment. Those hives are stored as DAT files on the hard drive. For instance, in the default XP install, the registry hive stored at ‘c:\\Documents and Settings\\Default User\\NTUSER.DAT’ will be used to set all the default registry entries whenever a new user logs into the machine. Set a value in that hive, and all future users will have that value.

NOTE: Do not confuse this with HKEY_USERS\.DEFAULT. The HKEY_USERS\.DEFAULT hive stores the values used when no one is logged in. “Huh? How could that be useful?” Well, if you think about it, controlling whether or not a computer puts itself to sleep if some one has booted it but not logged in can be very important. It might also be nice to set a screensaver that works when you log out of your computer but leave it turned on. An ultra secure person could set the color scheme to be entirely black on black, then only a person that really knows what they are doing could log into the computer – LOL. In any case, .DEFAULT and the Default User hives are NOT the same thing.

RE: Token Privileges:
Windows XP/NT/2000 and newer operating systems have advanced security methods to restrict what programs can and cannot do. These restrictions also allow the logging of some restricted access functions. So, for example, while it is possible for programs to set the system time, just any old program can’t do it.

The program has to ask for and get permission to update the time, before it can be accomplished. It is a bit like what a bell hop must do to get into someone’s hotel room. If a bell hop needs to get into room 5321 (let’s pretend this hotel uses keys and not plastic cards), the bell hop will tell his manager he’s gonna need to get into a room, look up which key that room needs, ask the manager for that key, unlock the room and do his thing. Then of course he will lock the door as soon as he is done. Note that if the bell hop does a bunch of other things before locking the door, the room could be burglarized. And when a good bell hop has to access the room several times, the room will be locked between times he is accessing it.

The process for Windows is the same:
Tell Windows you will be adjusting privileges by calling: OpenProcessToken(GetCurrentProcess(),
TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, TTokenHd);
Find the local name of the privilege you will be adjusting by calling LookupPrivilegeValue
Grant yourself access by setting TTokenPvg.Privileges[0].Attributes to SE_PRIVILEGE_ENABLED
Lock the door again by setting TTokenPvg.Privileges[0].Attributes to SE_PRIVILEGE_DISABLED

In my program, I have created three helper routines for working with the tokens: SetTokenPrivilege, GrantPrivilege and RevokePrivilege. The latter two only serve to make my calling code clear. Readability is essential for any professional grade program. At some point you will forget the details of every single program you’ve write. So, even if you are only writing a routine for your own use, you should do what you can to make it easier to read. Tasks like this may seem wasted on throw away programs, but the more you do it, the faster you will be and the more likely it will be that your habit of writing good code will pay off in the end.

Here are my Delphi privilege routines:

[Delphi]
{******************************************************************************
SetTokenPrivilege
A helper function that enables or disables specific privileges on the
specified computer. A NIL in SystemName means the privilege will be granted
for the current computer. Any other value must match the name of a computer
on your network.
******************************************************************************}
procedure SetTokenPrivilege(aSystemName: PChar; aPrivilegeName: PChar; aEnabled: Boolean);
var
TTokenHd: THandle;
TTokenPvg: TTokenPrivileges;
cbtpPrevious: DWORD;
rTTokenPvg: TTokenPrivileges;
pcbtpPreviousRequired: DWORD;
TokenOpened, ValueFound: Boolean;
begin // SetPrivilege
// The privilege system is only available on NT and beyond
if (Win32Platform = VER_PLATFORM_WIN32_NT)
then begin
// Retrieve the Token that represents this current application session
TokenOpened := OpenProcessToken(GetCurrentProcess(),
TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,
TTokenHd);

// Check for failure
if (not TokenOpened)
then raise Exception.Create(‘The current user does not have the access required to run this program.’)
else begin
// Get the name of the privilege (since Windows is multi-lingual, this must be done)
ValueFound := LookupPrivilegeValue(aSystemName, aPrivilegeName, TTokenPvg.Privileges[0].Luid) ;
TTokenPvg.PrivilegeCount := 1;

// Enable or disable the flag according to the bool passed
if (aEnabled)
then TTokenPvg.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED
else TTokenPvg.Privileges[0].Attributes := SE_PRIVILEGE_DISABLED; // See note on local constant declaration
cbtpPrevious := SizeOf(rTTokenPvg) ;
pcbtpPreviousRequired := 0;
if (not ValueFound)
then raise Exception.Create(‘This program is incompatible with the operating system installed on this computer.’)
else begin
try
// Adjust the permissions as required.
Windows.AdjustTokenPrivileges(TTokenHd, False, TTokenPvg, cbtpPrevious,
rTTokenPvg, pcbtpPreviousRequired);
except
raise Exception.Create(‘The current user does not have the required access to load a registry hive.’)
end;
end;
end
end;
end; // SetPrivilege
{******************************************************************************
GrantPrivilege
This routine grants the privilege(s) needed to access the hidden system hive
and load it into memory.
******************************************************************************}
procedure TfrmLoadHive.GrantPrivilege(aPrivilegeName: String);
begin // GrantPrivilege
SetTokenPrivilege(NIL, PChar(aPrivilegeName), TRUE);
end; // GrantPrivilege

{******************************************************************************
RevokePrivilege
This routine revokes privilege(s) given in GrantPrivilege
******************************************************************************}
procedure TfrmLoadHive.RevokePrivilege(aPrivilegeName: String);
begin // RevokePrivilege
SetTokenPrivilege(NIL, PChar(aPrivilegeName), FALSE);
end; // RevokePrivilege
[/Delphi]

In my case, I am using the SeRestorePrivilege token. This is actually one of the most powerful and lethal tokens. With it you are telling Windows that you are a Hard Drive backup program and you want to have access to all sorts of files that most programs are not allowed access to. Presumably you are doing this for good and not evil. Other tokens are:
SeCreateTokenPrivilege, SeAssignPrimaryTokenPrivilege, SeLockMemoryPrivilege, SeIncreaseQuotaPrivilege, SeUnsolicitedInputPrivilege, SeMachineAccountPrivilege, SeTcbPrivilege, SeSecurityPrivilege, SeTakeOwnershipPrivilege, SeLoadDriverPrivilege, SeSystemProfilePrivilege, SeSystemtimePrivilege, SeProfileSingleProcessPrivilege, SeIncreaseBasePriorityPrivilege, SeCreatePagefilePrivilege, SeCreatePermanentPrivilege, SeBackupPrivilege, SeRestorePrivilege, SeShutdownPrivilege, SeDebugPrivilege, SeAuditPrivilege, SeSystemEnvironmentPrivilege, SeChangeNotifyPrivilege, SeRemoteShutdownPrivilege, SeUndockPrivilege, SeSyncAgentPrivilege, SeEnableDelegationPrivilege, SeManageVolumePrivilege
So, that’s the basics. Take a look a the comments in the rest of the source code and you’ll soon see what happens and why.

Also try some different things. Run RegEdit and load the hive manually through File>Load Hive. Did you notice that you HAVE to be at a point within one of the preloaded hives before that option is enabled? What happens when you press the load hive button but you haven’t granted yourself privileges? What happens when you grant your self privileges and don’t revoke them b4 closing the program. Can you then load the hive when you rerun the program? What happens if you Grant 4 time but only unload once?

Experiment. But remember, you are playing with the registry and thar be monsters there. This app works fine on my system, I’ve used similar routine regularly for a couple years now, but I haven’t tested it with all versions of Windows and I have no idea how it will handle out-of-the-ordinary circumstances, like bad sectors in a dat file on your HD. Additionally, a Windows Service pack could totally change what this program does. So, in short, don’t come to me when you need to reinstall Windows. I’ll simply say it was a bad coincidence and anyway your system is beyond my control, you never should have run this program on it. I’m not responsible for your financial and emotional loss. You are responsible for making sure that source code you run on your computer does not have deliberate or accidental malicious behaviors.

http://www.TheCodeCave.com/downloads/delphi/LoadHiveDemo.exe
http://www.TheCodeCave.com/downloads/delphi/LoadHiveDemo.dpr
http://www.TheCodeCave.com/downloads/delphi/U_LoadHive.dfm
http://www.TheCodeCave.com/downloads/delphi/U_LoadHive.pas

Here’s a quick demonstration of how easy programming is in Delphi.

This small app allows you to copy text and past it again right away with it converted to proper case or upper case.  This was written for a ZTree user that had a bunch of files that he wanted t rename to partially uppercase.  There was no way to pick out the part of the name he wanted in upper case. So I wrote this routine to allow him to highlight part of the text, hit copy and then hit paste.  And viola, he it would be fixed.

So in Delphi, how do you access the clip board? Well, it couldn’t be simpler.  Just add the clipbrd unit to your uses statement like this:

[delphi]uses Clipbrd;[/delphi]

Then you can read and write to the clipboard  as text like this:

[delphi]A := Clipboard.AsText;
Clipboard.AsText := A + ‘BC’;[/delphi]

Of course it is best to check that you are dealing with text befor you try to get the information back from the clipboard.  That can be done like this:

[delphi]if (Clipboard.HasFormat(CF_TEXT)) then DoIt;[/delphi]

See! It is THAT straight forward.  If you want to see what  other clipboard formats there are, just highlight CF_TEXT in Delphi and hit F1 and you’ll get a full list.

Value	Meaning
CF_TEXT	Text with a CR-LF combination at the end of each line. A null character identifies the end of the text.
CF_BITMAP	A Windows bitmap graphic.
CF_METAFILEPICT	A Windows metafile graphic.
CF_PICTURE	An object of type TPicture.
CF_COMPONENT	Any persistent object.

So the instructions to create a full app are quite simple:
In Delphi, create a new app. In the Object Inspector, Name the main form frmCBFix, change the Border style to bsToolWindow, and change the form style to fsStayOnTop

Place a TEdit on the form and name it editCorrected text, clearing the default text value.

Add Clipbrd to the uses.

Put a TTimer on the form and double click the timer event in the Object Inspector.

Paste the following code into the unit replacing the automatic generated Timer1Timer procedure:

[delphi]{******************************************************************************
ProperCase
Converts a string to proper case by capitalizing each letter after a space or
punctuation. The only common punctuation not used is the apostrophe/single
quote. This avoids changing don’t to Don’T, but will sentences quoted
inside single quotes will not have their first letter capitalized.
******************************************************************************}
function ProperCase(aSrcStr: String): String;
var
Len, Index: integer;
begin
aSrcStr := Lowercase(aSrcStr);
Len := Length(aSrcStr);
aSrcStr[1] := UpperCase(string(aSrcStr[1]))[1];
for Index := 1 to Len – 1
do begin
if (aSrcStr[Index] in [‘ ‘,’$’,'”‘,'(‘,’)’,’`’,’!’,’?’,’<','!','>‘,’#’,’=’,’+’,’:’,’,’,’/’,’.’,’&’,’-‘,'{‘,’}’,'[‘,’]’,’|’])
then aSrcStr[Index + 1] := UpperCase(String(aSrcStr[Index + 1]))[1];
end;
Result := aSrcStr;
end;

{******************************************************************************
Timer1Timer
Fires periodically (orignally every 250ms), checks the clip board for text,
if it has changed, convert it to proper case and put the result in the
clipboard and the edit control.
******************************************************************************}
procedure TfrmCBFix.Timer1Timer(Sender: TObject);
begin // Timer1Timer
if Clipboard.HasFormat(CF_TEXT)
then begin
if (editCorrectedText.Text <> Clipboard.AsText)
then begin
editCorrectedText.Text := ProperCase(Clipboard.AsText);
Clipboard.AsText := editCorrectedText.Text;
end;
end;
end; // Timer1Timer [/delphi]
And you’re done!

Here are the files for this project:
http://www.TheCodeCave.com/downloads/delphi/CBFixerUpper.exe
http://www.TheCodeCave.com/downloads/delphi/CBFixerUpper.dpr
http://www.TheCodeCave.com/downloads/delphi/u_CBFix.dfm
http://www.TheCodeCave.com/downloads/delphi/u_CBFix.pas