Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]

Groups > de.comp.lang.delphi.misc > #19075 > unrolled thread

Drop File per Code?

Back to article view | Back to de.comp.lang.delphi.misc

Contents

  Drop File per Code? Alfred Gemsa <gemsa@gmx.de> - 2020-06-12 22:05 +0200
    Re: Drop File per Code? Jens Köhler <jkoehl@web.de> - 2020-06-13 10:16 +0200
    Re: Drop File per Code? Jens Köhler <jkoehl@web.de> - 2020-06-13 15:17 +0200
      Re: Drop File per Code? Alfred Gemsa <gemsa@gmx.de> - 2020-06-13 21:24 +0200
        Re: Drop File per Code? Alfred Gemsa <gemsa@gmx.de> - 2020-06-13 21:34 +0200
          Re: Drop File per Code? Jens Köhler <jkoehl@web.de> - 2020-06-14 09:11 +0200
            Re: Drop File per Code? Jens Köhler <jkoehl@web.de> - 2020-06-14 09:23 +0200
              Re: Drop File per Code? Alfred Gemsa <gemsa@gmx.de> - 2020-06-14 10:31 +0200

#19075 — Drop File per Code?

Ich hätt' da mal ne Frage:

Viele Anwendung reagieren auf Files, die man per Maus auf sie zieht.

Ist es auch möglich, per Delphi-Code einer fremden laufenden Anwendung 
einen File z.B. per ButtonClick "zu schicken"?

Delphi müsste sich das (die?) Handle der Anwendung besorgen (no problem) 
und dann eine WM_DROPFILES-Message schicken.

Nur, mit welchem Parametern?


//=============== Exkurs Start ==============

Umgekehrt geht es in Delphi ja so:

type
   TForm1 = class(TForm)
     procedure FormCreate(Sender: TObject);
   private
     { Private-Deklarationen }
   public
     procedure AcceptFiles( var msg : TMessage );
       message WM_DROPFILES;
   end;

procedure TForm1.AcceptFiles( var msg : TMessage );
const
   cnMaxFileNameLen = 255;
var
   i, nCount  : integer;
   acFileName : array [0..cnMaxFileNameLen] of char;
begin
   // find out how many files we're accepting
   nCount := DragQueryFile( msg.WParam,
                            $FFFFFFFF,
                            acFileName,
                            cnMaxFileNameLen );

   // query Windows one at a time for the file name
   for i := 0 to nCount-1 do begin
     DragQueryFile( msg.WParam, i,
                    acFileName, cnMaxFileNameLen );
     // do your thing with the acFileName
     MessageBox( Handle, acFileName, '', MB_OK );
   end;

   // let Windows know that you're done
   DragFinish( msg.WParam );
end;

//=============== Exkurs Ende ==============

Es scheint so zu sein, dass über DragQueryFile die Message WM_DROPFILES 
verarbeitet wird und unter anderem den Filenamen enthält.

Weiß da jemand B'Scheid?

Gruß, Alfred.

[toc] | [next] | [standalone]

#19076

Am 12.06.2020 um 22:05 schrieb Alfred Gemsa:
> Ich hätt' da mal ne Frage:
> 
> Viele Anwendung reagieren auf Files, die man per Maus auf sie zieht.
> 
> Ist es auch möglich, per Delphi-Code einer fremden laufenden Anwendung 
> einen File z.B. per ButtonClick "zu schicken"?
> 
> Weiß da jemand B'Scheid?
> Gruß, Alfred.


Hallo,

ich habe das in meinen Beständen gefunden. Schon etwas älter aber evtl. 
hilfts.

Jens

unit uDragFilesSrc;

