Zwischenablage Operationen in Delphi

Lokale Arbeitsstation: Win 7Zwischenablage Operationen in Delphi

Terminal Server: Win 2008 Server

Outlook: 2003 auf der lokalen Arbeitsstation ausgeführt wird.

Ich versuche, Kopieren und Einfügen von Outlook-Nachrichten von lokaler Arbeitsstation zu Terminalserver zu implementieren.

unter dem Code, kann ich Dateien von der lokalen Workstation-Server kopieren und einfügen ...

TmyMemoryStream = class(TMemoryStream); 

... 

procedure TmyMemoryStream.LoadFromIStream(AStream : IStream); 
var 
    iPos : Int64; 
    aStreamStat : TStatStg; 
    oOLEStream: TOleStream; 
begin 
    AStream.Seek(0, STREAM_SEEK_SET, iPos); 
    AStream.Stat(aStreamStat, STATFLAG_NONAME); 
    oOLEStream := TOLEStream.Create(AStream); 
    try 
    Self.Clear; 
    Self.Position := 0; 
    Self.CopyFrom(oOLEStream, aStreamStat.cbSize); 
    Self.Position := 0; 
    finally 
    oOLEStream.Free; 
    end; 
end;

... aber wenn ich versuche, eine Outlook-Nachricht zu kopieren und einzufügen, um den Strom Größe (aStreamStat.cbSize) ist 0. Ich bin in der Lage, den Betreff der Nachricht (Dateiname) zu erhalten, kann aber den Stream-Inhalt nicht lesen.

Was ist falsch an meinem Code?

komplette Code-Einheit:

unit Unit1; 

interface 
uses 
    dialogs, 
    Windows, ComCtrls, ActiveX, ShlObj, ComObj, StdCtrls, AxCtrls, 
    SysUtils, Controls, ShellAPI, Classes, Forms; 

type 

    {****************************************************************************} 

    TMyDataObjectHandler = class; 

    PFileDescriptorArray = Array of TFileDescriptor; 

    {****************************************************************************} 

    TMyDataObjectHandler = class(TObject) 
    strict private 
    CF_FileContents   : UINT; 
    CF_FileGroupDescriptorA : UINT; 
    CF_FileGroupDescriptorW : UINT; 
    CF_FileDescriptor   : UINT; 
    FDirectory     : string; 
    function _CanCopyFiles(const ADataObject : IDataObject) : boolean; 
    function _DoCopyFiles(const ADataObject : IDataObject) : HResult; 
    //function _ExtractFileNameWithoutExt(const FileName: string): string; 
    function _CopyFiles(AFileNames: TStringList): HResult; 
    procedure _GetFileNames(AGroup: PDropFiles; var AFileNames: TStringList); 
    procedure _ProcessAnsiFiles(ADataObject: IDataObject; AGroup: PFileGroupDescriptorA); 
    function _ProcessDropFiles(ADataObject: IDataObject; AGroup: PDropFiles): HResult; 
    procedure _ProcessFileContents(ADataObject: IDataObject; Index: UINT; AFileName: string; AFileSize : Cardinal); 
    function _ProcessStorageMedium(ADataObject: IDataObject; AMedium: STGMEDIUM; AFilename: string; AFileSize : Cardinal): HResult; 
    function _ProcessStreamMedium(ADataObject: IDataObject; AMedium: STGMEDIUM; AFileName: String; AFileSize : Cardinal): HResult; 
    procedure _ProcessUnicodeFiles(ADataObject: IDataObject; AGroup: PFileGroupDescriptorW); 
    function _CanCopyFile(AFileName: string): boolean; 
    public 
    constructor Create; reintroduce; 
    destructor Destroy; override; 
    function CanCopyFiles(const ADataObject : IDataObject; const ADirectory : string) : boolean; 
    procedure CopyFiles(const ADataObject : IDataObject; const ADirectory : string); 
    end; 

    {****************************************************************************} 

    TMyMemoryStream = class(TMemoryStream) 
    public 
    procedure LoadFromIStream(AStream : IStream; AFileSize : Cardinal); 
    function GetIStream : IStream; 
    end; 

    {****************************************************************************} 

implementation 

{------------------------------------------------------------------------------} 

{ TMyDataObjectHandler } 

function TMyDataObjectHandler.CanCopyFiles(const ADataObject : IDataObject; const ADirectory : string): boolean; 
begin 
    Result := IsDirectoryWriteable(ADirectory); 
    if Result then 
    begin 
    Result := _CanCopyFiles(ADataObject); 
    end; 
end; 

{------------------------------------------------------------------------------} 

