Subversion Repositories decoder

unit ShellEraseMain;

interface

uses

  ComServ, SysUtils, ShellAPI, Windows, Registry, ActiveX, ComObj, ShlObj,

  Graphics, classes, inifiles;

const

  GUID_TDFKontextMenuShellExt: TGUID = '{6B422248-BB90-4682-A128-F088E99AB520}';

type

  TDFKontextMenuShellExt = class(TComObject, IShellExtInit, IContextMenu)

    protected

      function IShellExtInit.Initialize = SEInitialize;

      function SEInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject; hKeyProgID: HKEY): HResult; stdcall;

      function QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst, idCmdLast, uflags: UINT): HResult; stdcall;

      function InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult; stdcall;

      function GetCommandString(idCmd, uType: UINT; pwReserved: PUINT; pszName: LPSTR; cchMax: UINT): HResult; stdcall;

  end;

implementation

var

  hBmp: TBitmap;

  handle: hwnd;

  vsl: tstringlist;

  path: string;

  langini: TIniFile;

type

  TDFKontextMenuShellExtFactory = class(TComObjectFactory)

  public

    procedure UpdateRegistry(Register: boolean); override;

  end;

function TDFKontextMenuShellExt.GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;

  pszName: LPSTR; cchMax: UINT): HResult;

begin

  try

    if (idCmd = 0) then

    begin

      if (uType = GCS_HELPTEXT) then

        StrCopy(pszName, pchar(langini.ReadString('ShlErase', 'openwith', '?')));

      Result := NOERROR;

    end

    else

      Result := E_INVALIDARG;

  except

    Result := E_UNEXPECTED;

  end;

end;

procedure ProcessMessages(hWnd: DWORD);

var

  Msg: TMsg;

begin

  while PeekMessage(Msg, hWnd, 0, 0, PM_REMOVE) do

    begin

      TranslateMessage(Msg);

      DispatchMessage(Msg);

    end;

end;

function ExecuteWithExitCode(filename, params, dir: string): integer;

var

  proc_info: TProcessInformation;

  startinfo: TStartupInfo;

  ExitCode: longword;

begin

  FillChar(proc_info, sizeof(TProcessInformation), 0);

  FillChar(startinfo, sizeof(TStartupInfo), 0);

  startinfo.cb := sizeof(TStartupInfo);

  if CreateProcess(nil, pchar(Format('"%s" %s', [filename, TrimRight(pchar(params))])), nil,

      nil, false, NORMAL_PRIORITY_CLASS, nil, pchar(path),

       startinfo, proc_info) <> False then

  begin

    // WaitForSingleObject(proc_info.hProcess, INFINITE);

    while WaitForSingleObject(proc_info.hProcess, 0) = WAIT_TIMEOUT do

    begin

      ProcessMessages(0);

      Sleep(50);

    end;

    GetExitCodeProcess(proc_info.hProcess, ExitCode);

    CloseHandle(proc_info.hThread);

    CloseHandle(proc_info.hProcess);

    result := ExitCode;

  end

  else

  begin

    result := -1;

  end;

end;

function TDFKontextMenuShellExt.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult;

var

  i, res: integer;

  fehler: boolean;

begin

  Result := E_FAIL;

  if (HiWord(Integer(lpici.lpVerb)) <> 0) then

    Exit;

  if not (LoWord(lpici.lpVerb) in [0, 1, 2]) then

  begin

    Result := E_INVALIDARG;

    Exit;

  end;

  res := Messagebox(handle, pchar(langini.ReadString('ShlErase', 'sicherheitsfrage', '?')), pchar(langini.ReadString('ShlErase', 'sicherheitsfragecaption', '?')), MB_ICONQUESTION or MB_YESNO);

  if res = ID_YES then

  begin

    if not fileexists(path+'Coder.exe') then

      Messagebox(handle, pchar(langini.ReadString('ShlErase', 'codermissing', '?')), pchar(langini.ReadString('ShlErase', 'error', '?')), MB_ICONERROR or MB_OK)

    else

    begin

      fehler := false;

      for i := 0 to vsl.count-1 do

      begin

        // ShellExecute(handle, 'open', PChar(path+'Coder.exe'), PChar('"'+vsl.Strings[i]+'" /e /notsilent'), pchar(path), SW_NORMAL);

        if ExecuteWithExitCode(path+'Coder.exe', '"'+vsl.Strings[i]+'" /e', path) = 8 then

          fehler := true;

      end;

      if fehler then

        MessageBox(handle, pchar(langini.ReadString('ShlErase', 'delerror', '?')), pchar(langini.ReadString('ShlErase', 'error', '?')), MB_OK + MB_ICONERROR)

      else

        MessageBox(handle, pchar(langini.ReadString('ShlErase', 'delok', '?')), pchar(langini.ReadString('ShlErase', 'information', '?')), MB_OK + MB_ICONINFORMATION);

    end;

  end;

  Result := NOERROR;

end;