{
TDragFilesSrc Component
© Angus Johnson
ajohnson@rpi.net.au
Version 1.0
September 1997.

DESCRIPTION: Enables dragging of files FROM your Form TO Windows Explorer
and other applications which can receive files.
Single or multiple files can either be MOVED or COPIED.

PUBLISHED PROPERTIES:
   DropEffect: TDropEffect (deCopy, deMove)
   VerifyFiles: boolean
PUBLIC PROPERTIES: (not available at design time)
   FileCount: TStringList (read only)
PUBLIC METHODS:
   AddFile(string)
   AddFiles(Tstrings)
   ClearFiles
   Execute: TDragResult (drInvalid, drCancelled, drDropped)
   OnDropping: TNotifyEvent

USAGE:
1. Add this non-visual component to the Form you wish to drag from.
2. Set DragEffect to either deMove or deCopy.
3. Before the Execute function is called, files need to be added
    to the FileList using one of the following functions -
    DragFilesSrc1.AddFile(filename:string);
    DragFilesSrc1.AddFiles(FileList: Tstrings);
    and DragFilesSrc1.ClearFiles - to clear files!
4. The function Execute (starts the drag operation). This function is
    usually called in a MouseDown or MouseMove method and has no parameters.
    The function returns - drInvalid, drCancelled, or drDropped - depending
    on success.
5. The OnDropping event is triggered (if assigned) immediately
    after the mouse is released at a valid drop point. This event may be 
used
    in the following situations (as examples):-
    Extracting files from an archive; or Downloading files from the net.
    It is MUCH more efficient to do these procedures here rather than in 
the method
    calling the Execute function, as the drag operation may be cancelled
    without the need for extracting or downloading files at all.
    In these 2 examples extract or download files into the temp 
directory (GetTempPath API)
    using this OnDropping event method, then move them from the temp 
directory
    by setting DragEffect to deMove.
6. Set VerifyFiles to either true or false.
    If true this verifies the existance of files on Execute
    and will immediately return 'drInvalid' if any one file listed does 
not exist.
    However, you may not wish to check for the existance of the files until
    the OnDropping event occurs (when the mouse is released at a valid 
drop point)
    as they may not even be created till then! (See the above examples.)
    Obviously, set VerifyFiles prior to calling the Execute function.

DISCLAIMER:
This software may be freely used but no guarantees are given
as to reliability. Please keep this header to acknowledge source.
USE AT YOUR OWN RISK.

PROBLEMS/COMMENTS/THANKS ...
ajohnson@rpi.net.au
}

interface

uses
   Windows, SysUtils,
   Classes, ole2;

type
   TDragResult = (drInvalid, drCancelled, drDropped);
   TDropEffect = (deCopy, deMove);

   //From SHLOBJ unit
   PDropFiles = ^TDropFiles;
   TDropFiles = packed record
     pFiles : DWORD;          // offset of file list
     pt     : TPoint;         // drop point (client coords)
     fNC    : BOOL;           // is it on NonClient area
     fWide  : BOOL;           // WIDE character switch
   end;

   TDragFilesSrc = class(TComponent)
   private
     fFileList    : TStringList;
     fVerifyFiles : boolean;
     fDropEffect  : TDropEffect;
     fDropping    : TNotifyEvent;
     function GetFileCount : integer;
   public
     procedure ClearFiles;
     procedure AddFile(filename : string);
     procedure AddFiles(FileList : TStrings);

     constructor Create(aOwner : TComponent); override;
     destructor Destroy; override;

     function Execute: TDragResult;
   published
     property DropEffect : TDropEffect read fDropEffect write fDropEffect;
     property VerifyFiles : boolean read fVerifyFiles write fVerifyFiles;
     property OnDropping : TNotifyEvent read fDropping write fDropping;
     property FileCount : integer read GetFileCount;
   end;

procedure Register;

implementation

{=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
Local Type Declarations of IDataObject , TMyEnum & IDropSource
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}
type
   TMyDataObject = class(IDataObject)
   private
     RefCount      : integer;

     FileList      : TStrings;
     FileListBytes : integer;
     ptrDropFile   : pdropfiles;

   public
     function QueryInterface(const iid : TIID; var obj): HResult; 
override; stdcall;
     function AddRef : Longint; override; stdcall;
     function Release : Longint; override; stdcall;
     function GetData(var formatetcIn : TFormatEtc;
                      var medium      : TStgMedium) : HResult; override; 
stdcall;
     function GetDataHere(var formatetc : TFormatEtc;
                          var medium    : TStgMedium): HResult; 
override; stdcall;
     function QueryGetData(var formatetc : TFormatEtc): HResult; 
