Delphi-PRAXiS
Seite 2 von 2     12   

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Win32/Win64 API (native code) (https://www.delphipraxis.net/17-win32-win64-api-native-code/)
-   -   Delphi Kontextmenü soll mehrere Dateien einem Pragramm schicken (https://www.delphipraxis.net/110195-kontextmenue-soll-mehrere-dateien-einem-pragramm-schicken.html)

gmc616 11. Apr 2008 00:55

Re: Kontextmenü soll mehrere Dateien einen Pragramm schicken
 
Ja, stimmt.
Die Message verwende ich an andere Stelle, aber für einen ähnlichen Zweck.
In diesem Fall ist sie sinnlos.

Wie gesagt: Der Code ist schon etwas alt und stammt noch aus meinen Bastelzeiten mit Delphi.

binio 16. Apr 2008 08:08

Re: Kontextmenü soll mehrere Dateien einen Pragramm schicken
 
Sehe ich das richtig das ich mit dem Programmcode alles das erreichen kann was ich wollte ?
Also die Aufrufe können dann so zu sagen aus der Liste nach und nach abgearbeitet werden ??
Oder fehlt da noch ein Stück Programmcode ?

Danke schonmal für den Quelltext der sehr einfach zu verstehen ist :o)

binio 16. Apr 2008 08:15

Re: Kontextmenü soll mehrere Dateien einen Pragramm schicken
 
Ich habe die *.exe gerade mal getestet. wenn ich 2 Textdateien markiere und dann sage öffnen mit und meine *.exe auswähle kommt nur eins der beiden Textdateien in die Liste des Programms...
Ich teste das gleich sofort mal wenn ich das per Registry eintrag mache, vieleicht ist da was anders.

_frank_ 16. Apr 2008 11:32

Re: Kontextmenü soll mehrere Dateien einen Pragramm schicken
 
ich habs mit drag&drop auf die exe probiert, hätte gedacht, es ist das gleiche, jedoch bekomme ich beim öffnen per kontextmenü nen Verschieben-Dialog :gruebel:, die Dateien werden aber richtig in die anwendung aufgenommen. der reg-eintrag ist korrekt...

Gruß Frank

_frank_ 25. Apr 2008 17:50

Re: Kontextmenü soll mehrere Dateien einen Pragramm schicken
 
hat jemand eine Idee, warum es nicht so funktioniert, wie gewünscht?

*push*

Gruß Frank

_frank_ 29. Apr 2008 18:04

Re: Kontextmenü soll mehrere Dateien einem Pragramm schicken
 
ich hab den thread mal mit ins DF gestellt...
http://www.delphi-forum.de/viewtopic...=499934#499934

Gruß Frank

orion3000 30. Apr 2008 11:40

Re: Kontextmenü soll mehrere Dateien einem Pragramm schicken
 
Hallo binio, versuchsmal mit folgender lib.

Hier die Projektdatei
Code:
library ExtKontextMenu;

uses
  Windows,
  ComServ,
  untMain in 'untMain.pas';

// Bildressource einbinden
// 12 x 12 Pixel
// Name = ExtKontextMenu oder ein anderer Name
{$R ExtKontextMenu.res}

exports
  DllGetClassObject,
  DllCanUnloadNow,
  DllRegisterServer,
  DllUnregisterServer;

begin
end.

Hier die dazu gehörende Unit.

Code:
unit untMain;

interface

uses
  ComServ, SysUtils, ShellAPI, Registry, Classes, Windows, ActiveX, ComObj, ShlObj, Graphics, Dialogs;

// Die GUID wird für die eindeutige Registrierung der Shell-Erweiterung benötigt
const
  GUID_ExtKontextMenuShellExt: TGUID = '{E8308BE3-0C9A-4429-9A3C-3F06E778C2DC}';

type
  ExtKontextMenuShellExt = 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
  // Aufnahme der selektierten Dateinamen
  FFileName: array[0..MAX_PATH] of Char;
  // für das Bild im Kontextmenü
  hBmp: TBitmap;

type
  ExtKontextMenuShellExtFactory = class(TComObjectFactory)
    public
      procedure UpdateRegistry(Register: boolean); override;
  end;

// wird aufgerufen, um einen Hilfetext zum Menü abzufragen, z. B. beim Überfahren
// des Menüs im Explorer wird in dessen Statuszeile dieser Text angezeigt
function ExtFKontextMenuShellExt.GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;
  pszName: LPSTR; cchMax: UINT): HResult;
