ClipboardAsString 的 Unicode 版本答案

【问题标题】：Unicode version of ClipboardAsStringClipboardAsString 的 Unicode 版本
【发布时间】：2016-06-07 21:18:37
【问题描述】：

多年来，我一直在使用 Peter Above 的 APIClipboard 单元，但它不再适用于 Unicode Delphi。

ClipboardAsString 返回 gobbledegook：

Procedure DataFromClipboard( fmt: DWORD; S: TStream );
  Var
    hMem: THandle;
    pMem: Pointer;
    datasize: DWORD;
  Begin { DataFromClipboard }
    Assert( Assigned( S ));
    hMem := GetClipboardData( fmt );
    If hMem <> 0 Then Begin
      datasize := GlobalSize( hMem );
      If datasize > 0 Then Begin
        pMem := GlobalLock( hMem );
        If pMem = Nil Then
          raise EclipboardError.Create( eLockFailed );
        try
          S.WriteBuffer( pMem^, datasize );
        finally
          GlobalUnlock( hMem );
        end;
      End;
    End;
  End;



Procedure CopyDataFromClipboard( fmt: DWORD; S: TStream );
  Begin { CopyDataFromClipboard }
    Assert( Assigned( S ));
    If OpenClipboard( 0 ) Then
      try
        DataFromClipboard( fmt , S );
      finally
        CloseClipboard;
      end
    Else
      raise EclipboardError.Create( eCannotOpenClipboard );
  End; 


Function ClipboardAsString: String;
  Const
    nullchar: Char = #0;
  Var
    ms: TMemoryStream;
  Begin { ClipboardAsString }
    If not IsClipboardFormatAvailable( CF_TEXT ) Then
      Result := EmptyStr
    Else Begin
      ms:= TMemoryStream.Create;
      try
        CopyDataFromClipboard( CF_TEXT , ms );
        ms.Seek( 0, soFromEnd );
        ms.WriteBuffer( nullChar, Sizeof( nullchar ));
        Result := Pchar( ms.Memory );
      finally
        ms.Free;
      end;
    End;
  End;

而 StringToClipboard 只复制第一个字符：

Procedure DataToClipboard( fmt: DWORD; Const data; datasize: Integer );
  Var
    hMem: THandle;
    pMem: Pointer;
  Begin { DataToClipboard }
    If datasize <= 0 Then Exit;
    hMem := GlobalAlloc( GMEM_MOVEABLE or GMEM_SHARE or GMEM_ZEROINIT ,
                         datasize );
    If hmem = 0 Then
      raise EclipboardError.Create( eSystemOutOfMemory );

    pMem := GlobalLock( hMem );
    If pMem = Nil Then Begin
      GlobalFree( hMem );
      raise EclipboardError.Create( eLockFailed );
    End;

    Move( data, pMem^, datasize );
    GlobalUnlock( hMem );
    If SetClipboardData( fmt, hMem ) = 0 Then
      raise EClipboarderror( eSetDataFailed );
  End; { DataToClipboard }

Procedure CopyDataToClipboard( fmt: DWORD; Const data; datasize: 
Integer;
                               emptyClipboardFirst: Boolean = true );
  Begin { CopyDataToClipboard }
    If OpenClipboard( 0 ) Then
      try
        If emptyClipboardFirst Then
          EmptyClipboard;
        DataToClipboard( fmt, data, datasize );
      finally
        CloseClipboard;
      end
    Else
      raise EclipboardError.Create( eCannotOpenClipboard );
  End; 

Procedure StringToClipboard( Const S: String );
  Begin
    If Length(S) > 0 Then
      CopyDataToClipboard( CF_TEXT, S[1], Length(S)+1);
  End;

我已搜索但找不到此单元的更新版本。有没有对 Unicode 字符串有更多经验的人知道解决这个问题的最佳方法？

谢谢

【问题讨论】：

是否将所有 pchar/string 实例替换为 pansichar/ansistring 不成功？
你为什么不改用Clipboard.AsText := S？

标签： delphi unicode

【解决方案1】：

CF_TEXT 是 Ansi，CF_UNICODETEXT 是 Unicode。需要根据string 是Ansi 还是Unicode 来更新代码以使用适当的格式，例如：

Const
  CFTextFmt = {$IFDEF UNICODE}CF_UNICODETEXT{$ELSE}CF_TEXT{$ENDIF};

Function ClipboardAsString: String;
  Var
    ms: TMemoryStream;
  Begin { ClipboardAsString }
    If not IsClipboardFormatAvailable( CFTextFmt ) Then
      Result := EmptyStr
    Else Begin
      ms := TMemoryStream.Create;
      try
        CopyDataFromClipboard( CFTextFmt, ms );
        SetString(Result, PChar(ms.Memory), ms.Size);
      finally
        ms.Free;
      end;
    End;
  End; 

Procedure StringToClipboard( Const S: String );
  Begin
    CopyDataToClipboard( CFTextFmt, PChar(S)^, (Length(S) + 1) * SizeOf(Char));
  End;

或者，您可以改用 VCL 自己的 TClipboard.AsText 属性，它会为您处理这些详细信息：

uses
  Clipbrd;

Function ClipboardAsString: String;
  Begin
    Result := Clipboard.AsText;
  End; 

Procedure StringToClipboard( Const S: String );
  Begin
    Clipboard.AsText := S;
  End;

话虽如此，顺便说一句，DataToClipboard() 有一些错误。它应该允许datasize 为 0 而不能忽略它，否则无法存储空白数据（这是可取的）。它不需要使用GMEM_ZEROINIT（不是错误，而是浪费了开销）。如果SetClipboardData() 失败，它需要释放HGLOBAL：

Procedure DataToClipboard( fmt: DWORD; Const data; datasize: Integer );
  Var
    hMem: THandle;
    pMem: Pointer;
  Begin { DataToClipboard }
    If datasize < 0 Then datasize := 0;
    hMem := GlobalAlloc( GMEM_MOVEABLE or GMEM_SHARE, datasize );
    If hMem = 0 Then
      raise EclipboardError.Create( eSystemOutOfMemory );
    Try
      If datasize > 0 Then 
      Begin
        pMem := GlobalLock( hMem );
        If pMem = Nil Then
          raise EclipboardError.Create( eLockFailed );
        Try
          Move( data, pMem^, datasize );
        Finally
          GlobalUnlock( hMem );
        End;
      End;
      If SetClipboardData( fmt, hMem ) = 0 Then
        raise EClipboarderror( eSetDataFailed );
    Except
      GlobalFree( hMem );
      raise;
    End;
  End; { DataToClipboard }

当emptyClipboardFirst 为 True 时，CopyDataToClipboard() 中还有一个错误：

如果应用程序在 hwnd 设置为 NULL 的情况下调用 OpenClipboard，EmptyClipboard 会将剪贴板所有者设置为 NULL； 这会导致 SetClipboardData 失败。

因此，在清空剪贴板并将新数据放入其中时，您必须将有效的非零 HWND 传递给 OpenClipboard()。

【讨论】：