override; stdcall;
     function GetCanonicalFormatEtc(var formatetc : TFormatEtc;
                                    var formatetcOut : TFormatEtc) : 
HResult; override; stdcall;
     function SetData(var formatetc : TFormatEtc;
                      var medium    : TStgMedium;
                          fRelease  : BOOL) : HResult; override; stdcall;
     function EnumFormatEtc(    dwDirection   : Longint;
                            var enumFormatEtc : IEnumFormatEtc) : 
HResult; override; stdcall;
     function DAdvise(var formatetc : TFormatEtc;
                          advf      : Longint;
                          advSink   : IAdviseSink;
                      var dwConnection : Longint) : HResult; override; 
stdcall;
     function DUnadvise(dwConnection : Longint) : HResult; override; 
stdcall;
     function EnumDAdvise(var enumAdvise : IEnumStatData) : HResult; 
override; stdcall;
     constructor Create(sl : TStrings);
     destructor Destroy; override;
   end;

   TMyEnum = class(IEnumFormatEtc)
   private
     RefCount: integer;
     Index: integer;
   public
     function QueryInterface(const iid: TIID; var obj): HResult; 
override; stdcall;
     function AddRef: Longint; override; stdcall;
     function Release: Longint; override; stdcall;
     function Next(    celt         : Longint;
                   var elt;
                       pceltFetched : PLongint): HResult; override; stdcall;
     function Skip(celt : Longint) : HResult; override; stdcall;
     function Reset: HResult; override; stdcall;
     function Clone(var enum : IEnumFormatEtc): HResult; override; stdcall;
   end;

   TMyDropSource = class(IDropSource)
   private
     RefCount     : integer;
     srcDropEffect: longint;
     srcDFS       : TDragFilesSrc;
   public
     function QueryInterface(const iid: TIID; var obj): HResult; 
override; stdcall;
     function AddRef: Longint; override; stdcall;
     function Release: Longint; override; stdcall;
     function QueryContinueDrag(fEscapePressed : BOOL;
                                grfKeyState    : Longint): HResult; 
override; stdcall;
     function GiveFeedback(dwEffect : Longint): HResult; override; stdcall;
     constructor Create(dfs : TDragFilesSrc);
   end;

{=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
TMyDataObject methods:
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}

constructor TMyDataObject.Create(sl: TStrings);
var
   i: integer;
begin
   inherited Create;
   FileList := TStringList.create;
   FileList.assign(sl);
   FileListBytes := 1;
   for i := 1 to FileList.count do
     inc(FileListBytes, length(FileList[i-1])+1);
end;
{=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}

destructor TMyDataObject.Destroy;
begin
   FileList.free;
   inherited destroy;
end;
{=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}

function TMyDataObject.QueryInterface(const iid : TIID; var obj) : 
HResult; stdcall;
begin
   if IsEqualIID(iid, IID_IUnknown)
   or IsEqualIID(iid, IID_IDataObject) then
   begin
     Pointer(obj) := self;
     AddRef;
     Result := S_OK;
   end else
   begin
     Pointer(obj) := nil;
     Result       := E_NoInterface;
   end;
end;
{=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}

function TMyDataObject.AddRef : Longint; stdcall;
begin
   Inc(RefCount);
   Result := RefCount;
end;
{=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}

function TMyDataObject.Release : Longint; stdcall;
begin
   Dec(RefCount);
   Result := RefCount;
   if RefCount = 0 then Free;
end;
{=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}

function TMyDataObject.GetData(var formatetcIn : TFormatEtc;
                                var medium      : TStgMedium): HResult; 
stdcall;
var
   h        : HGlobal;
   i, offset: integer;
