Jump to content
PeterPanettone

Fix for bug in JclShell

Recommended Posts

Posted (edited)

There is a bug in JclShell.pas concerning ShellLink Shortcuts. I have made a small demo app which demonstrates this bug and provides a fix for it:

 

Create a ShellLink Shortcut somewhere (which is a file with a .LNK extension) and enter a hotkey for it containing MODIFIER KEYS, for example:

 

image.thumb.png.a6d69cfaa48a8b4a6b603bd4f0412696.png

 

Now start the demo app:

 

JclShell_BugFix.zip

 

...and load the ShortcutLink. You will notice that the MODIFIER KEYS are missing from the hotkey:

 

image.thumb.png.9e4a8667cfd5ac28125ac952696ba60f.png

 

To activate the bug fix, uncomment these lines in the demo app source code:

 

// Get the MODIFIER KEYS from SL.HotKey:
HotKeyModifiers := Hi(SL.HotKey);
HotKey1.Modifiers := [];
if (HotKeyModifiers and HOTKEYF_ALT) = HOTKEYF_ALT then
  HotKey1.Modifiers := HotKey1.Modifiers + [hkAlt];
if (HotKeyModifiers and HOTKEYF_CONTROL) = HOTKEYF_CONTROL then
  HotKey1.Modifiers := HotKey1.Modifiers + [hkCtrl];
if (HotKeyModifiers and HOTKEYF_SHIFT) = HOTKEYF_SHIFT then
  HotKey1.Modifiers := HotKey1.Modifiers + [hkShift];
if (HotKeyModifiers and HOTKEYF_EXT) = HOTKEYF_EXT then
  HotKey1.Modifiers := HotKey1.Modifiers + [hkExt];

...and recompile the demo app and then run it which will get you the missing MODIFIER KEYS:

 

image.thumb.png.77bdff35121d7f9a26dcd2f780391a7b.png

 

Now let's try the opposite way:

 

Manually enter another hotkey in the HotKey box on the demo app, for example:

 

image.thumb.png.a43f218a5496c342665f95f34616bccd.png

 

Then SAVE the ShellLink Shortcut in any location you want by clicking the button "Save Shortcut Link". You will again notice that the MODIFIER KEYS are again missing from the hotkey of the saved ShellLink Shortcut:

 

image.thumb.png.8cdb3b47c5b7e90bb615f77f84b42ed5.png

 

Now UNCOMMENT the following code-line in the demo app source code, to include the MODIFIER KEYS in the hotkey of the saved ShellLink Shortcut and then recompile the demo app:

 

SL.HotKey := Winapi.Windows.MakeWord(Byte(HotKey1.HotKey), Byte(HotKey1.Modifiers));

...and you will get the desired result in the saved ShellLink Shortcut:

 

image.thumb.png.62721926f0d9e7d95a453951ea15314e.png

Edited by PeterPanettone

Share this post


Link to post

If you want this bugfix to be included in the JVCL, you will have to create a pull request on Github.

Share this post


Link to post

This is no JclShell bug. It is a handling error. Your code mixes HotKey and ShortCut.

 

THotKey.HotKey is not a (Windows) HotKey but a (Delphi) ShortCut. The IShellLink.GetHotKey function returns a (Windows) HotKey. Your "bug fix" code converts a HotKey to a ShortCut.

 

If you look a the ComCtrls.pas TCustomHotKey class you'll see that the "HotKey: TShortCut" property's setter uses the private method ShortCutToHotKey to convert the specified ShortCut into a HotKey in order to send it to the HotKey-Control.

Share this post


Link to post
Posted (edited)
11 minutes ago, jbg said:

It is a handling error.

How would you resolve this "handling error"?

Edited by PeterPanettone

Share this post


Link to post

Your code already does it. And the JclShell unit now (git master branch) has the new function ShellLinkShortCut() that converts the HotKey to a ShortCut.

Share this post


Link to post
19 minutes ago, jbg said:

And the JclShell unit now (git master branch) has the new function ShellLinkShortCut() that converts the HotKey to a ShortCut.

Congratulations, Andreas is a very fast guy!

 

image.thumb.png.d5e1618406780bbbdb1da8e70e167ead.png

 

Thanks, Andreas!

Share this post


Link to post

This is the new code added by Andreas to JclShell:

 

function ShellLinkShortCut(const Link: TShellLink): TShortCut;
type
  THotKeyModifiers = set of (hkShift, hkCtrl, hkAlt, hkExt);
var
  Modifiers: THotKeyModifiers;
begin
  if Link.HotKey = 0 then
    Result := scNone
  else
  begin
    Modifiers := THotKeyModifiers(HiByte(Link.HotKey));
    Result := LoWord(LoByte(Link.HotKey));
    if hkShift in Modifiers then
      Result := Result or scShift;
    if hkCtrl in Modifiers then
      Result := Result or scCtrl;
    if hkAlt in Modifiers then
      Result := Result or scAlt;
  end;