constructor TMyDataObjectHandler.Create; 
begin 
    inherited Create; 
    CF_FileContents   := $8000 OR RegisterClipboardFormat(CFSTR_FILECONTENTS)  AND $7FFF; 
    CF_FileGroupDescriptorA := $8000 OR RegisterClipboardFormat(CFSTR_FILEDESCRIPTORA) AND $7FFF; 
    CF_FileGroupDescriptorW := $8000 OR RegisterClipboardFormat(CFSTR_FILEDESCRIPTORW) AND $7FFF; 
    CF_FileDescriptor  := $8000 OR RegisterClipboardFormat(CFSTR_FILEDESCRIPTOR) AND $7FFF; 
end; 

{------------------------------------------------------------------------------} 

destructor TMyDataObjectHandler.Destroy; 
begin 
    // 
    inherited; 
end; 

{------------------------------------------------------------------------------} 

procedure TMyDataObjectHandler.CopyFiles(const ADataObject : IDataObject; const ADirectory : string); 
begin 
    FDirectory := ADirectory; 
    _DoCopyFiles(ADataObject); 
end; 

{------------------------------------------------------------------------------} 

function TMyDataObjectHandler._CanCopyFiles(const ADataObject : IDataObject) : boolean; 
var 
    eFORMATETC : IEnumFORMATETC; 
    OLEFormat : TFormatEtc; 
    iFetched : Integer; 
begin 
    Result := false; 
    if Succeeded(ADataObject.EnumFormatEtc(DATADIR_GET, eFormatETC)) then 
    begin 
    if Succeeded(eFormatETC.Reset) then 
    begin 
     while(eFORMATETC.Next(1, OLEFormat, @iFetched) = S_OK) and (not Result) do 
     begin 
     Result := (OLEFormat.cfFormat = CF_FileGroupDescriptorW) 
        or 
        (OLEFormat.cfFormat = CF_FileGroupDescriptorA) 
        or 
        (OLEFormat.cfFormat = CF_HDROP); 
     end; 
    end; 
    end; 
end; 

{------------------------------------------------------------------------------} 

function TMyDataObjectHandler._CanCopyFile(AFileName : string) : boolean; 
begin 
    Result := not FileExists(ExpandUNCFileName(FDirectory + ExtractFileName(AFileName))); 
end; 

{------------------------------------------------------------------------------} 

function TMyDataObjectHandler._CopyFiles(AFileNames : TStringList) : HResult; 
var 
    i: Integer; 
begin 
    Result := S_OK; 
    i := 0; 
    while(i < AFileNames.Count) do 
    begin 
    if _CanCopyFile(AFileNames[i]) then 
    begin 
     Copyfile(Application.MainForm.Handle, PChar(AFileNames[i]), PChar(FDirectory + ExtractFileName(AFileNames[i])), false); 
    end; 
    inc(i); 
    end; 
end; 

{------------------------------------------------------------------------------} 

procedure TMyDataObjectHandler._GetFileNames(AGroup: PDropFiles; var AFileNames : TStringList); 
var 
    sFilename : PAnsiChar; 
    s   : string; 