begin
   Result := DV_E_FORMATETC;
   if not Failed(QueryGetData(formatetcIn)) then
   begin
     h := GlobalAlloc(GMEM_MOVEABLE or GMEM_ZEROINIT,
                      FileListBytes + sizeof(tdropfiles));
     if h = 0 then
     begin
       Result:= E_OUTOFMEMORY;
       Exit;
     end;

     ptrdropfile := globallock(h);

     with ptrdropfile^ do
     begin
       pfiles := sizeof(Tdropfiles);
       pt.x   := 0;
       pt.y   := 0;
       longint(fnc)   := 0;
       longint(Fwide) := 0;
     end;

     //Add the filenames after header
     offset := sizeof(tdropfiles);
     for i := 1 to FileList.count do
     begin
       if i = FileList.count then
         strPcopy( pchar(longint(ptrdropfile)+offset), FileList[i-1]+#0#0)
       else
         strPcopy( pchar(longint(ptrdropfile)+offset), FileList[i-1]+#0);
       offset := offset + length(FileList[i-1])+1;
     end;

     globalunlock(h);

     with medium do
     begin
       tymed   := TYMED_HGLOBAL;
       hGlobal := h;
       unkForRelease := nil;
     end;
     result:=S_OK;
   end;
end;
{=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}

function TMyDataObject.GetDataHere(var formatetc : TFormatEtc;
                                    var medium    : TStgMedium) : 
HResult; stdcall;
begin
   Result := E_NOTIMPL;
end;
{=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}

function TMyDataObject.QueryGetData(var formatetc: TFormatEtc): HResult; 
stdcall;
begin
   with formatetc do
   begin
     if cfFormat <> CF_HDROP then
       Result := DV_E_FORMATETC
     else if (tymed and TYMED_HGLOBAL) = 0 then
       Result := DV_E_TYMED
     else
       Result := S_OK;
   end;
end;
{=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}

function TMyDataObject.GetCanonicalFormatEtc(var formatetc    : TFormatEtc;
                                              var formatetcOut : 
TFormatEtc) : HResult; stdcall;
begin
   Result := E_NOTIMPL;
end;
{=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}

function TMyDataObject.SetData(var formatetc: TFormatEtc;
                                var medium: TStgMedium;
                                fRelease: BOOL): HResult; stdcall;
begin
   Result := E_NOTIMPL;
end;
{=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}

function TMyDataObject.EnumFormatEtc(    dwDirection   : Longint;
                                      var enumFormatEtc : 
IEnumFormatEtc): HResult; stdcall;
begin
   if dwDirection = DATADIR_GET then
   begin
     enumFormatEtc := TMyEnum.Create;
     enumFormatEtc.AddRef;
     Result := S_OK;
   end else
   begin
     enumFormatEtc := nil;
     Result        := E_NOTIMPL;
   end;
end;
{=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}

function TMyDataObject.DAdvise(var formatetc : TFormatEtc;
                                    advf      : Longint;
                                    advSink   : IAdviseSink;
                                var dwConnection : Longint): HResult; 
stdcall;
begin
   Result := E_NOTIMPL;
end;
{=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}

function TMyDataObject.DUnadvise(dwConnection: Longint): HResult; stdcall;
begin
   Result := E_NOTIMPL;
end;
{=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}

function TMyDataObject.EnumDAdvise(var enumAdvise: IEnumStatData): 
HResult; stdcall;
begin
   Result := E_NOTIMPL;
end;

{=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
TMyEnum methods (called by TMyDataObject)
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}

function TMyEnum.QueryInterface(const iid: TIID; var obj): HResult; stdcall;
begin
   if IsEqualIID(iid, IID_IUnknown)
   or IsEqualIID(iid, IID_IEnumFormatEtc) then
   begin
     Pointer(obj) := self;
     AddRef;
     Result := S_OK;
   end else
   begin
     Pointer(obj) := nil;
     Result := E_NOINTERFACE;
   end;
end;
{=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}

function TMyEnum.AddRef: Longint; stdcall;
begin
   Inc(RefCount);
   Result := RefCount;
end;
{=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}

function TMyEnum.Release: Longint; stdcall;
begin
   Dec(RefCount);
   Result := RefCount;
   if RefCount = 0 then
     Free;
end;
{=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}

function TMyEnum.Next(celt: Longint; var elt;
       pceltFetched: PLongint): HResult; stdcall;
begin
   Result := S_FALSE;
   if (Index = 0) and (celt > 0) then
   begin
     Inc(Index);
     with TFormatEtc(elt) do
     begin
       cfFormat := CF_HDROP;
       ptd      := nil; // not sure I should do this!
       dwAspect := DVASPECT_CONTENT;
       lindex   := -1;
       tymed    := TYMED_HGLOBAL;
     end;

     if pceltFetched <> nil then pceltFetched^ := 1;
     if celt = 1 then Result := S_OK;
   end else
   begin
     if pceltFetched <> nil then pceltFetched^ := 0;
   end;
end;
{=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}

function TMyEnum.Skip(celt: Longint): HResult; stdcall;
begin
   Inc(Index, celt);
   if Index > 1 then Result := S_FALSE else Result := S_OK;
end;
{=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}

function TMyEnum.Reset: HResult; stdcall;
begin
   Index := 0;
   Result := S_OK;
end;
{=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}

function TMyEnum.Clone(var enum: IEnumFormatEtc): HResult; stdcall;
begin
   enum := TMyEnum.Create;
   enum.AddRef;
   TMyEnum(enum).Index := Index;
   Result := S_OK;
end;

{=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
TMyDropDSource methods
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}

constructor TMyDropSource.Create(dfs: TDragFilesSrc);
begin
   inherited Create;
   srcDFS := dfs;
end;
{=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}

function TMyDropSource.QueryInterface(const iid: TIID; var obj): 
HResult; stdcall;
begin
   if IsEqualIID(iid, IID_IUnknown)
   or IsEqualIID(iid, IID_IDropSource) then
   begin
     Pointer(obj) := self;
     AddRef;
     Result := S_OK;
   end else begin
     Pointer(obj) := nil;
     Result := E_NOINTERFACE;
   end;
end;
{=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}

function TMyDropSource.AddRef: Longint; stdcall;
begin
   Inc(RefCount);
   Result := RefCount;
end;
{=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}

function TMyDropSource.Release: Longint; stdcall;
begin
   Dec(RefCount);
   Result := RefCount;
   if RefCount = 0 then
     Free;
end;
{=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}

function TMyDropSource.QueryContinueDrag(fEscapePressed: BOOL;
       grfKeyState: Longint): HResult; stdcall;
var
   drpEffect: integer;
begin
    if srcDFS.DropEffect = deCopy then
      drpEffect := DROPEFFECT_COPY
    else
      drpEffect := DROPEFFECT_MOVE;

   if fEscapePressed then
     Result := DRAGDROP_S_CANCEL
   else
     if (grfKeyState and MK_LBUTTON) = 0 then
     begin
       if (srcDropEffect = drpEffect) and assigned( srcDFS.OnDropping ) then
         srcDFS.OnDropping(srcDFS); {do just before dropping}
       //Note: cancel a drop from OnDropping event by clearing FileList..
       if srcDFS.FileCount = 0 then
         Result := DRAGDROP_S_CANCEL
       else
         Result := DRAGDROP_S_DROP;
     end
     else
       Result := S_OK;
end;
{=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}

function TMyDropSource.GiveFeedback(dwEffect: Longint): HResult; stdcall;
begin
   srcDropEffect := dwEffect;
   Result := DRAGDROP_S_USEDEFAULTCURSORS;
end;

{=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
TDragFilesSrc methods:
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}

constructor TDragFilesSrc.Create(aOwner : TComponent);
begin
   inherited create(aOwner);
   fFileList := TStringList.Create;
   fFileList.sorted     := true;
   fFileList.Duplicates := dupIgnore;
   fVerifyFiles         := false;
   fDropEffect          := deCopy;
   fDropping            := nil;
end;
{=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}

destructor TDragFilesSrc.Destroy;
begin
   fFileList.free;
   inherited Destroy;
end;
{=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}

procedure TDragFilesSrc.ClearFiles;
begin
   fFileList.clear;
end;
{=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}

procedure TDragFilesSrc.AddFile(filename : string);
begin
   fFileList.add(filename);
end;
{=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}

procedure TDragFilesSrc.AddFiles(FileList: TStrings);
var
   i: integer;
begin
   for i := 1 to FileList.count do
     if FileList[i-1] <> '' then
       fFileList.add(FileList[i-1]);
end;
{=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}

function TDragFilesSrc.GetFileCount: integer;
begin
   result := fFileList.count;
end;

{=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}

function TDragFilesSrc.Execute : TDragResult;
var
   i          : integer;
   dwEffect   : Longint;
   DropSource : TMyDropSource;
   Dataobject : TMyDataObject;
begin
    Result := drInvalid;
    //Check that there are files in the list!
    if (fFileList.count = 0) or (fFileList[0] = '') then exit;
    if fVerifyFiles then
      for i := 1 to fFileList.count do
        if not fileexists(fFileList[i-1]) then exit;

    try
      DataObject := TMyDataObject.create(fFileList);
      DataObject.AddRef;
      try
        DropSource := TMyDropSource.create(self);
        DropSource.AddRef;
        //Note: DROPEFFECT_COPY =1, DROPEFFECT_MOVE =2
        //      hence the following is a crude typecast...
        //      DROPEFFECT := byte(fDropEffect)+1
        //      ie: deCopy -> DROPEFFECT_COPY, deMove -> DROPEFFECT_MOVE
        if (DoDragDrop(dataobject, dropsource,
                       byte(fDropEffect)+1, dwEffect) = DRAGDROP_S_DROP)
                  and (dwEffect = byte(fDropEffect)+1) then
          Result := drDropped
        else
          Result := drCancelled;
        DropSource.release;
      finally
        DataObject.release;
      end;
    except
    end;
end;

{=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
Register
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}

procedure Register;
begin
   RegisterComponents('Samples', [TDragFilesSrc]);
end;

{=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  Startup/Shutdown
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}

initialization
   OleInitialize(nil);

finalization
   OleUninitialize;
end.

[toc] | [prev] | [next] | [standalone]

#19077

Am 12.06.2020 um 22:05 schrieb Alfred Gemsa:
> Ich hätt' da mal ne Frage:
> 
> Ist es auch möglich, per Delphi-Code einer fremden laufenden Anwendung 
> einen File z.B. per ButtonClick "zu schicken"?
> 
> Gruß, Alfred.

und eine kurze Frage an Tante Google hat das ausgespuckt:

// uses ShlObj

procedure DoDropFiles(Wnd : HWND; Files : TStringList);

var
   Size      : Cardinal;
   DropFiles : PDropFiles;
   Run       : PChar;
   MemHandle : THandle;
   I         : Integer;

begin
   // first determine size of string buffer we have to allocate
   Size := 0;
   for I := 0 to Files.Count - 1 do
   begin
     // number of characters per string (as ANSI) plus one #0 terminator
     Inc(Size, Length(Files[I]) + 1);
   end;
   if Size > 0 then
   begin
     // entire string list is terminated by another #0, add drop files 
structure size too
     Inc(Size, 1 + SizeOf(TDropFiles));
     // allocate globally accessible memory
     MemHandle := GlobalAlloc(GHND or GMEM_SHARE, Size);
     DropFiles := GlobalLock(MemHandle);
     // fill the header
     with DropFiles^ do
     begin
       pFiles := SizeOf(TDropFiles); // offset of file list, it follows 
immediately the structure
       pt     := Point(0, 0);        // drop point (client coords), not 
important here
       fNC    := False;              // is it on NonClient area }, not 
important here
       fWide  := False;              // WIDE character switch, we pass 
ANSI string in this routine
     end;
     // and finally the file names
     Run := Pointer(DropFiles);
     Inc(Run, SizeOf(TDropFiles));
     for I := 0 to Files.Count - 1 do
     begin
       StrPCopy(Run, Files[I]);
       Inc(Run, Length(Files[I]));
     end;
     // put a final #0 character at the end
     Run^ := #0;
     // release the lock we have to the memory,...
     GlobalUnlock(MemHandle);
     // ...do the message...
     SendMessage(Wnd, WM_DROPFILES, MemHandle, 0);
     // ... and finally release the memory
     GlobalFree(MemHandle);
   end;  // if Size > 0
end;  // DoDropFiles

procedure TForm1.Button1Click(Sender: TObject);

var
   List : TStringList;
   wnd  : HWND;

begin

   wnd  := FindWindow('notepad', nil);
   if wnd <> 0 then;

   List := TStringList.Create;
   try
     List.Add('d:\Test.txt');
     DoDropFiles(wnd, List);
   finally
     List.Free;
   end;
end;

Jens

[toc] | [prev] | [next] | [standalone]

#19078

Am 13.06.2020 um 15:17 schrieb Jens Köhler:

Wenn man

>      SendMessage(Wnd, WM_DROPFILES, MemHandle, 0);

durch

        PostMessage(Wnd, WM_DROPFILES, MemHandle, 0)

ersetzt, tut's dein gepostetet Code. Er ist auch nachvollziehbar.

Danke, das hat sehr geholfen.

Alfred

[toc] | [prev] | [next] | [standalone]

#19079

Am 13.06.2020 um 21:24 schrieb Alfred Gemsa:
> Am 13.06.2020 um 15:17 schrieb Jens Köhler:
> 
> Wenn man
> 
>>      SendMessage(Wnd, WM_DROPFILES, MemHandle, 0);
> 
> durch
> 
>         PostMessage(Wnd, WM_DROPFILES, MemHandle, 0)
> 

Hm, im Netz gibt's wohl beide Versionen (wobei PostMessage in 
PolePosition liegt), aber

https://docs.microsoft.com/en-us/windows/win32/shell/wm-dropfiles

sagt selber PostMessage.

Alfred.

[toc] | [prev] | [next] | [standalone]

#19080

Am 13.06.2020 um 21:34 schrieb Alfred Gemsa:
> Am 13.06.2020 um 21:24 schrieb Alfred Gemsa:
>> Am 13.06.2020 um 15:17 schrieb Jens Köhler:
>>
>> Wenn man
>>>      SendMessage(Wnd, WM_DROPFILES, MemHandle, 0);
>> durch
>>         PostMessage(Wnd, WM_DROPFILES, MemHandle, 0)
> 
> Hm, im Netz gibt's wohl beide Versionen (wobei PostMessage in 
> PolePosition liegt), aber
> 
> Alfred.