begin
  Result := S_OK;
  try

  if(idCmd = 0) then
  begin
    if(uType = GCS_HELPTEXT) then
      StrCopy(pszName, 'Extern KontextMenu');

    Result := NOERROR;
  end
  else
    Result := E_INVALIDARG;

  except
    Result := E_UNEXPECTED;
  end;
end;

// wird aufgerufen, wenn ein Menüpunkt des Kontextmenüs gewählt wurde
function ExtKontextMenuShellExt.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult;
begin
  Result := E_FAIL;
  if (HiWord(Integer(lpici.lpVerb)) <> 0) then // kein Anwendungsaufruf
    Exit;

  // überprüfe den Index (0..Anzahl Menüpunkte - 1)
  if LoWord(lpici.lpVerb) > 4 then
  begin
    Result := E_INVALIDARG;
    Exit;
  end;

  // Hier könntest mit Hilfe einer Tstrinliste alle ausgewählten Datei(en) / Ordner in
     einen gesonderten Pfad, wie X:\windows\Filelst.dat speichern, diese dann mit Shellexecute
     als Parameter übergeben!      

  // Zeige je nach gewählten Menüpunkt eine Info an
  case LoWord(lpici.lpVerb) of
    0: ShowMessage('Menüpunkt 1');
    1: ShowMessage('Menüpunkt 2');
    3: ShowMessage('Menüpunkt 3');
  end;

  Result := NOERROR;
end;

// wird aufgerufen, wenn das Kontextmenü erstellt werden soll
// es wird dann in das Kontextmenü des Explorers integriert
function ExtKontextMenuShellExt.QueryContextMenu(Menu: HMENU; indexMenu,
  idCmdFirst, idCmdLast, uflags: UINT): HResult;
var
  hMnu: HMENU;
  hMnu2: HMENU;
  vReg: TRegistry;
  Idx: Integer;
  mii: TMenuItemInfo;
begin
  if ((uFlags and $0000000F) = CMF_NORMAL) or ((uFlags and CMF_EXPLORE) <> 0) or
     ((uFlags and CMF_VERBSONLY) <> 0) then // VERBS -- auch für Desktop-Icons
  begin
    // ffg. Menüstruktur soll erzeugt werden =>
    // ExtKontextMenü   - Hauptmenüeintrag (kein Index) - kann keine Aktion auslösen
    //   Menüpunkt 1   - Index 0
    //   Menüpunkt 2   - Index 1
    //   Menüpunkt 4   - hier kommt ein weiteres Untermenü (Index 2 - kann aber keine Aktion auslösen)
    //     Untermenü   - Index 3

    hMnu := CreatePopupMenu();
    AppendMenu(hMnu, MF_STRING, idCmdFirst, 'Menüpunkt 1');
    AppendMenu(hMnu, MF_STRING, idCmdFirst + 1, 'Menüpunkt 2');

    // Untermenü erzeugen - dies hat dann den "virtuellen" Index von 2
    hMnu2 := CreatePopupMenu();
    // das ist der dritte Menüpunkt
    AppendMenu(hMnu2, MF_STRING, idCmdFirst + 3, 'Untermenü');

    // Das Untermenü erhält den Text Menüpunkt 4
    mii.cbSize    := sizeof(TMenuItemInfo);
    mii.fMask     := MIIM_SUBMENU or MIIM_STRING or MIIM_ID;
    mii.wID       := idCmdFirst + 2;
    mii.hSubMenu  := hMnu2;
    mii.dwTypeData := PAnsiChar('Untermenü');
    InsertMenu(hMnu, idCmdFirst + 2, MF_STRING or MF_BYPOSITION or MF_POPUP, hMnu2, 'Menüpunkt 4'); // 2

    mii.cbSize    := sizeof(TMenuItemInfo);
    mii.fMask     := MIIM_SUBMENU or MIIM_STRING or MIIM_ID;
    mii.wID       := idCmdFirst + 4;
    mii.hSubMenu  := hMnu;
    mii.dwTypeData := PAnsiChar('DF KontextMenü');

    // die folgenden Anweisungen sind wichtig, damit das Bild korrekt erscheint.
    InsertMenuItem(Menu, indexMenu, True, mii);

    if hBmp.Handle <> 0 then
      SetMenuItemBitmaps(Menu, indexMenu, MF_BYPOSITION, hBmp.Handle, hBmp.Handle);

    Result := 4 // Anzahl der zusätzlichen Menüpunkte
  end
  else
    Result := 0;
end;

// es können 1-n Dateien/Ordner markiert werden, wenn ein Menüpunkt aufgerufen
// wird - hier werden diese Dateien ermittelt
function ExtKontextMenuShellExt.SEInitialize(pidlFolder: PItemIDList;
  lpdobj: IDataObject; hKeyProgID: HKEY): HResult;
