4

我已经为此奋斗了一周。将字符串指针传递给 DLL 函数时遇到困难。

背景

我们刚刚开始从 Office 2003 迁移到 Office 2010。在接下来的几年中，有些人将继续只使用 Office 2003。有些人将使用 Office 2010 64 位（为什么我不知道 - 但这是一个不同的主题）。

对我来说 - 我需要编写一些适用于所有版本的代码。几年前我在互联网上发现了这个功能并正在使用它。当我对我的库进行重写时，我注意到 Unicode 与 ANSI 调用完全混合在一起......并且该函数完全无法在 Access 2010 上运行。所以我去重写它。我想我很接近 - 但我注意到 dll 调用没有返回正确的值。

我为解决问题所做的一切

  • 我确保我阅读了 ByRef 和 ByVal 参数传递。
  • 我已经阅读了 varptr() 和 strptr() 之间的区别。我相信我正确地使用它们。
  • 我尝试将声明为字符串，但对这种方法感到不舒服，因为我不确定它将如何在 64 位系统或 Unicode 系统上发挥作用。
    • 使用指针时 - 此类疏忽会崩溃并可能损坏数据库
    • 使用指针意味着我不必在 Unicode 之间进行转换——它要么是 Unicode，要么不是——并且条件编译语句确保引用了正确的函数。

简短摘要示例

Public Sub foo()
   Dim strA As String
   Dim strCB As String
#If VB7 Then
   Dim lptstrA As LongPtr
   Dim lResult As LongPtr
#Else
   Dim lptstrA As Long
   Dim lResult As Long
#End If  
   
   strA = "T:\TEST\"
   lptstrA = StrPtr(strA)
   strCB = String$(255, vbNullChar)

   lResult = PathIsNetworkPath(lptstrA)
#If UNICODE Then
   CopyMemory StrPtr(strCB), lptstrA, (Len(strA))
#Else
   CopyMemory StrPtr(strCB), lptstrA, (Len(strA) * 2)
#End If
   Debug.Print "Returned: " & lResult
   Debug.Print "Buffer: " & strCB
   Debug.Print "Result: " & strA
End Sub

在我看来，这应该有效。我将指针传递给字符串。但...

结果

foo
返回：0
缓冲区：T:\TEST\
结果：T:\TEST\

所以函数返回零......它应该返回1。但是如果我们检查指针处的内存内容 - 它显然有数据。

完整代码

（不工作）

Option Explicit
'
' WNetGetConnection Return Result Constants
Private Const ERROR_SUCCESS As Long = 0&
Private Const ERROR_BAD_DEVICE As Long = 1200&
Private Const ERROR_NOT_CONNECTED = 2250&
Private Const ERROR_MORE_DATA = 234&
Private Const ERROR_CONNECTION_UNAVAIL = 1201&
Private Const ERROR_NO_NETWORK = 1222&
Private Const ERROR_EXTENDED_ERROR = 1208&
Private Const ERROR_NO_NET_OR_BAD_PATH = 1203&
'
' WNetGetConnection function retrieves the name of the network resource
' associated with a local device.
'   > msdn.microsoft.com/en-us/library/windows/desktop/aa385453(v=vs.85).aspx
'   - If the function succeeds, the return value is NO_ERROR.
'   - If the function fails, the return value is a system error code, such as
'     one of the following values.
'
' PathIsUNC function determines if the string is a valid Universal Naming
' Convention (UNC) for a server and share path.
'   > msdn.microsoft.com/en-us/library/windows/desktop/bb773712(v=vs.85).aspx
'   - Returns TRUE if the string is a valid UNC path, or FALSE otherwise.
'
' PathIsNetworkPath function determines whether a path string represents a
' network resource.
'   > msdn.microsoft.com/en-us/library/windows/desktop/bb773640(v=vs.85).aspx
'   - Returns TRUE if the string represents a network resource, or FALSE
'     otherwise.
'
' PathStripToRoot function removes all parts of the path except for the root
' information.
'   > msdn.microsoft.com/en-us/library/windows/desktop/bb773757(v=vs.85).aspx
'   - Returns TRUE if a valid drive letter was found in the path, or FALSE
'     otherwise.
'
' PathSkipRoot function parses a path, ignoring the drive letter or Universal
' Naming Convention (UNC) server/share path elements.
'   > msdn.microsoft.com/en-us/library/windows/desktop/bb773754(v=vs.85).aspx
'   - Returns the address of the beginning of the subpath that follows the root
'     (drive letter or UNC server/share).
'
' PathRemoveBackslash function removes the trailing backslash from a given
' path.
'   > msdn.microsoft.com/en-us/library/windows/desktop/bb773743(v=vs.85).aspx
'   - Returns the address of the NULL that replaced the backslash, or the
'     address of the last character if it's not a backslash.


