Создать папку в текущей папке проводника

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    MyHotKey: WORD;
    procedure WMHotKey(var Msg: TWMHotKey); message WM_HOTKEY;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
//https://otvet.mail.ru/question/217917260
const
  DirName = 'Q217917260';

function ExplorerDir(): string;
var
  Buf: PWideChar;
  hWin: HWND;
  n: Integer;
begin
  hWin := FindWindowW('CabinetWClass', nil);
  if hWin = 0 then
    Exit;
  n := GetWindowTextLengthW(hWin);
  if n > 0 then
  try
    Inc(n);
    GetMem(Buf, n);
    ZeroMemory(Buf, n);
    n := GetWindowTextW(hWin, Buf, n);
    Result := Copy(Buf, 1, n);
  finally
    FreeMem(Buf);
  end;
end;

procedure TForm1.WMHotKey(var Msg: TWMHotKey);
var
  DN: WideString;
begin
  if Msg.HotKey = MyHotKey then
  begin
    try
      DN := ExplorerDir + '\' + DirName;
      CreateDirectoryW(PWideChar(DN),  nil);
    except
      on E: Exception do
        E.CreateFmt('Error: ', [E.Message]);
    end;
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  UnRegisterHotKey(Handle, MyHotKey);
  GlobalDeleteAtom(MyHotKey);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  MyHotKey := GlobalAddAtom('CTRL+L');
  RegisterHotKey(Handle, MyHotKey, MOD_CONTROL, Ord('L'));
end;

end.