4

私は良い週のためにこれと戦ってきました。文字列ポインターを DLL 関数に渡すときに問題があります。

バックグラウンド

Office 2003 から Office 2010 への移行を開始したばかりです。今後数年間 Office 2003 のみを使用し続ける人もいます。Office 2010 64 ビットを使用する人もいます (理由はわかりませんが、それは別の話題です)。

私にとっては、すべてのバージョンで動作するコードを作成する必要があります。数年前にインターネットでこの機能を見つけて使用していました。ライブラリを書き直そうとしたとき、Unicode 呼び出しと ANSI 呼び出しが完全に混在していることに気付きました..そして、関数は Access 2010 では完全に機能しませんでした。私は近いと思いますが、dll 呼び出しが適切な値を返していないことに気付きました。

問題を解決するために私が行ったこと

  • ByRef および ByVal パラメータの受け渡しについて確認しました。
  • varptr() と strptr() の違いについて読みました。私はそれらを正しく使用していると信じています。
  • を文字列として宣言しようとしましたが、64 ビット システムまたは Unicode システムでどのように実行されるかがわからないため、このアプローチには不快です。
    • ポインターを操作する場合 - そのような見落としによりクラッシュし、DB が破損する可能性があります
    • ポインターを使用すると、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 を使用するようになっているため、文字列がメモリ内に 1 バイト文字として格納されているかどうかを心配する必要はありません。このため、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)

明らかに、この抽象化をさらに一歩進めることができます。

モジュールを用意し、すべてdeclareの をそこに置き、それらを非公開にします。
次に、そのモジュールにパブリック関数をdeclared 関数 (つまりPublic Function PathSkipRoot (...) As String、Public Function PathRemoveBackslash (...) As Stringなど) ごとに 1 つ用意し、それらのパブリック ラッパーのそれ​​ぞれにdeclareを使用して d 関数を呼び出すようにしWrappedStringます。
その後、コードの残りの部分では、プレーンStringバージョンの関数のみが表示されます。

于 2012-05-01T19:48:31.353 に答える