var
  StgMedium: TStgMedium;
  FormatEtc: TFormatEtc;
  Idx: 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;

  // alle ausgewählten Dateien ermitteln
  for Idx := 0 to DragQueryFile(StgMedium.hGlobal, $FFFFFFFF, nil, 0) - 1 do
  begin
    DragQueryFile(StgMedium.hGlobal, Idx, FFileName, SizeOf(FFileName));
    // hier können die Dateinamen eingesammelt werden, z. B.
    // StringListe.Add(FFileName);
  end;

  ReleaseStgMedium(StgMedium);
  Result := NOERROR;
end;

// Hier legen Sie die Einträge in der Registrierung fest
procedure ExtKontextMenuShellExtFactory.UpdateRegistry(Register: boolean);
var
  ClassID: string;
begin
  if Register then
  begin
    inherited UpdateRegistry(Register);

    ClassID := GUIDToString(GUID_ExtKontextMenuShellExt);

    // Die Shell-Erweiterung wird hier für Ordner (Folder) registriert
    // Der Text DFKontextMenu ist frei wählbar und charakterisier die eigene Erweiterung
    CreateRegKey('Folder\shellex', '', '');
    CreateRegKey('Folder\shellex\ContextMenuHandlers', '', '');
    CreateRegKey('Folder\shellex\ContextMenuHandlers\DFKontextMenu', '', ClassID);

    // Die Shell-Erweiterung wird hier für alle Dateien registriert
    // ansonsten muss statt des Sterns (alle Dateien) die konkrete Dateiendung
    // stehen, z. B. '.zip'
    // Der Text DFKontextMenu ist frei wählbar und charakterisier die eigene Erweiterung
    CreateRegKey('*\shellex', '', '');
    CreateRegKey('*\shellex\ContextMenuHandlers', '', '');
    CreateRegKey('*\shellex\ContextMenuHandlers\DFKontextMenu', '', ClassID);

    // Shell-Erweiterung als "genehmigt" eintragen
    if (Win32Platform = VER_PLATFORM_WIN32_NT) then
      with TRegistry.Create do
        try
          RootKey := HKEY_LOCAL_MACHINE;
          OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions', True);
          OpenKey('Approved', True);
          WriteString(ClassID, 'DFKontextMenu');
        finally
          Free;
        end;
  end
  else
  begin
    // wird die Shell-Erweiterung wieder entfernt, werden die Einträge der
    // Registrierung gelöscht
    DeleteRegKey('Folder\shellex\ContextMenuHandlers\ExternKontextMenu');
    DeleteRegKey('Folder\shellex\ContextMenuHandlers');
    DeleteRegKey('Folder\shellex');

    DeleteRegKey('*\shellex\ContextMenuHandlers\ExternKontextMenu');
    DeleteRegKey('*\shellex\ContextMenuHandlers');
    DeleteRegKey('*\shellex');

    inherited UpdateRegistry(Register);
  end;
end;

initialization
  // hier wird die Erweiterung registriert
  ExtKontextMenuShellExtFactory.Create(ComServer, ExtKontextMenuShellExt, GUID_ExtKontextMenuShellExt,
    '', 'DFKontextMenu', ciMultiInstance, tmApartment);
  // Bitmap erzeugen
  hBmp := TBitmap.Create;
  // Bild aus Ressourcendatei laden (der Name der Bildressource muss als 2. Parameter angegeben
  // werden - auf keinen Fall den DefaultNamen belassen, den der Bildeditor vergibt!
  hBmp.LoadFromResourceName(hInstance, 'DFKONTEXTMENU');
finalization
  // Bitmap wieder freigeben
  hBmp.Free;
end.
Du musst nur noch die passende Resource ersetellen, siehe Projektdatei ($R ExtKontextMenu.res).

Habe den Quellcode jetzt nicht überarbeitet, das müsstest du in folge tun!

nachdem Kompilieren muß nur noch die DLL mit Regsvr32 registriert werden.



Gruß
Orion3000

binio 30. Apr 2008 12:13

Re: Kontextmenü soll mehrere Dateien einem Pragramm schicken
 
Ok hab nun fast das was ich mir wünsche:
Delphi-Quellcode:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls,ShellAPI;

type stack1 = class
  public
    zeiger: Integer;
    wert: array[0..200] of String[255];
    procedure ini();
    procedure push(value:String);
    function pop():String;
    function gettop():String;
end;

const
  WM_FormActivate=WM_USER+10;

