hoạt động Clipboard trong Delphi

Question

máy trạm địa phương: Win 7

Terminal Server: Win 2008 Server

Outlook: 2003 đang chạy trên máy trạm địa phương.

Tôi đang cố triển khai sao chép và dán thư Outlook từ máy trạm cục bộ vào máy chủ đầu cuối.

Sử dụng mã dưới đây, tôi có thể sao chép và dán các tập tin từ máy trạm địa phương để máy chủ ...

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; 

... nhưng khi tôi cố gắng sao chép và dán một thông báo Outlook, kích thước dòng (aStreamStat.cbSize) là 0. Tôi có thể lấy chủ đề thư (tên tệp), nhưng không thể đọc nội dung luồng.

Có gì sai với mã của tôi?

Toàn bộ mã đơn vị:

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. 

Answer 1

Vấn đề là trong trường hợp CF_FILEDESCRIPTORW hoặc CF_FILEDESCRIPTORA Windows cung cấp IStream mà không hỗ trợ chức năng tìm kiếm và không hỗ trợ lĩnh vực StreamStat.cbSize đúng. Vì vậy, nó là cần thiết để có được kích thước dòng từ nFileSizeLow và nFileSizeHigh lĩnh vực hồ sơ TFileDescriptor. Ngoài ra nó là không thể sử dụng TStream.CopyFrom (oOLEStream,) vì trong trường hợp đối số thứ hai TStream gọi hàm Seek không được hỗ trợ và vì vậy bạn có ngoại lệ EOleSysError.