对lstrlenA或lstrlenW的调用返回了意外的值 [英] Calls to lstrlenA or lstrlenW are returning unexpected values

问题描述

摘要::在Excel VBA中，我有一个从剪贴板中获取CF_TEXT的函数，以及另一个用于CF_UNICODETEXT的函数.我使用 lstrlenA / lstrlenW 来获取字符串的长度，但是从这些调用中我得到了意外的结果.我需要帮助来了解原因.

Summary: In Excel VBA, I've got a function that gets CF_TEXT from the clipboard, and another function for CF_UNICODETEXT. I use lstrlenA / lstrlenW to get the length of the string, but I'm getting unexpected results from those calls. I'd like help to understand why.

详细信息:

在我的函数中，我在打开剪贴板后使用 CopyMemory 来获取字节数组，然后可以将其转换为字符串.我正在为64位Office调整项目，并希望确保涉及 CopyMemory 的所有内容都能正常工作.那让我测试了这些剪贴板功能，这就是我遇到此问题的方式.

Within my functions, I use CopyMemory after opening the clipboard to get a byte array that I can then turn into a string. I'm in the process of adapting the project for 64-bit Office, and wanted to make sure everything involving CopyMemory is working correctly. That got me testing these clipboard functions, which is how I encountered this issue.

在调用 CopyMemory 之前，我先调用 lstrlenA(pMem)/ lstrlenW(pMem)确定要复制多少.但是这些调用返回的长度超出预期.

Before calling CopyMemory, I'm calling lstrlenA(pMem) / lstrlenW(pMem) to determine how much to copy. But these calls are returning unexpected lengths.

以下是其中一项功能(忽略语言环境):

Here's one of the functions (ignoring locales):

Function GetANSITextFromClipboard() As String
    Dim hClip As LongPtr, pMem As LongPtr
    Dim cbText As Integer
    Dim abRetString() As Byte
    Dim RetString As String

    If IsClipboardFormatAvailable(CF_TEXT) Then
        If OpenClipboard(0) Then
            hClip = GetClipboardData(CF_TEXT)
            Dim clipSize As LongPtr         'added to check on mem size vs what's reported by lstrlenW
            clipSize = GlobalSize(hClip)
            pMem = GlobalLock(hClip)
            cbText = lstrlenA(pMem)

            If cbText > 0 Then
                ReDim abRetString(0 To cbText)
                CopyMemory abRetString(0), ByVal pMem, cbText '64-bit: should be good if cbText is right
                'strip terminating null
                If abRetString(UBound(abRetString)) = 0 Then
                    ReDim Preserve abRetString(0 To UBound(abRetString) - 1)
                End If
                RetString = StrConv(abRetString, vbUnicode)
            End If
            GlobalUnlock (hClip)
            CloseClipboard
            GetANSITextFromClipboard = RetString
        End If
    End If
End Function

这些与该函数相关的声明:

These are relevant declares for that function:

Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long 'returns BOOL
Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As LongPtr 'returns HANDLE
Declare PtrSafe Function CloseClipboard Lib "user32" () As Long 'returns BOOL

Declare PtrSafe Function GlobalSize Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr 'returns SIZE_T
Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr 'returns LPVOID
Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As Long  'returns BOOL

Declare PtrSafe Function lstrlenA Lib "kernel32" (ByVal lpString As String) As Long 'returns int

Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
    Destination As Any, _
    Source As Any, _
    ByVal length As LongPtr)

要测试，我将一些内容复制到剪贴板，然后运行以下命令:

To test, I copy something to the clipboard then run this:

Private Sub TestReadClipboard()
    Dim acbfFormats() As CBFormat
    Dim i As Integer
    Dim strPrompt As String
    Dim strBuffer As String

    If GetClipboardFormats(acbfFormats()) Then
        strPrompt = UBound(acbfFormats()) - LBound(acbfFormats()) + 1 & " formats:" & vbCrLf & vbCrLf
        For i = LBound(acbfFormats()) To UBound(acbfFormats())
            strPrompt = strPrompt & acbfFormats(i).uFormat & " = " & acbfFormats(i).name _
                        & " (" & acbfFormats(i).Size & " bytes)" & vbCrLf
        Next
    Else
        strPrompt = "Formats not available."
    End If
    MsgBox strPrompt

    strPrompt = "Plain text: " & GetANSITextFromClipboard & vbCrLf & vbCrLf
    strPrompt = strPrompt & "Unicode text: " & GetUnicodeTextFromClipboard & vbCrLf & vbCrLf
    strPrompt = strPrompt & "Locale: " & Right("00000000" & Hex(GetClipboardLocale), 8)
    MsgBox strPrompt
End Sub

CBFormat 是一个自定义类型，而 GetClipboardFormats 是一个自定义函数，该函数收集有关 CBFormat 数组中格式的详细信息.特别是，通过调用 GlobalSize()来设置每种格式的 CBFormat.size .

CBFormat is a custom type, and GetClipboardFormats is a custom function that collects details about the formats in a CBFormat array. In particular, CBFormat.size for each format is set by calling GlobalSize().

在第一次 MsgBox strPrompt 调用中，我看到的格式符合预期.每种格式的数据大小均符合预期:至少与我复制的文本一样.然后，当我调用 GetANSITextFromClipboard 时，前面看到的大小与 clipSize 相同.

At the first MsgBox strPrompt call, the formats I see are as expected. And the size of data for each format is as expected: at least as long as the text I copied. Then when I call into GetANSITextFromClipboard, the size seen earlier is the same as clipSize.

但是 cbText 始终是错误的.我尝试从不同来源多次复制到剪贴板，并且 lstrlenA 始终返回 13 .在Unicode函数中， lstrlenW 始终返回 7 .

But cbText is consistently wrong. I've tried copying to the clipboard multiple times from different sources, and lstrlenA is always returning 13. In the Unicode function, lstrlenW is always returning 7.

(我不使用 clipSize 作为要复制的长度，因为然后我以null结尾，并在字符串中进行垃圾操作.我可以遍历字节数组以查找null，然后将其重新映射为null，但我不需要.)

(I don't use clipSize as the length to copy because then I end up with null and following garbage in the string. I could walk the byte array looking for null and then redim to that, but I shouldn't need to.)

问题:为什么我对 lstrlenA / lstrlenW 的呼叫无法正常工作?

Question: Why don't my calls to lstrlenA/lstrlenW work?

推荐答案

您对 lstrlenA()的声明是错误的.不要使用 String ，它不是VBA中的8位字符串，而是16位COM

Your declaration of lstrlenA() is wrong. Don't use String, that is not an 8bit string in VBA, it is a 16bit COM BSTR string. Since you are passing a LongPtr from GlobalLock() to lstrlenA(), use LongPtr as the parameter type instead of String. Otherwise, you will just have to scan the byte array manually.

这篇关于对lstrlenA或lstrlenW的调用返回了意外的值的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！