unit OpenFolderInCmd;
interface
uses
Windows, ActiveX, ComObj, ShlObj, ShellApi;
type
TOpenFolderInCmd = class(TComObject, IUnknown, IContextMenu, IShellExtInit)
private
FPath: WideString;
function ShellGetPathFromIdListW(APItemIdList: PItemIdList): WideString;
protected
function QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst, idCmdLast,
uFlags: UINT): HResult; stdcall;
function InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult; stdcall;
function GetCommandString(idCmd: UINT_PTR; uFlags: UINT; pwReserved: PUINT;
pszName: LPSTR; cchMax: UINT): HResult; stdcall;
function IShellExtInit.Initialize = InitShellExt;
function InitShellExt (pidlFolder: PItemIDList; lpdobj: IDataObject;
hKeyProgID: HKEY): HResult; stdcall;
end;
TOpenFolderInCmdFactory = class(TComObjectFactory)
public
procedure UpdateRegistry (Register: Boolean); override;
end;
const
cName = 'OpenFolderInCmd';
cMenuCaption = 'Open folder in cmd';
cMenuHelp = 'Open current folder in command prompt';
cGUID: TGUID = '{55639E10-A032-4E22-B039-882E3BCCA67C}';
implementation
uses
ComServ, SysUtils, Registry;
function TOpenFolderInCmd.InitShellExt(pidlFolder: PItemIDList;
lpdobj: IDataObject; hKeyProgID: HKEY): HResult; stdcall;
var
medium: TStgMedium;
fe: TFormatEtc;
begin
Result := NOERROR;
if lpdobj <> nil then
begin
with fe do
begin
cfFormat := CF_HDROP;
ptd := nil;
dwAspect := DVASPECT_CONTENT;
lindex := -1;
tymed := TYMED_HGLOBAL;
end;
Result := lpdobj.GetData(fe, medium);
if not Failed (Result) then
begin
if DragQueryFileW(medium.hGlobal, $FFFFFFFF, nil, 0) = 1 then
begin
SetLength(FPath, 1000);
DragQueryFileW(medium.hGlobal, 0, PWideChar(FPath), 1000);
FPath := PWideChar(FPath);
if not DirectoryExists(FPath) then
Result := E_FAIL
end
else
Result := E_FAIL;
end;
ReleaseStgMedium(medium);
end
else
FPath := ShellGetPathFromIdListW(pidlFolder);
end;
function TOpenFolderInCmd.QueryContextMenu(Menu: HMENU;
indexMenu, idCmdFirst, idCmdLast, uFlags: UINT): HResult; stdcall;
begin
InsertMenu(Menu, indexMenu, MF_STRING or MF_BYPOSITION, idCmdFirst, cMenuCaption);
Result := 1;
end;
function TOpenFolderInCmd.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult; stdcall;
var
Drv: WideString;
Cmd: WideString;
begin
Result := NOERROR;
if HiWord(LongInt(lpici.lpVerb)) <> 0 then
begin
Result := E_FAIL;
Exit;
end;
if LoWord(LongInt(lpici.lpVerb)) > 0 then
begin
Result := E_INVALIDARG;
Exit;
end;
if LoWord(LongInt(lpici.lpVerb)) = 0 then
begin
FPath := IncludeTrailingBackslash(FPath);
Drv := ExtractFileDrive(FPath);
FPath := '"' + FPath + '"';
Cmd := '/K ' + Drv + ' && CD ' + FPath;
ShellExecuteW(0, 'runas', 'cmd.exe', PWideChar(Cmd), PWideChar(FPath), SW_SHOWNORMAL);
end;
end;
function TOpenFolderInCmd.GetCommandString(idCmd: UINT_PTR; uFlags: UINT;
pwReserved: PUINT; pszName: LPSTR; cchMax: UINT): HResult; stdcall;
begin
if (idCmd = 0) and (uFlags = GCS_HELPTEXT) then
begin
StrLCopy(pszName, cMenuHelp, cchMax);
Result := NOERROR;
end
else
Result := E_INVALIDARG;
end;
function TOpenFolderInCmd.ShellGetPathFromIdListW(APItemIdList: PItemIdList): WideString;
var
sz: array[ 0..MAX_PATH ] of WideChar;
w: Word;
begin
if (APItemIdList = nil) then
begin
w := 0;
APItemIdList := Pointer(@w);
end;
if SHGetPathFromIdListW(APItemIdList, @sz[0]) then
SetString(Result, sz, Strlen(sz))
else
Result := '';
end;
procedure TOpenFolderInCmdFactory.UpdateRegistry(Register: Boolean);
var
Reg: TRegistry;
begin
inherited UpdateRegistry (Register);
Reg := TRegistry.Create;
Reg.RootKey := HKEY_CLASSES_ROOT;
try
if Register then
begin
if Reg.OpenKey('\*\ShellEx\ContextMenuHandlers\' + cName, True) then
Reg.WriteString('', GUIDToString(cGUID));
if Reg.OpenKey('\Directory\Background\ShellEx\ContextMenuHandlers\' + cName, True) then
Reg.WriteString('', GUIDToString(cGUID));
if Reg.OpenKey('\Directory\shellex\ContextMenuHandlers\' + cName, True) then
Reg.WriteString('', GUIDToString(cGUID));
if Reg.OpenKey('\Drive\shellex\ContextMenuHandlers\' + cName, True) then
Reg.WriteString('', GUIDToString(cGUID));
end
else
begin
if Reg.OpenKey('\*\ShellEx\ContextMenuHandlers\' + cName, False) then
Reg.DeleteKey ('\*\ShellEx\ContextMenuHandlers\' + cName);
if Reg.OpenKey('\Directory\Background\shellex\ContextMenuHandlers\' + cName, False) then
Reg.DeleteKey ('\Directory\Background\shellex\ContextMenuHandlers\' + cName);
if Reg.OpenKey('\Directory\shellex\ContextMenuHandlers\' + cName, False) then
Reg.DeleteKey ('\Directory\shellex\ContextMenuHandlers\' + cName);
if Reg.OpenKey('\Drive\shellex\ContextMenuHandlers\' + cName, False) then
Reg.DeleteKey ('\Drive\shellex\ContextMenuHandlers\' + cName);
end;
finally
Reg.CloseKey;
Reg.Free;
end;
end;
initialization
TOpenFolderInCmdFactory.Create (ComServer, TOpenFolderInCmd, cGUID, cName,
cMenuCaption, ciMultiInstance, tmApartment);
end.
Recent