end;

This reduces the code in my demo app to load the ShellLink Shortcut to:

 

procedure TformMain.LoadShortcutShellLink(const AFile: string);
var
  SL: JclShell.TShellLink;
begin
  JclShell.ShellLinkResolve(AFile, SL);
  HotKey1.HotKey := JclShell.ShellLinkShortCut(SL);
end;

 

Share this post


Link to post
Posted (edited)

But even much simpler would be:

 

procedure TformMain.LoadShortcutShellLink(const AFile: string);
var
  SL: JclShell.TShellLink;
begin
  JclShell.ShellLinkResolve(AFile, SL);
  HotKey1.HotKey := SL.HotKey_;
end;

Andreas, could you please implement this in JclShell. Thank you!

 

And also the opposite conversion should be done internally in JclShell. In this way, the user would not have to do any conversions himself:

 

procedure TformMain.SaveShortcutShellLink(const AFile: string);
var
  SL: JclShell.TShellLink;
  HotKeyModifiers: Byte;
begin
  SL.Target := 'C:\Windows\System32\notepad.exe';
  SL.HotKey_ := HotKey1.HotKey;
  JclShell.ShellLinkCreate(SL, AFile);
end;

For this, the declaration of JclShell.TShellLink.Hotkey needs to be set to TShortcut. This really is a bug in JclShell.

 

To make this compatible to existing code, I would redeclare the TShellLink record in JclShell in this way:

 

// Shortcuts / Shell link
type
  PShellLink = ^TShellLink;
  TShellLink = record
    Arguments: string;
    ShowCmd: Integer;
    WorkingDirectory: string;
    IdList: PItemIDList;
    Target: string;
    Description: string;
    IconLocation: string;
    IconIndex: Integer;
    HotKey: Word; // Use ShellLinkShortCut() to convert it to a TShortCut or simply use:
    HotKey_: TShortCut;
  end;

 

Edited by PeterPanettone

Share this post


Link to post
Posted (edited)

This has nothing to do directly with JclShell, but it adds useful functionality to the demo app: Since ShellLink Shortcuts are often created in protected locations such as in StartMenu directories or on a Desktop (e.g. "C:\Users\Public\Desktop") I have added a routine which automatically saves the ShellLink Shortcut with Administrator rights if the saving with normal user rights fails:

 

procedure TformMain.SaveShortcutShellLink(const AFile: string);
var
  SL: JclShell.TShellLink;
  HR: Integer;
begin
  SL.Target := 'C:\Windows\System32\notepad.exe';

  // Uncomment the following code line to include the modifier keys in the saved ShellLink Shortcut:
  SL.HotKey := Winapi.Windows.MakeWord(Byte(HotKey1.HotKey), Byte(HotKey1.Modifiers));

  // other ShellLink properties:
  SL.Description := 'My description';

  HR := JclShell.ShellLinkCreate(SL, AFile);

  if HR <> Winapi.Windows.S_OK then
    SaveShortcutShellLinkAsAdministrator(AFile, SL);
end;

procedure TformMain.SaveShortcutShellLinkAsAdministrator(const AFile: string; AShellLink: JclShell.TShellLink);
var
  ts, ThisTempLnkFile, ThisParams: string;
  ThisShellExecExResult: Boolean;
begin
  System.SysUtils.DateTimeToString(ts, 'yymmddhhnnsszzz', Now);
  ThisTempLnkFile := System.SysUtils.IncludeTrailingBackslash(System.IOUtils.TPath.GetTempPath) + ts + '.lnk';
  JclShell.ShellLinkCreate(AShellLink, ThisTempLnkFile);
  // https://docs.microsoft.com/en-us/windows-server/administration/windows-commands/cmd
  ThisParams := '/C move ' + '"' + ThisTempLnkFile + '"' + ' ' + '"' + AFile + '"';
  ThisShellExecExResult := JclShell.ShellExecEx('cmd.exe', ThisParams, 'runas', SW_HIDE);
  //Winapi.ShellAPI.ShellExecute(0, 'runas', 'cmd.exe', PChar(ThisParams), '', Winapi.Windows.SW_HIDE);
end;

 

Edited by PeterPanettone

Share this post


Link to post
Posted (edited)

This is a more SECURE version of SaveShortcutShellLinkAsAdministrator for the demo app:

 

procedure TformMain.SaveShortcutShellLink(const AFile: string);
var
  SL: JclShell.TShellLink;
  HR: Integer;
begin
  SL.Target := 'C:\Windows\System32\notepad.exe';

  SL.HotKey := Winapi.Windows.MakeWord(Byte(HotKey1.HotKey), Byte(HotKey1.Modifiers));

  // other ShellLink properties:
  SL.Description := 'My description';

  HR := JclShell.ShellLinkCreate(SL, AFile);

  if HR <> Winapi.Windows.S_OK then
  begin
    if not SaveShortcutShellLinkAsAdministrator(AFile, SL) then
      MessageDlg('The Shortcut ShellLink could not be saved even with Administrator rights.', mtError, [mbOK], 0);
  end;
