Strona: [  << <   1   > >>  ]  z  1     
Autor Temat: Lista użytkowników bazy
anonim




Typ: Nie zarejestrowany
Lista użytkowników bazy

Witam serdecznie,

na serwerze jest udostępniony plik acces-a jako tabele i do niego podpięci są różni użytkownicy. W jaki sposób sprawdzić, kto jest aktualnie podłączony ? Dziękuję za pomoc i pozdrawiam .

08-06-2004 13:26
  
losmac
"profesorek"




Typ: neutral
Postów: 758
Zarejestrowany: May 2003
wypatrzone w sieci...


'===========================================
'========Get Active Users List==============
'===========================================

Option Compare Database
Option Explicit

Type SECURITY_ATTRIBUTES
  nLength As Long
  lpSecurityDescriptor As Long
  bInheritHandle As Long
End Type

Type OVERLAPPED
  Internal As Long
  InternalHigh As Long
  offset As Long
  OffsetHigh As Long
  hEvent As Long
End Type

Type SecInfo
    bMachine(1 To 32) As Byte
    bSecurity(1 To 32) As Byte
End Type

Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
End Type

Type BY_HANDLE_FILE_INFORMATION
        dwFileAttributes As Long
        ftCreationTime As FILETIME
        ftLastAccessTime As FILETIME
        ftLastWriteTime As FILETIME
        dwVolumeSerialNumber As Long
        nFileSizeHigh As Long
        nFileSizeLow As Long
        nNumberOfLinks As Long
        nFileIndexHigh As Long
        nFileIndexLow As Long
End Type

Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" _
                          (ByVal lpFileName As String, _
                            ByVal dwDesiredAccess As Long, _
                            ByVal dwShareMode As Long, _
                            lpSecurityAttributes As SECURITY_ATTRIBUTES, _
                            ByVal dwCreationDisposition As Long, _
                            ByVal dwFlagsAndAttributes As Long, _
                            ByVal hTemplateFile As Long) As Long

Declare Function CloseHandle Lib "kernel32" _
                            (ByVal hObject As Long) As Long

Declare Function LockFile Lib "kernel32" _
                            (ByVal hFile As Long, _
                            ByVal dwFileOffsetLow As Long, _
                            ByVal dwFileOffsetHigh As Long, _
                            ByVal nNumberOfBytesToLockLow As Long, _
                            ByVal nNumberOfBytesToLockHigh As Long) As Long
                           
Declare Function UnlockFile Lib "kernel32" _
                          (ByVal hFile As Long, _
                            ByVal dwFileOffsetLow As Long, _
                            ByVal dwFileOffsetHigh As Long, _
                            ByVal nNumberOfBytesToUnlockLow As Long, _
                            ByVal nNumberOfBytesToUnlockHigh As Long) As Long
                           
Declare Function SetFilePointer Lib "kernel32" _
                          (ByVal hFile As Long, _
                          ByVal lDistanceToMove As Long, _
                          lpDistanceToMoveHigh As Long, _
                          ByVal dwMoveMethod As Long) As Long
                         
Declare Function ReadFile Lib "kernel32" _
                          (ByVal hFile As Long, _
                          lpBuffer As Any, _
                          ByVal nNumberOfBytesToRead As Long, _
                          lpNumberOfBytesRead As Long, _
                          lpOverlapped As Any) As Long

Declare Function lread Lib "kernel32" Alias "_lread" (ByVal hFile As Long, _
                          lpBuffer As Any, ByVal wBytes As Long) As Long

Declare Function GetFileInformationByHandle Lib "kernel32" _
                          (ByVal hFile As Long, lpFileInformation As BY_HANDLE_FILE_INFORMATION) As Long
Declare Function GetFileType Lib "kernel32" (ByVal hFile As Long) As Long
Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long

Dim mSecurity As SECURITY_ATTRIBUTES
Dim mFileHandle As Long
Dim mFileInfo As BY_HANDLE_FILE_INFORMATION

Public Const GENERIC_READ = &H80000000
Public Const GENERIC_WRITE = &H40000000
Public Const FILE_SHARE_READ = &H1
Public Const FILE_SHARE_WRITE = &H2
Public Const FILE_FLAG_RANDOM_ACCESS = &H10000000
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Const OPEN_EXISTING = 3

Public Const FILE_BEGIN = 0
Public Const FILE_CURRENT = 1
Public Const FILE_END = 2