Bei mir hat es mit SendMessage funktioniert.
SendMessage wartet auf das OK der fremden Anwendung, PostMessage nicht.
Ob das in diesem Fall irgendwelche interessanten Auswirkungen hat, kann 
ich nicht sagen.

Jens

[toc] | [prev] | [next] | [standalone]

#19081

Am 14.06.2020 um 09:11 schrieb Jens Köhler:
> Am 13.06.2020 um 21:34 schrieb Alfred Gemsa:
>> Am 13.06.2020 um 21:24 schrieb Alfred Gemsa:
> 
> Bei mir hat es mit SendMessage funktioniert.
> SendMessage wartet auf das OK der fremden Anwendung, PostMessage nicht.
> Ob das in diesem Fall irgendwelche interessanten Auswirkungen hat, kann 
> ich nicht sagen.
> 
> Jens

Also es hat Auswirkungen.
Wenn z.B. im Editor eine geänderte Datei offen ist, ist das Programm bei 
SendMessage blockiert, bis man im Editor die Frage nach speichern 
beantwortet hat.

Jens

[toc] | [prev] | [next] | [standalone]

#19082

Am 14.06.2020 um 09:23 schrieb Jens Köhler:

> Also es hat Auswirkungen.
> Wenn z.B. im Editor eine geänderte Datei offen ist, ist das Programm bei 
> SendMessage blockiert, bis man im Editor die Frage nach speichern 
> beantwortet hat.

Ja, Sendmessage wartet, bis die Message verarbeitet wurde, PostMessage 
setzt nur ab und macht weiter.

Allerdings ist das Ziel bei beiden unterschiedlich, aus der 
Delphi-Win32-Hilfe:

"The SendMessage function sends the specified message to a window or 
windows. The function calls the window procedure for the specified 
window and does not return until the window procedure has processed the 
message. The PostMessage function, in contrast, posts a message to a 
thread's message queue and returns immediately."

Allerdings bleibst dabei: Sendmessage funktioniert bei mir nicht.

Alfred

[toc] | [prev] | [standalone]

Back to top | Article view | de.comp.lang.delphi.misc

csiph-web