Unicode-Version von ClipboardAsString

Question

Ich habe Peter Below's APIClipboard-Einheit seit vielen Jahren verwendet, aber es funktioniert nicht mehr unter Unicode Delphi.

ClipboardAsString kehrt 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; 

Und StringToClipboard Kopien nur das erste Zeichen:

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; 

ich gesucht habe aber eine aktualisierte Version dieses Geräts nicht finden können. Kennt jemand mit mehr Erfahrung mit Unicode-Strings den besten Weg, dies zu lösen?

Dank

Answer 1

CF_TEXT ist Ansi, CF_UNICODETEXT Unicode ist. Der Code muss aktualisiert werden, um das entsprechende Format auf der Grundlage zu verwenden, ob string Ansi oder Unicode sind, zum Beispiel:

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; 

Oder Sie könnten nur die eigene TClipboard.AsText Eigenschaft VCL verwenden, anstatt, die diese Informationen für Sie Griffe:

uses 
    Clipbrd; 

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

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

Mit diesem gesagt, eine Randnotiz, DataToClipboard() hat einige Bugs drin. Es sollte datasize 0 sein und es nicht ignorieren, sonst ist es nicht möglich, leere Daten zu speichern (was wünschenswert ist). Es muss nicht (kein Fehler, sondern verschwendeter Overhead) verwendet werden. Und muss es frei, die HGLOBAL wenn SetClipboardData() versagt:

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 } 

Es gibt auch einen Fehler in CopyDataToClipboard() wenn emptyClipboardFirst Wahr ist:

Wenn eine Anwendung ruft Open mit Hwnd auf NULL gesetzt, setzt EmptyClipboard die Zwischenablage-Besitzer auf NULL; Dies führt dazu, dass SetClipboardData fehlschlägt.

So müssen Sie eine gültige Nicht-Null HWND zu OpenClipboard() passieren, wenn die Zwischenablage leeren und dann neue Daten darauf setzen.