' For Access 2010 64-Bit Support, as well as backward compatibility
#If VBA7 Then

  #If UNICODE Then

    Public Declare PtrSafe Function WNetGetConnection _
                   Lib "mpr.dll" Alias "WNetGetConnectionW" ( _
                                  ByVal lpLocalName As LongPtr, _
                                  ByVal lpRemoteName As LongPtr, _
                                  lpnLength As Long _
                                 ) As Long

    Public Declare PtrSafe Function PathIsUNC _
                   Lib "shlwapi.dll" Alias "PathIsUNCW" ( _
                                  ByVal pszPath As LongPtr _
                                 ) As Long

    Public Declare PtrSafe Function PathIsNetworkPath _
                   Lib "shlwapi.dll" Alias "PathIsNetworkPathW" ( _
                                  ByVal pszPath As LongPtr _
                                 ) As Long

    Public Declare PtrSafe Function PathStripToRoot _
                   Lib "shlwapi.dll" Alias "PathStripToRootW" ( _
                                  ByVal pPath As LongPtr _
                                 ) As Long

    Public Declare PtrSafe Function PathSkipRoot _
                   Lib "shlwapi.dll" Alias "PathSkipRootW" ( _
                                  ByVal pPath As LongPtr _
                                 ) As Long

    Public Declare PtrSafe Function PathRemoveBackslash _
                   Lib "shlwapi.dll" Alias "PathRemoveBackslashW" ( _
                                  ByVal strPath As LongPtr _
                                 ) As LongPtr

    Public Declare PtrSafe Function lStrLen _
                   Lib "kernel32" Alias "lstrlenW" ( _
                                  ByVal lpString as longptr _
                                 ) As Integer
  #Else

    Public Declare PtrSafe Function WNetGetConnection _
                   Lib "mpr.dll" Alias "WNetGetConnectionA" ( _
                                  ByVal lpLocalName As LongPtr, _
                                  ByVal lpRemoteName As LongPtr, _
                                  ByVal lpnLength As Long _
                                 ) As Long

    Public Declare PtrSafe Function PathIsUNC _
                   Lib "shlwapi.dll" Alias "PathIsUNCA" ( _
                                  ByVal pszPath As LongPtr _
                                 ) As Long

    Public Declare PtrSafe Function PathIsNetworkPath _
                   Lib "shlwapi.dll" Alias "PathIsNetworkPathA" ( _
                                  ByVal pszPath As LongPtr _
                                 ) As Long

    Public Declare PtrSafe Function PathStripToRoot _
                   Lib "shlwapi.dll" Alias "PathStripToRootA" ( _
                                  ByVal pPath As LongPtr _
                                 ) As Long

    Public Declare PtrSafe Function PathSkipRoot _
                   Lib "shlwapi.dll" Alias "PathSkipRootA" ( _
                                  ByVal pPath As LongPtr _
                                 ) As Long

    Public Declare PtrSafe Function PathRemoveBackslash _
                   Lib "shlwapi.dll" Alias "PathRemoveBackslashA" ( _
                                  ByVal strPath As LongPtr _
                                 ) As LongPtr

    Public Declare PtrSafe Function lStrLen _
                   Lib "kernel32" Alias "lstrlenA" ( _
                                  ByVal lpString As LongPtr _
                                 ) As Integer

  #End If

  Public Declare Sub CopyMemory _
                 Lib "kernel32" Alias "RtlMoveMemory" ( _
                                ByVal Destination As LongPtr, _
                                ByVal Source As LongPtr, _
                                ByVal Length As Long _
                               )

