windows – Delphi中的剪贴板操作

Windows 前端之家
前端之家收集整理的这篇文章主要介绍了windows – Delphi中的剪贴板操作，前端之家小编觉得挺不错的，现在分享给大家，也给大家做个参考。
本地工作站：Win 7

终端服务器：Win 2008 Server

Outlook：2003在本地工作站上运行.

我试图实现从本地工作站到终端服务器的Outlook邮件的复制和粘贴.

使用下面的代码,我可以将文件从本地工作站复制并粘贴到服务器上

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;

…但是当我尝试复制和粘贴Outlook消息时,流大小(aStreamStat.cbSize)为0.我能够获取消息主题(文件名),但无法读取流内容.

我的代码有什么问题？

完成单位代码：

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,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,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,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,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.
问题是CF_FILEDESCRIPTORW或CF_FILEDESCRIPTORA Windows提供的IStream不支持Seek功能,并且不支持正确的StreamStat.cbSize字段.因此,需要从TFileDescriptor记录的nFileSizeLow和nFileSizeHigh字段获取流大小.也不可能使用TStream.CopyFrom(oOLEStream,0),因为在第二个参数为零的情况下,TStream调用Seek函数不受支持,因此您有EOleSysError异常.
原文链接：https://www.f2er.com/windows/363914.html

猜你在找的Windows相关文章

[Windows]ping itsafe&环境变量
（1）when you ping a computer from itsafe,the ping command should return the local I...
win10启动telnet
1、点击win菜单，点击设置图标 2、选择系统选项 3、选择应用与程序选项 4、拉到最下方，选...
不能往Windows Server 2008 R2 Server中复制文件的解决方法
目前一直直接往Windows 2008 R2 Server中复制文件（暂时还没有搭建ftp服务），突然不能复制...
windows下使用vscode配合xebug调试php脚本
windows下使用vscode配合xebug调试php脚本 要下载有php_xebug.dll扩展的版本,最新版可能没...
windows - win10开启和安装ubuntu子系统
在控制面板的程序与功能里启用和关闭windows功能打开，适用于linux的windows子系统
Windows10开发指定端口号
一、打开控制面板，选择Window Defender防火墙 二、选择高级设置 三、右键入站规则，新建规...
Win10如何快速截屏
Win10不用QQ，如何快速截屏？ 年轻的时候想截图总是需要把QQ打开，但是直到我遇到了一种尴...
windows10安装ubuntu双系统教程（绝对史上最详细） Windows10安装ubuntu16.04双系统教程Windows10安装ubuntu18.04双系统教程Windows10安装ubuntu16.04双系统教程
友情提示：如果你参照教程安装出现了问题，极有可能是因为不同电脑之间的差异导致，可能有...
Windows10安装ubuntu18.04双系统教程 Windows10安装ubuntu16.04双系统教程
写在前面：本教程为windows10安装ubuntu18.04（64位）双系统教程，是我多次安装双系统的经...
windows和ubuntu双系统修改默认启动项
安装完ubuntu系统后，打开电脑到选择系统的界面我们发现默认的是ubuntu系统，如果你是经常...
LinuxWindowsCentOSUbuntuNginxWebServiceScalaMemcacheApacheRedisDockerBashAzureTomcatLNMPShell数据结构服务器运维网络安全
xebugnodemondocker-copydcoselasticsearcwindows-contdocker-windodocker-awsamazon-cloudenvoyproxyhashicorp-vaswisscomdevkafka-pythonzscalerphoton-osdocker-swarmkamongoogle-cloudconcoursewso2-ampersistent-vapi-managerprocess-manamanjarojenkins-workhypriotremoteapikeystonejsbitcoindbitcoin-test