Kontrol af adgang til server

h_s -> i hvilken forbindelse skal du bruge det?

Jeg skal bruge det i en makro, for at tjekke om der er adgang til at hente noget data. Det er G-drevet!

Nedenstående har jeg hentet her:

http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=25445&lngWId=1

Det er vel en slags indirekte bevis for adgang?

'**************************************
'Windows API/Global Declarations for :Ge
'    t the UNC Path
'**************************************
' To be put inside a module
'Possible return codes from the API
'Public Const ERROR_BAD_DEVICEAs Long = 1200
'Public Const ERROR_CONNECTION_UNAVAILAs Long = 1201
'Public Const ERROR_EXTENDED_ERRORAs Long = 1208
'Public Const ERROR_MORE_DATAAs Long = 234
'Public Const ERROR_NOT_SUPPORTEDAs Long = 50
'Public Const ERROR_NO_NET_OR_BAD_PATHAs Long = 1203
'Public Const ERROR_NO_NETWORKAs Long = 1222
'Public Const ERROR_NOT_CONNECTEDAs Long = 2250
'Public Const NO_ERRORAs Long = 0
'This API returns a UNC from a drive let
'    ter


Declare Function WNetGetConnection Lib "mpr.dll" Alias _
    "WNetGetConnectionA" _
    (ByVal lpszLocalName As String, _
    ByVal lpszRemoteName As String, _
    cbRemoteName As Long) As Long


Function GetUNCPath(ByVal strDriveLetter As String, _
    ByRef strUNCPath As String) As Long
    On Local Error GoTo GetUNCPath_Err
    Dim strMsg As String
    Dim lngReturn As Long
    Dim strLocalName As String
    Dim strRemoteName As String
    Dim lngRemoteName As Long
    strLocalName = strDriveLetter
    strRemoteName = String$(255, Chr$(32))
    lngRemoteName = Len(strRemoteName)
    'Attempt to grab UNC
    lngReturn = WNetGetConnection(strLocalName, _
    strRemoteName, _
    lngRemoteName)


    If lngReturn = NO_ERROR Then
        'No problems - return the UNC
        'to the passed ByRef string
        GetUNCPath = NO_ERROR
        strUNCPath = Trim$(strRemoteName)
        strUNCPath = Left$(strUNCPath, Len(strUNCPath) - 1)
    Else
        'Problems - so return original
        'drive letter and error number
        GetUNCPath = lngReturn
        strUNCPath = strDriveLetter & "\"
    End If
GetUNCPath_End:
    Exit Function
GetUNCPath_Err:
    GetUNCPath = ERROR_NOT_SUPPORTED
    strUNCPath = strDriveLetter
    Resume GetUNCPath_End
End Function


Sub UNCTjek()

Dim strUNC As String


If GetUNCPath("H:", strUNC) = NO_ERROR Then
    MsgBox "The UNC of the specified drive is " & strUNC
Else
    MsgBox "There was a problem, sorry!"
End If

End Sub

her er to makroer. Der ene tester om der er read-access og den anden om der er write-access

Sub test_drive_Read_access()
Dim x As Variant
On Error GoTo IngenAdgang
  Dim stSti As String
  stSti = "O:\logistik\*.*"
  x = Dir(stSti)
  If x = "" Then GoTo IngenAdgang
  MsgBox "adgang OK"
  Exit Sub
IngenAdgang:
  MsgBox "Ingen adgang"
End Sub

Sub Test_Drive_Write_Access()
  Dim x As Boolean
  Dim stStiOgFil As String
  stStiOgFil = "O:\Logistik\test.txt"
  x = test_server(stStiOgFil)
  If x = False Then MsgBox "Ingen adgang" Else MsgBox "adgang OK"
End Sub

Private Function test_server(StiOgFil) As Boolean
  On Error GoTo IngenAdgang
  Open StiOgFil For Output As #1
  Write #1, "Testing"
  Close #1
  test_server = True
  Kill StiOgFil
  Exit Function
IngenAdgang:
  test_server = False
End Function

bak> Hvormeget skal jeg bruge hvis jeg skal have både skrive og læse rettigheder? Jeg synes jeg kan se 3 makroer!
Hvis man har skriverettigheder, har man så også læserettigheder?

Bak>har du glemt dette spørgsmål?

Ja det har jeg da glemt.. :-)
Du skal bruge alle tre, men kun
Test_Drive_Write_Access
test_drive_Read_access

kan køres.

Function test_server(StiOgFil) As Boolean
bliver brugt af Test_Drive_Write_Access

Så Bak, nu har jeg også endelig fået set på dine forslag - og det lykkedes :-)
Vil du smide et svar!

ok :-)