I thought there was a way to do this but I can't remember it. Ho can you convert a UNC path back to a local drive and path (mapped or local). I believe there was an API but I can't find it.
ex. \\server\development converts to Z:\Development
Printable View
I thought there was a way to do this but I can't remember it. Ho can you convert a UNC path back to a local drive and path (mapped or local). I believe there was an API but I can't find it.
ex. \\server\development converts to Z:\Development
That does exactly the OPPOSITE of what I asked for...???
Sorry. :(
How about one of these:
http://vbnet.mvps.org/index.html?cod...ndfilename.htm
http://vbnet.mvps.org/index.html?cod...umresource.htm
I didn't read closely on the first one and these 2 I am somewhat guessing.
Does this help?
http://www.mentalis.org/apilist/208B...6D012A1D2.html
I think I know what Randem wants, something like a reverse share translation. If you have a remote share folder, translate that into the remote systems logical path.
\\servername\sharename <-> C:\Somefolder\sharedfoldername
I have this code in one of my programs. It may take a bit for me to find it cause it may be in sourcesafe. Be back.
Too much editng to make an example from my program. I did find the APIs needed which lead me to find an easy example on allapi.net.
Example Source
VB Code:
'This example was submitted by Lee Carpenter ' 'It needs a class module and a form, with a label (m_lblStatus) on the form 'In the class module (CprgNetShareGetInfo) Option Explicit 'local variable(s) to hold property value(s) Private mvarstrServer As Variant 'local copy Private mvarstrNetName As Variant 'local copy Private mvarnType As Long 'local copy Private mvarstrRemark As Variant 'local copy Private mvarnCurrent_uses As Long 'local copy Private mvarnMax_uses As Long 'local copy Private mvarstrPath As Variant 'local copy Private mvarnLastError As Long 'local copy Private mvarstrLastError As Variant 'local copy Private mvarNET_API_STATUS As Long 'local copy 'local variable(s) to hold internal value(s) ' Private constants, types and declares to call ' Const STYPE_DISKTREE As Long = 0 Const STYPE_PRINTQ As Long = 1 Const STYPE_DEVICE As Long = 2 Const STYPE_IPC As Long = 3 Const STYPE_SPECIAL As Long = &H80000000 Const ERROR_SUCCESS As Long = 0& Const NERR_Success As Long = 0& Const ERROR_ACCESS_DENIED As Long = 5& Const ERROR_INVALID_LEVEL As Long = 124& Const ERROR_INVALID_PARAMETER As Long = 87& Const ERROR_MORE_DATA As Long = 234& Const ERROR_NOT_ENOUGH_MEMORY As Long = 8& Const ERROR_INVALID_NAME As Long = 123& Const NERR_BASE As Long = 2100& Const NERR_NetNameNotFound As Long = (NERR_BASE + 210) Private Type SHARE_INFO_502 shi502_netname As Long ' LPWSTR shi502_netname; shi502_type As Long ' DWORD shi502_type; shi502_remark As Long ' LPWSTR shi502_remark; shi502_permissions As Long ' DWORD shi502_permissions; shi502_max_uses As Long ' DWORD shi502_max_uses; shi502_current_uses As Long ' DWORD shi502_current_uses; shi502_path As Long ' LPWSTR shi502_path; shi502_passwd As Long ' LPWSTR shi502_passwd; shi502_reserved As Long ' DWORD shi502_reserved; shi502_security_descriptor As Long ' PSECURITY_DESCRIPTOR shi502_security_descriptor; End Type 'NET_API_STATUS NET_API_FUNCTION 'NetShareGetInfo ( ' IN LPTSTR servername, ' IN LPTSTR netname, ' IN DWORD level, ' OUT LPBYTE * bufptr ' ); Private Declare Function NetShareGetInfo Lib "Netapi32.dll" _ ( _ strServerName As Any, _ strNetName As Any, _ ByVal nLevel As Long, _ pBuffer As Long _ ) As Long Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _ ( _ Destination As Any, _ ByVal Source As Any, _ ByVal Length As Long _ ) Private Declare Function NetApiBufferFree Lib "Netapi32.dll" _ ( _ ByVal lpBuffer As Long _ ) As Long Private Declare Sub lstrcpyW Lib "kernel32" _ ( _ dest As Any, _ ByVal src As Any _ ) Private Declare Function lstrlenW Lib "kernel32" _ ( _ ByVal lpszString As Any _ ) As Long Continued....
:DVB Code:
Public Property Get NET_API_STATUS() As Long 'used when retrieving value of a property, on the right side of an assignment. 'Syntax: Debug.Print X.NET_API_STATUS NET_API_STATUS = mvarNET_API_STATUS End Property Public Property Get strLastError() As Variant 'used when retrieving value of a property, on the right side of an assignment. 'Syntax: Debug.Print X.strLastError If IsObject(mvarstrLastError) Then Set strLastError = mvarstrLastError Else strLastError = mvarstrLastError End If End Property Public Property Get nLastError() As Long 'used when retrieving value of a property, on the right side of an assignment. 'Syntax: Debug.Print X.nLastError nLastError = mvarnLastError End Property Public Property Get strPath() As Variant 'used when retrieving value of a property, on the right side of an assignment. 'Syntax: Debug.Print X.strPath If IsObject(mvarstrPath) Then Set strPath = mvarstrPath Else strPath = mvarstrPath End If End Property Public Property Get nMax_uses() As Long 'used when retrieving value of a property, on the right side of an assignment. 'Syntax: Debug.Print X.nMax_uses nMax_uses = mvarnMax_uses End Property Public Property Get nCurrent_uses() As Long 'used when retrieving value of a property, on the right side of an assignment. 'Syntax: Debug.Print X.nCurrent_uses nCurrent_uses = mvarnCurrent_uses End Property Public Property Get strRemark() As Variant 'used when retrieving value of a property, on the right side of an assignment. 'Syntax: Debug.Print X.strRemark If IsObject(mvarstrRemark) Then Set strRemark = mvarstrRemark Else strRemark = mvarstrRemark End If End Property Public Property Get nType() As Long 'used when retrieving value of a property, on the right side of an assignment. 'Syntax: Debug.Print X.nType nType = mvarnType End Property Public Property Get strType() As Variant 'used when retrieving value of a property, on the right side of an assignment. 'Syntax: Debug.Print X.strType Select Case mvarnType Case STYPE_DISKTREE strType = "Disk Drive" Case STYPE_PRINTQ strType = "Print Queue" Case STYPE_DEVICE strType = "Communication device" Case STYPE_IPC strType = "Interprocess communication (IPC)" Case STYPE_SPECIAL strType = "Special share" Case Else strType = "Error: Unknown" End Select End Property Public Property Get strNetName() As Variant 'used when retrieving value of a property, on the right side of an assignment. 'Syntax: Debug.Print X.strNetName If IsObject(mvarstrNetName) Then Set strNetName = mvarstrNetName Else strNetName = mvarstrNetName End If End Property Public Property Get strServer() As Variant 'used when retrieving value of a property, on the right side of an assignment. 'Syntax: Debug.Print X.strServer If IsObject(mvarstrServer) Then Set strServer = mvarstrServer Else strServer = mvarstrServer End If End Property Public Sub Initialize() ' Reset the everything ' mvarnLastError = 0 mvarstrLastError = "" mvarstrServer = "" mvarstrNetName = "" mvarnType = 0 mvarstrRemark = "" mvarnCurrent_uses = 0 mvarnMax_uses = 0 mvarstrPath = "" End Sub Public Sub GetInfo(strShareName As Variant) Dim pNetName() As Byte Dim pServer() As Byte Dim ptmpBuffer As Long Dim tmpBuffer As SHARE_INFO_502 Dim strNetName As String Dim x As Integer Call Initialize ' copy the network share name without leading spaces. ' strNetName = LTrim(strShareName) ' check for leading server in the name. ' If Left(strNetName, 2) = "\\" Then ' find the end of the server in the name ' x = InStr(3, strNetName, "\") ' only a server in the name ' If x = 0 Then mvarnLastError = ERROR_INVALID_NAME mvarstrLastError = "Need share name not server name." Exit Sub Else mvarstrServer = Left(strNetName, x - 1) strNetName = Mid(strNetName, x + 1) End If End If ' strip off any remaining leading \ ' If Left(strNetName, 1) = "\" Then strNetName = Mid(strNetName, 2) End If ' Find the end of the share name. ' x = InStr(strNetName, "\") If x > 0 Then strNetName = Left(strNetName, x - 1) End If ' Check for drive letter ' x = InStr(strNetName, ":") If x > 0 Then mvarnLastError = ERROR_INVALID_NAME mvarstrLastError = "Drive letter specified for share name." Exit Sub End If ' Convert the string to a UNI string, happens automatically. ' pNetName = strNetName & vbNullChar If Len(mvarstrServer) > 0 Then ' format the server name ' If Left(mvarstrServer, 2) = "\\" Then pServer = mvarstrServer & vbNullChar Else pServer = "\\" & mvarstrServer & vbNullChar End If ' Get the network infomation on the share. ' mvarNET_API_STATUS = NetShareGetInfo _ ( _ pServer(0), _ pNetName(0), _ 502, _ ptmpBuffer _ ) Else ' Get the network infomation on the share. ' NOTE: the first parameter is the server name, by sending a ' null you are only looking at the current machine. ' mvarNET_API_STATUS = NetShareGetInfo _ ( _ vbEmpty, _ pNetName(0), _ 502, _ ptmpBuffer _ ) End If ' Check for errors. If mvarNET_API_STATUS <> NERR_Success Then Select Case mvarNET_API_STATUS Case ERROR_ACCESS_DENIED mvarstrLastError = "NetShareGetInfo: ERROR_ACCESS_DENIED" Case ERROR_INVALID_LEVEL mvarstrLastError = "NetShareGetInfo: ERROR_INVALID_LEVEL" Case ERROR_INVALID_PARAMETER mvarstrLastError = "NetShareGetInfo: ERROR_INVALID_PARAMETER" Case ERROR_MORE_DATA mvarstrLastError = "NetShareGetInfo: ERROR_MORE_DATA" Case ERROR_NOT_ENOUGH_MEMORY mvarstrLastError = "NetShareGetInfo: ERROR_NOT_ENOUGH_MEMORY" Case ERROR_INVALID_NAME mvarstrLastError = "NetShareGetInfo: ERROR_INVALID_NAME" Case NERR_NetNameNotFound mvarstrLastError = "NetShareGetInfo: NERR_NetNameNotFound" Case Else mvarstrLastError = "NetShareGetInfo: Unknown " & mvarNET_API_STATUS End Select mvarnLastError = mvarNET_API_STATUS Exit Sub End If ' Copy the return buffer to a type definition for processing. Call CopyMemory(tmpBuffer, ptmpBuffer, LenB(tmpBuffer)) ' save the return buffer information. mvarstrNetName = UtoA(tmpBuffer.shi502_netname) mvarnType = tmpBuffer.shi502_type mvarstrRemark = UtoA(tmpBuffer.shi502_remark) mvarnCurrent_uses = tmpBuffer.shi502_current_uses mvarnMax_uses = tmpBuffer.shi502_max_uses mvarstrPath = UtoA(tmpBuffer.shi502_path) ' Free the buffer. mvarNET_API_STATUS = NetApiBufferFree(ptmpBuffer) ' Check for errors. If mvarNET_API_STATUS <> ERROR_SUCCESS Then mvarnLastError = mvarNET_API_STATUS mvarstrLastError = "NetApiBufferFree: Unknown" Exit Sub End If End Sub Private Function UtoA(pUNIstring As Long) As String Dim wrkByte() As Byte Dim wrkStr As String ' Get space for string each character is two bytes and a null terminator. ReDim wrkByte(lstrlenW(pUNIstring) * 2 + 2) ' Copy the string to a byte array Call lstrcpyW(wrkByte(0), pUNIstring) ' Covert the string from a UNI string to a ASCII string. ' this happens automatically when a byte array is copied to a string. wrkStr = wrkByte ' return everything upto the the null terminator. UtoA = Left(wrkStr, InStr(wrkStr, Chr(0)) - 1) End Function 'In a form Option Explicit Private Sub Form_Load() m_lblStatus.Caption = "" ' Good test - admin share TestShareGetInfo "admin$" ' Good test - share with leading slash TestShareGetInfo "\admin$" ' Good test - share with trailing slash TestShareGetInfo "admin$\" ' Good test - share with trailing slash TestShareGetInfo "\admin$\" ' Good test TestShareGetInfo "testdata" ' Good test - should not have server name, but we fix that TestShareGetInfo "\\lee\testdata" ' Good test - should not have server name, but we fix that TestShareGetInfo "\\lee\admin$" ' *** Good test - remote server TestShareGetInfo "\\maggie\admin$" ' *** Bad test - no share TestShareGetInfo "NoShareCalledThis" ' *** Bad test - no remote share TestShareGetInfo "\\maggie\NoShareCalledThis" End Sub Private Sub TestShareGetInfo(strShare As String) Dim x As New CprgNetShareGetInfo m_lblStatus.Caption = m_lblStatus.Caption & "Test Share: " & strShare & " = " x.GetInfo strShare If x.nLastError = 0 Then m_lblStatus.Caption = m_lblStatus.Caption _ & vbCrLf & " Server: " & x.strServer & " Path: " & x.strPath & vbCrLf Else m_lblStatus.Caption = m_lblStatus.Caption & vbCrLf & " Error: " _ & x.nLastError & " " & x.strLastError & vbCrLf End If End Sub
RobDog888,
That's a lot of code... I wrote the routine to do what I needed, but I thought it was just one API long ago...
VB Code:
sPath = TranslatePath("\\192.168.1.100\Shared Folder\Folder\") Private Sub TranslatePath() as String Dim NetInfo As Variant NetInfo = GetNetworkDrives TranslatePath= GetLocalName(sPath, NetInfo) End Sub Public Function GetLocalName(sPath As String, sNet As Variant) Dim i As Long Dim sVar As Variant GetLocalName = sPath For i = LBound(sNet) To UBound(sNet) sVar = Split(sNet(i), ",") If Right(sVar(1), 1) <> "\" Then sVar(1) = sVar(1) & "\" If InStr(sPath, sVar(1)) > 0 Then GetLocalName = sVar(0) & Mid(sPath, Len(sVar(1))) ' Create the Mapped drive and path name Exit For End If Next i End Function Public Function GetNetworkDrives() As Variant Dim hEnum As Long Dim NetInfo(1023) As NETRESOURCE Dim entries As Long Dim nStatus As Long Dim LocalName As String Dim UNCName As String Dim i As Long Dim j As Long Dim r As Long Dim AR() As String ' Modified from Original Code By Randem Systems, INC ' 'KPD-Team 1999 'URL: [url]http://www.allapi.net/[/url] 'E-Mail: [email][email protected][/email] '-> This sample was created by Donald Grover ' Begin the enumeration nStatus = WNetOpenEnum(RESOURCE_CONNECTED, RESOURCETYPE_ANY, 0&, ByVal 0&, hEnum) ' LetterToUNC = DriveLetter 'Check for success from open enum If ((nStatus = 0) And (hEnum <> 0)) Then ' Set number of entries entries = 1024 ' Enumerate the resource nStatus = WNetEnumResource(hEnum, entries, NetInfo(0), CLng(Len(NetInfo(0))) * 1024) ' Check for success If nStatus = 0 Then For i = 0 To entries - 1 ' Get the local name LocalName = "" If NetInfo(i).lpLocalName <> 0 Then LocalName = Space(lstrlen(NetInfo(i).lpLocalName) + 1) r = lstrcpy(LocalName, NetInfo(i).lpLocalName) End If ' Strip null character from end If Len(LocalName) <> 0 Then LocalName = Left(LocalName, (Len(LocalName) - 1)) End If ' Get the remote name UNCName = "" If NetInfo(i).lpRemoteName <> 0 Then UNCName = Space(lstrlen(NetInfo(i).lpRemoteName) + 1) r = lstrcpy(UNCName, NetInfo(i).lpRemoteName) End If ' Strip null character from end If Len(UNCName) <> 0 Then UNCName = Left(UNCName, (Len(UNCName) - 1)) End If On Error Resume Next j = UBound(AR) + 1 ReDim Preserve AR(j) AR(j) = LocalName & "," & UNCName On Error GoTo 0 Exit For Next i End If End If ' End enumeration nStatus = WNetCloseEnum(hEnum) mGetNetworkDrives = AR() End Function
Quote:
Originally Posted by randem
Well you could work in reverse right? Loop through your mapped drives and stop when it matches the server you're looking for.
umilmi81,
Yes, I have done that. I was looking for an API that I thought existed at one time.
The class isnt too bad but to use the class is not more then x.GetInfo strShare to place the call and x.strServer and x.strPath. Its worked perfectly for me in my app for about 2 years now. :)