end;

function TformMain.SaveShortcutShellLinkAsAdministrator(const AFile: string; AShellLink: JclShell.TShellLink): Boolean;
// SECURELY create Shortcut ShellLink as administrator
var
  ts, ThisTempLnkFile, ThisParams, SourceHash, TargetHash: string;
  
  function GetHashFromFile(const AFileToHash: string): string;
  var
    IdMD5: IdHashMessageDigest.TIdHashMessageDigest5;
    FS: TFileStream;
  begin
    IdMD5 := IdHashMessageDigest.TIdHashMessageDigest5.Create;
    FS := TFileStream.Create(AFileToHash, fmOpenRead or fmShareDenyWrite);
    try
      Result := IdMD5.HashStreamAsHex(FS);
    finally
      FS.Free;
      IdMD5.Free;
    end;
  end;
begin
  Result := False;

  // create temporary ShellLink Shortcut:
  System.SysUtils.DateTimeToString(ts, 'yymmddhhnnsszzz', Now);
  ThisTempLnkFile := System.SysUtils.IncludeTrailingBackslash(System.IOUtils.TPath.GetTempPath) + ts + '.lnk';
  if JclShell.ShellLinkCreate(AShellLink, ThisTempLnkFile) = Winapi.Windows.S_OK then
  begin
    // get the MD5 hash of the temporary ShellLink Shortcut (to compare it later with the target hash):
    SourceHash := GetHashFromFile(ThisTempLnkFile);
  end
  else
  begin
    MessageDlg('Could not create a temporary ShellLink Shortcut', mtError, [mbOK], 0);
    EXIT;
  end;

  // MOVE the temporary ShellLink Shortcut to the real target:
  // https://docs.microsoft.com/en-us/windows-server/administration/windows-commands/cmd
  ThisParams := '/C move ' + '"' + ThisTempLnkFile + '"' + ' ' + '"' + AFile + '"';
  Result := JclShell.ShellExecAndWait('cmd.exe', ThisParams, 'runas', SW_HIDE);
  if not Result then EXIT;
  //OR: Winapi.ShellAPI.ShellExecute(0, 'runas', 'cmd.exe', PChar(ThisParams), '', Winapi.Windows.SW_HIDE);

  // Check whether the target file exists:
  if not FileExists(AFile) then EXIT;
  // Compare the MD5 hashes of the source file and of the target file:
  TargetHash := GetHashFromFile(AFile);
  Result := SameText(SourceHash, TargetHash);
end;

 

Edited by PeterPanettone

Share this post


Link to post
17 hours ago, PeterPanettone said:

 


function TformMain.SaveShortcutShellLinkAsAdministrator(const AFile: string; AShellLink: JclShell.TShellLink): Boolean;
begin
 [...]
  else
  begin
    MessageDlg('Could not create a temporary ShellLink Shortcut', mtError, [mbOK], 0);
    EXIT;
  end;
  [...]
  if not Result then EXIT;
  [...]
  if not FileExists(AFile) then EXIT;
  [...]
end;

 

 

On 12/20/2019 at 10:29 AM, PeterPanettone said:

I have found a new DEFINITION of "Early Return":

 

"STUPIDITY TRYING TO LOOK SMART"

Jokes aside 🙂

A couple of questions popped up in my mind:

- Are you sure that "RunAs" is an allowed verb for ShellExecute? https://docs.microsoft.com/en-us/windows/win32/api/shellapi/nf-shellapi-shellexecutea does not seem include it, only https://docs.microsoft.com/en-us/windows/win32/api/shellapi/ns-shellapi-shellexecuteinfoa (JCL's ShellExecAndWait is using the Ex version, so the code itself is good, it's only a misleading comment)

- Tip: If the file exists but corrupted (hashes do not match) delete the target file as its useless anyway; but...

- Why are you comparing the hashes before and after moving? Did you experience corruption in any occasion? I'm only asking because I personally never met this before.

- A little bit more resource friendly way of verification might be to check the exit code of move. I'd say might, because as it never failed on me I don't know what exit code it returns if it corrupted the data. So take this with a grain of salt.

Share this post


Link to post
2 hours ago, aehimself said:

Tip: If the file exists but corrupted (hashes do not match) delete the target file as its useless anyway;

Why do you want to throw away the fish before eating it?

 

2 hours ago, aehimself said:

Why are you comparing the hashes before and after moving?

To check whether they are the same.

 

2 hours ago, aehimself said:

A little bit more resource friendly way of verification might be to check the exit code of move

How would you do that?

 

2 hours ago, aehimself said:

Are you sure that "RunAs" is an allowed verb for ShellExecute?

Until now it always worked.

 

2 hours ago, aehimself said:

Jokes aside

Where is the joke?

Share this post


Link to post

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

×