How i can block users to access the database with same ID from different computers(IP-s) in the same time.I have some users who share the ID and i want to block this.
I need something like Sametime, when i connect from another computer i am disconnected from old computer.
Subject: I’m pretty sure you can’t
Subject: Try this…
This is how I would try to do it:
Note: You could create the view in the database itself, but only if users have delete access in the ACL,
The code will perform a lookup agaisnt the view you created earlier, locate the current user and compare the computer name. If it is a different name, prevent the user form continuing. If the user is not found, create a new document with current user’s name and computer name.
======= Script Library Functions.Win32.UserFunctions =======
Option Public
Option Declare
’ ***** Declarations for Win32 call to get logged in Windows User *****
Declare Function w32_WNetGetUser Lib “mpr.dll” Alias “WNetGetUserA” (Byval lpszLocalName As String, Byval lpszUserName As String, lpcchBuffer As Long) As Long
’ ***** Declarations for Win32 call to get computer name *****
Declare Function GetComputerName Lib “kernel32” Alias “GetComputerNameA” (Byval lpBuffer As String, nSize As Long) As Long
Declare Function GetWindowsDirectory Lib “kernel32.dll” Alias “GetWindowsDirectoryA” (Byval lpBuffer As String, Byval nSize As Long) As Long
’ ***** Declarations for Win32 call to get IP addresses *****
Declare Function GetIpAddrTable_API Lib “IpHlpApi” Alias “GetIpAddrTable” (pIPAddrTable As Variant, pdwSize As Long, ByVal bOrder As Long) As Long
Function GetIpAddrTable() As Variant
' Returns an array with the local IP addresses (as strings).
' Author: Christian d'Heureuse, www.source-code.biz
Dim Buf(0 To 511) As Byte
Dim BufSize As Long
Dim rc As Long
Dim IpAddrs() As String
Dim NrOfEntries As Integer
Dim i As Integer
Dim j As Integer
Dim s As String
BufSize = UBound(Buf) + 1
rc = GetIpAddrTable_API(Buf(0), BufSize, 1)
’ If rc <> 0 Then Err.Raise vbObjectError, , "GetIpAddrTable failed with return value " & rc
NrOfEntries = Buf(1) * 256 + Buf(0)
If NrOfEntries = 0 Then
GetIpAddrTable = IpAddrs
Exit Function
End If
ReDim IpAddrs(0 To NrOfEntries - 1) As String
For i = 0 To NrOfEntries - 1
s = ""
For j = 0 To 3
If j > 0 Then
s = s & "."
End If
s = s & Buf(4 + i * 24 + j)
Next
IpAddrs(i) = s
Next
GetIpAddrTable = IpAddrs
End Function
Function GetWindowsDir() As String
Dim strWindowsDir As String ' Variable to return the path of Windows Directory
Dim lngWindowsDirLength As Long ' Variable to return the the lenght of the path
strWindowsDir = Space(250) ' Initilize the buffer to receive the string
lngWindowsDirLength = GetWindowsDirectory(strWindowsDir, 250) ' Read the path of the windows directory
strWindowsDir = Left(strWindowsDir, lngWindowsDirLength) ' Extract the windows path from the buffer
GetWindowsDir = strWindowsDir
End Function
Function GetCurrentComputerName() As String
Dim strComputerName As String ' Variable to return the path of computer name
strComputerName = Space(250) ' Initilize the buffer to receive the string
GetComputerName strComputerName, Len(strComputerName)
strComputerName = Mid(Trim$(strComputerName), 1, Len(Trim$(strComputerName)) - 1)
GetCurrentComputerName = strComputerName
End Function
Function WNetGetUser() As String
’ **********
’ Purpose: Retrieve the network user name
’ Paramters: None
’ Returns: The indicated name
’ Notes:
’ A zero-length string is returned if the function fails
’ **********
Dim vbNullString As String
Dim lpUserName As String
Dim lpnLength As Long
Dim lResult As Long
lpnLength = 256
lpUserName = Space(lpnLength)
lResult = w32_WNetGetUser(vbNullString, lpUserName, lpnLength)
If lResult = 0 Then
WNetGetUser = CStringToVBString(lpUserName)
Else
WNetGetUser = ""
End If
End Function
Function GetAvailablePrinters() As String
Dim WScript As Variant
Dim objNetwork As Variant
Dim colPrinters As Variant
Dim i As Integer
Dim printerlist As String
Set objNetwork = CreateObject("WScript.Network")
Set colPrinters = objNetwork.EnumPrinterConnections
For i = 0 To colPrinters.Count -1 Step 2
’ Wscript.Echo colPrinters.Item(i) & Chr$(9) & colPrinters.Item (i + 1)
printerlist = printerlist & colPrinters.Item(i) & Chr$(9) & colPrinters.Item (i + 1) & ";"
Next
Msgbox printerlist
GetAvailablePrinters = printerlist
End Function
Function CStringToVBString(psCString As String) As String
’ **********
’ Purpose: Convert a C string to a VB string
’ Parameters: (Input Only)
’ psCString - the C string to convert
’ Returns: The converted VB string
’ Notes:
’ Returns everything to the left of the first Null character
’ **********
Dim sReturn As String
Dim iNullCharPos As Integer
iNullCharPos = Instr(psCString, Chr$(0))
If iNullCharPos > 0 Then
' return everything left of the null
sReturn = Left(psCString, iNullCharPos - 1)
Else
' no null, return the original string
sReturn = psCString
End If
CStringToVBString = sReturn
End Function
Function GetDefaultPrinter()
Dim WshNetwork As Variant
Dim sDefault As String
Dim sRegVal As String
Set WshNetwork = CreateObject("WScript.Shell")
sRegVal = "HKCU\Software\Microsoft\Windows NT\CurrentVersion\Windows\Device"
sDefault = ""
On Error Resume Next
sDefault = WshNetwork.RegRead(sRegVal)
sDefault = Left(sDefault ,Instr(sDefault, ",") - 1)
On Error Goto 0
GetDefaultPrinter = sDefault
End Function