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.