![]() |
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. |
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) |
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. |
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 |
Re: Kontextmenü soll mehrere Dateien einen Pragramm schicken
hat jemand eine Idee, warum es nicht so funktioniert, wie gewünscht?
*push* Gruß Frank |
Re: Kontextmenü soll mehrere Dateien einem Pragramm schicken
ich hab den thread mal mit ins DF gestellt...
![]() Gruß Frank |
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:
Du musst nur noch die passende Resource ersetellen, siehe Projektdatei ($R ExtKontextMenu.res).
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. 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 |
Re: Kontextmenü soll mehrere Dateien einem Pragramm schicken
Ok hab nun fast das was ich mir wünsche:
Delphi-Quellcode:
Dejoch gibt es da noch 2 Probleme.
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. Er Beendet das Projekt nicht
Delphi-Quellcode:
Und bleibt hängen wenn die Exe 2 mal aufgerufen wird.
showmessage('FERTIG. Programm wird Beendet');
SingleInstanceFrm.Close; 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. |
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