MS Access og active directory

Jeg kan oplyse at databasen er opdelt i en frontend og en backend. Jeg ikke om det kan give problemer?

Det kan den godt. Eksemplet her andvender mixed mode:

Modul (Grupper):
Option Compare Database
Option Explicit

Private Declare Function LStrCpy Lib "kernel32" (ByVal Dest As String, ByVal Source As Any) As Integer

'Network
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Private Declare Function NetGetDCName Lib "NETAPI32.DLL" (ServerName As Any, DomainName As Any, DCNPtr As Long) As Long

Private Declare Function NetUserGetInfo Lib "NETAPI32.DLL" (ByVal server As String, ByVal userName As String, ByVal Level As Integer, Buffer As Any, ByVal cbBuffer As Integer, pcbTotal As Integer) As Integer

Private Declare Function NetUserGetGroups0 Lib "NETAPI32.DLL" Alias "NetUserGetGroups" (ServerName As Byte, userName As Byte, ByVal Level As Long, Buffer As Long, ByVal PrefMaxLen As Long, EntriesRead As Long, TotalEntries As Long) As Long

Private Declare Function NetApiBufferFree Lib "NETAPI32.DLL" (ByVal pBuffer As Long) As Long

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function lstrlenA Lib "kernel32" (ByVal lpString As Long) As Long

Private Declare Function PtrToStr Lib "kernel32" Alias "lstrcpyW" (retval As Byte, ByVal Ptr As Long) As Long
Private Declare Function StrToPtr Lib "kernel32" Alias "lstrcpyW" (ByVal Ptr As Long, Source As Byte) 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 StrLen Lib "kernel32" Alias "lstrlenW" (ByVal Ptr As Long) As Long

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 GetVersionExA Lib "kernel32.dll" (lpVersionInformation As OSVERSIONINFO) As Integer

Private Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type

Const winver9x As Integer = 1
Const winverNT As Integer = 2

Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (pTo As Any, uFrom As Any, ByVal lSize As Long)


Public Function listUserGroups(Groupname As String) As Boolean
listUserGroups = False

        Dim Result As Long, BufPtr As Long, EntriesRead As Long
        Dim TotalEntries As Long, ResumeHandle As Long, BufLen As Long
        Dim SNArray() As Byte, GNArray(99) As Byte, UNArray() As Byte
        Dim GName As String, i As Integer, UNPtr As Long
        Dim TempPtr As MungeLong, TempStr As MungeInt

        Dim DCName As String, UName As String

        'get the name of a domain controller & the name of the user running us
        DCName = GetPrimaryDCName()
        UName = NT_User.Bruger7
         
       

                SNArray = DCName & vbNullChar
                UNArray = UName & vbNullChar

                Result = NetUserGetGroups0(SNArray(0), UNArray(0), 0, BufPtr, -1, EntriesRead, TotalEntries)
       

        If Result <> 0 And Result <> 234 Then ' 234 = more data; should never happen seeing as though we ask for all of it at once
                MsgBox "Error " & Result & " enumerating group " & EntriesRead & " of " & TotalEntries
                Exit Function
        End If


                For i = 1 To EntriesRead
                        Result = PtrToInt(TempStr.XLo, BufPtr + (i - 1) * 4, 2)
                        Result = PtrToInt(TempStr.XHi, BufPtr + (i - 1) * 4 + 2, 2)
                        LSet TempPtr = TempStr ' munge 2 Integers To a Long

                        'Copy string to array and convert to a string
                        Result = PtrToStr(GNArray(0), TempPtr.X)
                        GName = Left(GNArray, StrLen(TempPtr.X))
                        If GName = Groupname Then listUserGroups = True
                Next i



                Result = NetApiBufferFree(BufPtr) ' Don't leak memory
End Function

