Функция показывает имя пользователя ACCESS и имя компьютера подключенных к базе данных Никакие дополнительные библиотеки не используются, работает с Access 2.0 и выше. А принцип - анализ .ldb Авторство не мое, я только ее немного правил, чтоб она работала и на Access 2.0 Кто автор к сожалению не знаю. 'Это в раздел описаний модуля Type UserRec bMach(1 To 32) As String * 1 '1-е 32 байта для имени машины bUser(1 To 32) As String * 1 '2-е 32 байта для имени пользователя End Type 'Это сама функция Function WhosOn() As String Dim iLDBFile As Integer Dim i As Integer Dim sLogStr As String, sLogins As String Dim sMach As String, sUser As String Dim rUser As UserRec ' Defined in General Dim spath Dim db As Database On Error GoTo Err_WhosOn 'получаем ссылку на текщую БД Set db = DBEngine.Workspaces(0).Databases(0) ' определяем путь и имя текущей базы spath = db.name ' получаем незанятый номера файла для использования инструкцией OPEN iLDBFile = freefile 'формируем имя ldb-файла spath = Left(spath, Len(spath) - 3) & "ldb" 'проверяем наличие ldb-файла If Dir(spath) = "" Then WhosOn = "ldb-файл отсутствует": GoTo Exit_WhosOn 'открываем ldb-файл для чтения Open spath For Binary Access Read Shared As iLDBFile 'пока не встречен конец ldb-файла Do While Not EOF(iLDBFile) 'считываем из файла данные в переменную rUser 32 байта 'в rUser.bMach и 32 байта в rUser.bUser Get iLDBFile, , rUser i = 1: sMach = "" 'пока код i-го символа в переменной rUser.bMach <> 0 'добавляем i-й символ rUser.bMach к переменной sMach 'по окончании цикла в переменной sMach будет 'сетевое имя подключенной машины While Asc(rUser.bMach(i)) <> 0 sMach = sMach & rUser.bMach(i) i = i + 1 Wend i = 1: sUser = "" 'пока код i-го символа в переменной rUser.bUser <> 0 'добавляем i-й символ rUser.bUser к переменной sUser 'по окончании цикла в переменной sUser будет имя пользователя While Asc(rUser.bUser(i)) <> 0 sUser = sUser & rUser.bUser(i) i = i + 1 Wend 'формируем строку с именем машины и пользователя '(переменные sMach и sUser) sLogStr = sMach & " -- " & sUser 'если такой пары машина-пользователь нет в результирующей 'добавляем в результирующую строку и разделитель (";") If InStr(sLogins, sLogStr) = 0 Then sLogins = sLogins & sLogStr _ & ";" Loop 'закрываем ldb-файл Close iLDBFile 'присваиваем функции сформированную строку WhosOn = sLogins Exit_WhosOn: Set db = Nothing Exit Function Err_WhosOn: If Err = 68 Then MsgBox "Нет доступа к LDB файлу.", 48, "Ошибка" Else MsgBox "Ошибка #" & Err & Chr(13) + Chr(10) & Error(Err), 48, "Ошибка" Close iLDBFile End If Resume Exit_WhosOn End Function
|