AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

DropStream als Datei speichern ?

Ein Thema von Orbmu2k · begonnen am 12. Mai 2005 · letzter Beitrag vom 16. Mai 2005
 
Benutzerbild von Orbmu2k
Orbmu2k

Registriert seit: 29. Nov 2004
Ort: Erfurt
254 Beiträge
 
Turbo Delphi für Win32
 
#1

DropStream als Datei speichern ?

  Alt 12. Mai 2005, 10:14
Ich stehe vor einem Problem ich bekomme es einfach nicht in Gang einen DropStream von einem fremden Programm (Notes Mail) in einer Datei zu speichern.

Ich muss auch sagen das ich nicht wirklich weiter komme mit den Bespielen die es da so gibt. Diese Verarbeiten immer nur reinen Text und keinen Stream.

Hier ist mein bisheriger Code... er nimmt den Drop zwar an aber scheitertert dann mit der Fehlermeldung "Invalid FORMATETC structure"

Delphi-Quellcode:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ActiveX, ShlObj, ComObj, StdCtrls;

type
  TfrmTPDrop = class(TForm, IDropTarget)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
     function DragEnter(const dataObj: IDataObject;
                       grfKeyState: Longint;
                       pt: TPoint;
                       var dwEffect: Longint): HResult; stdcall;
    function DragOver(grfKeyState: Longint;
                      pt: TPoint;
                      var dwEffect: Longint): HResult; stdcall;
    function DragLeave: HResult; stdcall;
    function Drop(const dataObj: IDataObject;
                  grfKeyState: Longint; pt: TPoint;
                  var dwEffect: Longint): HResult; stdcall;
   function _AddRef: Integer; stdcall;
   function _Release: Integer; stdcall;
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  frmTPDrop: TfrmTPDrop;


implementation

{$R *.dfm}

uses
  ShellAPI;

procedure SaveDropDataToFile(Data:Pointer;Filename: String);
var
  fs: TFileStream;
  sa: IStream;
begin
  fs := TFileStream.Create(Filename,fmCreate);
  try
    sa := TStreamAdapter.Create(fs, soReference) as IStream;
    sa.Read(Data,SizeOf(Data),0);
  finally
    fs.Free;
  end;
end;

function TfrmTPDrop.DragEnter(const dataObj: IDataObject;
  grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult;
begin
  dwEffect := DROPEFFECT_COPY;
  Result := S_OK;
end;

function TfrmTPDrop.DragLeave: HResult;
begin
  Result := S_OK;
end;

function TfrmTPDrop.DragOver(grfKeyState: Integer; pt: TPoint;
  var dwEffect: Integer): HResult;
begin
  dwEffect := DROPEFFECT_COPY;
  Result := S_OK;
end;

function TfrmTPDrop.Drop(const dataObj: IDataObject; grfKeyState: Integer;
  pt: TPoint; var dwEffect: Integer): HResult;
var
  aFmtEtc: TFORMATETC;
  aStgMed: TSTGMEDIUM;
  pData: Pointer;
begin
  if (dataObj = nil) then
    raise Exception.Create('IDataObject-Pointer is not valid!');

  with aFmtEtc do
  begin
    cfFormat := CF_RIFF ;
    ptd := nil;
    dwAspect := DVASPECT_CONTENT;
    lindex := -1;
    tymed := TYMED_ISTREAM ;
  end;
  OleCheck(dataObj.GetData(aFmtEtc, aStgMed));
  try
    pData := GlobalLock(aStgMed.hGlobal);
    SaveDropDataToFile(pData,'c:\stream.doc');
  finally
    GlobalUnlock(aStgMed.hGlobal);
    ReleaseStgMedium(aStgMed);
  end;
  Result := S_OK;
end;

procedure TfrmTPDrop.FormCreate(Sender: TObject);
begin
  OleInitialize(nil);
  OleCheck(RegisterDragDrop(Handle, Self));
end;

procedure TfrmTPDrop.FormDestroy(Sender: TObject);
begin
  RevokeDragDrop(Handle);
  OleUninitialize;
end;

function TfrmTPDrop._AddRef: Integer;
begin
  Result := 1;
end;

function TfrmTPDrop._Release: Integer;
begin
  Result := 1;
end;



end.
Irgendwie ist mir das zu hoch
  Mit Zitat antworten Zitat
 


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 05:21 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