Fix for bug in JclShell

[PeterPanettone 157]

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:

 

 

Now start the demo app:

 

JclShell_BugFix.zip

 

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

 

 

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:

 

 

Now let's try the opposite way:

 

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

 

 

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:

 

 

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:

 

Edited January 4, 2020 by PeterPanettone

[dummzeuch 1505]

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

[PeterPanettone 157]

I have tried to report the bug here:

 

https://issuetracker.delphi-jedi.org/bug_report.php

 

...but I got this error message:

 

This page isn’t working issuetracker.delphi-jedi.org is currently unable to handle this request.
HTTP ERROR 500

[jbg 239]

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.

[PeterPanettone 157]

11 minutes ago, jbg said:

It is a handling error.

How would you resolve this "handling error"?

Edited January 4, 2020 by PeterPanettone

[jbg 239]

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.

[PeterPanettone 157]

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!

 

 

Thanks, Andreas!

[PeterPanettone 157]

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;

 

[PeterPanettone 157]

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 January 4, 2020 by PeterPanettone

[dummzeuch 1505]

15 hours ago, PeterPanettone said:

I have tried to report the bug here:

 

https://issuetracker.delphi-jedi.org/bug_report.php

That page is petty much dead. The only way to reach anybody of the Jedi team (the few that are left) is through GitHub.

[PeterPanettone 157]

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 January 5, 2020 by PeterPanettone

[PeterPanettone 157]

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 January 9, 2020 by PeterPanettone

[aehimself 396]

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.

[PeterPanettone 157]

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?

[TurboMagic 92]

On 1/5/2020 at 10:35 AM, dummzeuch said:

That page is petty much dead. The only way to reach anybody of the Jedi team (the few that are left) is through GitHub.

There is a Mantis bugtracker linked on the JCL and JVCL project description pages on GitHub. That works.

[PeterPanettone 157]

2 hours ago, TurboMagic said:

There is a Mantis bugtracker linked on the JCL and JVCL project description pages on GitHub. That works.

I found the JCL project on GitHub, but not the JVCL project. Do you have a link?

[dummzeuch 1505]

10 hours ago, TurboMagic said:

There is a Mantis bugtracker linked on the JCL and JVCL project description pages on GitHub. That works.

Last time I tried to submit a bug report trough Mantis, somebody told me that it was sheer luck if anybody even looked at it. That was a few years ago though.

[toms 29]

16 hours ago, PeterPanettone said:

I found the JCL project on GitHub, but not the JVCL project. Do you have a link?

Googled and found this: https://github.com/project-jedi

[PeterPanettone 157]

7 hours ago, toms said:

Googled and found this: https://github.com/project-jedi

Thanks. I have only searched in GitHub for "jvcl".