1

I'm building a Delphi XE3 application which needs to be able to have files dropped onto it. I have the Explorer > Application side of things working, but for the life of me can't figure out to get the filename when going from Application > Application.

Assuming one file is dropped from say Outlook (or any other application), I have this which works as long as I manually assign filename before hand. 

SetFormatEtc( FormatEtc , CF_FILECONTENTS );
OleCheck( dataObj.GetData( FormatEtc , Medium ) );
OleStream := TOleStream.Create( IUnknown( Medium.stm ) as IStream );
MemStream := TMemoryStream.Create;
OleStream.Position := 0;
MemStream.CopyFrom( OleStream , OleStream.Size );

TMemoryStream( MemStream ).SaveToFile( 'C:\' + filename );

MemStream.Free;
OleStream.Free;
ReleaseStgMedium( Medium );
Ranky
  • 117
  • 1
  • 7

1 Answers1

6

CF_FILECONTENTS format can contain several stream. You must check CF_FILEDESCRIPTORW and CF_FILEDESCRIPTORA formats for detection of stream count and stream names. Some sources:

function ContainFormat(ADataObject: IDataObject; AFormat: TClipFormat;
  ATymed: Longint; AAspect: LongInt = DVASPECT_CONTENT; AIndex: LongInt = -1): Boolean;
var Format: TFormatEtc;
begin
  ZeroMemory(@Format, SizeOf(Format));
  Format.cfFormat := AFormat;
  Format.dwAspect := AAspect;
  Format.lindex := AIndex;
  Format.tymed := ATymed;
  Result := ADataObject.QueryGetData(Format) = S_OK;
end;

procedure InvalidMedium;
begin
  raise Exception.Create('Invalid medium');
end;

function ExtractStream(ADataObject: IDataObject; AIndex: Integer): IStream;
var Format: TFormatEtc;
    Medium: TStgMedium;
begin
  ZeroMemory(@Format, SizeOf(Format));
  Format.cfFormat := CF_FILECONTENTS;
  Format.dwAspect := DVASPECT_CONTENT;
  Format.lindex := AIndex;
  Format.tymed := TYMED_ISTREAM;
  ZeroMemory(@Medium, SizeOf(Medium));
  OleCheck(ADataObject.GetData(Format, Medium));
  try
    if (Medium.tymed and TYMED_ISTREAM = 0) or not Assigned(Medium.stm) then
      InvalidMedium;
    Result := IStream(Medium.stm);
  finally
    ReleaseStgMedium(Medium);
  end
end;

procedure WorkWithDropObject(const AFileName: UnicodeString; AStream: IStream);
begin

end;

procedure ProcessDataObject(ADataObject: IDataObject);
var Format: TFormatEtc;
    Medium: TStgMedium;
    FGDA: PFileGroupDescriptorA;
    FGDW: PFileGroupDescriptorW;
    i: Integer;
    Stream: IStream;
begin
  if ContainFormat(ADataObject, CF_FILECONTENTS, TYMED_ISTREAM) then
    begin
      if ContainFormat(ADataObject, CF_FILEDESCRIPTORW, TYMED_HGLOBAL) then
        begin
          Format.cfFormat := CF_FILEDESCRIPTORW;
          Format.dwAspect := DVASPECT_CONTENT;
          Format.lindex := -1;
          Format.tymed := TYMED_HGLOBAL;
          ZeroMemory(@Medium, SizeOf(Medium));
          OleCheck(ADataObject.GetData(Format, Medium));
          try
            if (Medium.tymed and TYMED_HGLOBAL = 0) or (Medium.hGlobal = 0) then
              InvalidMedium;
            FGDW := GlobalLock(Medium.hGlobal);
            if not Assigned(FGDW) then
              RaiseLastOSError;
            try
              for i := 0 to FGDW.cItems - 1 do
                begin
                  Stream := ExtractStream(ADataObject, i);
                  try
                    WorkWithDropObject(FGDW.fgd[i].cFileName, Stream);
                  finally
                    Stream := nil;
                  end;
                end;
            finally
              GlobalUnlock(Medium.hGlobal);
            end;
          finally
            ReleaseStgMedium(Medium);
          end
        end
      else
        if ContainFormat(ADataObject, CF_FILEDESCRIPTORA, TYMED_HGLOBAL) then
          begin
            Format.cfFormat := CF_FILEDESCRIPTORA;
            Format.dwAspect := DVASPECT_CONTENT;
            Format.lindex := -1;
            Format.tymed := TYMED_HGLOBAL;
            ZeroMemory(@Medium, SizeOf(Medium));
            OleCheck(ADataObject.GetData(Format, Medium));
            try
              if (Medium.tymed and TYMED_HGLOBAL = 0) or (Medium.hGlobal = 0) then
                InvalidMedium;
              FGDA := GlobalLock(Medium.hGlobal);
              if not Assigned(FGDA) then
                RaiseLastOSError;
              try
                for i := 0 to FGDA.cItems - 1 do
                  begin
                    Stream := ExtractStream(ADataObject, i);
                    try
                      WorkWithDropObject(FGDA.fgd[i].cFileName, Stream);
                    finally
                      Stream := nil;
                    end;
                  end;
              finally
                GlobalUnlock(Medium.hGlobal);
              end;
            finally
              ReleaseStgMedium(Medium);
            end
          end;
    end;
end;

Also I you want to create universal software you should process the following formats:

  • CF_FILENAMEW/CF_FILENAMEA
  • CF_HDROP
  • CF_IDLIST
  • CF_FILEDESCRIPTORW/CF_FILEDESCRIPTORA/CF_FILECONTENTS
Denis Anisimov
  • 3,297
  • 1
  • 10
  • 18
  • After I got my head around what I was doing wrong, this makes perfect sense. Thanks – Ranky Jan 21 '14 at 05:53
  • This is excellent code . I created my own workWithdropObject (I call it writeaFile in mine). it uses a ToleStream and a TFileSteam and works perfectly well on Windows 10. But on Windows 2016 Server and 2019 server it blows up in the oleStream.size. – David Bolton May 25 '21 at 09:39
  • `oleStream := TOleStream.Create(Astream);` `olestream.seek(0,soFromBeginning);` `try `fs:= TFileStream.Create(FileName, fmCreate or fmShareDenyRead);` `fs.CopyFrom(OleStream,oleStream.Size);` The parameter is incorrect – David Bolton May 25 '21 at 09:46
  • Answering my own comment. I solved this. The problem is using Size in oleStream. Instead declare a tStatStg. call Stat on the iStream and use the cbSize field from thetStatStg. that works. `var ulsize:array[0..3] of longint; // ULARGE_INTEGER;` `size : int64;` `tat:TStatStg;` then `zeromemory(@ulsize,sizeof(ulsize));` `AStream.Stat(tat,ulsize[0]);` `size := tat.cbSize;` and use this size in the fs.CopyFrom – David Bolton May 25 '21 at 13:47