API Call to find out the Network Name of the computer running the DB 1

[KirkJewell]

I have managed to find an API call (and the rest of code needed to use it) to find out the current user login name (Windows Login).

what I really needed to know was the Network Identity of the computer running the Access database.

Can any one help.
[sig][/sig]

 

[MichaelRed]

KirkJewell,

Not EXACTLY the answer you are looking for, ...) you are looking for. I developed the following function to provide the User list (with machine name) for a multiuser data base, so I could at least know who was logged on to the data base. You would (obviously) need to modify it to read the corredt LDB file (it is ALWAYS the dame name as the database, and ALWAYS resides in the same directory (Folder) as the database. Specifically, You need to replace "EPIP" with the Name of your database.

The Query "qDel_Ldb_Stuff" just deletes the records in the "tblLdb_Stuff", however the sql for it is:


DELETE DISTINCTROW tblLDB_Stuff.*
FROM tblLDB_Stuff
WITH OWNERACCESS OPTION;


The table [tblLDB_Stuff] design is:
Field Name Field Type (Lsn) Comment
MyLDBMachine Text(50) Machine Name
MyLDBUser Text(90) User Name
LDB95 Yes/No In the (Access 95).LDB File
LDB97 Yes/Bo In the (Access 97).LDB File



the module code is:


Public Function ReadLdbUsers()
Dim MyDb As Database
Dim qDelLDB_Stuff As QueryDef

Dim Idx As Integer
Dim SpaceCnt As Integer
Dim MyLDB As Integer

Dim strLDB As String
Dim MyMachine As String
Dim MyUser As String
Dim MyUsrTmp As String
Dim MyPath As String
Dim MyLdbFile As String
Dim MyChar As String * 1

Set MyDb = CurrentDb()
Set qDelLDB_Stuff = MyDb.QueryDefs("qDelLDB_Stuff&quot
qDelLDB_Stuff.Execute

MyPath = GetDbPath
MyLdbFile = MyPath & "Epip.LDB"
MyLdbFile = Dir(MyPath & "Epip.Ldb&quot
If (MyLdbFile = "&quot Then
MsgBox ("No Epip Users On-Line&quot
Exit Function
Else
MyLdbFile = MyPath & "Epip.LDB"
Open MyLdbFile For Input As #1
End If

Line Input #1, strLDB

MyLDB = 95
For Idx = Len(strLDB) To 1 Step -1 'Walk Line -- Backwards
MyChar = Mid$(strLDB, Idx, 1) 'Get Single Character
If (MyChar = " &quot Then 'Check For Spaces
SpaceCnt = SpaceCnt + 1 'Increment Consecutive
If (SpaceCnt = 2) Then 'Found the User
MyUser = Trim(MyUser) 'Trim Spaces
MyMachine = Mid$(strLDB, Idx - 29, 29)
MyMachine = Trim(MyMachine) 'Now the Machine
Idx = Idx - 29 'Adjust the Index
Call AddUsrRec(MyUser, MyMachine, MyLDB) 'Put User/Machine in Table
MyUser = "" 'Reset User for Next
MyMachine = "" 'Reset Machine for Next
End If
Else
SpaceCnt = 0 'No Space, Reset Count
End If
MyUsrTmp = MyUser 'Save User
MyUser = MyChar & MyUsrTmp 'Put this char in Front
Next Idx 'Next Character

Close #1


MyLdbFile = MyPath & GetDbName & ".LDB"
Open MyLdbFile For Input As #1

Line Input #1, strLDB

MyLDB = 97
For Idx = Len(strLDB) To 1 Step -1 'Walk Line -- Backwards
MyChar = Mid$(strLDB, Idx, 1) 'Get Single Character
If (MyChar = " &quot Then 'Check For Spaces
SpaceCnt = SpaceCnt + 1 'Increment Consecutive
If (SpaceCnt = 2) Then 'Found the User
MyUser = Trim(MyUser) 'Trim Spaces
MyMachine = Mid$(strLDB, Idx - 29, 29)
MyMachine = Trim(MyMachine) 'Now the Machine
Idx = Idx - 29 'Adjust the Index
If (ChkUsrRec(MyUser) = True) Then
Call EditUsrRec(MyUser, MyLDB)
Else
Call AddUsrRec(MyUser, MyMachine, MyLDB) 'Put User/Machine in Table
End If
MyUser = "" 'Reset User for Next
MyMachine = "" 'Reset Machine for Next
End If
Else
SpaceCnt = 0 'No Space, Reset Count
End If
MyUsrTmp = MyUser 'Save User
MyUser = MyChar & MyUsrTmp 'Put this char in Front
Next Idx 'Next Character

Close #1


End Function



The following is called by [ReadLdbUsers] it just returtns the path name for the database


Public Function GetDbPath() As String
GetDbPath = Left(CurrentDb.Name, (InStr(CurrentDb.Name, GetDbName) - 1))
End Function



The following is called by [ReadLdbUsers] It adds the user name and machine name to the table and 'defines' wheather the User is running Ms Access 95 or 97..

Public Function AddUsrRec(MyUser, MyMachine, MyLDB)
Dim MyDb As Database
Dim MyFil As Recordset

Dim UsrNameLen As Integer
Dim MachNamelen As Integer

Dim MyUsrTmp As String
Dim MyChar As String * 1

Set MyDb = CurrentDb()
Set MyFil = MyDb.OpenRecordset("tblLDB_Stuff&quot

With MyFil
.AddNew
!MyLDBMachine = MyMachine
!MyLDBUser = MyUser
If (MyLDB = 95) Then
!LDB95 = True
ElseIf (MyLDB = 97) Then
!LDB97 = True
End If
' !MachLen = MachNamelen
' !UserLen = UsrNameLen
' !UsrStrLen = SubStrLen
.Update
End With

End Function
[/b]

The "double" loop is to accomodate the possability of users having Ms. Access 95 or Ms Access 97,If you do not get a 'quick' response to the original request, you may be able to modify these routines to suit your needs.

[sig]<p>MichaelRed<br><a href=mailto:mred@duvallgroup.com>mred@duvallgroup.com</a><br>There is never time to do it right but there is always time to do it over[/sig]

 

[KirkJewell]

Thanks for the code/advice - I shall try it out on Monday.

It 'sounds' perfect.

(I'm allowing users to logon through FrontEnds to a BackEnd at multiple computers and need - I have stopped short at allowing this AND multiple logons at the same computer).

Regards
Kirk
[sig][/sig]

 

[goingkraze]

I was trying to get this code to work, but it seems to be missing two functions. Do you have the code for ChkusrRec and EditUsrRec? It is calling these in the ReadldbUsers section. Thanks for any assistance. This seems to be exactly the code I have been looking for for a while.