B
boying2023
Unregistered / Unconfirmed
GUEST, unregistred user!
我将微软网站提供的HTML剪贴板操作代码转换为Delphi代码，遗憾的是发现不支持多语（在Delphi2009下就更有问题了），我试验了微软提供的VB代码，也不支持多语，不知道微软为什么也犯这种错误。试验过程：将日语或韩语等写入到HTML剪贴板中，使用word粘贴，不能成功，如果是英文则没有问题。下面是我转换后的delphi代码，请大家帮忙看看。VB的源码我也贴出来，供参考。（delphi2009以前的版本string是不支持多语的，但2009编译也不支持，奇怪）//Delphi源码：//使用 PutHTMLClipboard 传入日文文字，word不能读取剪贴板格式unit uHtmlClpbrd;interface uses SysUtils,Classes,Windows,Clipbrd;Const m_sDescription = 'Version:1.0' + #13#10 + 'StartHTML:aaaaaaaaaa' + #13#10 + 'EndHTML:bbbbbbbbbb' + #13#10 + 'StartFragment:cccccccccc' + #13#10 + 'EndFragment:dddddddddd' + #13#10 ;type THTMLClpbord = class private FC_HTM_ClpFormat : Longint; FHtmClpStream : TStringStream; FHtmClpText : String; public constructor create; destructor Destroy;override; function PutHTMLClipboard(sHtmlFragment : String; sContextStart : String = '<HTML><BODY>'; sContextEnd : String = '</BODY></HTML>'):Boolean; Function GetHTMLClipboard():String; property HtmClpText : string read FHtmClpText; property HtmClpStream : TStringStream read FHtmClpStream; end;implementation{ THTMLClpbord }constructor THTMLClpbord.create;begin FC_HTM_ClpFormat := RegisterClipboardFormat('HTML Format'); FHtmClpStream := TStringStream.Create(''); end;destructor THTMLClpbord.Destroy;begin FreeAndNil(FHtmClpStream); inherited;end;function THTMLClpbord.GetHTMLClipboard: String;var sData : String; lpData : Pointer; hMemHandle, nClipSize : Longint; nStartFrag, nEndFrag, nIndx : Longint; begin If FC_HTM_ClpFormat = 0 Then Exit ; If OpenClipboard(0) Then begin GlobalUnlock(hMemHandle);// 'Retrieve the data from the clipboard hMemHandle := GetClipboardData(FC_HTM_ClpFormat); If hMemHandle > 0 Then begin lpData := GlobalLock(hMemHandle); If lpData <> nil Then begin nClipSize := lstrlen(lpData);// GetMem(sData,nClipSize + 10); FHtmClpStream.Size := 0; FHtmClpStream.WriteBuffer(lpData^, nClipSize);//GlobalSize(Data));// CopyMemory(sData,lpData, nClipSize);// 'If StartFragment appears in the data's description,// 'then retrieve the offset specified in the description// 'for the start of the fragment. Likewise, if EndFragment// 'appears in the description, then retrieve the// 'corresponding offset. sData := FHtmClpStream.DataString; FHtmClpText := sData; nIndx := Pos('StartFragment:',sData); If nIndx > 0 Then nStartFrag := StrToIntDef(Copy(sData,nIndx + lstrlen('StartFragment:'), 10),0); nIndx := Pos('EndFragment:',sData); If nIndx > 0 Then nEndFrag := StrToIntDef(Copy(sData, nIndx + lstrlen('EndFragment:'), 10),0);// 'Return the fragment given the starting and ending// 'offsets If (nStartFrag > 0) And (nEndFrag > 0) Then Result := Copy(sData, nStartFrag + 1,(nEndFrag - nStartFrag)); FHtmClpText := Result; end;//if end;//if CloseClipboard; End;//if end;function THTMLClpbord.PutHTMLClipboard(sHtmlFragment : String; sContextStart : String = '<HTML><BODY>'; sContextEnd : String = '</BODY></HTML>'):Boolean;var sData : String; hMemHandle : Longint; lpData : Pointer;begin Result := False; FHtmClpStream.Size := 0; If FC_HTM_ClpFormat = 0 Then Exit;// 'Add the starting and ending tags for the HTML fragment sContextStart := sContextStart + '<!--StartFragment -->'; sContextEnd := '<!--EndFragment -->' + sContextEnd;// 'Build the HTML given the description, the fragment and the context.// 'And, replace the offset place holders in the description with values// 'for the offsets of StartHMTL, EndHTML, StartFragment and EndFragment. sData := m_sDescription + sContextStart + sHtmlFragment + sContextEnd; sData := StringReplace(sData, 'aaaaaaaaaa', Format('%.10d',[lstrlen(m_sDescription)]),[]);//lstrlen sData := StringReplace(sData, 'bbbbbbbbbb', Format('%.10d',[lstrlen(PChar(sData))]),[]); sData := StringReplace(sData, 'cccccccccc', Format('%.10d',[lstrlen(PChar(m_sDescription + sContextStart))]),[]); sData := StringReplace(sData, 'dddddddddd', Format('%.10d',[lstrlen(PChar(m_sDescription + sContextStart + sHtmlFragment))]),[]); FHtmClpText := sData; FHtmClpStream.Size := 0; FHtmClpStream.WriteString(sData);// 'Add the HTML code to the clipboard if OpenClipboard(0) then begin hMemHandle := GlobalAlloc(0, lstrlen(PChar(sData)) * 2); if hMemHandle = 0 then Exit; lpData := GlobalLock(hMemHandle); If lpData <> nil Then begin FHtmClpStream.Position := 0; FHtmClpStream.ReadBuffer(lpData^,FHtmClpStream.Size);// CopyMemory(lpData,Pointer(sData), lstrlen(PChar(sData))); GlobalUnlock(hMemHandle); EmptyClipboard; SetClipboardData(FC_HTM_ClpFormat, hMemHandle); End;//if CloseClipboard; Result := True; end;//ifend;end.//VB源码 参考：http://support.microsoft.com/kb/274326/Option ExplicitPrivate Declare Function CloseClipboard Lib "user32" () As LongPrivate Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As LongPrivate Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As LongPrivate Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As LongPrivate Declare Function EmptyClipboard Lib "user32" () As LongPrivate Declare Function RegisterClipboardFormat Lib "user32" Alias "RegisterClipboardFormatA" (ByVal lpString As String) As LongPrivate Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As LongPrivate Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As LongPrivate Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal cbLength As Long)Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As LongPrivate Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpData As Long) As Long Private Const m_sDescription = _ "Version:1.0" & vbCrLf & _ "StartHTML:aaaaaaaaaa" & vbCrLf & _ "EndHTML:bbbbbbbbbb" & vbCrLf & _ "StartFragment:cccccccccc" & vbCrLf & _ "EndFragment:dddddddddd" & vbCrLf Private m_cfHTMLClipFormat As LongPublic HTMLText As String Function RegisterCF() As Long 'Register the HTML clipboard format If (m_cfHTMLClipFormat = 0) Then m_cfHTMLClipFormat = RegisterClipboardFormat("HTML Format") End If RegisterCF = m_cfHTMLClipFormat End Function Public Sub DLLPutHTMLClipboard(sHtmlFragment As String, _ Optional sContextStart As String = "<HTML><BODY>", _ Optional sContextEnd As String = "</BODY></HTML>") Dim sData As String HTMLText = "" If RegisterCF = 0 Then Exit Sub 'Add the starting and ending tags for the HTML fragment sContextStart = sContextStart & "<!--StartFragment -->" sContextEnd = "<!--EndFragment -->" & sContextEnd 'Build the HTML given the description, the fragment and the context. 'And, replace the offset place holders in the description with values 'for the offsets of StartHMTL, EndHTML, StartFragment and EndFragment. sData = m_sDescription & sContextStart & sHtmlFragment & sContextEnd sData = Replace(sData, "aaaaaaaaaa", _ Format(Len(m_sDescription), "0000000000")) sData = Replace(sData, "bbbbbbbbbb", Format(Len(sData), "0000000000")) sData = Replace(sData, "cccccccccc", Format(Len(m_sDescription & _ sContextStart), "0000000000")) sData = Replace(sData, "dddddddddd", Format(Len(m_sDescription & _ sContextStart & sHtmlFragment), "0000000000")) 'Add the HTML code to the clipboard If CBool(OpenClipboard(0)) Then Dim hMemHandle As Long, lpData As Long hMemHandle = GlobalAlloc(0, Len(sData) + 10) If CBool(hMemHandle) Then lpData = GlobalLock(hMemHandle) If lpData <> 0 Then CopyMemory ByVal lpData, ByVal sData, Len(sData) HTMLText = sData GlobalUnlock hMemHandle EmptyClipboard SetClipboardData m_cfHTMLClipFormat, hMemHandle End If End If Call CloseClipboard End If End Sub Public Function DLLGetHTMLClipboard() As String Dim sData As String If RegisterCF = 0 Then Exit Function If CBool(OpenClipboard(0)) Then Dim hMemHandle As Long, lpData As Long Dim nClipSize As Long GlobalUnlock hMemHandle 'Retrieve the data from the clipboard hMemHandle = GetClipboardData(m_cfHTMLClipFormat) If CBool(hMemHandle) Then lpData = GlobalLock(hMemHandle) If lpData <> 0 Then nClipSize = lstrlen(lpData) sData = String(nClipSize + 10, 0) Call CopyMemory(ByVal sData, ByVal lpData, nClipSize) Dim nStartFrag As Long, nEndFrag As Long Dim nIndx As Long 'If StartFragment appears in the data's description, 'then retrieve the offset specified in the description 'for the start of the fragment. Likewise, if EndFragment 'appears in the description, then retrieve the 'corresponding offset. nIndx = InStr(sData, "StartFragment:") If nIndx Then nStartFrag = CLng(Mid(sData, _ nIndx + Len("StartFragment:"), 10)) End If nIndx = InStr(sData, "EndFragment:") If nIndx Then nEndFrag = CLng(Mid(sData, nIndx + Len("EndFragment:"), 10)) End If 'Return the fragment given the starting and ending 'offsets If (nStartFrag > 0 And nEndFrag > 0) Then DLLGetHTMLClipboard = Mid(sData, nStartFrag + 1, _ (nEndFrag - nStartFrag)) End If End If End If Call CloseClipboard End If End Function
]
></o