#Else

  #If UNICODE Then

    Public Declare Function WNetGetConnection _
                   Lib "mpr.dll" Alias "WNetGetConnectionW" ( _
                                  ByVal lpLocalName As Long, _
                                  ByVal lpRemoteName As Long, _
                                  lpnLength As Long _
                                 ) As Long

    Public Declare Function PathIsUNC _
                   Lib "shlwapi.dll" Alias "PathIsUNCW" ( _
                                  ByVal pszPath As Long _
                                 ) As Long

    Public Declare Function PathIsNetworkPath _
                   Lib "shlwapi.dll" Alias "PathIsNetworkPathW" ( _
                                  ByVal pszPath As Long _
                                 ) As Long

    Public Declare Function PathStripToRoot _
                   Lib "shlwapi.dll" Alias "PathStripToRootW" ( _
                                  ByVal pPath As Long _
                                 ) As Long

    Public Declare Function PathSkipRoot _
                   Lib "shlwapi.dll" Alias "PathSkipRootW" ( _
                                  ByVal pPath As Long _
                                 ) As Long

    Public Declare Function PathRemoveBackslash _
                   Lib "shlwapi.dll" Alias "PathRemoveBackslashW" ( _
                                  ByVal strPath As Long _
                                 ) As Long

    Public Declare Function lStrLen _
                   Lib "kernel32" Alias "lstrlenW" ( _
                                  ByVal lpString As Long _
                                 ) As Integer
 #Else

    Public Declare Function WNetGetConnection _
                   Lib "mpr.dll" Alias "WNetGetConnectionA" ( _
                                  ByVal lpLocalName As Long, _
                                  ByVal lpRemoteName As Long, _
                                  ByVal lpnLength As Long _
                                 ) As Long

    Public Declare Function PathIsUNC _
                   Lib "shlwapi.dll" Alias "PathIsUNCA" ( _
                                  ByVal pszPath As Long _
                                 ) As Long

    Public Declare Function PathIsNetworkPath _
                   Lib "shlwapi.dll" Alias "PathIsNetworkPathA" ( _
                                  ByVal pszPath As Long _
                                 ) As Long

    Public Declare Function PathStripToRoot _
                   Lib "shlwapi.dll" Alias "PathStripToRootA" ( _
                                  ByVal pPath As Long _
                                 ) As Long

    Public Declare Function PathSkipRoot _
                   Lib "shlwapi.dll" Alias "PathSkipRootA" ( _
                                  ByVal pPath As Long _
                                 ) As Long

    Public Declare Function PathRemoveBackslash _
                   Lib "shlwapi.dll" Alias "PathRemoveBackslashA" ( _
                                  ByVal strPath As Long _
                                 ) As Long

    Public Declare Function lStrLen _
                   Lib "kernel32" Alias "lstrlenA" ( _
                                  ByVal lpString As Long _
                                 ) As Integer

  #End If

  Public Declare Sub CopyMemory _
                   Lib "kernel32" Alias "RtlMoveMemory" ( _
                                  ByVal Destination As Long, _
                                  ByVal Source As Long, _
                                  ByVal Length As Long _
                                 )

#End If

