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异常.

版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。

相关推荐


文章浏览阅读2.2k次,点赞6次,收藏20次。在我们平时办公工作中,很多时候我们经常会使用到虚拟机来进行环境的测试,我们平时在虚拟机上接触的最多的莫过于Linux和Winwdos。不过虚拟机环境和物理机环境是无法直接传输的,那么有的时候呢,同学们又想要在两者之间相互传输文件,可能就会使用QQ邮箱等形式来传输,这样的效率又慢而且繁琐,今天我就为大家带来一种非常便捷的传输方式。通过XFTP工具来进行文件传输。_xftp连接windows
文章浏览阅读1k次。解决 Windows make command not found 和 安装 GCC 环境_windows下载gcc
文章浏览阅读3.2k次,点赞2次,收藏6次。2、鼠标依次点击“计算机配置“ - ”管理模板“ - ”网络“ - ”Lanman工作站”,点击右侧的“启用不安全的来宾登录”策略。Windows访问samba共享时,提示“你不能访问此共享文件夹,因为你组织的安全策略阻止未经身份验证的来宾访问”1、键盘按下window+R键,输入gpedit.msc,启动本地组策略编辑器。首先在终端中输入sudo ufw status查看当前防火墙状态。默认状态是“未配置”,修改为“已启用”。示例:创建一个narada的目录在/home下。1.更新apt储存库列表。_ubuntu samba 目标文件夹访问被拒绝
文章浏览阅读1.3w次。蓝光版属于高清版的一种。BD英文全名是Blu-ray Disc,一种高清的电影版本,这种电影十分清晰但是数据量巨大,占数十G甚至上百G的容量,只有蓝光光碟才能装得下,所以这种高清电影被称为BD版。一般的高清电影多半是从蓝光电影、国外的高清电视频道上压制而来的,可以通过网络下载,多数都经过二次压缩,画质要逊于原视频,不过压缩后的容量从蓝光的25G-50G会减少成4G-8G等(15G-20G不等)。众所周知,视频有两种常见的清晰度,BD和HD,在看电影的时候最常出现这两个标志,那么BD和HD具体指的是什么呢?_bd hd
文章浏览阅读974次,点赞7次,收藏8次。提供了更强大的功能,因为它允许直接访问当前元素,而不需要类型转换。接口,它可以提供一个迭代器,用于按顺序访问集合中的元素。接口是只读的,它只能支持前向迭代,不能修改集合中的元素。类型的集合实例,并向其中添加了几个元素。接口,可以创建一个能够迭代访问泛型集合中元素的迭代器。接口,我们可以在 C# 中实现可迭代的集合,并使用。循环和迭代器手动遍历集合,并输出每个元素的值。接口表示一个可枚举的集合,它定义了一个方法。属性,用于获取集合中当前位置的元素。存储集合中的元素,并实现了。的泛型集合类,它实现了。
文章浏览阅读1.4w次,点赞5次,收藏22次。如果使用iterator的remove方法则会正常,因为iterator的remove方法会在内部调用List的remove方法,但是会修改excepedModCount的值,因此会正常运行。因为遍历过程中进行remove 操作时,该位置后面的元素会挤到前面来,这时候会发生一种情况就是原来元素的位置会被他后面的元素取代,而该位置已经遍历过了,所以该元素不会背遍历。当我们倒序遍历元素的时候,无论删除元素之后的元素怎么移动,之前的元素对应的索引(index)是不会发生变化的,所以在删除元素的时候不会发生问题。_list删除某个元素
文章浏览阅读2.9w次,点赞45次,收藏192次。Windows下配置Visual Studio _vs2022环境变量配置
文章浏览阅读7w次,点赞162次,收藏778次。pip 是Python包管理工具,提供了对 Python 包的查找、下载、安装、卸载的功能,目前Python 3.4 和 2.7 及以上版本都有配套安装,一般pip的位置在...pythonScripts文件夹里面,而在其他版本需要自行下载。_python pip install安装
文章浏览阅读5.8k次,点赞2次,收藏12次。①此电脑右击----->选择属性----->高级系统设置----->环境变量----->path----->编辑----->新建。第一个选项意思就是将安装路径填入到系统环境变量中,这里勾选,后面使用可能会出现问题,建议不要勾选,安装好之后手动添加环境变量。注意:如果提示conda不是内部或外部命令,原因是Anaconda的环境变量没配置好。如果不想立即打开anaconda,不勾选直接finish就好。②输入 conda --version ,查看conda环境。②直接按win键,搜索“环境变量”_windows安装anaconda
文章浏览阅读5.1k次,点赞8次,收藏55次。Windows 系统从零配置 Python 环境,安装CUDA、CUDNN、PyTorch 详细教程_windows cuda cudnn配置
文章浏览阅读1.5w次,点赞54次,收藏68次。macOS系统自带有VNC远程桌面,我们可以在控制端上安装配置VNC客户端,以此来实现远程控制macOS。但通常需要在不同网络下进行远程控制,为此,我们可以在macOS被控端上使用cpolar做内网穿透,映射VNC默认端口5900,通过所生成的公网地址,来实现在公网环境下远程控制VNC。_vnc mac
文章浏览阅读2.4k次,点赞5次,收藏11次。进入后根据自己的电脑系统下载,这是python 3.10版本下载地址,如果想要下载其它版本可进入此链接(下载完成后点击进行安装点击下一步,到这一步时,可以选择将Anaconda添加我的PATH环境变量中,这样就不用自己手动配置和环境变量。安装完成后,打开终端,输出 python 命令可查看是否安装成功。如果显示自己刚才安装的版本号说明安装成功。查看conda版本命令:conda info。_paddlespeech下载
文章浏览阅读3.3k次。所以如果要删除之前新增的课程编译原理,只需输入命令del Course:8:Cname,同时还应该把本课程的学分删除del Course:8:Ccredit,如下图所示;Redis并没有修改数据的命令,所以如果在Redis中要修改一条数据,只能在使用set命令时,使用同样的键值,然后用新的value值来覆盖旧的数据。先调用get命令,输出原先的值,然后set新的值,最后再get得到新值,所以修改成功。输入命令后没有报错,表示成功了,刷新windows的服务,多了一个redis服务。_redis windows服务
文章浏览阅读2.1w次,点赞9次,收藏56次。​​接着在【工作负荷】中,选择【使用C++桌面开发】 ,右边【安装详细信息】去除其它可选项,只勾选【MSVCv142 】和 【Windows 10 SDK】,按图示修改,然后右下角点击安装,之后会有提示让你重启电脑。重启电脑之后,再进行pip安装。报错原因是pip所安装的包需要使用C++编译后才能够正常安装,但是当前安装环境中缺少完整的C++编译环境,因此安装失败。3.安装Microsoft Visual C++ Build Tool离线安装包(1个多G),CSDN资源很多,需要积分下载,_error: microsoft visual c++ 14.0 or greater is required. get it with "micros
文章浏览阅读1.1w次,点赞3次,收藏7次。Step 3: 在右侧窗口中找到名称为“LongPathsEnabled”的“DWORD (32 位) 值”条目,并双击它。通过注册表方法或组策略方法启用长路径支持后,您将能够在 Windows 中使用长路径,并能够访问和处理长路径下的文件和文件夹。Step 2: 依次选择“计算机配置” > “管理模板” > “系统” > “文件资源管理器”。Step 3: 找到“启用 Win32 长路径”设置,双击它。Step 4: 选择“已启用”选项按钮,然后选择“应用”按钮。_windows长路径支持
文章浏览阅读2.5k次,点赞81次,收藏86次。
文章浏览阅读1.3k次,点赞65次,收藏50次。顺序表,链表,栈,队列,ArrayList,LinkedList,Stack,Queue
文章浏览阅读2.3k次,点赞2次,收藏2次。AnyTXTSearcher是一款能够帮助我们对文档以及文本内容进行快速搜索和管理的工具,通过该软件能够搜索各种Office文档,文本文件,代码,PDF文档等,顶级的全文搜索引擎1秒钟之内即可完成搜索。_anytxt searcher
文章浏览阅读8.8k次,点赞73次,收藏70次。有时,在删除/移动/重命名文件夹/文件时,会遇到如下警告,即使将打开的程序关闭了,后台也可能会有没关干净的相关进程。_解除占用
文章浏览阅读4.3w次,点赞91次,收藏102次。JDK(Java Development Kit)是Java开发工具包的缩写,包含了Java编译器、Java虚拟机、Java类库等众多组件,是Java开发的基石,提供了编写、编译和运行Java程序所必需的工具。同时,为了让系统能够正确识别Java环境,在开始使用JDK进行Java开发之前,需要先把JDK安装到本地计算机,并配置好相应的环境变量。本文将介绍JDK安装与环境变量配置的方法。_windows安装jdk并配置环境变量