function TDFKontextMenuShellExt.QueryContextMenu(Menu: HMENU; indexMenu,

  idCmdFirst, idCmdLast, uflags: UINT): HResult;

begin

  Result := 0;

  if ((uFlags and $0000000F) = CMF_NORMAL) or

      ((uFlags and CMF_EXPLORE) <> 0) or

      ((uFlags and CMF_VERBSONLY <> 0)) then

  begin

    InsertMenu(Menu, indexMenu, MF_STRING or MF_BYPOSITION, idCmdFirst, pchar(langini.readstring('ShlErase', 'context', '?')));

    if hBmp.Handle <> 0 then

      SetMenuItemBitmaps(Menu, indexMenu, MF_BYPOSITION, hBmp.Handle, hBmp.Handle);

    Result := 1;

  end;

end;

function TDFKontextMenuShellExt.SEInitialize(pidlFolder: PItemIDList;

  lpdobj: IDataObject; hKeyProgID: HKEY): HResult;

var

  StgMedium: TStgMedium;

  FormatEtc: TFormatEtc;

  FFileName: array[0..MAX_PATH] of Char;

  i: Integer;

begin

  if (lpdobj = nil) then

  begin

    Result := E_INVALIDARG;

    Exit;

  end;

  with FormatEtc do

  begin

    cfFormat := CF_HDROP;

    ptd      := nil;

    dwAspect := DVASPECT_CONTENT;

    lindex   := -1;

    tymed    := TYMED_HGLOBAL;

  end;

  Result := lpdobj.GetData(FormatEtc, StgMedium);

  if Failed(Result) then

    Exit;

  vsl := tstringlist.Create;

  vSL.Clear;

  for i := 0 to DragQueryFile(StgMedium.hGlobal, $FFFFFFFF, nil, 0) - 1 do

  begin

    DragQueryFile(StgMedium.hGlobal, i, FFileName, SizeOf(FFileName));

    vSl.Add(FFileName);

  end;

  ReleaseStgMedium(StgMedium);

  Result := NOERROR;

end;

procedure TDFKontextMenuShellExtFactory.UpdateRegistry(Register: boolean);

var

  ClassID: string;

begin

  ClassID := GUIDToString(GUID_TDFKontextMenuShellExt);

  if Register then

  begin

    inherited UpdateRegistry(Register);

    CreateRegKey('Folder\shellex', '', '');

    CreateRegKey('Folder\shellex\ContextMenuHandlers', '', '');

    CreateRegKey('Folder\shellex\ContextMenuHandlers\(De)Coder-Erase', '', ClassID);

    CreateRegKey('*\shellex', '', '');

    CreateRegKey('*\shellex\ContextMenuHandlers', '', '');

    CreateRegKey('*\shellex\ContextMenuHandlers\(De)Coder-Erase', '', ClassID);

    if (Win32Platform = VER_PLATFORM_WIN32_NT) then

      with TRegistry.Create do

        try

          RootKey := HKEY_LOCAL_MACHINE;

          OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved', True);

          WriteString(ClassID, '(De)Coder-Erase');

          CloseKey;

        finally

          Free;

        end;

  end

  else

  begin

    DeleteRegKey('Folder\shellex\ContextMenuHandlers\(De)Coder-Erase');

    DeleteRegKey('Folder\shellex\ContextMenuHandlers');

    DeleteRegKey('Folder\shellex');

    DeleteRegKey('*\shellex\ContextMenuHandlers\(De)Coder-Erase');

    DeleteRegKey('*\shellex\ContextMenuHandlers');

    DeleteRegKey('*\shellex');

    if (Win32Platform = VER_PLATFORM_WIN32_NT) then

      with TRegistry.Create do

        try

          RootKey := HKEY_LOCAL_MACHINE;

          OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved', True);

          DeleteValue(ClassID);

          CloseKey;

        finally

          Free;

        end;

    inherited UpdateRegistry(Register);

  end;

end;

initialization

  // Initialisierung

  TDFKontextMenuShellExtFactory.Create(ComServer, TDFKontextMenuShellExt, GUID_TDFKontextMenuShellExt,

    '', '(De)Coder Eraser', ciMultiInstance, tmApartment);

  hBmp := TBitmap.Create;

  hBmp.LoadFromResourceName(hInstance, 'KONTEXTICON');

  path := '';

  // Pfad ermitteln

  with TRegistry.Create do

    try

      RootKey := HKEY_CURRENT_USER;

      OpenKeyReadOnly('SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\(De)Coder_is1');

      path := ReadString('InstallLocation');

      CloseKey;

      if path = '' then

      begin

        RootKey := HKEY_LOCAL_MACHINE;

        OpenKeyReadOnly('SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\(De)Coder_is1');

        path := ReadString('InstallLocation');

        CloseKey;

      end;

    finally

      free;

    end;

  // Language.ini öffnen

  langini := TIniFile.Create(path+'Language.ini');

finalization

  hBmp.Free;

  langini.Free;

end.