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

[rollstuhlfahrer]

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

[EWeiss]

Meine Routine..
Müßtest du dir aber anpassen.

Delphi-Quellcode:

      WM_DROPFILES: // Drag & drop
      begin
         nFilesDropped := DragQueryFile(wP, LongWord(-1), '', 0);
         sFileName := '';
         PlayListCount := 0;
         hList  := 0;
         SetLength(PlayList, MAX_PATH);
         if nFilesDropped > 0 then
         begin
           // Sichtbare PlayListe nur Titel
           hPlaylist := GetMainItem(ID_PLAYLIST);
           ListDeleteAll(hPlaylist);
           // PlayListe incl. Pfad
           hList := GetMainItem(ID_PLAYLISTBOX);
           ListDeleteAll(hList);
           for K := 0 to nFilesDropped - 1 do
           begin
             SetLength(sFileName, DragQueryFile(wP, k, nil, 0));
             DragQueryFile(wP, K, @sFileName[1], Length(sFileName) + 1);
             sFileName := LowerCase(sFileName);
             nCheck := BassCheckExtension(sFileName);
             if nCheck = 1 then
             begin
               if ListAdd(hList, sFileName) > -1 then
               begin
                 ListAdd(hPlaylist, ExtractFileName(AnsiLeftStr(sFileName, Length(sFileName) - 4)));
                 inc(PlayListCount);
               end;
             end else
             if nCheck = 0 then
             begin
               Files := nil;
               Ext := Split(BASSAUDIOEXT, ',');
               for IntExt  := 0 to Length(Ext)- 1 do
                 FindAllFiles(sFileName, Ext[IntExt], True);
               for IntI := 0 to length(Files) - 1 do
               begin
                 if ListAdd(hList, Files[IntI]) > -1 then
                 begin
                   ListAdd(hPlaylist, ExtractFileName(AnsiLeftStr(Files[IntI], Length(Files[IntI]) - 4)));
                   inc(PlayListCount);
                 end;
               end;
              end; // end nCheck
           end; // end for K
         end; // end nFilesDropped
         DragFinish(wP);
         SavePlayList(hList, PlayListCount);
         PlayListPlay(hList, PlayListCount);
         SetForegroundWindow(WinHandle);
         // TopItem der Playlist ermitteln
         ItemTop := TMPlayList.ListGetTopIndex(TMPlayList.Handle);
         // Trackbar Value übergeben
         If (ItemTop > 0) Then
           SetTrackValue(SkinEngine.GetMainItem(ID_TRACK_VSCROLL),  ItemTop - 1)
         else
         SetTrackValue(SkinEngine.GetMainItem(ID_TRACK_VSCROLL), ItemTop);
      end;

gruss

[rollstuhlfahrer]

Schade. Deine Routine funktioniert leider nur für die falsche Richtung. Ich will explizit Dateien aus meinem Programm herausziehen können (1 Datei) und nicht reinfallen lassen. Das Reinfallen-lassen soll über einem Explorer-Fenster funktionieren, deshalb auch der Titel nach Explorer nicht von Explorer.

Bernhard

[EWeiss]

Zitat von rollstuhlfahrer:

Schade. Deine Routine funktioniert leider nur für die falsche Richtung. Ich will explizit Dateien aus meinem Programm herausziehen können (1 Datei) und nicht reinfallen lassen. Das Reinfallen-lassen soll über einem Explorer-Fenster funktionieren, deshalb auch der Titel nach Explorer nicht von Explorer.

Bernhard

Ohh sorry.. hab da was überlesen

gruss

[Assarbad]

Moin,

also mir fällt nur auf, daß der Code rund um die fragliche Stelle etwas seltsam aussieht:

Delphi-Quellcode:

// Wozu eigentlich? Ist doch ohnehin nur ein Pointer ...
  p := AllocMem(SizeOf(PItemIDList));
  // Der Teil ist klar
  // Wenn p hier nil ist und das Ding erfolgreich
  // ist, wird in p der Pointer zurückgegeben.
  // *Dein* Wert aus AllocMem ist dann wech ...
  OleCheck(Folder.ParseDisplayName(0, nil, PWideChar(WideString(FileName)), chEaten, p, dwAttributes));

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

  // Freigeben ala Shell
  if p <> nil then
    Malloc.Free(p);
  // Wozu nochmal?
  // Wert von p ist hier ungültig, ist aber
  // auch nicht der Wert den AllocMem vergeben
  // hat ...
  FreeMem(p); // <-- AV hier

  Malloc.Free(FolderPidl);

Kommentare inline.

[rollstuhlfahrer]

OK, hab den Fehler gefunden, nachdem ich bei jedem Statement auch mal wirklich den Rückgabewert geprüft hatte. Dann kam irgendwann die Meldung "CoInitialize wurde nicht aufgerufen", obwohl das genau so und direkt vor der Drag-Operation geschah (sogar mehrfach).
Das Problem an der Fehlermeldung ist aber, dass nicht CoInitialize gemeint ist, sondern OleInitialize.

Nach dessen Aufruf geht jetzt alles wie gewünscht.

Woher das AllocMem kommt ist auch einfach zu erklären: Das war vorher eine Funktion, mit der man mehr als eine Datei draggen kann. Da ich diese Funktionalität sowie TStrings nicht brauche, hatte ich die Schleife herausoperiert (allerdings nicht vollständig, wie ich feststellen musste, danke Assarbad dafür).

Bernhard

[Assarbad]

Danke für den Hinweis mit OleInitialize. Mir war dieser feine Unterschied vorher garnicht so bewußt. Da ja irgendwann OLE "umbenannt" wurde, ging ich implizit immer von zu CoInitialize identischer Funktionalität aus.

Wieder etwas gelernt.

[EWeiss]

NONVCL...

Habe jetzt auch das problem aber nicht nach Explorer sondern in ein anderes Fenster meiner Anwendung.
In dem einen habe ich einen Button mit nem Icon drin von diesen möchte ich den pfad auf den Button des andere Fensters ablegen.

Also der Pfad woher das Icon aus dem ersten Fenster erstellt wurde.

Kann man deine Unit dementsprechend anpassen ?
Oder hat jemand ne andere Idee? Wobei es aber über dragdrop realisiert werden soll.

Alternativ könnte ich ja mit SendMessage arbeiten aber das möchte ich nicht.

ach dann halt nicht

gruss