Function GetPrimaryDCName() As String

        Dim Result As Long, DCName As String, DCNPtr As Long
        Dim DCNArray(100) As Byte


                Result = NetGetDCName(0&, 0&, DCNPtr)

        If Result <> 0 Then
                MsgBox "Unable to determine Domain Controller Name"
                Exit Function
        End If


                Result = PtrToStr(DCNArray(0), DCNPtr)
                Result = NetApiBufferFree(DCNPtr)
                DCName = DCNArray()

        GetPrimaryDCName = DCName

End Function

Modul (bruger):

Option Compare Text
Option Explicit
Option Base 0
    Private Bruger As String
   
Type Bruger_Opl
        navn As String
        Banksted As String
End Type
       
      Type WKSTA_INFO_101
        wki101_platform_id As Long
        wki101_computername As Long
        wki101_langroup As Long
        wki101_ver_major As Long
        wki101_ver_minor As Long
        wki101_lanroot As Long
      End Type

      Type WKSTA_USER_INFO_1
        wkui1_username As Long
        wkui1_logon_domain As Long
        wkui1_logon_server As Long
        wkui1_oth_domains As Long
      End Type

      Declare Function WNetGetUser& Lib "Mpr" Alias "WNetGetUserA" _
        (lpName As Any, ByVal lpUserName$, lpnLength&)
      Declare Function NetWkstaGetInfo& Lib "netapi32" _
        (strServer As Any, ByVal lLevel&, pbBuffer As Any)
      Declare Function NetWkstaUserGetInfo& Lib "netapi32" _
        (reserved As Any, ByVal lLevel&, pbBuffer As Any)
      Declare Sub lstrcpyW Lib "kernel32" (Dest As Any, ByVal src As Any)
      Declare Sub LStrCpy Lib "kernel32" Alias "lstrcpy" (Dest As Any, ByVal src As Any)
      Declare Sub RtlMoveMemory Lib "kernel32" _
        (Dest As Any, src As Any, ByVal size&)
      Declare Function NetApiBufferFree& Lib "netapi32" (ByVal Buffer&)


    Private Function GetWorkstationInfo()
        Dim ret As Long, Buffer(512) As Byte, i As Integer
        Dim wk101 As WKSTA_INFO_101, pwk101 As Long
        Dim wk1 As WKSTA_USER_INFO_1, pwk1 As Long
        Dim cbusername As Long, userName As String
       
        ' Clear all of the display values.
        userName = ""

        ' Windows 95 or NT - call WNetGetUser to get the name of the user.
        userName = Space(256)
        cbusername = Len(userName)
        ret = WNetGetUser(ByVal 0&, userName, cbusername)
        If ret = 0 Then
            ' Success - strip off the null.
            userName = Left(userName, InStr(userName, Chr(0)) - 1)
        Else
            userName = ""
        End If

 
        Bruger = userName
      End Function


Nu kan du så måle på, hvilke grupper den pågældende bruger er medlem af.

Jeg er ikke helt sikker på at jeg forstår hvad du siger? "Måle på, hvilke grupper den pågældende bruger er medlem af". Det det handler om er styre adgangen til Access via Active directory fremfor Acces egen sikkerhedsfunktion.

Ja - du kan ved opstart måle på medlemskab af en given gruppe - hvis ikke vedkommende bruger er medlem - lukkes databasen. Du kan lave forskellige typer af brugere i din applikation - alt sammen med windows logon.

Det vil sige at koden skal sættes til at køre ved opstart af databasen. Eksempelvis når en hovedformular køres!

Ja eksempelvis... Vil du have et kodeeksempel ?

Har du ikke lige givet det ovenfor?????

Jo - på koden til modulerne ;O)

Her er funktionen der undersøger om den pågældende bruger er medlem af gruppen DB_Acc_admin

Function Admin() As Boolean
Dim retval
    DoCmd.Hourglass True
    retval = SysCmd(acSysCmdSetStatus, "Vent - undersøger rettigheder")
    Admin = False
    If NT_Groups.listUserGroups("DB_Acc_admin") = True Then Admin = True
    DoCmd.Hourglass False
    retval = SysCmd(acSysCmdClearStatus)
End Function

Takker for point ;O))