debaser003
Programmer
I would like to find the local path (C:\folder\folder\file) of a unc path of a shared file or folder (\\computer\share\folder\file).
I have come across two examples of code that get the job done in win2000, winnt and winxp, but none that do it in win95 and win98.
The code found for nt machines is as follows:
Dim sLocalPath as string
sLocalPath=GetLocalPath("MYDomain","ServerWhereTheUncPointsTo","\\Server\DatabaseShare")
'sLocalPath should hold the local path for UNC Share, this works even if its executing against itself
Function GetLocalPath(sDomName As String, sServer As String, sUNCShare As String) As String
Dim Fserver As IADsContainer
Dim Share As IADsFileShare
If Left(sServer, 2) = "\\" Then sServer = Mid(sServer, 3)
Set Fserver = GetObject("WinNT://" & sDomName & "/" & sServer & "/lanmanserver")
' Enumerate existing shares
For Each Share In Fserver
If Share.Class = "FileShare" Then
sShareName = Share.Name
sFullShare = "\\" & sServer & "\" & sShareName
If UCase(sFullShare) = UCase(sUNCShare) Then
GetLocalPath = Share.Path
End If
End If
sShareName = ""
sFullShare = ""
sLocalPath = ""
Next Share
Set Fserver = Nothing
End Function
---- and also ----
Private Type MungeLong
x As Long
Dummy As Integer
End Type
Private Type MungeInt
XLo As Integer
XHi As Integer
Dummy As Integer
End Type
Private Declare Function NetShareGetInfo Lib "NETAPI32" _
(ByRef ServerName As Byte, _
ByRef NetName As Byte, _
ByVal Level As Long, _
ByRef buffer As Long) As Long
Private Declare Function NetAPIBufferFree Lib "netapi32.dll" _
Alias "NetApiBufferFree" (bufptr As Any) As Long
Private Declare Function PtrToInt Lib "kernel32" Alias "lstrcpynW" _
(RetVal As Any, ByVal Ptr As Long, _
ByVal nCharCount As Long) As Long
Private Declare Function PtrToStr Lib "kernel32" Alias "lstrcpyW" _
(RetVal As Byte, ByVal Ptr As Long) As Long
Private Declare Function StrLen Lib "kernel32" Alias "lstrlenW" _
(ByVal Ptr As Long) As Long
Public Function GetLocalPath(sUNCPath As String) As String
Dim sTemp As String
Dim sServer As String
Dim sShare As String
Dim baServer() As Byte
Dim baShare() As Byte
Dim Result As Long
Dim Buf As Long
Dim TempStr As MungeInt
Dim TempPtr As MungeLong
Dim STRArray(0 To 255) As Byte
Dim sBasePath As String
sTemp = Mid(sUNCPath, 3)
sServer = Left(sTemp, InStr(1, sTemp, "\") - 1)
sTemp = Mid(sTemp, InStr(1, sTemp, "\") + 1)
If InStr(1, sTemp, "\") > 0 Then
sShare = Left(sTemp, InStr(1, sTemp, "\") - 1)
sTemp = Mid(sTemp, InStr(1, sTemp, "\"))
Else
sShare = sTemp
sTemp = ""
End If
baServer = "\\" & sServer & Chr(0)
baShare = UCase(sShare) & Chr(0)
Result = NetShareGetInfo(baServer(0), baShare(0), 2, Buf)
mvarLastError = Result
If Result = 0 Then
Result = PtrToInt(TempStr.XLo, Buf + 24, 2)
Result = PtrToInt(TempStr.XHi, Buf + 26, 2)
LSet TempPtr = TempStr
Result = PtrToStr(STRArray(0), TempPtr.x)
sBasePath = Left(STRArray, StrLen(TempPtr.x))
Result = NetAPIBufferFree(Buf)
Server = sServer
GetLocalPath = sBasePath & sTemp
End If
End Function
----
I would like to make my application accessible to windows 95 and 98 machines. Does anyone know a way to do this with full compatibility?
Thanks!
I have come across two examples of code that get the job done in win2000, winnt and winxp, but none that do it in win95 and win98.
The code found for nt machines is as follows:
Dim sLocalPath as string
sLocalPath=GetLocalPath("MYDomain","ServerWhereTheUncPointsTo","\\Server\DatabaseShare")
'sLocalPath should hold the local path for UNC Share, this works even if its executing against itself
Function GetLocalPath(sDomName As String, sServer As String, sUNCShare As String) As String
Dim Fserver As IADsContainer
Dim Share As IADsFileShare
If Left(sServer, 2) = "\\" Then sServer = Mid(sServer, 3)
Set Fserver = GetObject("WinNT://" & sDomName & "/" & sServer & "/lanmanserver")
' Enumerate existing shares
For Each Share In Fserver
If Share.Class = "FileShare" Then
sShareName = Share.Name
sFullShare = "\\" & sServer & "\" & sShareName
If UCase(sFullShare) = UCase(sUNCShare) Then
GetLocalPath = Share.Path
End If
End If
sShareName = ""
sFullShare = ""
sLocalPath = ""
Next Share
Set Fserver = Nothing
End Function
---- and also ----
Private Type MungeLong
x As Long
Dummy As Integer
End Type
Private Type MungeInt
XLo As Integer
XHi As Integer
Dummy As Integer
End Type
Private Declare Function NetShareGetInfo Lib "NETAPI32" _
(ByRef ServerName As Byte, _
ByRef NetName As Byte, _
ByVal Level As Long, _
ByRef buffer As Long) As Long
Private Declare Function NetAPIBufferFree Lib "netapi32.dll" _
Alias "NetApiBufferFree" (bufptr As Any) As Long
Private Declare Function PtrToInt Lib "kernel32" Alias "lstrcpynW" _
(RetVal As Any, ByVal Ptr As Long, _
ByVal nCharCount As Long) As Long
Private Declare Function PtrToStr Lib "kernel32" Alias "lstrcpyW" _
(RetVal As Byte, ByVal Ptr As Long) As Long
Private Declare Function StrLen Lib "kernel32" Alias "lstrlenW" _
(ByVal Ptr As Long) As Long
Public Function GetLocalPath(sUNCPath As String) As String
Dim sTemp As String
Dim sServer As String
Dim sShare As String
Dim baServer() As Byte
Dim baShare() As Byte
Dim Result As Long
Dim Buf As Long
Dim TempStr As MungeInt
Dim TempPtr As MungeLong
Dim STRArray(0 To 255) As Byte
Dim sBasePath As String
sTemp = Mid(sUNCPath, 3)
sServer = Left(sTemp, InStr(1, sTemp, "\") - 1)
sTemp = Mid(sTemp, InStr(1, sTemp, "\") + 1)
If InStr(1, sTemp, "\") > 0 Then
sShare = Left(sTemp, InStr(1, sTemp, "\") - 1)
sTemp = Mid(sTemp, InStr(1, sTemp, "\"))
Else
sShare = sTemp
sTemp = ""
End If
baServer = "\\" & sServer & Chr(0)
baShare = UCase(sShare) & Chr(0)
Result = NetShareGetInfo(baServer(0), baShare(0), 2, Buf)
mvarLastError = Result
If Result = 0 Then
Result = PtrToInt(TempStr.XLo, Buf + 24, 2)
Result = PtrToInt(TempStr.XHi, Buf + 26, 2)
LSet TempPtr = TempStr
Result = PtrToStr(STRArray(0), TempPtr.x)
sBasePath = Left(STRArray, StrLen(TempPtr.x))
Result = NetAPIBufferFree(Buf)
Server = sServer
GetLocalPath = sBasePath & sTemp
End If
End Function
----
I would like to make my application accessible to windows 95 and 98 machines. Does anyone know a way to do this with full compatibility?
Thanks!