Unicode版本的ClipboardAsString

Question

我一直在使用Peter Below的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字符串经验的人是否知道解决此问题的最佳方法？

谢谢

Answer 1

CF_TEXT是Ansi,CF_UNICODETEXT是Unicode.需要更新代码以使用基于stringAnsi或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(不是bug,但是浪费了开销).并且它需要释放HGLOBALif SetClipboardData()失败:

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 }

还有中的错误CopyDataToClipboard()时emptyClipboardFirst是正确的:

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

所以,你必须通过有效的非零HWND来OpenClipboard()清空剪贴板时,然后把它的新数据.