Public Function GetUncPath(tsLocal As String) As String  
   Dim tsRoot As String  
   Dim tsPath As String  
   Dim tsRemoteRoot As String  
   Dim tsRemote As String  
   Dim tcbTemp As String  
   #If VBA7 Then  
     Dim lptsLocal As LongPtr  
     Dim lptsRoot As LongPtr  
     Dim lptsPath As LongPtr  
     Dim lptsRemote As LongPtr  
     Dim lptcbTemp As LongPtr  
     Dim lpResult As LongPtr  
   #Else  
     Dim lptsLocal As Long  
     Dim lptsRoot As Long  
     Dim lptsPath As Long  
     Dim lptsRemote As Long  
     Dim lptcbTemp As Long  
     Dim lpResult As Long  
   #End If  
   Dim lResult As Long  

   ' Initialize strings.   Since Strings are essentially a pointer to  
   ' a pointer, we use StrPtr() instead of VarPtr()  
   '  
   tsLocal = tsLocal & vbNullChar       ' Just in case  
   tsRoot = String(255, vbNullChar)     ' Path Root / Drive Letter  
   tsPath = String(255, vbNullChar)     ' Path Without Root  
   tsRemote = String(255, vbNullChar)   ' Remote Path + Root, Resolved  
   tcbTemp = String(255, vbNullChar)    ' Temporary Copy Buffer  
   lptsLocal = StrPtr(tsLocal)          ' Pointer to Local Path  
   lptsRoot = StrPtr(tsRoot)            ' Pointer to Root  
   lptsPath = StrPtr(tsPath)            ' Pointer to Path  
   lptsRemote = StrPtr(tsRemote)        ' Pointer to Remote  

   ' Check is already in UNC Format  
   lResult = PathIsUNC(lptsLocal)  
   If (lResult <> 0) Then  
     GetUncPath = tsLocal
     Exit Function
   End If

   ' Check if its a local path or network.  If Local - use that path.
   lResult = PathIsNetworkPath(lptsLocal)  
>! PathIsNetworkPath(lptsLocal) always returns 0
   If lResult = 0 Then
     GetUncPath = tsLocal
     Exit Function
   End If

   ' Extract our root from path (ie. Drive letter)
   ' ### lStrLen(lptsLocal returns 1 ??  ###
   CopyMemory lptsRoot, lptsLocal, lStrLen(lptsLocal) 
>! lStrLen(lptsLocal) always returns 1 -- unsure why
   lResult = PathStripToRoot(lptsRoot)
   If (lResult = 0) Then
     ' An error has occurred
     GetUncPath = ""
     Exit Function
    End If

   ' Strip Backslash
   lpResult = PathRemoveBackslash(lptsRoot)

   ' Find our Path portion
   CopyMemory lptsPath, lptsLocal, lStrLen(lptsLocal)
   lptsPath = PathSkipRoot(lptsPath)

   ' Strip Backslash
   lpResult = PathRemoveBackslash(lptsPath)

   ' Convert our Root to a UNC Network format
   lResult = WNetGetConnection(lptsRemote, lptsRoot, lStrLen(lptsRoot))
   If lResult = ERROR_SUCCESS Then
     tsRemote = tsRemote & tsPath     ' Add Remote + Path to build UNC path
     GetUncPath = tsRemote            ' Return resolved path
   Else
     ' Errors have occurred
     GetUncPath = ""
   End If
End Function

我错过了什么？

4

2 回答 2

2

这是我想出的最终产品 - 随时提出批评意见。

正如 Gserg 所指出的，我不需要担心字符串是否在内存中存储为单字节字符，因为现在每台现代计算机都将使用 Unicode。因此，我能够消除使用 CopyMemory 函数并改用指针算法。

我选择不使用对象工厂包装器，而是自己控制类初始化。

这已经在 Access 2003 和 Access 2010 上进行了测试。它兼容 32 位和 64 位。

模块：GetUNC

Option Compare Database
Option Explicit

#If VBA7 Then
  Private Declare PtrSafe Function WNetGetConnection Lib "mpr.dll" Alias "WNetGetConnectionW" (ByVal lpLocalName As LongPtr, ByVal lpRemoteName As Long, lpnLength As Long) As Long
  Private Declare PtrSafe Function PathIsUNC Lib "shlwapi.dll" Alias "PathIsUNCW" (ByVal pszPath As LongPtr) As Long
  Private Declare PtrSafe Function PathIsNetworkPath Lib "shlwapi.dll" Alias "PathIsNetworkPathW" (ByVal pszPath As LongPtr) As Long
  Private Declare PtrSafe Function PathStripToRoot Lib "shlwapi.dll" Alias "PathStripToRootW" (ByVal pPath As LongPtr) As LongPtr
  Private Declare PtrSafe Function PathSkipRoot Lib "shlwapi.dll" Alias "PathSkipRootW" (ByVal pPath As LongPtr) As Long
  Private Declare PtrSafe Function PathRemoveBackslash Lib "shlwapi.dll" Alias "PathRemoveBackslashW" (ByVal strPath As LongPtr) As LongPtr
