Delphi-PRAXiS - Delphi [nonVCL]Drag&Drop nach Explorer will nicht (AV)

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)

- Programmieren allgemein (https://www.delphipraxis.net/40-programmieren-allgemein/)

- - Delphi [nonVCL]Drag&Drop nach Explorer will nicht (AV) (https://www.delphipraxis.net/158574-%5Bnonvcl%5Ddrag-drop-nach-explorer-will-nicht-av.html)

[nonVCL]Drag&Drop nach Explorer will nicht (AV)

HI @all,

ich versuche gerade folgendes zu realisieren: Ich habe ein nonVCL-Programm und bei diesem soll eine Drag&Drop-Operation gestartet werden können. Die dazugehörige Datei, die geDrag&Dropped (^^) werden soll, existiert und liegt lesbar auf der Platte. COM wird initialisiert. Nur leider bekomme ich die Operation nicht gestartet. An der markierten Zeile im Code wird eine AV geworfen und ich habe keinen Plan, wie man die a) wieder weg bekommt und b) die Operation endlich starten kann.
Als Vorlage dient der Code von den

Schweizern, der unter Verwendung der VCL funktioniert (hab ich schon einmal geschaut).

Delphi-Quellcode:

			unit FilesDragDropU;

interface

uses

  Windows, ActiveX, ShlObj, SysUtils, COMObj;

type

  TDropSource = class(TInterfacedObject, IDropSource)

  protected

    fDirectory: String;

    fFileName: String;

  public

    constructor Create(Directory: String; FileName: String);

    // Funktionen für Drag&Drop

    function GiveFeedback(dwEffect: Integer): HRESULT; stdcall;

    function QueryContinueDrag(fEscapePressed: LongBool;

      grfKeyState: Integer): HRESULT; stdcall;

    procedure AfterConstruction; override;

  end;

implementation

function GetFileListDataObject(const Directory: string; FileName: String): IDataObject;

{type

  PArrayOfPItemIDList = ^TArrayOfPItemIDList;

  TArrayOfPItemIDList = array[0..0] of PItemIDList;}

var

  Malloc: IMalloc;

  Root: IShellFolder;

  FolderPidl: PItemIDList;

  Folder: IShellFolder;

  p: PItemIDList;

  chEaten: ULONG;

  dwAttributes: ULONG;

begin

  Result := nil;

  OleCheck(SHGetMalloc(Malloc));

  OleCheck(SHGetDesktopFolder(Root));

  OleCheck(Root.ParseDisplayName(0, nil, PWideChar(WideString(Directory)), chEaten, FolderPidl, dwAttributes));

  OleCheck(Root.BindToObject(FolderPidl, nil, IShellFolder, Pointer(Folder)));

  p := AllocMem(SizeOf(PItemIDList));

  OleCheck(Folder.ParseDisplayName(0, nil, PWideChar(WideString(FileName)), chEaten, p, dwAttributes));

  OleCheck(Folder.GetUIObjectOf(0, 1, p, IDataObject, nil, Pointer(Result)));

  if p <> nil then

    Malloc.Free(p);

  FreeMem(p); // <-- AV hier

  Malloc.Free(FolderPidl);

end;

{ TDropSource }

procedure TDropSource.AfterConstruction;

var

  DataObject: IDataObject;

  Effect: Integer;

begin

  inherited;

  DataObject := GetFileListDataObject(fDirectory, fFileName);

  Effect := DROPEFFECT_NONE;

  DoDragDrop(DataObject, Self, DROPEFFECT_COPY, Effect);

end;

constructor TDropSource.Create(Directory: String; FileName: String);

begin

  fDirectory := Directory;

  fFileName := FileName;

end;

function TDropSource.GiveFeedback(dwEffect: Integer): HRESULT;

begin

  Result := DRAGDROP_S_USEDEFAULTCURSORS;

end;

function TDropSource.QueryContinueDrag(fEscapePressed: LongBool;

  grfKeyState: Integer): HRESULT;

begin

  // Operation abbrechen, wenn ESC gedrückt oder die rechte Maustaste gedrückt (Standard)

  if fEscapePressed or (grfKeyState and MK_RBUTTON = MK_RBUTTON) then

  begin

    Result := DRAGDROP_S_CANCEL;

  end

  else

    // Operation abschließen, wenn linke Maustaste losgelassen (Standard)

    if grfKeyState and MK_LBUTTON = 0 then

    begin

      Result := DRAGDROP_S_DROP;

    end

    else

    // Ansonsten Operation fortführen (Standard)

    begin

      Result := S_OK;

    end;

end;

end.

Was ich bis jetzt versucht habe? - Da ich nicht durchblicke (ich hoffe mal, das hier ist eine Stelle mit Plug&Forget-Faktor) habe ich versucht, FreeMem auszukommentieren. Dann kommt zwar die AV nicht, der Drag&Drop-Vorgang wird aber nicht gestartet.

Was mache ich falsch?

Bernhard