Public Function a_test()
    Dim strPath As String
    Dim strActiveUserList As String
   
    strPath = CodeDb().Name
    strPath = Mid(strPath, 1, InStr(1, strPath, "." - 1) & ".ldb"
    strActiveUserList = ReadLocks(strPath)
    MsgBox strActiveUserList
End Function

Public Function ReadLocks(ByVal vstrDBPath As String) As String
                         
    Dim USecInfo As SecInfo
    Dim aszTempUserList(0 To 254, 0 To 2) As String
    Dim aszUserList() As String
    Dim iaCnt As Integer
    Dim iCnt As Integer
    Dim iOffset As Integer
    Dim lBytesRead As Long
    Dim myoverlap As OVERLAPPED
    Dim dwPos As Long
    Dim lLock As Long
    Dim lByte As Long
    Dim strValueList As String
    Dim lngRet As Long

    With mSecurity
        .nLength = Len(mSecurity)
        .lpSecurityDescriptor = 0
        .bInheritHandle = True
    End With

    mFileHandle = CreateFile( _
                  vstrDBPath, _
                  GENERIC_READ Or GENERIC_WRITE, _
                  FILE_SHARE_READ Or FILE_SHARE_WRITE, _
                  mSecurity, _
                  OPEN_EXISTING, _
                  FILE_FLAG_RANDOM_ACCESS Or FILE_ATTRIBUTE_NORMAL, _
                  0)

    If mFileHandle = 0 Then
        MsgBox "Cannot open ldb"
        ReadLocks = ""
        Exit Function
    End If
   
    'lngRet = GetFileInformationByHandle(mFileHandle, mFileInfo)
   
    SetFilePointer mFileHandle, 0, 0, FILE_BEGIN
    iOffset = 0
    iaCnt = 0

    Do
        'If ReadFile(mFileHandle, USecInfo, 64, lBytesRead, 0) = 0 Then
        lBytesRead = lread(mFileHandle, USecInfo, 64)
        If lBytesRead = 0 Then Exit Do
        If lBytesRead <> 64 Then
            MsgBox "error reading ldb"
            ReadLocks = ""
            Exit Function
        End If
       
        With USecInfo
            aszTempUserList(iaCnt, 0) = szBytesToString(.bSecurity)
            aszTempUserList(iaCnt, 1) = szBytesToString(.bMachine)
            aszTempUserList(iaCnt, 2) = iOffset
        End With
        iaCnt = iaCnt + 1
        iOffset = iOffset + 64
    Loop

    iaCnt = 0
    dwPos = &H10000001
    strValueList = "User name;Machine;"
    Do Until dwPos = &H100000FF
        lLock = LockFile(mFileHandle, dwPos, 0, 1, 0)
        If lLock = 0 Then
            lByte = lHexToLong(Right$(Hex(dwPos), 2))
            iOffset = lByte * 64 - 64
            For iaCnt = 0 To 254
                If aszTempUserList(iaCnt, 2) = "" Then Exit For
                If aszTempUserList(iaCnt, 2) = iOffset Then
                    strValueList = strValueList & _
                                  aszTempUserList(iaCnt, 0) & ";" & _
                                  aszTempUserList(iaCnt, 1) & ";"
                End If
            Next iaCnt
        Else
            lLock = UnlockFile(mFileHandle, dwPos, 0, 1, 0)
        End If
        dwPos = dwPos + 1
    Loop

    CloseHandle (mFileHandle)
    ReadLocks = strValueList
End Function

Public Function szBytesToString(pbytArray() As Byte) As String
    Dim szTemp As String
   
    szTemp = StrConv(pbytArray(), vbUnicode)
    szBytesToString = Left$(szTemp, (InStr(1, szTemp, Chr(0))) - 1)
End Function

Public Function lHexToLong(ByVal szHex As String) As Long
    lHexToLong = Val("&H " & szHex & "&"
End Function



_____________________________________________
POSTULATY STARUSZKA:
1) Ludzie, dbajcie o polszczyznę!!!
2) Ludzie, zadawajcie kompletne pytania, a nie rzucacie ochłapy i trzeba się domyślać o co chodzi!!!

Powodzenia
Maciej Łoś

08-06-2004 18:14
Pokaż profil losmac  Wyślij email do losmac   Odwiedź stronę losmac  
Wszystkich odpowiedzi: 1 :: Maxymalnie na stronę: 20
Strona: [  << <   1   > >>  ]  z  1