begin 
    sFilename := PAnsiChar(AGroup) + AGroup^.pFiles; 
    while (sFilename^ <> #0) do 
    begin 
    if (AGroup^.fWide) then 
    begin 
     s := PWideChar(sFilename); 
     Inc(sFilename, (Length(s) + 1) * 2); 
    end 
    else 
    begin 
     s := PWideChar(sFilename); 
     Inc(sFilename, Length(s) + 1); 
    end; 
    AFileNames.Add(s); 
    end; 
end; 

{------------------------------------------------------------------------------} 

function TMyDataObjectHandler._ProcessDropFiles(ADataObject: IDataObject; AGroup: PDropFiles) : HResult; 
var 
    sFiles : TStringList; 
begin 
    Result := S_OK; 
    sFiles := TStringList.Create; 
    try 
    _GetFileNames(AGroup, sFiles); 
    if (sFiles.Count > 0) then 
    begin 
     Result := _CopyFiles(sFiles); 
    end; 
    finally 
    sFiles.Free; 
    end; 
end; 

{------------------------------------------------------------------------------} 

function TMyDataObjectHandler._ProcessStorageMedium(ADataObject: IDataObject; AMedium: STGMEDIUM; AFilename : string; AFileSize : Cardinal) : HResult; 
var 
    StorageInterface  : IStorage; 
    FileStorageInterface : IStorage; 
    sGUID    : PGuid; 
    iCreateFlags   : integer; 
begin 
    Result := S_OK; 
    if _CanCopyFile(AFileName) then 
    begin 
    sGUID := nil; 
    StorageInterface := IStorage(AMedium.stg); 
    iCreateFlags := STGM_CREATE OR STGM_READWRITE OR STGM_SHARE_EXCLUSIVE; 
    Result := StgCreateDocfile(PWideChar(ExpandUNCFileName(FDirectory + AFilename)), iCreateFlags, 0, FileStorageInterface); 
    if Succeeded(Result) then 
    begin 
     Result := StorageInterface.CopyTo(0, sGUID, nil, FileStorageInterface); 
     if Succeeded(Result) then 
     begin 
     Result := FileStorageInterface.Commit(0); 
     end; 
     FileStorageInterface := nil; 
    end; 
    StorageInterface := nil; 
    end; 
end; 

{------------------------------------------------------------------------------} 

function TMyDataObjectHandler._ProcessStreamMedium(ADataObject: IDataObject; AMedium: STGMEDIUM; AFileName : String; AFileSize : Cardinal) : HResult; 
var 
    Stream : IStream; 
    myStream: TMyMemoryStream; 
begin 
    Result := S_OK; 
    if _CanCopyFile(AFileName) then 
    begin 
    Stream := ISTREAM(AMedium.stm); 
    if (Stream <> nil) then 
    begin 
     myStream := TMyMemoryStream.Create; 
     try 
     myStream.LoadFromIStream(Stream, AFileSize); 
     myStream.SaveToFile(ExpandUNCFileName(FDirectory + AFileName)); 
     finally 
     myStream.Free; 
     end; 
    end; 
    end; 
end; 

{------------------------------------------------------------------------------} 

procedure TMyDataObjectHandler._ProcessFileContents(ADataObject: IDataObject; Index: UINT; AFileName : string; AFileSize : Cardinal); 
var 
    Fetc: FORMATETC; 
    Medium: STGMEDIUM; 
begin 
    Fetc.cfFormat := CF_FILECONTENTS; 
    Fetc.ptd := nil; 
    Fetc.dwAspect := DVASPECT_CONTENT; 
    Fetc.lindex := Index; 
    Fetc.tymed := TYMED_HGLOBAL or TYMED_ISTREAM or TYMED_ISTORAGE; 
    if SUCCEEDED(ADataObject.GetData(Fetc, Medium)) then 
    begin 
    try 
     case Medium.tymed of 
     TYMED_HGLOBAL : ; 
     TYMED_ISTREAM : _ProcessStreamMedium(ADataObject, Medium, AFileName, AFileSize); 
     TYMED_ISTORAGE : _ProcessStorageMedium(ADataObject, Medium, AFileName, AFileSize); 
     else ; 
     end; 
    finally 
     ReleaseStgMedium(Medium); 
    end; 
    end; 
end; 

{------------------------------------------------------------------------------} 

procedure TMyDataObjectHandler._ProcessAnsiFiles(ADataObject: IDataObject; AGroup: PFileGroupDescriptorA); 
var 
    I   : UINT; 
    sFileName : AnsiString; 
    iSize  : Cardinal; 
begin 
    for I := 0 to AGroup^.cItems-1 do 
    begin 
    sFileName := AGroup^.fgd[I].cFileName; 
    if (AGroup^.fgd[I].dwFlags and FD_FILESIZE) = FD_FILESIZE then 
    begin 
     iSize := (AGroup^.fgd[I].nFileSizeLow and $7FFFFFFF); 
    end 
    else 
    begin 
     iSize := 0; 
    end; 
    _ProcessFileContents(ADataObject, I, string(sFileName), iSize); 
    end; 
end; 

{------------------------------------------------------------------------------} 

procedure TMyDataObjectHandler._ProcessUnicodeFiles(ADataObject : IDataObject; 
                AGroup  : PFileGroupDescriptorW); 
var 
    I: UINT; 
    sFileName: WideString; 
    iSize: Cardinal; 
begin 
    for I := 0 to AGroup^.cItems-1 do 
    begin 
    sFileName := AGroup^.fgd[I].cFileName; 
    if (AGroup^.fgd[I].dwFlags and FD_FILESIZE) = FD_FILESIZE then 
    begin 
     iSize := (AGroup^.fgd[I].nFileSizeLow and $7FFFFFFF); 
    end 
    else 
    begin 
     iSize := 0; 
    end; 
    _ProcessFileContents(ADataObject, I, sFileName, iSize); 
    end; 
end; 


{------------------------------------------------------------------------------} 

function TMyDataObjectHandler._DoCopyFiles(const ADataObject : IDataObject) : HResult; 
var 
    Fetc  : FORMATETC; 
    Medium  : STGMEDIUM; 
    Enum  : IEnumFORMATETC; 
    Group  : Pointer; 
begin 
    Result := ADataObject.EnumFormatEtc(DATADIR_GET, Enum); 
    if FAILED(Result) then 
    Exit; 
    while (true) do 
    begin 
    Result := (Enum.Next(1, Fetc, nil)); 
    if (Result = S_OK) then 
    begin 
     if (Fetc.cfFormat = CF_FILEGROUPDESCRIPTORA) or 
     (Fetc.cfFormat = CF_FILEGROUPDESCRIPTORW) or 
     (Fetc.cfFormat = CF_HDROP) then 
     begin 
     Result := ADataObject.GetData(Fetc, Medium); 
     if FAILED(Result) then 
      Exit; 
     try 
      if (Medium.tymed = TYMED_HGLOBAL) then 
      begin 
      Group := GlobalLock(Medium.hGlobal); 
      try 
       if Fetc.cfFormat = CF_FILEGROUPDESCRIPTORW then 
       begin 
       _ProcessUnicodeFiles(ADataObject, PFileGroupDescriptorW(Group)); 
       break; 
       end 
       else if Fetc.cfFormat = CF_FILEGROUPDESCRIPTORA then 
       begin 
       _ProcessAnsiFiles(ADataObject, PFileGroupDescriptorA(Group)); 
       break; 
       end 
       else if Fetc.cfFormat = CF_HDROP then 
       begin 
       _ProcessDropFiles(ADataObject, PDropFiles(Group)); 
       break; 
       end; 
      finally 
       GlobalUnlock(Medium.hGlobal); 
      end; 
      end; 
     finally 
      ReleaseStgMedium(Medium); 
     end; 
     end; 
    end 
    else 
     break; 
    end; 
end; 

{------------------------------------------------------------------------------} 

//function TMyDataObjectHandler._ExtractFileNameWithoutExt(const FileName: string): string; 
//begin 
// Result := ChangeFileExt(ExtractFileName(FileName), EmptyStr); 
//end; 

{------------------------------------------------------------------------------} 

{ TMyMemoryStream } 

function TMyMemoryStream.GetIStream: IStream; 
var 
    oStreamAdapter : TStreamAdapter; 
    tPos   : Int64; 
begin 
    oStreamAdapter := TStreamAdapter.Create(Self); 
    oStreamAdapter.Seek(0, 0, tPos); 
    Result := oStreamAdapter as IStream; 
end; 

procedure TMyMemoryStream.LoadFromIStream(AStream : IStream; AFileSize : Cardinal); 
var 
    iPos : Int64; 
    aStreamStat   : TStatStg; 
    oOLEStream: TOleStream; 
    HR: Int64; 
begin 
    oOLEStream := TOLEStream.Create(AStream); 
    try 
    Self.Clear; 
    Self.Position := 0; 
    try 
     HR := Self.CopyFrom(oOLEStream, 0); 
    except 
    on E : Exception do 
    begin 
     showMessage(E.ClassName + ' ' + E.Message); 
    end; 
    end; 
    Self.Position := 0; 
    finally 
    oOLEStream.Free; 
    end; 
end; 

end.

Quelle

2013-02-20 Pavan

Ich bemerke, dass Sie den Rückgabewert von 'Stat' ignoriert haben. Ist diese Funktion erfolgreich? Sie könnten sowohl die 'Seek'- als auch' Stat'-Aufrufe überspringen, wenn Sie für den zweiten 'CopyFrom' -Parameter einfach 0 übergeben haben. Die Übergabe von 0 sucht automatisch nach dem Anfang des Quelldatenstroms und kopiert das gesamte Objekt. –

@Rob Kennedy: Versuchte Entfernen der Seek und Stat-Aufrufe und 0 als 2. Parameter zu CopyFrom. Der Aufruf von CopyFrom schlägt jedoch mit einer Ausnahme fehl. EOleSysError - Parameter ist falsch. – Pavan

@Rob Kennedy: Ich habe den vollständigen Gerätecode beigefügt. Dieser Code ist jedoch nicht für die Verwendung in der Produktion geeignet, da er offensichtliche Probleme enthält, obwohl geringfügig. – Pavan

Das Problem ist, dass IStream bei CF_FILEDESCRIPTORW oder CF_FILEDESCRIPTORA von Windows bereitzustellen, die keine Sucht-Funktion nicht unterstützt und nicht korrekt StreamStat.cbSize Feld unterstützen. Daher ist es erforderlich, die Stream-Größe aus den Feldern nFileSizeLow und nFileSizeHigh des TFileDescriptor-Datensatzes zu ermitteln. Außerdem ist es unmöglich, TStream.CopyFrom (oOLEStream,) zu verwenden, da TStream im Fall von Zero-second-Argumenten die Seek-Funktion aufruft, die nicht unterstützt wird und daher eine EOleSysError-Ausnahme vorliegt.

Quelle

2013-10-07 17:48:14

Antwort

Verwandte Themen