mirror of
https://github.com/doublecmd/doublecmd.git
synced 2026-06-28 10:02:14 +00:00
UPD: Better Total Commander plugins compatibility
This commit is contained in:
Alexander Koblov
parent
041a4e038b
commit
a51b586239
4 changed files with 134 additions and 142 deletions
|
|
@ -129,7 +129,7 @@ uses
|
|||
, uTotalCommander, FileUtil, Windows, ShlObj, uShlObjAdditional
|
||||
, uWinNetFileSource, uVfsModule, uLng, uMyWindows, DCStrUtils
|
||||
, uListGetPreviewBitmap, uThumbnailProvider, uDCReadSVG, uFileSourceUtil
|
||||
, Dialogs, Clipbrd, uShowMsg
|
||||
, Dialogs, Clipbrd, uShowMsg, uDebug, JwaDbt
|
||||
{$ENDIF}
|
||||
{$IFDEF UNIX}
|
||||
, BaseUnix, fFileProperties, uJpegThumb
|
||||
|
|
@ -374,6 +374,27 @@ var
|
|||
ShellContextMenu : TShellContextMenu = nil;
|
||||
|
||||
{$IFDEF MSWINDOWS}
|
||||
|
||||
var
|
||||
OldWProc: WNDPROC;
|
||||
|
||||
function MyWndProc(hWnd: HWND; uiMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
|
||||
begin
|
||||
if (uiMsg = WM_SETTINGCHANGE) and (lParam <> 0) and (StrComp('Environment', {%H-}PAnsiChar(lParam)) = 0) then
|
||||
begin
|
||||
UpdateEnvironment;
|
||||
DCDebug('WM_SETTINGCHANGE:Environment');
|
||||
end;
|
||||
|
||||
if (uiMsg = WM_DEVICECHANGE) and (wParam = DBT_DEVNODES_CHANGED) and (lParam = 0) then
|
||||
begin
|
||||
Screen.UpdateMonitors; // Refresh monitor list
|
||||
DCDebug('WM_DEVICECHANGE:DBT_DEVNODES_CHANGED');
|
||||
end;
|
||||
|
||||
Result := CallWindowProc(OldWProc, hWnd, uiMsg, wParam, lParam);
|
||||
end;
|
||||
|
||||
procedure ActivateHandler(Self, Sender: TObject);
|
||||
var
|
||||
I: Integer = 0;
|
||||
|
|
@ -534,13 +555,16 @@ begin
|
|||
// Disable application button on taskbar
|
||||
with Widgetset do
|
||||
SetWindowLong(AppHandle, GWL_EXSTYLE, GetWindowLong(AppHandle, GWL_EXSTYLE) or WS_EX_TOOLWINDOW);
|
||||
// Emulate Total Commander window
|
||||
CreateTotalCommanderWindow(MainForm.Handle);
|
||||
// Register network file source
|
||||
RegisterVirtualFileSource(rsVfsNetwork, TWinNetFileSource);
|
||||
if (Win32MajorVersion > 5) and IsUserAdmin then // if run under administrator
|
||||
MainForm.Caption:= MainForm.Caption + ' - Administrator';
|
||||
|
||||
// Add main window message handler
|
||||
{$PUSH}{$HINTS OFF}
|
||||
OldWProc := WNDPROC(SetWindowLongPtr(Application.MainForm.Handle, GWL_WNDPROC, LONG_PTR(@MyWndProc)));
|
||||
{$POP}
|
||||
|
||||
with frmMain do
|
||||
begin
|
||||
Handler.Code:= @MenuHandler;
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
{
|
||||
Double Commander
|
||||
-------------------------------------------------------------------------
|
||||
Creates Total Commander fake window (some plugins don't work without it)
|
||||
Total Commander integration functions
|
||||
|
||||
Copyright (C) 2009-2019 Alexander Koblov (alexx2000@mail.ru)
|
||||
|
||||
|
|
@ -30,8 +30,6 @@ unit uTotalCommander;
|
|||
|
||||
{$MODE DELPHI}
|
||||
|
||||
{.$DEFINE DEBUG}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
|
|
@ -59,7 +57,6 @@ const
|
|||
var
|
||||
sTotalCommanderMainbarFilename: string = TCCONFIG_MAINBAR_NOTPRESENT;
|
||||
|
||||
procedure CreateTotalCommanderWindow({%H-}hWindow: HWND);
|
||||
function ConvertTCStringToString(TCString: ansistring): string;
|
||||
function ConvertStringToTCString(sString: string): ansistring;
|
||||
function ReplaceDCEnvVars(const sText: string): string;
|
||||
|
|
@ -75,11 +72,11 @@ implementation
|
|||
|
||||
uses
|
||||
//Lazarus, Free-Pascal, etc.
|
||||
Graphics, LCLVersion, Forms, JwaDbt, SysUtils, LCLProc, LazUTF8,
|
||||
Graphics, LCLVersion, Forms, SysUtils, LCLProc, LazUTF8,
|
||||
|
||||
//DC
|
||||
fOptionsMisc, uKASToolItemsExtended,
|
||||
DCClassesUtf8, DCOSUtils, uDebug, DCStrUtils, uPixMapManager, uShowMsg,
|
||||
DCClassesUtf8, DCOSUtils, DCStrUtils, uPixMapManager, uShowMsg,
|
||||
uDCUtils, uLng, uGlobs, uGlobsPaths, DCConvertEncoding, uMyWindows;
|
||||
|
||||
type
|
||||
|
|
@ -605,108 +602,10 @@ const
|
|||
//cm_WorkWithDirectoryHotlist
|
||||
|
||||
var
|
||||
wcFakeWndClass: TWndClassEx;
|
||||
//hMainWindow,
|
||||
{$IFDEF DEBUG}
|
||||
hFakeWindow: HWND;
|
||||
{$ENDIF}
|
||||
TCIconSize: integer = 32;
|
||||
TCNumberOfInstance: integer;
|
||||
TCListOfCreatedTCIconFilename: TStringList;
|
||||
|
||||
procedure UpdateEnvironment;
|
||||
var
|
||||
dwSize: DWORD;
|
||||
ASysPath: UnicodeString;
|
||||
AUserPath: UnicodeString;
|
||||
APath: UnicodeString = '';
|
||||
begin
|
||||
// System environment
|
||||
if RegReadKey(HKEY_LOCAL_MACHINE, 'System\CurrentControlSet\Control\Session Manager\Environment', 'Path', ASysPath) then
|
||||
begin
|
||||
APath := ASysPath;
|
||||
if (Length(APath) > 0) and (APath[Length(APath)] <> PathSeparator) then APath += PathSeparator;
|
||||
end;
|
||||
// User environment
|
||||
if RegReadKey(HKEY_CURRENT_USER, 'Environment', 'Path', AUserPath) then
|
||||
begin
|
||||
APath := APath + AUserPath;
|
||||
if (Length(APath) > 0) and (APath[Length(APath)] <> PathSeparator) then APath += PathSeparator;
|
||||
end;
|
||||
// Update path environment variable
|
||||
if Length(APath) > 0 then
|
||||
begin
|
||||
SetLength(ASysPath, MaxSmallInt + 1);
|
||||
dwSize:= ExpandEnvironmentStringsW(PWideChar(APath), PWideChar(ASysPath), MaxSmallInt);
|
||||
if (dwSize = 0) or (dwSize > MaxSmallInt) then
|
||||
ASysPath:= APath
|
||||
else begin
|
||||
SetLength(ASysPath, dwSize - 1);
|
||||
end;
|
||||
SetEnvironmentVariableW('Path', PWideChar(ASysPath));
|
||||
end;
|
||||
end;
|
||||
|
||||
{ WindowProc }
|
||||
function WindowProc(hWnd: HWND; uiMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
|
||||
begin
|
||||
{
|
||||
Resend message to DoubleCommander main window.
|
||||
|
||||
Disabled currently, because it may interfere with LCL, especially since the fake
|
||||
TotalCmd window is also a main app window (WS_OVERLAPPEDWINDOW). May be enabled
|
||||
in future if any plugins need this, but following messages should be skipped
|
||||
because they are known to cause conflict:
|
||||
- WM_ACTIVATEAPP
|
||||
Confuses LCL about which main form (window) is currently active and
|
||||
it stops calling OnExit events for controls (see TWinControl.WMKillFocus).
|
||||
}
|
||||
//SendMessage(hMainWindow, uiMsg, wParam, lParam);
|
||||
|
||||
if (uiMsg = WM_SETTINGCHANGE) and (lParam <> 0) and (StrComp('Environment', {%H-}PAnsiChar(lParam)) = 0) then
|
||||
begin
|
||||
UpdateEnvironment;
|
||||
DCDebug('WM_SETTINGCHANGE:Environment');
|
||||
end;
|
||||
|
||||
{$IF (lcl_fullversion >= 1020000)}
|
||||
if (uiMsg = WM_DEVICECHANGE) and (wParam = DBT_DEVNODES_CHANGED) and (lParam = 0) then
|
||||
begin
|
||||
Screen.UpdateMonitors; // Refresh monitor list
|
||||
DCDebug('WM_DEVICECHANGE:DBT_DEVNODES_CHANGED');
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF DEBUG}
|
||||
WriteLn(uiMsg);
|
||||
{$ENDIF}
|
||||
Result := DefWindowProc(hWnd, uiMsg, wParam, lParam);
|
||||
end;
|
||||
|
||||
{ CreateTotalCommanderWindow }
|
||||
procedure CreateTotalCommanderWindow(hWindow: HWND);
|
||||
begin
|
||||
// hMainWindow:= hWindow;
|
||||
FillByte(wcFakeWndClass, SizeOf(wcFakeWndClass), 0);
|
||||
wcFakeWndClass.cbSize := SizeOf(wcFakeWndClass);
|
||||
wcFakeWndClass.Style := CS_HREDRAW or CS_VREDRAW;
|
||||
wcFakeWndClass.lpfnWndProc := @WindowProc;
|
||||
wcFakeWndClass.hInstance := hInstance;
|
||||
wcFakeWndClass.hbrBackground := Color_BtnFace + 12;
|
||||
wcFakeWndClass.lpszMenuName := nil;
|
||||
wcFakeWndClass.lpszClassName := 'TTOTAL_CMD';
|
||||
RegisterClassEx(wcFakeWndClass);
|
||||
// Create Total Commander fake window
|
||||
{$IFDEF DEBUG}
|
||||
hFakeWindow :=
|
||||
{$ENDIF}
|
||||
CreateWindowEx(0, 'TTOTAL_CMD', 'Double Commander', WS_OVERLAPPEDWINDOW, 100, 100, 300, 300, 0, 0, hInstance, nil);
|
||||
{$IFDEF DEBUG}
|
||||
// Show window (for debugging only)
|
||||
ShowWindow(hFakeWindow, SW_SHOW);
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
// Test have been made with string from site http://stackoverflow.com/questions/478201/how-to-test-an-application-for-correct-encoding-e-g-utf-8
|
||||
// Note: If you ever "think" to change or modify this routine, make sure to test the following:
|
||||
// 1o) Make a directory with utf-8 special characters, a path like this: "Card-♠♣♥♦"
|
||||
|
|
|
|||
|
|
@ -30,38 +30,10 @@ implementation
|
|||
|
||||
uses
|
||||
Classes, SysUtils, Win32Int, WSLCLClasses, Forms, Windows, Win32Proc,
|
||||
Controls, WSForms, Win32WSForms, LCLType, fMain;
|
||||
Controls, LCLType, fMain, Win32WSControls, uImport;
|
||||
|
||||
const
|
||||
ClassNameW: UnicodeString = 'DClass'#0;
|
||||
|
||||
type
|
||||
|
||||
{ TWin32WSCustomFormEx }
|
||||
|
||||
TWin32WSCustomFormEx = class(TWin32WSCustomForm)
|
||||
published
|
||||
class function CreateHandle(const AWinControl: TWinControl;
|
||||
const AParams: TCreateParams): HWND; override;
|
||||
end;
|
||||
|
||||
{ TWin32WSCustomFormEx }
|
||||
|
||||
class function TWin32WSCustomFormEx.CreateHandle(const AWinControl: TWinControl;
|
||||
const AParams: TCreateParams): HWND;
|
||||
var
|
||||
AClass: String;
|
||||
AMainForm: Boolean;
|
||||
begin
|
||||
AMainForm := AWinControl is TfrmMain;
|
||||
if AMainForm then
|
||||
begin
|
||||
AClass := ClsName;
|
||||
ClsName := String(ClassNameW);
|
||||
end;
|
||||
Result := inherited CreateHandle(AWinControl, AParams);
|
||||
if AMainForm then ClsName := AClass;
|
||||
end;
|
||||
ClassNameW: PWideChar = 'TTOTAL_CMD'; // for compatibility with plugins
|
||||
|
||||
function WinRegister: Boolean;
|
||||
var
|
||||
|
|
@ -77,17 +49,79 @@ begin
|
|||
if hIcon = 0 then
|
||||
hIcon := Windows.LoadIcon(0, IDI_APPLICATION);
|
||||
hCursor := Windows.LoadCursor(0, IDC_ARROW);
|
||||
LPSzClassName := PWideChar(ClassNameW);
|
||||
LPSzClassName := ClassNameW;
|
||||
end;
|
||||
Result := Windows.RegisterClassW(@WindowClassW) <> 0;
|
||||
end;
|
||||
|
||||
var
|
||||
__GetProp: function(hWnd: HWND; lpString: LPCSTR): HANDLE; stdcall;
|
||||
__SetProp: function(hWnd: HWND; lpString: LPCSTR; hData: HANDLE): WINBOOL; stdcall;
|
||||
__CreateWindowExW: function(dwExStyle: DWORD; lpClassName: LPCWSTR; lpWindowName: LPCWSTR; dwStyle: DWORD; X: longint; Y: longint; nWidth: longint; nHeight: longint; hWndParent: HWND; hMenu: HMENU; hInstance: HINST; lpParam: LPVOID): HWND; stdcall;
|
||||
|
||||
function _GetProp(hWnd: HWND; lpString: LPCSTR): HANDLE; stdcall;
|
||||
var
|
||||
Atom: UIntPtr absolute lpString;
|
||||
begin
|
||||
if (Atom > MAXWORD) and (lpString = 'WinControl') then
|
||||
Result:= __GetProp(hWnd, 'WinControlDC')
|
||||
else
|
||||
Result:= __GetProp(hWnd, lpString);
|
||||
end;
|
||||
|
||||
function _SetProp(hWnd: HWND; lpString: LPCSTR; hData: HANDLE): WINBOOL; stdcall;
|
||||
var
|
||||
Atom: UIntPtr absolute lpString;
|
||||
begin
|
||||
if (Atom > MAXWORD) and (lpString = 'WinControl') then
|
||||
Result:= __SetProp(hWnd, 'WinControlDC', hData)
|
||||
else
|
||||
Result:= __SetProp(hWnd, lpString, hData);
|
||||
end;
|
||||
|
||||
function _CreateWindowExW(dwExStyle: DWORD; lpClassName: LPCWSTR; lpWindowName: LPCWSTR; dwStyle: DWORD; X: longint; Y: longint; nWidth: longint; nHeight: longint; hWndParent: HWND; hMenu: HMENU; hInstance: HINST; lpParam: LPVOID): HWND; stdcall;
|
||||
var
|
||||
AParams: PNCCreateParams absolute lpParam;
|
||||
begin
|
||||
if (hWndParent = 0) and Assigned(AParams) and (AParams^.WinControl is TfrmMain) then lpClassName:= ClassNameW;
|
||||
Result:= __CreateWindowExW(dwExStyle, lpClassName, lpWindowName, dwStyle, X, Y, nWidth, nHeight, hWndParent, hMenu, hInstance, lpParam);
|
||||
end;
|
||||
|
||||
procedure Initialize;
|
||||
var
|
||||
hModule: THandle;
|
||||
pLibrary, pFunction: PPointer;
|
||||
begin
|
||||
WinRegister;
|
||||
// Replace TCustomForm widgetset class
|
||||
RegisterCustomForm;
|
||||
RegisterWSComponent(TCustomForm, TWin32WSCustomFormEx);
|
||||
|
||||
pLibrary:= FindImportLibrary(MainInstance, user32);
|
||||
if Assigned(pLibrary) then
|
||||
begin
|
||||
hModule:= GetModuleHandle(user32);
|
||||
|
||||
pFunction:= FindImportFunction(pLibrary, GetProcAddress(hModule, 'CreateWindowExW'));
|
||||
if Assigned(pFunction) then
|
||||
begin
|
||||
Pointer(__CreateWindowExW):= ReplaceImportFunction(pFunction, @_CreateWindowExW);
|
||||
end;
|
||||
|
||||
// Prevent plugins written in Lazarus from crashing by changing the name for
|
||||
// GetProp/SetProp to store control data from 'WinControl' to 'WinControlDC'
|
||||
|
||||
pFunction:= FindImportFunction(pLibrary, GetProcAddress(hModule, 'GetPropA'));
|
||||
if Assigned(pFunction) then
|
||||
begin
|
||||
Pointer(__GetProp):= ReplaceImportFunction(pFunction, @_GetProp);
|
||||
end;
|
||||
|
||||
pFunction:= FindImportFunction(pLibrary, GetProcAddress(hModule, 'SetPropA'));
|
||||
if Assigned(pFunction) then
|
||||
begin
|
||||
Pointer(__SetProp):= ReplaceImportFunction(pFunction, @_SetProp);
|
||||
end;
|
||||
end;
|
||||
Windows.GlobalDeleteAtom(WindowInfoAtom);
|
||||
WindowInfoAtom := Windows.GlobalAddAtom('WindowInfoDC');
|
||||
end;
|
||||
|
||||
initialization
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@
|
|||
-------------------------------------------------------------------------
|
||||
This unit contains specific WINDOWS functions.
|
||||
|
||||
Copyright (C) 2006-2018 Alexander Koblov (alexx2000@mail.ru)
|
||||
Copyright (C) 2006-2019 Alexander Koblov (alexx2000@mail.ru)
|
||||
|
||||
This program is free software; you can redistribute it and/or
|
||||
modify it under the terms of the GNU General Public License
|
||||
|
|
@ -153,6 +153,8 @@ function ExtractFileAttributes(const FindData: TWin32FindDataW): DWORD;
|
|||
|
||||
procedure InitErrorMode;
|
||||
|
||||
procedure UpdateEnvironment;
|
||||
|
||||
procedure FixCommandLineToUTF8;
|
||||
|
||||
implementation
|
||||
|
|
@ -940,6 +942,39 @@ begin
|
|||
SetErrorMode(SEM_FAILCRITICALERRORS or SEM_NOOPENFILEERRORBOX);
|
||||
end;
|
||||
|
||||
procedure UpdateEnvironment;
|
||||
var
|
||||
dwSize: DWORD;
|
||||
ASysPath: UnicodeString;
|
||||
AUserPath: UnicodeString;
|
||||
APath: UnicodeString = '';
|
||||
begin
|
||||
// System environment
|
||||
if RegReadKey(HKEY_LOCAL_MACHINE, 'System\CurrentControlSet\Control\Session Manager\Environment', 'Path', ASysPath) then
|
||||
begin
|
||||
APath := ASysPath;
|
||||
if (Length(APath) > 0) and (APath[Length(APath)] <> PathSeparator) then APath += PathSeparator;
|
||||
end;
|
||||
// User environment
|
||||
if RegReadKey(HKEY_CURRENT_USER, 'Environment', 'Path', AUserPath) then
|
||||
begin
|
||||
APath := APath + AUserPath;
|
||||
if (Length(APath) > 0) and (APath[Length(APath)] <> PathSeparator) then APath += PathSeparator;
|
||||
end;
|
||||
// Update path environment variable
|
||||
if Length(APath) > 0 then
|
||||
begin
|
||||
SetLength(ASysPath, MaxSmallInt + 1);
|
||||
dwSize:= ExpandEnvironmentStringsW(PWideChar(APath), PWideChar(ASysPath), MaxSmallInt);
|
||||
if (dwSize = 0) or (dwSize > MaxSmallInt) then
|
||||
ASysPath:= APath
|
||||
else begin
|
||||
SetLength(ASysPath, dwSize - 1);
|
||||
end;
|
||||
SetEnvironmentVariableW('Path', PWideChar(ASysPath));
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure FixCommandLineToUTF8;
|
||||
var
|
||||
I, nArgs: Integer;
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue