program UltraExplorerHookLoader;

// The contents of this file are subject to the Mozilla Public License
// Version 1.1 (the "License"); you maynot use this file except in compliance
// with the License. You may obtain a copy of the License at http://www.mozilla.org/MPL/
//
// Alternatively, you may redistribute this library, use and/or modify it under the terms of the
// GNU Lesser General Public License as published by the Free Software Foundation;
// either version 2.1 of the License, or (at your option) any later version.
// You may obtain a copy of the LGPL at http://www.gnu.org/copyleft/.
//
// Software distributed under the License is distributed on an "AS IS" basis,
// WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the
// specific language governing rights and limitations under the License.

// This is a lower level hook (LL) so it is not necessary to be in a DLL

{$R *.res}

{$DEFINE TNT}

uses
  Windows,
  TntRegistry,
  TntSysUtils,
  SysUtils,
  ShellAPI,
  Messages;

const
  WINDOWCLASSNAME = 'UltraExplorerHookLoaderClass';
  WH_KEYBOARD_LL = 13;
  str_HookData = 'UltraKeyboardHookData';
  ID_SHELLEXECUTE = 101;

type
  TKBDLLHookStruct = packed record
    vkCode,
    scanCode,
    flags,
    time: DWORD;
    dwExtraInfo: PULONG;
  end;
  PKBDLLHookStruct = ^TKBDLLHookStruct;

type
  PHookData = ^THookData;
  THookData = record
    WindowHandle: THandle; // Handle of the Window to notify when the critera is encountered
    HookHandle: THandle;   // Handle returned by the SetWindowHookEx for CallNextHook
  end;

// global Variables, this works because this is a Lower Level Hook not in a DLL
// The context switches to this process for every call so there is only one
// instance running, unlike in a DLL that is loaded into other processes
var
  NextHookHandle: THandle = 0;
  WinKeyDown: Boolean = False;
  E_KeyDown: Boolean = False;
  MainWnd: HWnd;
  TimerID: Cardinal = 0;
  ShellExecuteW_MP: function(hWnd: HWND; Operation, FileName, Parameters, Directory: PWideChar; ShowCmd: Integer): HINST; stdcall;

function WideShellExecute(hWnd: HWND; Operation, FileName, Parameters, Directory: WideString; ShowCmd: Integer = SW_NORMAL): HINST;
var
  OperationA, FileNameA, ParametersA, DirectoryA: string;
  PA, DA: PChar;
  PW, DW: PWideChar;
begin
  if Assigned(ShellExecuteW_MP) then
  begin
    PW := nil;
    DW := nil;
    if Parameters <> '' then
      PW := PWideChar(Parameters);
    if Directory <> '' then
      DW := PWideChar(Directory);
    Result := ShellExecuteW_MP(hWnd, PWideChar(Operation), PWideChar(FileName), PW, DW, SW_NORMAL)
  end else
  begin
    OperationA := Operation;
    FileNameA := FileName;
    ParametersA := Parameters;
    DirectoryA := Directory;
    PA := nil;
    DA := nil;
    if ParametersA <> '' then
      PA := PChar( ParametersA);
    if DirectoryA <> '' then
      DA := PChar( DirectoryA);
    Result := ShellExecuteA(hWnd, PChar(OperationA), PChar(FileNameA), PA, DA, SW_NORMAL)
  end
end;

function WideDirectoryExists(const Name: WideString): Boolean;
begin
  Result := TntSysUtils.WideDirectoryExists(Name);
end;

