2013-02-20 21 views
10

workstation locale: Win 7operazioni relative agli Appunti a Delfi

Terminal Server: Win 2008 Server

Outlook: 2003 in esecuzione su workstation locale.

Sto cercando di implementare la copia e incolla dei messaggi di Outlook dalla workstation locale al terminal server.

Usando il codice qui sotto, sono in grado di copiare e incollare i file da workstation locale al server ...

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; 

... ma quando provo a copiare e incollare un messaggio di Outlook, la dimensione del flusso (aStreamStat.cbSize) è 0. Sono in grado di ottenere l'oggetto del messaggio (nome del file), ma non riesco a leggere il contenuto del flusso.

Cosa c'è di sbagliato nel mio codice?

Completa codice dell'unità:

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. 
+0

Ho notato che hai ignorato il valore restituito da 'Stat'. Questa funzione ha avuto successo? Puoi saltare entrambe le chiamate 'Seek' e' Stat' se hai semplicemente passato 0 per il secondo parametro 'CopyFrom'. Passare 0 cerca automaticamente l'inizio del flusso di origine e copia l'intera cosa. –

+0

@Rob Kennedy: Ho provato a rimuovere le chiamate Seek e Stat e 0 come secondo parametro a CopyFrom. Ma ancora, la chiamata a CopyFrom fallisce con un'eccezione. EOleSysError - Il parametro non è corretto. – Pavan

+0

@Rob Kennedy: ho allegato il codice completo dell'unità. Tuttavia questo codice non è per uso produttivo in quanto contiene problemi evidenti anche se minori. – Pavan

risposta

1

Il problema è che in caso di CF_FILEDESCRIPTORW o CF_FILEDESCRIPTORA di Windows forniscono IStream che non supporta la funzione Seek e non supporta corretta campo StreamStat.cbSize. Quindi è necessario ottenere la dimensione del flusso dai campi nFileSizeLow e nFileSizeHigh del record TFileDescriptor. Inoltre, è impossibile utilizzare TStream.CopyFrom (oOLEStream,) perché in caso di argomento secondo zero TStream chiama la funzione Seek che non è supportata e pertanto si dispone dell'eccezione EOleSysError.