本地工作站：Win 7
terminal服务器：Win 2008服务器
Outlook：2003在本地工作站上运行。
我试图从本地工作站复制和粘贴Outlook消息到terminal服务器。
TPath.GetTempfilename回复“目录名称无效”
Muldiv可以比存储已知值和在其他代码中进行math运算效率低
什么会导致部分处理泄漏？
如何访问windowsshell上下文菜单项？
获取unicode符号的别名
使用下面的代码，我能够复制和粘贴文件从本地工作站到服务器…
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消息时，stream大小（ aStreamStat.cbSize ）为0.我能够获取消息主题（文件名），但无法读取stream内容。
我的代码有什么问题？
完整的单位代码：
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.
Delphi XE5中的ShowMessage缩短了
RAD Studio 10.2 Indy不使用Gmail发送电子邮件
如何在windows XP上显示windows照片打印向导？
delphi：如何发送命令到其他应用程序？
为delphi的pdf文件添加资源pipe理器上下文菜单项
问题是，如果CF_fileDESCRIPTORW或CF_fileDESCRIPTORA windows提供不支持Seek函数的IStream，并且不支持正确的StreamStat.cbSize字段。 所以有必要从TfileDescriptor记录的nfileSizeLow和nfileSizeHigh字段中获取流大小。 也不可能使用TStream.copyFrom（oolEStream， 0 ），因为在第二个参数为零的情况下，TStream调用Seek函数，这是不被支持的，所以你有EoleSysError异常。
总结以上是内存溢出为你收集整理的Delphi中的剪贴板 *** 作全部内容，希望文章能够帮你解决Delphi中的剪贴板 *** 作所遇到的程序开发问题。
如果觉得内存溢出网站内容还不错，欢迎将内存溢出网站推荐给程序员好友。
欢迎分享，转载请注明来源：内存溢出
微信扫一扫
支付宝扫一扫
评论列表（0条）