Zum Inhalt springen

Zugriff auf Access-DB


Dragan

Empfohlene Beiträge

Hier den Quellcode habe ich gefunden

dabei zeigt alle User an die die DB geöffnet haben

Bloß hat er irgendwie an manchen Stellen ein Problem beim Kompilieren unter Access97 bei 2000 gehts....

Er bringt irgend so nen Fehler Objektbibliothek nicht gefunden

Private Sub UpdateBtn_Click()

Me.LoggedOn.RowSource = WhosOn()

End Sub

'-------------------------------------------------------------------------------------

' Subject : WhosOn()

' Purpose : Will read *.LDB file and read who's currently

' logged on and their station name.

'

' The LDB file has a 64 byte record.

'

' The station name starts at byte 1 and is null

' terminated.

'

' Log-in names start at the 33rd byte and are

' also null terminated.

'

' I had to change the way the file was accessed

' because the Input() function did not return

' nulls, so there was no way to see where the

' names ended.

'-------------------------------------------------------------------------------------

Private Function WhosOn() As String

On Error GoTo Err_WhosOn

Dim iLDBFile As Integer, iStart As Integer

Dim iLOF As Integer, I As Integer

Dim sPath As String, X As String

Dim sLogStr As String, sLogins As String

Dim sMach As String, sUser As String

Dim rUser As UserRec ' Defined in General

Dim dbCurrent As Database

' Get Path of current database. Should substitute this code

' for an attached table path in a multi-user environment.

Set dbCurrent = DBEngine.Workspaces(0).Databases(0)

sPath = dbCurrent.Name

dbCurrent.Close

' Iterate thru dbCurrent.LDB file for login names.

sPath = Left(sPath, InStr(1, sPath, ".")) + "LDB"

' Test for valid file, else Error

X = Dir(sPath)

iStart = 1

iLDBFile = FreeFile

Open sPath For Binary Access Read Shared As iLDBFile

iLOF = LOF(iLDBFile)

Do While Not EOF(iLDBFile)

Get iLDBFile, , rUser

With rUser

I = 1

sMach = ""

While .bMach(I) <> 0

sMach = sMach & Chr(.bMach(I))

I = I + 1

Wend

I = 1

sUser = ""

While .bUser(I) <> 0

sUser = sUser & Chr(.bUser(I))

I = I + 1

Wend

End With

sLogStr = sMach & " -- " & sUser

If InStr(sLogins, sLogStr) = 0 Then

sLogins = sLogins & sLogStr & ";"

End If

iStart = iStart + 64 'increment to next record offset

Loop

Close iLDBFile

WhosOn = sLogins

Exit_WhosOn:

Exit Function

Err_WhosOn:

If Err = 68 Then

MsgBox "Couldn't populate the list", 48, "No LDB File"

Else

MsgBox "Error: " & Err.Number & vbCrLf & Err.Description

Close iLDBFile

End If

Resume Exit_WhosOn

End Function

Link zu diesem Kommentar
Auf anderen Seiten teilen

Dein Kommentar

Du kannst jetzt schreiben und Dich später registrieren. Wenn Du ein Konto hast, melde Dich jetzt an, um unter Deinem Benutzernamen zu schreiben.

Gast
Auf dieses Thema antworten...

×   Du hast formatierten Text eingefügt.   Formatierung wiederherstellen

  Nur 75 Emojis sind erlaubt.

×   Dein Link wurde automatisch eingebettet.   Einbetten rückgängig machen und als Link darstellen

×   Dein vorheriger Inhalt wurde wiederhergestellt.   Editor leeren

×   Du kannst Bilder nicht direkt einfügen. Lade Bilder hoch oder lade sie von einer URL.

Fachinformatiker.de, 2024 by SE Internet Services

fidelogo_small.png

Schicke uns eine Nachricht!

Fachinformatiker.de ist die größte IT-Community
rund um Ausbildung, Job, Weiterbildung für IT-Fachkräfte.

Fachinformatiker.de App

Download on the App Store
Get it on Google Play

Kontakt

Hier werben?
Oder sende eine E-Mail an

Social media u. feeds

Jobboard für Fachinformatiker und IT-Fachkräfte

×
×
  • Neu erstellen...