#Else
  Private Declare Function WNetGetConnection Lib "mpr.dll" Alias "WNetGetConnectionW" (ByVal lpLocalName As Long, ByVal lpRemoteName As Long, lpnLength As Long) As Long
  Private Declare Function PathIsUNC Lib "shlwapi.dll" Alias "PathIsUNCW" (ByVal pszPath As Long) As Long
  Private Declare Function PathIsNetworkPath Lib "shlwapi.dll" Alias "PathIsNetworkPathW" (ByVal pszPath As Long) As Long
  Private Declare Function PathStripToRoot Lib "shlwapi.dll" Alias "PathStripToRootW" (ByVal pPath As Long) As Long
  Private Declare Function PathSkipRoot Lib "shlwapi.dll" Alias "PathSkipRootW" (ByVal pPath As Long) As Long
  Private Declare Function PathRemoveBackslash Lib "shlwapi.dll" Alias "PathRemoveBackslashW" (ByVal strPath As Long) As Long
#End If

Public Function GetUNCPath(sLocalPath As String) As String
  Dim lResult As Long
#If VBA7 Then
  Dim lpResult As LongPtr
#Else
  Dim lpResult As Long
#End If
  Dim ASLocal As APIString
  Dim ASPath As APIString
  Dim ASRoot As APIString
  Dim ASRemoteRoot As APIString
  Dim ASTemp As APIString

  Set ASLocal = New APIString
  ASLocal.Value = sLocalPath

  If ASLocal.Pointer > 0 Then
    lResult = PathIsUNC(ASLocal.Pointer)
  End If
  If lResult <> 0 Then
    GetUNCPath = ASLocal.Value
    Exit Function
  End If

  If ASLocal.Pointer > 0 Then
    lResult = PathIsNetworkPath(ASLocal.Pointer)
  End If
  If lResult = 0 Then
    GetUNCPath = ASLocal.Value
    Exit Function
  End If

  ' Extract Root
  Set ASRoot = New APIString
  ASRoot.Value = sLocalPath
  If ASRoot.Length = 2 And Mid(ASRoot.Value, 2, 1) = ":" Then
    ' We have a Root with no Path
    Set ASPath = New APIString
    ASPath.Value = ""
  Else
    If ASRoot.Pointer > 0 Then
      lpResult = PathStripToRoot(ASRoot.Pointer)
    End If
    ASRoot.TruncToNull
    If ASRoot.Pointer > 0 And Mid(ASRoot.Value, ASRoot.Length) = "\" Then
      lpResult = PathRemoveBackslash(ASRoot.Pointer)
      ASRoot.TruncToPointer lpResult
    End If

    ' Extract Path
    Set ASPath = New APIString
    ASPath.Value = sLocalPath
    lpResult = PathSkipRoot(ASPath.Pointer)
    ASPath.TruncFromPointer lpResult
    If ASPath.Length > 0 Then
      If ASPath.Pointer > 0 And Mid(ASPath.Value, ASPath.Length) = "\" Then
        lpResult = PathRemoveBackslash(ASPath.Pointer)
        ASPath.TruncToPointer lpResult
      End If
    End If
  End If

  ' Resolve Local Root into Remote Root
  Set ASRemoteRoot = New APIString
  ASRemoteRoot.Init 255
  If ASRoot.Pointer > 0 And ASRemoteRoot.Pointer > 0 Then
    lResult = WNetGetConnection(ASRoot.Pointer, ASRemoteRoot.Pointer, LenB(ASRemoteRoot.Value))
  End If
  ASRemoteRoot.TruncToNull

  GetUNCPath = ASRemoteRoot.Value & ASPath.Value
End Function

类模块：APIString