function WideIsDrive(Drive: WideString): Boolean;
begin
  if Length(Drive) = 3 then
    Result := (LowerCase(Drive[1]) >= 'a') and (LowerCase(Drive[1]) <= 'z') and (Drive[2] = ':') and (Drive[3] = '\')
  else
  if Length(Drive) = 2 then
    Result := (LowerCase(Drive[1]) >= 'a') and (LowerCase(Drive[1]) <= 'z') and (Drive[2] = ':')
  else
    Result := False
end;

function WideStripTrailingBackslash(const S: WideString; Force: Boolean = False): WideString;
begin
  Result := S;
  if Result <> '' then
  begin
    // Works with FilePaths and FTP Paths
    if Result[ Length(Result)] in [WideChar('/'), WideChar('\')] then
      if not WideIsDrive(Result) or Force then // Don't strip off if is a root drive
        SetLength(Result, Length(Result) - 1);
  end;
end;

function IsUnicode: Boolean;
begin
  Result := Win32Platform = VER_PLATFORM_WIN32_NT
end;

function ExtractFileDirW(const FileName: WideString): WideString;
begin
  {$IFDEF TNT}
    Result := WideExtractFileDir( FileName)
  {$ELSE}
    Result := ExtractFileDir( AnsiString(FileName))
  {$ENDIF}
end;

function ModuleFileName(PathOnly: Boolean = True): Widestring;
var
  BufferA: array[0..MAX_PATH] of AnsiChar;
  BufferW: array[0..MAX_PATH] of WideChar;
begin
  if IsUnicode then
  begin
    FillChar(BufferW, SizeOf(BufferW), #0);
    if GetModuleFileNameW(0, BufferW, SizeOf(BufferW)) > 0 then
    begin
      if PathOnly then
        Result := ExtractFileDirW(BufferW)
      else
        Result := BufferW;
    end
  end else
  begin
    FillChar(BufferA, SizeOf(BufferA), #0);
    if GetModuleFileNameA(0 , BufferA, SizeOf(BufferA)) > 0 then
    begin
      if PathOnly then
        Result := ExtractFileDirW(BufferA)
      else
        Result := BufferA
    end
  end
end;

procedure TimerFunc(hwnd: HWND; uMsg: UINT;	idEvent: UINT; dwTime: DWORD); stdcall;
var
  Reg: TTntRegistry;
  Path: WideString;
begin
  KillTimer(HWND, idEvent);
  TimerID := 0;
  Reg := TTntRegistry.Create;
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    if not Reg.OpenKeyReadOnly('SOFTWARE\Mustangpeak\UltraExplorer') then
    begin
      Path := Reg.ReadString('Path');
      if WideDirectoryExists(Path) then
        WideShellExecute(0, 'open', PWideChar( WideStripTrailingBackslash(Path) +  '\UltraExplorer.exe'), '', '');
    end else
    begin
      Path := WideStripTrailingBackslash( ModuleFileName(True)) + '\UltraExplorer.exe';
      if WideFileExists(Path) then
        WideShellExecute(0, 'open', PWideChar( Path), '', '');
    end
  finally
    Reg.Free;

  end
end;

function KeyboardProc(Code: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT stdcall;
begin
  Result := 0;
  try
    if (Code = HC_ACTION) and (wParam = WM_KEYDOWN) then
    begin
      if (PKBDLLHookStruct( lParam)^.vkCode = VK_LWIN) or (PKBDLLHookStruct( lParam)^.vkCode = VK_RWIN) then
        WinKeyDown := True;
      if (PKBDLLHookStruct( lParam)^.vkCode = Ord('e')) or (PKBDLLHookStruct( lParam)^.vkCode = Ord('E')) then
      begin
        E_KeyDown := True;
        // Block Explorer from being run, we MUST run in < 50ms or the next hook will be called anyway
        if WinKeyDown then
        begin
          Result := 1;
          if TimerID = 0 then
            TimerID := SetTimer(MainWnd, ID_SHELLEXECUTE, 300, @TimerFunc);
        end
      end
    end;
    if (Code = HC_ACTION) and (wParam = WM_KEYUP) then
    begin
      // ANY key up should reset the flags
      WinKeyDown := False;
      E_KeyDown := False;
    end;

    if (NextHookHandle <> 0) and (Result = 0) then
      Result := CallNextHookEx(NextHookHandle, Code, wParam, lParam);
  except
  end
end;

procedure SetHook; stdcall;
begin
  NextHookHandle := SetWindowsHookEx(WH_KEYBOARD_LL, KeyboardProc, hInstance, 0);
end;

procedure RemoveHook; stdcall;
begin
  if NextHookHandle <> 0 then
  begin
    UnHookWindowsHookEx(NextHookHandle);
    NextHookHandle := 0
  end
end;


function WindowProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
  case uMsg of
    WM_DESTROY:
      begin
        PostQuitMessage(0);
        Result := 0;
      end;
    WM_CREATE:
      begin
        Result := 0;
      end;
    WM_NCCREATE:
      begin
        Result := 1
      end;
    else
      Result := DefWindowProc(hWnd, uMsg, wParam, lParam);
  end;
end;


function CreateWindow: HWnd;
var
  WndClass: TWndClass;
  Success: Boolean;
begin
  Result := 0;
  if not GetClassInfo(hInstance, WINDOWCLASSNAME, WndClass) then
  begin
    WndClass.style := CS_BYTEALIGNCLIENT or CS_BYTEALIGNWINDOW;
    WndClass.lpfnWndProc := @WindowProc;
    WndClass.cbClsExtra := 0;
    WndClass.cbWndExtra := 0;
    WndClass.hInstance := hInstance;
    WndClass.hIcon := LoadIcon(0, IDI_APPLICATION);
    WndClass.hCursor := LoadCursor(0, IDC_ARROW);
    WndClass.hbrBackground := COLOR_WINDOW + 1;
    WndClass.lpszMenuName := nil;
    WndClass.lpszClassName := WINDOWCLASSNAME;
    Success := Windows.RegisterClass(WndClass) <> 0;
  end else
    Success := True;
  if Success then
    Result := CreateWindowA(WINDOWCLASSNAME, WINDOWCLASSNAME,
      WS_POPUP and not WS_VISIBLE, 0, 0, 0, 0, 0, 0, hInstance, nil);
end;

var
  Msg: TMsg;
  Shell32Handle: THandle;
begin
  Shell32Handle := LoadLibrary(Shell32);
  if Shell32Handle <> 0 then
    ShellExecuteW_MP := GetProcAddress(Shell32Handle, 'ShellExecuteW');
  MainWnd := CreateWindow;
  if MainWnd <> 0 then
  begin
    SetWindowText(MainWnd, WINDOWCLASSNAME);
    SetHook;
    while GetMessage(Msg, 0, 0, 0) do
    begin
      TranslateMessage(Msg);
      DispatchMessage(Msg)
    end;
    RemoveHook;
  end;
  if Shell32Handle <> 0 then
    FreeLibrary(Shell32Handle)
end.