type
  TSingleInstanceFrm = class(TForm)
    ListBox1: TListBox;
    procedure FormCreate(Sender: TObject);
  private
    { Private-Deklarationen }
    procedure WMCopyData(var Msg: TWMCopyData); message WM_COPYDATA;
    procedure ProcessFilename(fName:string);
  public
    { Public-Deklarationen }
  end;

var
  SingleInstanceFrm: TSingleInstanceFrm;
  Stack: stack1;
  status: boolean =false;

implementation

{$R *.DFM}

procedure stack1.ini();
begin
  zeiger:=0;
end;

procedure stack1.push(value:String);
var both: boolean;
i: integer;
begin
  both:=false;
  if (zeiger<200) then
  begin
    for i:=0 to zeiger do
    begin
      if (value = wert[i]) then both:=true;
    end;
    if (both <> true) then
    begin
      wert[zeiger]:=value;
      zeiger:=zeiger+1;
    end;
  end;
end;

function stack1.pop():String;
begin
  if (zeiger>0) then
  begin
    zeiger:=zeiger-1;
    Result:=wert[zeiger];
  end
  else
    Result:='';
end;


function stack1.gettop(): String;
begin
  if (zeiger>0) AND (zeiger<200) then Result:=wert[zeiger-1];
end;

procedure TSingleInstanceFrm.WMCopyData(var Msg: TWMCopyData);
var s:array[0..max_path-1] of Char;
begin
  StrLCopy(s,Msg.CopyDataStruct.lpData, Msg.CopyDataStruct.cbData);
  ProcessFilename(s);
end;

procedure TSingleInstanceFrm.ProcessFilename(fName:string);
var
   SEInfo: TShellExecuteInfo;
   ExitCode: DWORD;
   ExecuteFile, ParamString, StartInString: string;
begin
   ExecuteFile:='c:\sleep.exe';

   repeat
    if status=false then
    begin
      status:=true;
      FillChar(SEInfo, SizeOf(SEInfo), 0);
      SEInfo.cbSize := SizeOf(TShellExecuteInfo);
      with SEInfo do begin
        fMask := SEE_MASK_NOCLOSEPROCESS;
        Wnd := Application.Handle;
        lpFile := PChar(ExecuteFile);
        {
        ParamString can contain the
        application parameters.
        }
        //lpParameters := PChar(Stack.pop()) ;
{
StartInString specifies the
name of the working directory.
If ommited, the current directory is used.
}
// lpDirectory := PChar(StartInString) ;
        nShow := SW_SHOWNORMAL;
      end;
      if ShellExecuteEx(@SEInfo) then
      begin
        repeat
          Application.ProcessMessages;
          GetExitCodeProcess(SEInfo.hProcess, ExitCode);
        until (ExitCode <> STILL_ACTIVE) or Application.Terminated;
        ShowMessage('Calculator terminated');
        Stack.pop();
        status:=false;
      end
      else
        ShowMessage('Error starting Calc!');
    end
    else
      Stack.push(fName);
   until Stack.zeiger = 0;
   showmessage('FERTIG. Programm wird Beendet');
   SingleInstanceFrm.Close;
end;


  {
  Stack.push(fName);

  for i:=0 to Stack.zeiger-1 do
  begin
    showmessage('Stackzähler:'+inttostr(i));
    showmessage('Stackinhalt:'+Stack.wert[i]);
  end;
  ListBox1.Items.Add(fName);
  ShellExecute(SingleInstanceFrm.Handle, nil, 'c:\sleep.exe', nil, nil, SW_SHOWNORMAL);
  //ShellExecute(SingleInstanceFrm.Handle, nil, pchar(fName), nil, nil, SW_SHOWNORMAL);
  //ExecuteFile(fName);
end;                  }

procedure TSingleInstanceFrm.FormCreate(Sender: TObject);
begin
  Stack:=stack1.create;
  if ParamStr(1)<>'' then
    ProcessFilename(ParamStr(1));
end;

end.
Dejoch gibt es da noch 2 Probleme.
Er Beendet das Projekt nicht
Delphi-Quellcode:
   showmessage('FERTIG. Programm wird Beendet');
   SingleInstanceFrm.Close;
Und bleibt hängen wenn die Exe 2 mal aufgerufen wird.
Also die sleep.exe ist ein Programm das einfach 10 Sekunden was macht und sich dann Beendet.
Somit teste ich ob erst nachdem ich die Sleep.exe beendet habe die nächte abarbeitung stattfinden kann.
Ich denke ich bin kurz vorm Ziel nur fehlt hier noch der letzte Schliff.

Würde mich sehr über Hilfe freuen


Alle Zeitangaben in WEZ +1. Es ist jetzt 05:05 Uhr.
Seite 2 von 2     12   

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz