Tools Links Login

Excel/Word/Access user log

It keeps a log (IP, TIME (local), NetworkUserName) of those that open the office document you put the code in.
Example: Peter 7/29/2001 11:27:12 AM 172.19.20.22

Original Author: uloncha

Inputs

UserId, IP (taken from registry), Time stamp.

Assumptions

Read side effects. IP is taken from registry so it is necessary to point to its key.
I took some code from other programmer's cotributions, if you recognize the code please let me know and i will mention you.

Returns

Writes inputs in builtindocumentproperties.

Side Effects

if file is opened too oftenly and the log is not cleared, "comment" may become too big (i bet it will crash). Also, note that comments can be read by anyone and cleared too (unless document is write protected with password)

API Declarations

Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const REG_SZ = 1 ' Unicode
Public Const REG_DWORD = 4 ' 32-bit
Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hkey As Long, ByVal lpsubkey As String, phkresult As Long) As Long
Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hkey As Long, ByVal lpvaluename As String, ByVal lpreserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Declare Function GetComputerNameA Lib "kernel32" (ByVal lpBuffer As String, nSize As Long) As Long

Code

Public Function getstring(hkey As Long, strpath As String, strvalue As String)
Dim keyhand, datatype, lResult, lDataBufSize As Long
Dim strBuf As String
Dim intZeroPos As Integer
  r = RegOpenKey(hkey, strpath, keyhand)
lResult = RegQueryValueEx(keyhand, strvalue, 0&, lValueType, ByVal 0&, lDataBufSize)
If lValueType = REG_SZ Then
  strBuf = String(lDataBufSize, " ")
  lResult = RegQueryValueEx(keyhand, strvalue, 0&, 0&, ByVal strBuf, lDataBufSize)
  If lResult = ERROR_SUCCESS Then
   intZeroPos = InStr(strBuf, Chr$(0))
   If intZeroPos > 0 Then
    getstring = Left$(strBuf, intZeroPos - 1)
   Else
    getstring = strBuf
   End If
  End If
End If
End Function
Public Function NetworkUserName() As String
Dim lpBuff As String * 25
Dim retval As Long
retval = GetUserName(lpBuff, 25)
NetworkUserName = Left(lpBuff, InStr(lpBuff, Chr(0)) - 1)
End Function
Public Function WorkstationID() As String
Dim sBuffer As String * 255
If GetComputerNameA(sBuffer, 255&) > 0 Then
WorkstationID = Left$(sBuffer, InStr(sBuffer, vbNullChar) - 1)
Else
WorkstationID = "?"
End If
End Function
Sub AUTO_Open()'put it in workbook_open in excel
ip = getstring(HKEY_LOCAL_MACHINE, "SystemCurrentControlSetServicesClassNetTrans

About this post

Posted: 2002-06-01
By: ArchiveBot
Viewed: 91 times

Categories

Visual Basic 6

Attachments

No attachments for this post


Loading Comments ...

Comments

No comments have been added for this post.

You must be logged in to make a comment.