Option Compare Database
Option Explicit

 Private sBuffer As String

 Private Sub Class_Initialize()
   sBuffer = vbNullChar
 End Sub

 Private Sub Class_Terminate()
   sBuffer = ""
 End Sub

 Public Property Get Value() As String
   Value = sBuffer
 End Property

 Public Property Let Value(ByVal sNewStr As String)
   sBuffer = sNewStr
 End Property

 ' Truncates Length
#If VBA7 Then
  Public Sub TruncToPointer(ByVal lpNewUBound As LongPtr)
#Else
  Public Sub TruncToPointer(ByVal lpNewUBound As Long)
#End If
   Dim lpDiff As Long
   If lpNewUBound <= StrPtr(sBuffer) Then Exit Sub
   lpDiff = (lpNewUBound - StrPtr(sBuffer)) \ 2
   sBuffer = Mid(sBuffer, 1, lpDiff)
 End Sub

 ' Shifts Starting Point forward
#If VBA7 Then
 Public Sub TruncFromPointer(ByVal lpNewLBound As LongPtr)
#Else
 Public Sub TruncFromPointer(ByVal lpNewLBound As Long)
#End If
   Dim lDiff As Long
   If lpNewLBound <= StrPtr(sBuffer) Then Exit Sub
   If lpNewLBound >= (StrPtr(sBuffer) + LenB(sBuffer)) Then
     sBuffer = ""
     Exit Sub
   End If
   lDiff = (lpNewLBound - StrPtr(sBuffer)) \ 2
   sBuffer = Mid(sBuffer, lDiff)
 End Sub

 Public Sub Init(Size As Long)
   sBuffer = String(Size, vbNullChar)
 End Sub

Public Sub TruncToNull()
  Dim lPos As Long
  lPos = InStr(sBuffer, vbNullChar)
  If lPos = 0 Then Exit Sub
  sBuffer = Mid(sBuffer, 1, lPos - 1)
End Sub

Public Property Get Length() As Long
  Length = Len(sBuffer)
End Property

#If VBA7 Then
 Public Property Get Pointer() As LongPtr
#Else
 Public Property Get Pointer() As Long
#End If
   Pointer = StrPtr(sBuffer)
 End Property

感谢您的帮助。

于 2012-05-10T16:41:11.823 回答
1

所以你所做的就是假装字符串总是指针的一点抽象（嗯......实际上，这是一个反向抽象来删除指针是字符串的内置抽象）。

您现在需要一种简单的方法来使用该抽象。

上课，WrappedString（未测试，没有 Office 2010）：

Option Explicit

Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)

Private buf() As Byte

Friend Sub Init(s As String)
  Dim len_of_s_in_bytes As Long
  len_of_s_in_bytes = LenB(s)

  If len_of_s_in_bytes = 0 Then Exit Sub

  #If UNICODE Then
    ReDim b(1 To len_of_s_in_bytes + 2) 'Adding the null terminator
    CopyMemory b(LBound(b)), ByVal StrPtr(s), len_of_s_in_bytes
  #Else
    b = StrConv(s & vbNullChar, vbFromUnicode)
  #End If

End Sub

#If VB7 Then
Public Property Get Pointer() As LongPtr
  Pointer = VarPtr(b(LBound(b)))
End Property
#Else
Public Property Get Pointer() As Long
  Pointer = VarPtr(b(LBound(b)))
End Property
#End If

为什么你需要一个类而不仅仅是一个转换函数：避免内存泄漏。需要释放分配的指针，类析构函数会处理这个问题。

然后在一个模块中有一个构造函数：

Public Function ToWrappedString(s As String) As WrappedString
  Set ToWrappedString = New WrappedString
  ToWrappedString.Init s
End Function

然后你可以调用你的函数：

lResult = PathIsNetworkPath(ToWrappedString("T:\TEST\").Pointer)

显然，您可以将这个抽象更进一步：

有一个模块，把你所有的declares 放在那里并将它们设为私有。
然后在该模块中具有公共函数，每个declared 函数（即Public Function PathSkipRoot (...) As String等）一个公共函数Public Function PathRemoveBackslash (...) As String，并使每个公共包装器declare使用 d 调用 d 函数WrappedString。
然后其余代码将只看到String函数的普通版本。

于 2012-05-01T19:48:31.353 回答