none
VBscript - Insert Statement into SQL database

    Question

  • Hi,

    Matthew Beattie very kindly created the following script for me a little while back, the script is working brilliantly, but I now have a requirement to input the data straight into a SQL Server. I have tried to edit the script myself, but although I am not getting any errors, the data is not being loaded into the SQL server. The code that Matthew wrote is below and I have added a new function to perform the upload onto the bottom of it. It is worth noting that the script still appends the information to the log file that is created.

    '----------------------------------------------------------------------------------------------------------------------------
    'Script Name : AuditDomainAccess.vbs
    'Author      : Matthew Beattie
    'Created     : 15/01/09
    'Description : This script logs domain logon and logoff events to a centralised log file that is created daily.
    '----------------------------------------------------------------------------------------------------------------------------
    'Initialization  Section
    '----------------------------------------------------------------------------------------------------------------------------
    Option Explicit
    Const ForReading   = 1
    Const ForWriting   = 2
    Const ForAppending = 8
    Dim objDictionary, objFSO, wshShell, wshNetwork
    Dim scriptBaseName, scriptPath, scriptLogPath
    Dim ipAddress, macAddress, item, messageType, message
    On Error Resume Next
       Set objDictionary = NewDictionary
       Set objFSO        = CreateObject("Scripting.FileSystemObject")
       Set wshShell      = CreateObject("Wscript.Shell")
       Set wshNetwork    = CreateObject("Wscript.Network")
       scriptBaseName    = objFSO.GetBaseName(Wscript.ScriptFullName)
       scriptPath        = objFSO.GetFile(Wscript.ScriptFullName).ParentFolder.Path
       If Err.Number <> 0 Then
          Wscript.Quit
       End If
    On Error Goto 0
    '----------------------------------------------------------------------------------------------------------------------------
    'Main Processing Section
    '----------------------------------------------------------------------------------------------------------------------------
    On Error Resume Next
       ProcessScript
       If Err.Number <> 0 Then
          Wscript.Quit
       End If
       LogScriptResults
    On Error Goto 0
    '----------------------------------------------------------------------------------------------------------------------------
    'Functions Processing Section
    '----------------------------------------------------------------------------------------------------------------------------
    'Name       : ProcessScript -> Primary Function that controls all other script processing.
    'Parameters : None          ->
    'Return     : None          ->
    '----------------------------------------------------------------------------------------------------------------------------
    Function ProcessScript()
       Dim shareNames, logonServer
       On Error Resume Next
          logonServer = Replace(wshShell.ExpandEnvironmentStrings("%logonserver%"), "\\", "")
          If Err.Number <> 0 Then
             logonServer = ""
          End If
       On Error Goto 0
       shareNames = Array("\\testserver01\Logs$","\\" & logonServer & "\Logs$")
       '-------------------------------------------------------------------------------------------------------------------------
       'If the default log path does exist set the log path to another share name that does or exit if all shares are unavailable
       '-------------------------------------------------------------------------------------------------------------------------
       If Not SetLogPath(shareNames, scriptLogPath) Then
          Exit Function
       End If
       If Not GetIPConfig(ipAddress, macAddress) Then
          ipAddress  = "0.0.0.0"
          macAddress = "00:00:00:00:00:00"
       End If
       BuildMessage 0, IsoFriendlyDate(now) & "," & IsoTimeString(now) & "," & wshNetwork.ComputerName & "," & _
                       ipAddress & "," & wshNetwork.UserName & "," & _
                       logonServer & "," & Mid(scriptPath, InStrRev(scriptPath, "\") + 1)
    End Function
    '----------------------------------------------------------------------------------------------------------------------------
    'Name       : SetLogPath -> Checks an Array of sharenames and sets one to the scripts log path if the default is unavailable.
    'Parameters : shareNames -> A share name or array of shares names.
    '           : logPath    -> Input/Output : Variable assigned to a valid share name that exists and is online.
    'Return     : SetLogPath -> Function returns True and a valid log path otherwise returns False.
    '----------------------------------------------------------------------------------------------------------------------------
    Function SetLogPath(shareNames, logPath)
       Dim shareName
       SetLogPath = False
       If Not IsArray(shareNames) Then
          shareNames = Array(shareNames)
       End If
       If Not objFSO.FolderExists(logPath) Then
          For Each shareName In shareNames
             If objFSO.FolderExists(shareName) Then
                logPath = shareName
                Exit For
             Else
                shareName = ""
             End If
          Next
          If shareName = "" Then
             Exit Function
          End If
       End If
       SetLogPath = True
    End Function
    '----------------------------------------------------------------------------------------------------------------------------
    'Name       : NewDictionary -> Creates a new dictionary object.
    'Parameters : None          ->
    'Return     : NewDictionary -> Returns a dictionary object.
    '----------------------------------------------------------------------------------------------------------------------------
    Function NewDictionary
       Dim dict
       Set dict          = CreateObject("scripting.Dictionary")
       dict.CompareMode  = vbTextCompare
       Set NewDictionary = dict
    End Function
    '----------------------------------------------------------------------------------------------------------------------------
    'Name       : BuildMessage -> Builds a message string and adds it to a global dictionary object.
    'Parameters : messageType  -> Number indicating the type of message.
    'Parameters : message      -> Text string to include in the log message.
    'Return     : None         -> 
    '----------------------------------------------------------------------------------------------------------------------------
    Function BuildMessage(messageType, message)
       Dim line
       For Each line In SplitMessage(message, vbNewLine)
          If line <> "" Then
             Select Case messageType
                Case 1
                   objDictionary(objDictionary.Count) = messageType & "," & "Error " & Err.Number & " Hex(" & _
                                                        Hex(Err.Number) & ") " & line & ". " & Err.Description
                Case Else
                   objDictionary(objDictionary.Count) = messageType & "," & line
             End Select
          End If
       Next
    End Function
    '----------------------------------------------------------------------------------------------------------------------------
    'Name       : SplitMessage -> Splits a message string into an Array of strings.
    'Parameters : message      -> Text string to include in the log message.
    '           : delimiter    -> Character used to split the message into to an Array.
    'Return     : None         -> Returns an Array of stings or a single blank string if the input stringValue is empty.
    '----------------------------------------------------------------------------------------------------------------------------
    Function SplitMessage(stringValue, delimiter)
       If stringValue = "" Then
          SplitMessage = Array("")
       Else
          SplitMessage = Split(stringValue, delimiter)
       End If
    End Function
    '----------------------------------------------------------------------------------------------------------------------------
    'Name       : GetIPConfig -> Enumerates the IP & MAC Address of the system via WMI
    'Parameters : ipAddress   -> Input/Output : Variable assigned to the IP Address of the system.
    'Parameters : macAddress  -> Input/Output : Variable assigned to the MAC Address of the system.
    'Return     : GetIPConfig -> Returns True and the systems IP & MAC Address if successful otherwise returns False.
    '----------------------------------------------------------------------------------------------------------------------------
    Function GetIPConfig(ipAddress, macAddress)
       Dim objConfig
       GetIPConfig = False
       ipAddress   = ""
       On Error Resume Next
          For Each objConfig in Getobject("winmgmts:").ExecQuery("select * from " & _
                                                                 "Win32_NetworkAdapterConfiguration where IPEnabled = True")
             ipAddress  = objConfig.IPAddress(0)
             macAddress = objConfig.MACAddress(0)
             If ipAddress <> "" And ipAddress <> "0.0.0.0" And MACAddress <> "" Then
                Exit For
             End If
          Next
       On Error Goto 0
       If Err.Number <> 0 Then
          BuildMessage 1, "Enumerating Network Configuration"
          Exit Function
       End If
       GetIPConfig = True
    End Function
    '----------------------------------------------------------------------------------------------------------------------------
    'Name       : IsoDateTimeString -> Generate an ISO date and time string from a date/time value.
    'Parameters : dateValue         -> Input date/time value.
    'Return     : IsoDateTimeString -> Date and time parts of the input value in "yyyy-mm-dd hh:mm:ss" format.
    '----------------------------------------------------------------------------------------------------------------------------
    Function IsoDateTimeString(dateValue)
       IsoDateTimeString = IsoDateString (dateValue) & " " & IsoTimeString (dateValue)
    End Function
    '----------------------------------------------------------------------------------------------------------------------------
    'Name       : IsoFileName -> Generate the filename from a date/time value.
    'Parameters : dateValue     -> Input date/time value.
    'Return     : IsoDateString -> Date part of the input value in "yyyy-mm-dd" format.
    '----------------------------------------------------------------------------------------------------------------------------
    Function IsoFriendlyDate(dateValue)
       On Error Resume Next
          IsoFriendlyDate = Right (  "0" &   Day (dateValue), 2) & "/" & _
                  Right (  "0" & Month (dateValue), 1) & "/" & _
                  Right ("000" &  Year (dateValue), 4)
                          If Err.Number <> 0 Then
             BuildMessage 1, "Enumerating IsoFriendlyDate"
             IsoDateString = "00-0-0000"
          End If
       On Error Goto 0
    End Function
    '----------------------------------------------------------------------------------------------------------------------------
    'Name       : IsoDateString -> Generate an ISO date string from a date/time value.
    'Parameters : dateValue     -> Input date/time value.
    'Return     : IsoDateString -> Date part of the input value in "yyyy-mm-dd" format.
    '----------------------------------------------------------------------------------------------------------------------------
    Function IsoDateString(dateValue)
       On Error Resume Next
          IsoDateString = Right (  "0" &   Day (dateValue), 2) & "-" & _
                  Right (  "0" & Month (dateValue), 2) & "-" & _
                  Right ("000" &  Year (dateValue), 4)
                          If Err.Number <> 0 Then
             BuildMessage 1, "Enumerating IsoDateString"
             IsoDateString = "00-00-0000"
          End If
       On Error Goto 0
    End Function
    '----------------------------------------------------------------------------------------------------------------
    'Name       : IsoTimeString -> Generate an ISO time string from a date/time value.
    'Parameters : dateValue     -> Input date/time value.
    'Return     : IsoTimeString -> Time part of the input value in "hh:mm:ss" format.
    '----------------------------------------------------------------------------------------------------------------------------
    Function IsoTimeString(dateValue)
       On Error Resume Next
          IsoTimeString = Right ("0" &   Hour (dateValue), 2) & ":" & _
                          Right ("0" & Minute (dateValue), 2) & ":" & _
                          Right ("0" & Second (dateValue), 2)
          If Err.Number <> 0 Then
             BuildMessage 1, "Enumerating IsoTimeString"
             IsoTimeString = "00:00:00"
          End If
       On Error Goto 0
    End Function
    '----------------------------------------------------------------------------------------------------------------------------
    'Name       : LogMessage -> Parses the input message to be logged to the LogToFile Function.
    'Parameters : logPath    -> Full folder path and file name of the Log file without with file extension
    'Parameters : type       -> Number indicating the message type where:
    '           :            -> 0            : = success message         (the log file recieves the .log file extension)
    '           :            -> 1            : = error message           (the log file recieves the .err file extension)
    '           :            -> Other number : = unspecifed message type (the log file recieves the .err file extension)
    'Parameters : message    -> Text string to include in the log message.
    'Return     : None       -> 
    '----------------------------------------------------------------------------------------------------------------------------
    Function LogMessage(logPath, messageType, message)
       Select Case messageType
          case 0
             If Not LogToCentralFile(logPath & ".csv", message) Then
                Exit Function
             End If
          Case Else
             If Not LogToCentralFile(logPath & ".err", message) Then
                Exit Function
             End If
       End Select
    End Function
    '----------------------------------------------------------------------------------------------------------------------------
    'Name       : LogToCentralFile -> Attempts to Appends information to a central file.
    'Parameters : logSpec          -> Folder path, file name and extension of the central log file to append to.
    '           : message          -> String to include in the central log file
    'Return     : LogToCentralFile -> Returns True if Successfull otherwise False.
    '----------------------------------------------------------------------------------------------------------------------------
    Function LogToCentralFile(logSpec, message)
       Dim attempts, objLogFile
       LogToCentralFile = False
       '-------------------------------------------------------------------------------------------------------------------------
       'Attempt to append to the central log file up to 10 times, as it may be locked by some other system.
       '-------------------------------------------------------------------------------------------------------------------------
       attempts = 0
       Do
          On Error Resume Next
             Set objLogFile = objFSO.OpenTextFile(logSpec, ForAppending, True)
             If Err.Number = 0 Then
                objLogFile.WriteLine message
                objLogFile.Close
                LogToCentralFile = True
                Exit Function
             End If
          On Error Goto 0
          Randomize
          Wscript.sleep 1000 + Rnd * 100
          attempts = attempts + 1
       Loop Until attempts >= 10
    End Function
    '----------------------------------------------------------------------------------------------------------------------------
    'Name       : LogScriptResults -> Loops through the messages in the global Dictionary object and logs each message to the 
    '           :                  -> appropriate log file based on messageType.
    'Parameters : None             ->
    'Return     : None             ->
    '----------------------------------------------------------------------------------------------------------------------------
    Function LogScriptResults
       Dim messageType, message, item
       On Error Resume Next
          For Each item In objDictionary.Items   
             messageType = Split(item, ",", 2)(0)
             message     = Split(item, ",", 2)(1)
             If Err.Number = 0 Then
                If messageType = 0 Then
                   LogMessage scriptLogPath & "\" & Left(IsoDateTimeString(Now), 10), messageType, message
                Else
                   logMessage scriptLogPath & "\" & scriptBaseName, messageType, message
                End If
             End If
          Next
       On Error Goto 0
    End Function
    '----------------------------------------------------------------------------------------------------------------------------
    Function WriteToDatabase
    
    Dim mConnection
    
    Set mConnection = CreateObject("ADODB.Connection")
    mConnection.Open "Provider=SQLOLEDB.1;Data Source=testserver01;Initial Catalog=auditing","administrator","password"
    
    mConnection.Execute "INSERT INTO logon_logoff_data (Logon_Date,Logon_Time,Workstation,IP_Address,Username,Logon_Server,LogonLogoff_Event) VALUES ('IsoFriendlyDate(now) & "," & IsoTimeString(now) & "," & wshNetwork.ComputerName & "," ipAddress & "," & wshNetwork.UserName & "," logonServer & "," & Mid(scriptPath, InStrRev(scriptPath, "\")"
    
    Set mConnection = Nothing
    
    End Function
    If someone has any idea where I have gone wrong that would be great.

    Thanks
    Matt
    Thursday, August 13, 2009 2:03 PM

Answers

  • Hi Matt

    Let me explain how to set up the scripts, follow these steps in order:

    Create your SQL database. 

    Enter the following SQL statement to create your table schema:

    "Create Table DomainAudit (IsoDateTime datetime,ComputerName nvarchar(50),IPAddress ntext,MACAddress ntext,LogonName nvarchar(50),DomainController nvarchar(50), EventType text)"

    Create the "Logs$" share on your domain controller and assign appropriate share and NTFS permissions to allow users to create and append to the log file.

    Copy the "AuditDomainAccess.vbs" script into your group policy scripts logon\logoff folders on your domain controller (Edit the "shareNames" variable to specify your unc or dfs share names)

    Copy the "ImportAuditLogs.vbs" to "C:\Scripts\ImportAuditLogs\ImportAuditLogs.vbs" on your SQL server. (Edit the "hostName", "databaseName",  and "tableName" variables to specify your sqlServer, database and tableName values.)

    Create a scheduled task on your SQL Server to run at 12:05 AM daily using a service account that has SQL permissions to update the database and permissions to the "Logs$" share on the domain controller to read the log files and delete them once it's imported them.

    The reason your modified code is not working is because there are multiple syntax errors in it due to undefined variables and typos. I'd advise against editing my code if you don't completely understand it. If you do want to edit it and make your own version then i'd suggest you always use the "Option Explicit" statement to catch your spelling errors and use the "On Error Resume Next" whenever you create an object or perform a task that may fail so you can perform error checking.

    Seeing as you really want to append your audit information to SQL at logon\logoff i've written a script for you which does this for you using the "Insert" sql statement. It will work (assuming you change the variables "sqlServerName", "databaseName", "tableName" and "scriptLogPath" to specify your values. Do not change any other code. Get it working "as is" then modify it one step at a time. This way when you break it you'll know exactly what change caused your error. 

    If you follow my instructions and you have set your SQL, NTFS and Share permissions accordingly it will work.

    Copy the code below and apply it to either a new group policy object or the default domain policy. I strongly advise against using this in production because domain users can edit your database recordset and if your SQL server ever crashes, is rebooted or disconnected from the the network then auditing will fail (unless your using SQL fail over clustering).

    Make sure you use this command to create your database table:

    "Create Table DomainAudit (IsoDateTime datetime,ComputerName nvarchar(50),IPAddress ntext,MACAddress ntext,LogonName nvarchar(50),DomainController nvarchar(50), EventType text)"

    Let me know how you go with it.

    Cheers

    Matt :)

    '----------------------------------------------------------------------------------------------------------------------------
    'Script Name : AuditDomainAccess.vbs
    'Author      : Matthew Beattie
    'Created     : 19/08/09
    'Description : This script audits domain access by logging users logon and logoff events directly to an SQL database.
    '----------------------------------------------------------------------------------------------------------------------------
    'Initialization  Section
    '----------------------------------------------------------------------------------------------------------------------------
    Option Explicit
    Const ForAppending = 8
    Dim objFSO, wshShell, wshNetwork
    Dim scriptPath, scriptLogPath, scriptBaseName
    On Error Resume Next
       Set objFSO     = CreateObject("Scripting.FileSystemObject")
       Set wshShell   = CreateObject("Wscript.Shell")
       Set wshNetwork = CreateObject("Wscript.Network")
       scriptBaseName = objFSO.GetBaseName(Wscript.ScriptFullName)
       scriptPath     = objFSO.GetFile(Wscript.ScriptFullName).ParentFolder.Path
       scriptLogPath  = "\\testdb01\Logs$\" & scriptBaseName
       If Err.Number <> 0 Then
          Wscript.Quit
       End If
    On Error Goto 0
    '----------------------------------------------------------------------------------------------------------------------------
    'Main Processing Section
    '----------------------------------------------------------------------------------------------------------------------------
    On Error Resume Next
       ProcessScript
       If Err.Number <> 0 Then
          Wscript.Quit
       End If
    On Error Goto 0
    '----------------------------------------------------------------------------------------------------------------------------
    'Functions Processing Section
    '----------------------------------------------------------------------------------------------------------------------------
    'Name       : ProcessScript -> Primary Function that controls all other script processing.
    'Parameters : None          ->
    'Return     : None          ->
    '----------------------------------------------------------------------------------------------------------------------------
    Function ProcessScript
       Dim sqlServerName, databaseName, tableName, tableFields, tableValues
       Dim eventType, logonServer, ipAddress, macAddress, i
       databaseName  = "DomainAudit"
       sqlServerName = "testdb01"
       tableName     = "DomainAccess"
       '-------------------------------------------------------------------------------------------------------------------------
       'Enumerate the EventType (Logon\Logoff) from the script's path. Enumerate the authenticating domain controller.
       '-------------------------------------------------------------------------------------------------------------------------
       On Error Resume Next
          eventType   = Mid(scriptPath, InStrRev(scriptPath, "\") + 1)
          logonServer = Replace(wshShell.ExpandEnvironmentStrings("%logonserver%"), "\\", "")
          If Err.Number <> 0 Then
             logonServer = ""
          End If
       On Error Goto 0
       '-------------------------------------------------------------------------------------------------------------------------
       'Enumerate the IP and MAC Address of the current system.
       '-------------------------------------------------------------------------------------------------------------------------
       If Not GetIPConfig(ipaddress, macAddress) Then
          ipAddress  = ""
          macAddress = ""
       End If
       '-------------------------------------------------------------------------------------------------------------------------
       'Create the database record as a string to insert into the database table.
       '-------------------------------------------------------------------------------------------------------------------------
       tableFields = "IsoDateTime,ComputerName,IPAddress,MACAddress,LogonName,DomainController,EventType"
       tableValues = Array(IsoDateTimeString(Now),wshNetwork.ComputerName,ipAddress, _
                           macAddress,wshNetwork.UserName,logonServer,eventType)
       For i = 0 To UBound(tableValues)
          tableValues(i) = "'" & tableValues(i) & "'"
       Next
       tableValues = Join(tableValues, ",")
       '-------------------------------------------------------------------------------------------------------------------------
       'Insert the record into the SQL database table.
       '-------------------------------------------------------------------------------------------------------------------------
       If Not InsertDatabaseRecord(sqlServerName, databaseName, tableName, tableFields, tableValues) Then
          Exit Function
       End If
    End Function
    '----------------------------------------------------------------------------------------------------------------------------
    'Name       : DQ          -> Place double quotes around a string and replace double quotes
    '           :             -> within the string with pairs of double quotes.
    'Parameters : stringValue -> String value to be double quoted
    'Return     : DQ          -> Double quoted string.
    '----------------------------------------------------------------------------------------------------------------------------
    Function DQ(ByVal stringValue)
       If stringValue <> "" Then
          DQ = """" & Replace (stringValue, """", """""") & """"
       Else
          DQ = """"""
       End If
    End Function
    '----------------------------------------------------------------------------------------------------------------------------
    'Name       : IsoDateTimeString -> Generate an ISO date and time string from a date/time value.
    'Parameters : dateValue         -> Input date/time value.
    'Return     : IsoDateTimeString -> Date and time parts of the input value in "yyyy-mm-dd hh:mm:ss" format.
    '----------------------------------------------------------------------------------------------------------------------------
    Function IsoDateTimeString(dateValue)
       IsoDateTimeString = IsoDateString(dateValue) & " " & IsoTimeString(dateValue)
    End Function
    '----------------------------------------------------------------------------------------------------------------------------
    'Name       : IsoDateString -> Generate an ISO date string from a date/time value.
    'Parameters : dateValue     -> Input date/time value.
    'Return     : IsoDateString -> Date part of the input value in "yyyy-mm-dd" format.
    '----------------------------------------------------------------------------------------------------------------------------
    Function IsoDateString(dateValue)
       On Error Resume Next
          IsoDateString = Right("000" &  Year(dateValue), 4) & "-" & _
                          Right(  "0" & Month(dateValue), 2) & "-" & _
                          Right(  "0" &   Day(dateValue), 2)
          If Err.Number <> 0 Then
             BuildMessage 1, "Enumerating IsoDateString"
             IsoDateString = "0000-00-00"
          End If
       On Error Goto 0
    End Function
    '----------------------------------------------------------------------------------------------------------------------------
    'Name       : IsoTimeString -> Generate an ISO time string from a date/time value.
    'Parameters : dateValue     -> Input date/time value.
    'Return     : IsoTimeString -> Time part of the input value in "hh:mm:ss" format.
    '----------------------------------------------------------------------------------------------------------------------------
    Function IsoTimeString(dateValue)
       On Error Resume Next
          IsoTimeString = Right("0" &   Hour(dateValue), 2) & ":" & _
                          Right("0" & Minute(dateValue), 2) & ":" & _
                          Right("0" & Second(dateValue), 2)
          If Err.Number <> 0 Then
             BuildMessage 1, "Enumerating IsoTimeString"
             IsoTimeString = "00:00:00"
          End If
       On Error Goto 0
    End Function
    '----------------------------------------------------------------------------------------------------------------------------
    'Name       : GetIPConfig -> Enumerates the IP & MAC Address of the system via WMI
    'Parameters : ipAddress   -> Input/Output : Variable assigned to the IP Address of the system.
    '           : macAddress  -> Input/Output : Variable assigned to the MAC Address of the system.
    'Return     : GetIPConfig -> Returns True and the systems IP & MAC Address if successful otherwise returns False.
    '----------------------------------------------------------------------------------------------------------------------------
    Function GetIPConfig(ipAddress, macAddress)
       Dim objConfig
       GetIPConfig = False
       ipAddress   = ""
       On Error Resume Next
          For Each objConfig in Getobject("winmgmts:").ExecQuery("select * from " & _
                                                                 "Win32_NetworkAdapterConfiguration where IPEnabled = True")
             ipAddress  = objConfig.IPAddress(0)
             macAddress = objConfig.MACAddress(0)
             If ipAddress <> "" And ipAddress <> "0.0.0.0" And MACAddress <> "" Then
                Exit For
             End If
          Next
       On Error Goto 0
       If Err.Number <> 0 Then
          LogError "Enumerating Network Configuration"
          Exit Function
       End If
       GetIPConfig = True
    End Function
    '----------------------------------------------------------------------------------------------------------------------------
    Function InsertDatabaseRecord(hostName, databaseName, tableName, tableFields, tableValues)
       Dim objConnection, sqlStatement
       InsertDatabaseRecord = False
       sqlStatement         = "Insert Into " & tableName & "(" & tableFields & ") Values (" & tableValues & ")"
       On Error Resume Next
          Set objConnection = CreateObject("ADODB.Connection")
          If Err.Number <> 0 Then
             LogError "Creating ADO connection Object"
             Exit Function
          End If
          objConnection.Open "Provider=SQLOLEDB.1;Integrated Security=SSPI;" & _
                             "Persist Security Info=False;Initial Catalog=" & databaseName & ";" & _
                             "Data Source=" & hostName
          If Err.Number <> 0 Then
             LogError "Opening the " & DQ(databaseName) & " on " & DQ(hostName)
             Exit Function
          End If
          objConnection.execute sqlStatement
          If Err.Number <> 0 Then
             LogError "Executing SQL Statement " & DQ(sqlStatement)
             Exit Function
          End If
       On Error Goto 0
       InsertDatabaseRecord = True
    End Function
    '----------------------------------------------------------------------------------------------------------------------------
    'Name       : LogError -> Logs an error related to the error object to a central log file.
    'Parameters : message  -> String containing a description of what caused the error.
    'Return     : LogError -> None.
    '----------------------------------------------------------------------------------------------------------------------------
    Function LogError(message)
       Dim errorMessage
       errorMessage = "Error " & Err.Number & " (Hex " & Hex(Err.Number) & ") " & message & ". " & Err.Description
       If Not LogToCentralFile(scriptLogPath & ".err", errorMessage) Then
          Exit Function
       End If
    End Function
    '----------------------------------------------------------------------------------------------------------------------------
    'Name       : LogToCentralFile -> Attempts to Appends information to a central file.
    'Parameters : logSpec          -> Folder path, file name and extension of the central log file to append to.
    '           : message          -> String to include in the central log file
    'Return     : LogToCentralFile -> Returns True if Successfull otherwise False.
    '----------------------------------------------------------------------------------------------------------------------------
    Function LogToCentralFile(logSpec, message)
       Dim attempts, objLogFile
       LogToCentralFile = False
       '-------------------------------------------------------------------------------------------------------------------------
       'Attempt to append to the central log file up to 10 times, as it may be locked by some other system.
       '-------------------------------------------------------------------------------------------------------------------------
       attempts = 0
       Do
          On Error Resume Next
             Set objLogFile = objFSO.OpenTextFile(logSpec, ForAppending, True)
             If Err.Number = 0 Then
                objLogFile.WriteLine message
                objLogFile.Close
                LogToCentralFile = True
                Exit Function
             End If
          On Error Goto 0
          Randomize
          Wscript.sleep 1000 + Rnd * 100
          attempts = attempts + 1
       Loop Until attempts >= 10
    End Function
    '----------------------------------------------------------------------------------------------------------------------------
    Wednesday, August 19, 2009 5:29 AM
    Moderator

All replies

  • oN THE fUNCTION:

    ...VALUES ('" & IsoFriendlyDate(now) & "','" & iso...
    Friday, August 14, 2009 11:52 AM
  • Hi Avx,

    Thanks for that - I have tried that but still no luck, I am using something slightly different now, but along the same lines - can you see what is wrong?

    Function WriteToDatabase()
    
    strInitialDB = "auditing"
    strSQLServer = "localhost" 'type the name of SQL Server instance here.
    strTable = "logon_logoff_data" 'Name of table to fetch rows from.
    
    strQuery = "INSERT INTO " & strTable & "(Logon_Date,Logon_Time,Workstation,IP_Address,Username,Logon_Server,LogonLogoff_Event) VALUES ('" & IsoFriendlyDate(now) & "','" & IsoTimeString(now) & "','" & wshNetwork.ComputerName & "','" & ipAddress & "','" & wshNetwork.UserName & "','" & logonServer & "','" & Mid(scriptPath, InStrRev(scriptPath, "\")) & "')"
    
    Set objConn = CreateObject("ADODB.Connection")
    ' open the master data source
    objConn.Open "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=" & strInitialDB & ";Data Source=" & strSQLServer
    
    set objRS = objConn.execute(strQuery)
    
    End Function
    Thanks
    Matt
    Friday, August 14, 2009 12:40 PM
  • Hi Matt

    I think the reason your modified script it is not inserting the information into your SQL database is because you have not called your "WriteToDatabase" function in the "Main processing Section" therefore it is not even attempting to insert the recordset into the database because your "WriteToDatabase" function is not being executed.

    I'm not a DBA but i'm assuming that "domain users" would require permissions to modify your SQL database to be able to insert and update the recordset at logon\logoff (bad idea). This would potentially expose all auditing information youve stored in your database to all users as opossed to potentially exposing a log file in a hidden share for a 24 hour period before moving it to a restricted location.

    I'm working on a script for you which will move the log files every 24 hours (except for the current log being appended to) to a restricted location that user's do not have NTFS permissions to modify. Each log file in this directory will be directly imported into the SQL database using the "bulk insert" command and assuming it is successful then the .log files would be deleted. I haven't had the chance to test my script yet but once i'm done i'll post it it for you.

    If you really want to write the information directly to the database at logon\logoff then call your "WriteToDatabase" function in the main processing section as follows:

    '----------------------------------------------------------------------------------------------------------------------------
    'Main Processing Section
    '----------------------------------------------------------------------------------------------------------------------------
    On Error Resume Next
       ProcessScript
       If Err.Number <> 0 Then
          Wscript.Quit
       End If
       LogScriptResults
       WriteToDatabase
    On Error Goto 0
    


    Cheers

    Matt :)
    Sunday, August 16, 2009 6:05 AM
    Moderator
  • Hi Matt,

    Thanks for the reply :) - I thought it might be something simple like not calling the function - as you may have gathered, I am still quite new to VBS :) - so just trying to get the reigns.

    I have put the function call in where you said, but I am not getting anywhere, I am able to run the code on its own, and it works fine, but when inside the script above, I am not getting any results. I have also tried to stick fixed values into the script, but still no luck.

    As for the user permissions, the script that I am now using (see below) uses the system account to stick the information in to the database I believe, so users are unable to gain access to the data I hope, but that is something I can look in to once the system is up and running hopefully.

    strInitialDB = "auditing"
    strSQLServer = "localhost" 'type the name of SQL Server instance here.
    strTable = "logon_logoff_data" 'Name of table to fetch rows from.
    
    'strQuery contain the query that will be executed and result will be displayed
    'in HTML window. Specify any SQL query here, and you will get the result for
    'that in HTML window.
    strQuery = "INSERT INTO " & strTable & "(Logon_Date,Logon_Time,Workstation,IP_Address,Username,Logon_Server,LogonLogoff_Event) VALUES ('14/8/2009','9:05:36','WEBSERVER01','192.168.232.129','Administrator','WEBSERVER01','Desktop')"
    
    Set objConn = CreateObject("ADODB.Connection")
    
    ' open the master data source
    objConn.Open "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=" & strInitialDB & ";Data Source=" & strSQLServer
    
    set objRS = objConn.execute(strQuery)
    Appreciate you continuing to work on this for me Matt

    Cheers
    Matt
    Monday, August 17, 2009 7:44 AM
  • Hey Matt

    I've figured it out for you. Here is a script that uses the bulk insert command to import the logs into a SQL database.  This assumes the following fieldNames and datatypes for the database table:

    Create Table DomainAudit (IsoDateTime datetime,ComputerName nvarchar(50),IPAddress ntext,MACAddress ntext,LogonName nvarchar(50),DomainController nvarchar(50), EventType text)

    Please note that you need to edit my previous script "AuditDomainAccess" to remove the code that creates the header row otherwise the bulk insert will fail as the header row datatypes are invalid.

    I've tested this in a virtual environment running a Windows Server 2003 SP2 Domain Controller, SQL Server 2005 SP3 and Windows7 Client. Works fine for me, if you have any trouble post the error log the script creates for you and i'll try and figure out what the problem is.

    Save the following code as "ImportAuditLogs.vbs" and configure it as a scheduled task using an account that has permissions to your SQL database and modify permissions to log file path as it attempts to delete the logs files once it's done importing them into the database. Schedule the task daily at 00:05 AM. It will connect to the logs directory EG "\\testdc01\log$" and attempt to import the log file using the bulk import command to SQL server. If this is successfull it deletes the log file.

    I'll repost the modified code for the "AuditDomainAccess.vbs" script. Here is the code for "ImportAuditLogs.vbs"

    Hope this helps

    Cheers

    Matt :)

    P.S...What about that beer?


    '----------------------------------------------------------------------------------------------------------------------------
    'Script Name : ImportAuditLogs.vbs
    'Author      : Matthew Beattie
    'Created     : 18/08/09
    'Description : This script imports the domain access audit logs to an SQL Database.
    '----------------------------------------------------------------------------------------------------------------------------
    'Initialization  Section
    '----------------------------------------------------------------------------------------------------------------------------
    Option Explicit
    Const ForAppending = 8
    Dim objFSO, scriptBaseName, scriptPath, scriptLogPath
    On Error Resume Next
       Set objFSO        = CreateObject("Scripting.FileSystemObject")
       scriptBaseName    = objFSO.GetBaseName(Wscript.ScriptFullName)
       scriptPath        = objFSO.GetFile(Wscript.ScriptFullName).ParentFolder.Path
       scriptLogPath     = scriptPath & "\" & scriptBaseName
       If Err.Number <> 0 Then
          Wscript.Quit
       End If
    On Error Goto 0
    '----------------------------------------------------------------------------------------------------------------------------
    'Main Processing Section
    '----------------------------------------------------------------------------------------------------------------------------
    On Error Resume Next
       ProcessScript
       If Err.Number <> 0 Then
          Wscript.Quit
       End If
    On Error Goto 0
    '----------------------------------------------------------------------------------------------------------------------------
    'Functions Processing Section
    '----------------------------------------------------------------------------------------------------------------------------
    'Name       : ProcessScript -> Primary Function that controls all other script processing.
    'Parameters : None          ->
    'Return     : None          ->
    '----------------------------------------------------------------------------------------------------------------------------
    Function ProcessScript
       Dim hostName, databaseName, tableName, folderPath, currentLog, file
       hostName     = "testdb01"
       databaseName = "DomainAccess"
       tableName    = "DomainAudit"
       folderPath   = "\\testdc01\logs$"
       currentLog   = Left(IsoDateTimeString(Now), 10) & ".log"
       On Error Resume Next
          '----------------------------------------------------------------------------------------------------------------------
          'Attempt to import each file into the SQL Database. This assumes files in the folderPath directory are valid log files.
          '----------------------------------------------------------------------------------------------------------------------
          For Each file In objFSO.GetFolder(folderPath).files
             Do
                If StrComp(file.Name, currentLog, vbTextCompare) <> 0 Then
                   If Not ImportLogToDataBase(hostName, databaseName, tableName, file.Path) Then
                      Exit Do
                   Else
                      LogMessage DQ(file.Path) & " was successfully imported into the " & _
                                 DQ(databaseName) & " SQL Database on " & DQ(hostName)
                      '----------------------------------------------------------------------------------------------------------
                      'Delete the log file as it has been successfully imported into the SQL database and is no longer required.
                      '----------------------------------------------------------------------------------------------------------
                      file.Delete
                      If Err.Number <> 0 Then
                         LogError "Deleting file " & DQ(file.Path)
                         Exit Do
                      End If
                   End If
                End If
             Loop Until True
          Next
       On Error Goto 0
    End Function
    '----------------------------------------------------------------------------------------------------------------------------
    'Name       : ImportLogToDataBase -> Attempts to import the domain access audit log into an SQL database.
    'Parameters : hostName            -> String containing the computer name of the SQL server to connect to.
    '           : databaseName        -> String containing the SQL database name hosted on the database server.
    '           : tableName           -> String containing the database table name to import the log file to.
    '           : logSpec             -> String containing the SQL database name hosted on the database server.
    'Return     : ImportLogToDataBase -> Returns True if the log was successfully imported otherwise returns False
    '----------------------------------------------------------------------------------------------------------------------------
    Function ImportLogToDataBase(hostName, databaseName, tableName, logSpec)
       Dim objConnection, results, sqlStatement
       ImportLogToDataBase = False
       On Error Resume Next
          Set objConnection = CreateObject("ADODB.Connection")
          If Err.Number <> 0 Then
             LogError "Creating ADO Object on " & DQ(hostName)
             Exit Function
          End If
          objConnection.Open "Provider=sqloledb;Data Source=" & hostName & ";" & _
                             "Initial Catalog=" & databaseName & ";Integrated Security=SSPI"
          If Err.Number <> 0 Then
             LogError "Opening the " & DQ(databaseName) & " SQL database on " & DQ(hostName)
             Exit Function
          End If
          sqlStatement = "Bulk Insert " & databaseName & ".dbo.[" & tableName & "] From " & DQ(logSpec) & _
                         "With (FieldTerminator = ',', RowTerminator = '\n')"
          objConnection.Execute sqlStatement
          If Err.Number <> 0 Then
             LogError "Executing " & DQ(sqlStatement)
             Exit Function
          End If
          objConnection.Close
       On Error Goto 0
       ImportLogToDataBase = True
    End Function
    '----------------------------------------------------------------------------------------------------------------------------
    'Name       : DQ          -> Place double quotes around a string and replace double quotes
    '           :             -> within the string with pairs of double quotes.
    'Parameters : stringValue -> String value to be double quoted
    'Return     : DQ          -> Double quoted string.
    '----------------------------------------------------------------------------------------------------------------------------
    Function DQ (ByVal stringValue)
       If stringValue <> "" Then
          DQ = """" & Replace (stringValue, """", """""") & """"
       Else
          DQ = """"""
       End If
    End Function
    '----------------------------------------------------------------------------------------------------------------------------
    'Name       : IsoDateTimeString -> Generate an ISO date and time string from a date/time value.
    'Parameters : dateValue         -> Input date/time value.
    'Return     : IsoDateTimeString -> Date and time parts of the input value in "yyyy-mm-dd hh:mm:ss" format.
    '----------------------------------------------------------------------------------------------------------------------------
    Function IsoDateTimeString(dateValue)
       IsoDateTimeString = IsoDateString (dateValue) & " " & IsoTimeString (dateValue)
    End Function
    '----------------------------------------------------------------------------------------------------------------------------
    'Name       : IsoDateString -> Generate an ISO date string from a date/time value.
    'Parameters : dateValue     -> Input date/time value.
    'Return     : IsoDateString -> Date part of the input value in "yyyy-mm-dd" format.
    '----------------------------------------------------------------------------------------------------------------------------
    Function IsoDateString(dateValue)
       On Error Resume Next
          IsoDateString = Right ("000" &  Year (dateValue), 4) & "-" & _
                          Right (  "0" & Month (dateValue), 2) & "-" & _
                          Right (  "0" &   Day (dateValue), 2)
          If Err.Number <> 0 Then
             BuildMessage 1, "Enumerating IsoDateString"
             IsoDateString = "0000-00-00"
          End If
       On Error Goto 0
    End Function
    '----------------------------------------------------------------------------------------------------------------------------
    'Name       : IsoTimeString -> Generate an ISO time string from a date/time value.
    'Parameters : dateValue     -> Input date/time value.
    'Return     : IsoTimeString -> Time part of the input value in "hh:mm:ss" format.
    '----------------------------------------------------------------------------------------------------------------------------
    Function IsoTimeString(dateValue)
       On Error Resume Next
          IsoTimeString = Right ("0" &   Hour (dateValue), 2) & ":" & _
                          Right ("0" & Minute (dateValue), 2) & ":" & _
                          Right ("0" & Second (dateValue), 2)
          If Err.Number <> 0 Then
             BuildMessage 1, "Enumerating IsoTimeString"
             IsoTimeString = "00:00:00"
          End If
       On Error Goto 0
    End Function
    '----------------------------------------------------------------------------------------------------------------------------
    'Name      : LogMessage -> Parses a message to the log file.   
    'Parameters: message    -> String containnig the message to include in the log file.
    'Return    : None       ->    
    '----------------------------------------------------------------------------------------------------------------------------
    Function LogMessage(message)   
       If Not LogToFile(scriptLogPath & ".log", message) Then  
          Exit Function  
       End If  
    End Function  
    '----------------------------------------------------------------------------------------------------------------------------
    'Name      : LogError -> Logs the current information about the error object.
    'Parameters: message  -> String containnig the message that relates to the process that caused the error.
    'Return    : None     ->    
    '----------------------------------------------------------------------------------------------------------------------------
    Function LogError(message)
       Dim errorMessage
       errorMessage = "Error " & Err.Number & " (Hex " & Hex(Err.Number) & ") " & message & ". " & Err.Description
       If Not LogToFile(scriptLogPath & ".err", errorMessage) Then
          Exit Function
       End If
    End Function  
    '----------------------------------------------------------------------------------------------------------------------------
    'Name       : LogToFile -> Write a message into the user's network log file.   
    'Parameters : LogSpec   -> String containing the Folder path, file name and extension of the log file to write to.   
    '           : message   -> String containing the Message to be logged.   
    'Return     : LogToFile -> Returns True if successful otherwise returns false.   
    '----------------------------------------------------------------------------------------------------------------------------
    Function LogToFile(logSpec, message)   
       LogToFile = False  
       On Error Resume Next  
          With objFSO.OpenTextFile(logSpec, ForAppending, True)   
             .WriteLine Date & " " & Time & " " & message
             .Close   
          End With  
          If Err.Number <> 0 Then  
             Exit Function  
          End If  
       On Error Goto 0   
       LogToFile = True  
    End Function
    '----------------------------------------------------------------------------------------------------------------------------
    Tuesday, August 18, 2009 6:06 AM
    Moderator
  • Hey Matt

    Just for your reference here is my origonal script minus the code insert the header row in the log files.

    Cheers

    Matt :)

    '----------------------------------------------------------------------------------------------------------------------------
    'Script Name : AuditDomainAccess.vbs
    'Author      : Matthew Beattie
    'Created     : 15/01/09
    'Description : This script logs domain logon and logoff events to a centralised log file that is created daily.
    '----------------------------------------------------------------------------------------------------------------------------
    'Initialization  Section
    '----------------------------------------------------------------------------------------------------------------------------
    Option Explicit
    Const ForReading   = 1
    Const ForWriting   = 2
    Const ForAppending = 8
    Dim objDictionary, objFSO, wshShell, wshNetwork
    Dim scriptBaseName, scriptPath, scriptLogPath
    Dim ipAddress, macAddress, item, messageType, message
    On Error Resume Next
       Set objDictionary = NewDictionary
       Set objFSO        = CreateObject("Scripting.FileSystemObject")
       Set wshShell      = CreateObject("Wscript.Shell")
       Set wshNetwork    = CreateObject("Wscript.Network")
       scriptBaseName    = objFSO.GetBaseName(Wscript.ScriptFullName)
       scriptPath        = objFSO.GetFile(Wscript.ScriptFullName).ParentFolder.Path
       If Err.Number <> 0 Then
          Wscript.Quit
       End If
    On Error Goto 0
    '----------------------------------------------------------------------------------------------------------------------------
    'Main Processing Section
    '----------------------------------------------------------------------------------------------------------------------------
    On Error Resume Next
       ProcessScript
       If Err.Number <> 0 Then
          Wscript.Quit
       End If
       LogScriptResults
    On Error Goto 0
    '----------------------------------------------------------------------------------------------------------------------------
    'Functions Processing Section
    '----------------------------------------------------------------------------------------------------------------------------
    'Name       : ProcessScript -> Primary Function that controls all other script processing.
    'Parameters : None          ->
    'Return     : None          ->
    '----------------------------------------------------------------------------------------------------------------------------
    Function ProcessScript()
       Dim shareNames, logonServer
       On Error Resume Next
          logonServer = Replace(wshShell.ExpandEnvironmentStrings("%logonserver%"), "\\", "")
          If Err.Number <> 0 Then
             logonServer = ""
          End If
       On Error Goto 0
       shareNames = Array("\\testdc01\Logs$","\\" & logonServer & "\Logs$")
       '-------------------------------------------------------------------------------------------------------------------------
       'If the default log path does exist set the log path to another share name that does or exit if all shares are unavailable
       '-------------------------------------------------------------------------------------------------------------------------
       If Not SetLogPath(shareNames, scriptLogPath) Then
          Exit Function
       End If
       '-------------------------------------------------------------------------------------------------------------------------
       'Enumerate the IP and MAC Addresses from the local system for logging.
       '-------------------------------------------------------------------------------------------------------------------------
       If Not GetIPConfig(ipAddress, macAddress) Then
          ipAddress  = "0.0.0.0"
          macAddress = "00:00:00:00:00:00"
       End If
       '-------------------------------------------------------------------------------------------------------------------------
       'Add the Event Type, system and user information to the global message dictionary to write to the log file.
       '-------------------------------------------------------------------------------------------------------------------------
       BuildMessage 0, IsoDateTimeString(Now) & "," & wshNetwork.ComputerName & "," & _
                       ipAddress & "," & macAddress & "," & wshNetwork.UserName & "," & _
                       logonServer & "," & Mid(scriptPath, InStrRev(scriptPath, "\") + 1)
    End Function
    '----------------------------------------------------------------------------------------------------------------------------
    'Name       : SetLogPath -> Checks an Array of sharenames and sets one to the scripts log path if the default is unavailable.
    'Parameters : shareNames -> A share name or array of shares names.
    '           : logPath    -> Input/Output : Variable assigned to a valid share name that exists and is online.
    'Return     : SetLogPath -> Function returns True and a valid log path otherwise returns False.
    '----------------------------------------------------------------------------------------------------------------------------
    Function SetLogPath(shareNames, logPath)
       Dim shareName
       SetLogPath = False
       If Not IsArray(shareNames) Then
          shareNames = Array(shareNames)
       End If
       If Not objFSO.FolderExists(logPath) Then
          For Each shareName In shareNames
             If objFSO.FolderExists(shareName) Then
                logPath = shareName
                Exit For
             Else
                shareName = ""
             End If
          Next
          If shareName = "" Then
             Exit Function
          End If
       End If
       SetLogPath = True
    End Function
    '----------------------------------------------------------------------------------------------------------------------------
    'Name       : NewDictionary -> Creates a new dictionary object.
    'Parameters : None          ->
    'Return     : NewDictionary -> Returns a dictionary object.
    '----------------------------------------------------------------------------------------------------------------------------
    Function NewDictionary
       Dim dict
       Set dict          = CreateObject("scripting.Dictionary")
       dict.CompareMode  = vbTextCompare
       Set NewDictionary = dict
    End Function
    '----------------------------------------------------------------------------------------------------------------------------
    'Name       : BuildMessage -> Builds a message string and adds it to a global dictionary object.
    'Parameters : messageType  -> Number indicating the type of message.
    'Parameters : message      -> Text string to include in the log message.
    'Return     : None         -> 
    '----------------------------------------------------------------------------------------------------------------------------
    Function BuildMessage(messageType, message)
       Dim line
       For Each line In SplitMessage(message, vbNewLine)
          If line <> "" Then
             Select Case messageType
                Case 1
                   objDictionary(objDictionary.Count) = messageType & "," & "Error " & Err.Number & " Hex(" & _
                                                        Hex(Err.Number) & ") " & line & ". " & Err.Description
                Case Else
                   objDictionary(objDictionary.Count) = messageType & "," & line
             End Select
          End If
       Next
    End Function
    '----------------------------------------------------------------------------------------------------------------------------
    'Name       : BuildErrorString -> Builds an error string relating to the properties of the Error object.
    'Parameters : message          -> String containg a description of the function or process that generated the error.
    'Return     : buildErrorString -> Returns an error string relating to the properties of the Error object.
    '----------------------------------------------------------------------------------------------------------------------------
    Function BuildErrorString(message)
       BuildErrorString = "Error " & Err.Number & " (Hex " & Hex(Err.Number) & ") " & message & ". " & Err.Description
    End Function
    '----------------------------------------------------------------------------------------------------------------------------
    'Name       : SplitMessage -> Splits a message string into an Array of strings.
    'Parameters : message      -> Text string to include in the log message.
    '           : delimiter    -> Character used to split the message into to an Array.
    'Return     : None         -> Returns an Array of stings or a single blank string if the input stringValue is empty.
    '----------------------------------------------------------------------------------------------------------------------------
    Function SplitMessage(stringValue, delimiter)
       If stringValue = "" Then
          SplitMessage = Array("")
       Else
          SplitMessage = Split(stringValue, delimiter)
       End If
    End Function
    '----------------------------------------------------------------------------------------------------------------------------
    'Name       : GetIPConfig -> Enumerates the IP & MAC Address of the system via WMI
    'Parameters : ipAddress   -> Input/Output : Variable assigned to the IP Address of the system.
    'Parameters : macAddress  -> Input/Output : Variable assigned to the MAC Address of the system.
    'Return     : GetIPConfig -> Returns True and the systems IP & MAC Address if successful otherwise returns False.
    '----------------------------------------------------------------------------------------------------------------------------
    Function GetIPConfig(ipAddress, macAddress)
       Dim objConfig
       GetIPConfig = False
       ipAddress   = ""
       On Error Resume Next
          For Each objConfig in Getobject("winmgmts:").ExecQuery("select * from " & _
                                                                 "Win32_NetworkAdapterConfiguration where IPEnabled = True")
             ipAddress  = objConfig.IPAddress(0)
             macAddress = objConfig.MACAddress(0)
             If ipAddress <> "" And ipAddress <> "0.0.0.0" And MACAddress <> "" Then
                Exit For
             End If
          Next
       On Error Goto 0
       If Err.Number <> 0 Then
          BuildMessage 1, "Enumerating Network Configuration"
          Exit Function
       End If
       GetIPConfig = True
    End Function
    '----------------------------------------------------------------------------------------------------------------------------
    'Name       : IsoDateTimeString -> Generate an ISO date and time string from a date/time value.
    'Parameters : dateValue         -> Input date/time value.
    'Return     : IsoDateTimeString -> Date and time parts of the input value in "yyyy-mm-dd hh:mm:ss" format.
    '----------------------------------------------------------------------------------------------------------------------------
    Function IsoDateTimeString(dateValue)
       IsoDateTimeString = IsoDateString (dateValue) & " " & IsoTimeString (dateValue)
    End Function
    '----------------------------------------------------------------------------------------------------------------------------
    'Name       : IsoDateString -> Generate an ISO date string from a date/time value.
    'Parameters : dateValue     -> Input date/time value.
    'Return     : IsoDateString -> Date part of the input value in "yyyy-mm-dd" format.
    '----------------------------------------------------------------------------------------------------------------------------
    Function IsoDateString(dateValue)
       On Error Resume Next
          IsoDateString = Right ("000" &  Year (dateValue), 4) & "-" & _
                          Right (  "0" & Month (dateValue), 2) & "-" & _
                          Right (  "0" &   Day (dateValue), 2)
          If Err.Number <> 0 Then
             BuildMessage 1, "Enumerating IsoDateString"
             IsoDateString = "0000-00-00"
          End If
       On Error Goto 0
    End Function
    '----------------------------------------------------------------------------------------------------------------------------
    'Name       : IsoTimeString -> Generate an ISO time string from a date/time value.
    'Parameters : dateValue     -> Input date/time value.
    'Return     : IsoTimeString -> Time part of the input value in "hh:mm:ss" format.
    '----------------------------------------------------------------------------------------------------------------------------
    Function IsoTimeString(dateValue)
       On Error Resume Next
          IsoTimeString = Right ("0" &   Hour (dateValue), 2) & ":" & _
                          Right ("0" & Minute (dateValue), 2) & ":" & _
                          Right ("0" & Second (dateValue), 2)
          If Err.Number <> 0 Then
             BuildMessage 1, "Enumerating IsoTimeString"
             IsoTimeString = "00:00:00"
          End If
       On Error Goto 0
    End Function
    '----------------------------------------------------------------------------------------------------------------------------
    'Name       : LogMessage -> Parses the input message to be logged to the LogToFile Function.
    'Parameters : logPath    -> Full folder path and file name of the Log file without with file extension
    'Parameters : type       -> Number indicating the message type where:
    '           :            -> 0            : = success message         (the log file recieves the .log file extension)
    '           :            -> 1            : = error message           (the log file recieves the .err file extension)
    '           :            -> Other number : = unspecifed message type (the log file recieves the .err file extension)
    'Parameters : message    -> Text string to include in the log message.
    'Return     : None       -> 
    '----------------------------------------------------------------------------------------------------------------------------
    Function LogMessage(logPath, messageType, message)
       Select Case messageType
          case 0
             If Not LogToCentralFile(logPath & ".log", message) Then
                Exit Function
             End If
          Case Else
             If Not LogToCentralFile(logPath & ".err", message) Then
                Exit Function
             End If
       End Select
    End Function
    '----------------------------------------------------------------------------------------------------------------------------
    'Name       : LogToCentralFile -> Attempts to Appends information to a central file.
    'Parameters : logSpec          -> Folder path, file name and extension of the central log file to append to.
    '           : message          -> String to include in the central log file
    'Return     : LogToCentralFile -> Returns True if Successfull otherwise False.
    '----------------------------------------------------------------------------------------------------------------------------
    Function LogToCentralFile(logSpec, message)
       Dim attempts, objLogFile
       LogToCentralFile = False
       '-------------------------------------------------------------------------------------------------------------------------
       'Attempt to append to the central log file up to 10 times, as it may be locked by some other system.
       '-------------------------------------------------------------------------------------------------------------------------
       attempts = 0
       Do
          On Error Resume Next
             Set objLogFile = objFSO.OpenTextFile(logSpec, ForAppending, True)
             If Err.Number = 0 Then
                objLogFile.WriteLine message
                objLogFile.Close
                LogToCentralFile = True
                Exit Function
             End If
          On Error Goto 0
          Randomize
          Wscript.sleep 1000 + Rnd * 100
          attempts = attempts + 1
       Loop Until attempts >= 10
    End Function
    '----------------------------------------------------------------------------------------------------------------------------
    'Name       : LogScriptResults -> Loops through the messages in the global Dictionary object and logs each message to the 
    '           :                  -> appropriate log file based on messageType.
    'Parameters : None             ->
    'Return     : None             ->
    '----------------------------------------------------------------------------------------------------------------------------
    Function LogScriptResults
       Dim messageType, message, item
       On Error Resume Next
          For Each item In objDictionary.Items   
             messageType = Split(item, ",", 2)(0)
             message     = Split(item, ",", 2)(1)
             If Err.Number = 0 Then
                If messageType = 0 Then
                   LogMessage scriptLogPath & "\" & Left(IsoDateTimeString(Now), 10), messageType, message
                Else
                   LogMessage scriptLogPath & "\" & Left(IsoDateTimeString(Now), 10), 1, BuildErrorString("Splitting String")
                End If
             End If
          Next
       On Error Goto 0
    End Function
    '----------------------------------------------------------------------------------------------------------------------------
    Tuesday, August 18, 2009 6:34 AM
    Moderator
  • Hey Matt,

    Looking brilliant - I will run that up in my environment now and get it all tested :)

    Now yes, that beer.....let me sort it out for you....

    Cheers
    Matt
    Tuesday, August 18, 2009 8:47 AM
  • Hey Matt :)

    No worries...any of these should suffice :)

    http://www.lowenbrau.com.au/beers.htm
    http://www.bavarianshavemorefun.com/pure_bier/

    Now as for the script, i noticed you have changed the "IsoDateTimeString" function to:

    IsoFriendlyDate(now) & "," & IsoTimeString(now)

    I'm assuming you've done this because you want to seperate the date and the time into different fields in your database? This is not really necessary as you can perform any calculation\query using the ISO date format but if you really want to change it just make sure you also edit the fields in your SQL database table with the correct data types or the bulk insert command may fail. For example if you were to use the following command to create your database table:

    Create Table DomainAudit (IsoDateTime datetime,ComputerName nvarchar(50),IPAddress ntext,MACAddress ntext,LogonName nvarchar(50),DomainController nvarchar(50), EventType text)

    ...and you attempted to use the bulk import command to import a log file containing the following fields...

    EventDate,EventTime,ComputerName,IPAddress,MACAddress,LogonName,DomainController,EventType

    the bulk import command will fail because the SQL database expects 7 fields, not 8 fields in the database table. In that case you would probably want to create your table as follows:

    Create Table DomainAudit (EventDate datetime,EventTime datetime,ComputerName nvarchar(50),IPAddress ntext,MACAddress ntext,LogonName nvarchar(50),DomainController nvarchar(50), EventType text)

    I'd recommend just using ISO standard time in the code that i've posted but it's up to you if you want to change it, whatever works for you. Let me know if you have any trouble.

    Cheers

    Matt :)

    Tuesday, August 18, 2009 11:42 AM
    Moderator
  • Hi Matt,

    I will sort out those beers for you ;)

    Just to let you know that I have been playing around with the original script that you posted above and the ImportAuditLogs.vbs script that you very kindly wrote - and it does not seem to be working as expected. From what I can see, if I place the ImportAuditLogs.vbs it is trying to import that script and not the log file, but if I place the ImportAuditLogs.vbs  script on the C: drive, nothing happens, and no err log is created. I modified the script to import directly from the text file, and it works fine - so somewhere along the line its not picking up the log file from a varible in the script. To clarify, the logs share hasnt moved and the ImportAuditLogs.vbs and the LogonAudit.vbs scipts are located on the root of C: at present for testing. Also to confirm, when I stick the root of the file into the script instead of the varible, then it does not delete log file either.

    Function ImportLogToDataBase(hostName, databaseName, tableName, logSpec)
       Dim objConnection, results, sqlStatement
       ImportLogToDataBase = False
       On Error Resume Next
          Set objConnection = CreateObject("ADODB.Connection")
          If Err.Number <> 0 Then
             LogError "Creating ADO Object on " & DQ(hostName)
             Exit Function
          End If
          objConnection.Open "Provider=sqloledb;Data Source=" & hostName & ";" & _
                             "Initial Catalog=" & databaseName & ";Integrated Security=SSPI"
          If Err.Number <> 0 Then
             LogError "Opening the " & DQ(databaseName) & " SQL database on " & DQ(hostName)
             Exit Function
          End If
          sqlStatement = "Bulk Insert " & databaseName & ".dbo.[" & tableName & "] From " & DQ(logSpec) & _
                         "With (FieldTerminator = ',', RowTerminator = '\n')"
          objConnection.Execute sqlStatement
          If Err.Number <> 0 Then
             LogError "Executing " & DQ(sqlStatement)
             Exit Function
          End If
          objConnection.Close
       On Error Goto 0
       ImportLogToDataBase = True
    End Function


    Oh I am so stuck!

    Cheers
    Matt
    Tuesday, August 18, 2009 1:40 PM
  • Hi Matt,

    Sorry to be a pain, but I have put together (using parts of your lovely code) - a script that will enter directly into the DB - basically, the reason I am so keen to input directly in to the DB is that I want to be able to run live queries on the DB for specific reasons, so I need live data really.

    Code is as follows:

       Set wshShell      = CreateObject("Wscript.Shell")
       Set wshNetwork    = CreateObject("Wscript.Network")
    
    Call GetIPConfig (ipaddress,macAddress)
    Call IsoTimeString(Now)
    ProcessScript()
    WriteToDatabase()
    
    '--------------------------------------------------------------------------------------------------------
    
    Function IsoFriendlyDate(dateValue)
       On Error Resume Next
          IsoFriendlyDate = Right (  "0" &   Day (dateValue), 2) & "/" & _
          		      Right (  "00" & Month (dateValue), 2) & "/" & _
          		      Right ("000" &  Year (dateValue), 4)
                          If Err.Number <> 0 Then
             BuildMessage 1, "Enumerating IsoFriendlyDate"
             IsoDateString = "00-00-0000"
          End If
       On Error Goto 0
    End Function
    
    '--------------------------------------------------------------------------------------------------------
    
    Function IsoTimeString(dateValue)
       On Error Resume Next
          IsoTimeString = Right ("0" &   Hour (dateValue), 2) & ":" & _
                          Right ("0" & Minute (dateValue), 2) & ":" & _
                          Right ("0" & Second (dateValue), 2)
          If Err.Number <> 0 Then
             BuildMessage 1, "Enumerating IsoTimeString"
             IsoTimeString = "00:00:00"
          End If
       On Error Goto 0
    End Function
    
    '--------------------------------------------------------------------------------------------------------
    
    Function ProcessScript()
       Dim logonServer
       On Error Resume Next
          logonServer = Replace(wshShell.ExpandEnvironmentStrings("%logonserver%"), "")
          If Err.Number <> 0 Then
             logonServer = ""
    End If
    End Function
    
    '--------------------------------------------------------------------------------------------------------
    
    Function GetIPConfig(ipAddress, macAddress)
       Dim objConfig
       GetIPConfig = False
       ipAddress   = ""
       On Error Resume Next
          For Each objConfig in Getobject("winmgmts:").ExecQuery("select * from " & _
                                                                 "Win32_NetworkAdapterConfiguration where IPEnabled = True")
             ipAddress  = objConfig.IPAddress(0)
             macAddress = objConfig.MACAddress(0)
             If ipAddress <> "" And ipAddress <> "0.0.0.0" And MACAddress <> "" Then
                Exit For
             End If
          Next
       On Error Goto 0
       If Err.Number <> 0 Then
          BuildMessage 1, "Enumerating Network Configuration"
          Exit Function
       End If
       GetIPConfig = True
    End Function
    
    
    '--------------------------------------------------------------------------------------------------------
    
    Function WriteToDatabase()
    
    strInitialDB = "auditing"
    strSQLServer = "localhost" 'type the name of SQL Server instance here.
    strTable = "logon_logoff_data" 'Name of table to fetch rows from.
    
    'strQuery contain the query that will be executed and result will be displayed
    'in HTML window. Specify any SQL query here, and you will get the result for
    'that in HTML window.
    strQuery = "INSERT INTO " & strTable & "(Logon_Date,Logon_Time,Workstation,IP_Address,Username,Logon_Server,LogonLogOff_Event) VALUES ('" & IsoFriendlyDate(Now) & "','" & IsoTimeString(Now) & "','" & wshNetwork.ComputerName & "','" & ipAddress & "','" & wshNetwork.UserName & "','','')"
    
    Set objConn = CreateObject("ADODB.Connection")
    
    ' open the master data source
    objConn.Open "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=" & strInitialDB & ";Data Source=" & strSQLServer
    
    set objRS = objConn.execute(strQuery)
    
    End Function


    As you can see, I have not worked out a way to get the last 2 varibles to input in to the database. Is there anything you can help with plz? Maybe even a tidy up? Oh I am ever so cheeky ;)

    Cheers
    Matt

    Tuesday, August 18, 2009 3:32 PM
  • Hi Matt

    Let me explain how to set up the scripts, follow these steps in order:

    Create your SQL database. 

    Enter the following SQL statement to create your table schema:

    "Create Table DomainAudit (IsoDateTime datetime,ComputerName nvarchar(50),IPAddress ntext,MACAddress ntext,LogonName nvarchar(50),DomainController nvarchar(50), EventType text)"

    Create the "Logs$" share on your domain controller and assign appropriate share and NTFS permissions to allow users to create and append to the log file.

    Copy the "AuditDomainAccess.vbs" script into your group policy scripts logon\logoff folders on your domain controller (Edit the "shareNames" variable to specify your unc or dfs share names)

    Copy the "ImportAuditLogs.vbs" to "C:\Scripts\ImportAuditLogs\ImportAuditLogs.vbs" on your SQL server. (Edit the "hostName", "databaseName",  and "tableName" variables to specify your sqlServer, database and tableName values.)

    Create a scheduled task on your SQL Server to run at 12:05 AM daily using a service account that has SQL permissions to update the database and permissions to the "Logs$" share on the domain controller to read the log files and delete them once it's imported them.

    The reason your modified code is not working is because there are multiple syntax errors in it due to undefined variables and typos. I'd advise against editing my code if you don't completely understand it. If you do want to edit it and make your own version then i'd suggest you always use the "Option Explicit" statement to catch your spelling errors and use the "On Error Resume Next" whenever you create an object or perform a task that may fail so you can perform error checking.

    Seeing as you really want to append your audit information to SQL at logon\logoff i've written a script for you which does this for you using the "Insert" sql statement. It will work (assuming you change the variables "sqlServerName", "databaseName", "tableName" and "scriptLogPath" to specify your values. Do not change any other code. Get it working "as is" then modify it one step at a time. This way when you break it you'll know exactly what change caused your error. 

    If you follow my instructions and you have set your SQL, NTFS and Share permissions accordingly it will work.

    Copy the code below and apply it to either a new group policy object or the default domain policy. I strongly advise against using this in production because domain users can edit your database recordset and if your SQL server ever crashes, is rebooted or disconnected from the the network then auditing will fail (unless your using SQL fail over clustering).

    Make sure you use this command to create your database table:

    "Create Table DomainAudit (IsoDateTime datetime,ComputerName nvarchar(50),IPAddress ntext,MACAddress ntext,LogonName nvarchar(50),DomainController nvarchar(50), EventType text)"

    Let me know how you go with it.

    Cheers

    Matt :)

    '----------------------------------------------------------------------------------------------------------------------------
    'Script Name : AuditDomainAccess.vbs
    'Author      : Matthew Beattie
    'Created     : 19/08/09
    'Description : This script audits domain access by logging users logon and logoff events directly to an SQL database.
    '----------------------------------------------------------------------------------------------------------------------------
    'Initialization  Section
    '----------------------------------------------------------------------------------------------------------------------------
    Option Explicit
    Const ForAppending = 8
    Dim objFSO, wshShell, wshNetwork
    Dim scriptPath, scriptLogPath, scriptBaseName
    On Error Resume Next
       Set objFSO     = CreateObject("Scripting.FileSystemObject")
       Set wshShell   = CreateObject("Wscript.Shell")
       Set wshNetwork = CreateObject("Wscript.Network")
       scriptBaseName = objFSO.GetBaseName(Wscript.ScriptFullName)
       scriptPath     = objFSO.GetFile(Wscript.ScriptFullName).ParentFolder.Path
       scriptLogPath  = "\\testdb01\Logs$\" & scriptBaseName
       If Err.Number <> 0 Then
          Wscript.Quit
       End If
    On Error Goto 0
    '----------------------------------------------------------------------------------------------------------------------------
    'Main Processing Section
    '----------------------------------------------------------------------------------------------------------------------------
    On Error Resume Next
       ProcessScript
       If Err.Number <> 0 Then
          Wscript.Quit
       End If
    On Error Goto 0
    '----------------------------------------------------------------------------------------------------------------------------
    'Functions Processing Section
    '----------------------------------------------------------------------------------------------------------------------------
    'Name       : ProcessScript -> Primary Function that controls all other script processing.
    'Parameters : None          ->
    'Return     : None          ->
    '----------------------------------------------------------------------------------------------------------------------------
    Function ProcessScript
       Dim sqlServerName, databaseName, tableName, tableFields, tableValues
       Dim eventType, logonServer, ipAddress, macAddress, i
       databaseName  = "DomainAudit"
       sqlServerName = "testdb01"
       tableName     = "DomainAccess"
       '-------------------------------------------------------------------------------------------------------------------------
       'Enumerate the EventType (Logon\Logoff) from the script's path. Enumerate the authenticating domain controller.
       '-------------------------------------------------------------------------------------------------------------------------
       On Error Resume Next
          eventType   = Mid(scriptPath, InStrRev(scriptPath, "\") + 1)
          logonServer = Replace(wshShell.ExpandEnvironmentStrings("%logonserver%"), "\\", "")
          If Err.Number <> 0 Then
             logonServer = ""
          End If
       On Error Goto 0
       '-------------------------------------------------------------------------------------------------------------------------
       'Enumerate the IP and MAC Address of the current system.
       '-------------------------------------------------------------------------------------------------------------------------
       If Not GetIPConfig(ipaddress, macAddress) Then
          ipAddress  = ""
          macAddress = ""
       End If
       '-------------------------------------------------------------------------------------------------------------------------
       'Create the database record as a string to insert into the database table.
       '-------------------------------------------------------------------------------------------------------------------------
       tableFields = "IsoDateTime,ComputerName,IPAddress,MACAddress,LogonName,DomainController,EventType"
       tableValues = Array(IsoDateTimeString(Now),wshNetwork.ComputerName,ipAddress, _
                           macAddress,wshNetwork.UserName,logonServer,eventType)
       For i = 0 To UBound(tableValues)
          tableValues(i) = "'" & tableValues(i) & "'"
       Next
       tableValues = Join(tableValues, ",")
       '-------------------------------------------------------------------------------------------------------------------------
       'Insert the record into the SQL database table.
       '-------------------------------------------------------------------------------------------------------------------------
       If Not InsertDatabaseRecord(sqlServerName, databaseName, tableName, tableFields, tableValues) Then
          Exit Function
       End If
    End Function
    '----------------------------------------------------------------------------------------------------------------------------
    'Name       : DQ          -> Place double quotes around a string and replace double quotes
    '           :             -> within the string with pairs of double quotes.
    'Parameters : stringValue -> String value to be double quoted
    'Return     : DQ          -> Double quoted string.
    '----------------------------------------------------------------------------------------------------------------------------
    Function DQ(ByVal stringValue)
       If stringValue <> "" Then
          DQ = """" & Replace (stringValue, """", """""") & """"
       Else
          DQ = """"""
       End If
    End Function
    '----------------------------------------------------------------------------------------------------------------------------
    'Name       : IsoDateTimeString -> Generate an ISO date and time string from a date/time value.
    'Parameters : dateValue         -> Input date/time value.
    'Return     : IsoDateTimeString -> Date and time parts of the input value in "yyyy-mm-dd hh:mm:ss" format.
    '----------------------------------------------------------------------------------------------------------------------------
    Function IsoDateTimeString(dateValue)
       IsoDateTimeString = IsoDateString(dateValue) & " " & IsoTimeString(dateValue)
    End Function
    '----------------------------------------------------------------------------------------------------------------------------
    'Name       : IsoDateString -> Generate an ISO date string from a date/time value.
    'Parameters : dateValue     -> Input date/time value.
    'Return     : IsoDateString -> Date part of the input value in "yyyy-mm-dd" format.
    '----------------------------------------------------------------------------------------------------------------------------
    Function IsoDateString(dateValue)
       On Error Resume Next
          IsoDateString = Right("000" &  Year(dateValue), 4) & "-" & _
                          Right(  "0" & Month(dateValue), 2) & "-" & _
                          Right(  "0" &   Day(dateValue), 2)
          If Err.Number <> 0 Then
             BuildMessage 1, "Enumerating IsoDateString"
             IsoDateString = "0000-00-00"
          End If
       On Error Goto 0
    End Function
    '----------------------------------------------------------------------------------------------------------------------------
    'Name       : IsoTimeString -> Generate an ISO time string from a date/time value.
    'Parameters : dateValue     -> Input date/time value.
    'Return     : IsoTimeString -> Time part of the input value in "hh:mm:ss" format.
    '----------------------------------------------------------------------------------------------------------------------------
    Function IsoTimeString(dateValue)
       On Error Resume Next
          IsoTimeString = Right("0" &   Hour(dateValue), 2) & ":" & _
                          Right("0" & Minute(dateValue), 2) & ":" & _
                          Right("0" & Second(dateValue), 2)
          If Err.Number <> 0 Then
             BuildMessage 1, "Enumerating IsoTimeString"
             IsoTimeString = "00:00:00"
          End If
       On Error Goto 0
    End Function
    '----------------------------------------------------------------------------------------------------------------------------
    'Name       : GetIPConfig -> Enumerates the IP & MAC Address of the system via WMI
    'Parameters : ipAddress   -> Input/Output : Variable assigned to the IP Address of the system.
    '           : macAddress  -> Input/Output : Variable assigned to the MAC Address of the system.
    'Return     : GetIPConfig -> Returns True and the systems IP & MAC Address if successful otherwise returns False.
    '----------------------------------------------------------------------------------------------------------------------------
    Function GetIPConfig(ipAddress, macAddress)
       Dim objConfig
       GetIPConfig = False
       ipAddress   = ""
       On Error Resume Next
          For Each objConfig in Getobject("winmgmts:").ExecQuery("select * from " & _
                                                                 "Win32_NetworkAdapterConfiguration where IPEnabled = True")
             ipAddress  = objConfig.IPAddress(0)
             macAddress = objConfig.MACAddress(0)
             If ipAddress <> "" And ipAddress <> "0.0.0.0" And MACAddress <> "" Then
                Exit For
             End If
          Next
       On Error Goto 0
       If Err.Number <> 0 Then
          LogError "Enumerating Network Configuration"
          Exit Function
       End If
       GetIPConfig = True
    End Function
    '----------------------------------------------------------------------------------------------------------------------------
    Function InsertDatabaseRecord(hostName, databaseName, tableName, tableFields, tableValues)
       Dim objConnection, sqlStatement
       InsertDatabaseRecord = False
       sqlStatement         = "Insert Into " & tableName & "(" & tableFields & ") Values (" & tableValues & ")"
       On Error Resume Next
          Set objConnection = CreateObject("ADODB.Connection")
          If Err.Number <> 0 Then
             LogError "Creating ADO connection Object"
             Exit Function
          End If
          objConnection.Open "Provider=SQLOLEDB.1;Integrated Security=SSPI;" & _
                             "Persist Security Info=False;Initial Catalog=" & databaseName & ";" & _
                             "Data Source=" & hostName
          If Err.Number <> 0 Then
             LogError "Opening the " & DQ(databaseName) & " on " & DQ(hostName)
             Exit Function
          End If
          objConnection.execute sqlStatement
          If Err.Number <> 0 Then
             LogError "Executing SQL Statement " & DQ(sqlStatement)
             Exit Function
          End If
       On Error Goto 0
       InsertDatabaseRecord = True
    End Function
    '----------------------------------------------------------------------------------------------------------------------------
    'Name       : LogError -> Logs an error related to the error object to a central log file.
    'Parameters : message  -> String containing a description of what caused the error.
    'Return     : LogError -> None.
    '----------------------------------------------------------------------------------------------------------------------------
    Function LogError(message)
       Dim errorMessage
       errorMessage = "Error " & Err.Number & " (Hex " & Hex(Err.Number) & ") " & message & ". " & Err.Description
       If Not LogToCentralFile(scriptLogPath & ".err", errorMessage) Then
          Exit Function
       End If
    End Function
    '----------------------------------------------------------------------------------------------------------------------------
    'Name       : LogToCentralFile -> Attempts to Appends information to a central file.
    'Parameters : logSpec          -> Folder path, file name and extension of the central log file to append to.
    '           : message          -> String to include in the central log file
    'Return     : LogToCentralFile -> Returns True if Successfull otherwise False.
    '----------------------------------------------------------------------------------------------------------------------------
    Function LogToCentralFile(logSpec, message)
       Dim attempts, objLogFile
       LogToCentralFile = False
       '-------------------------------------------------------------------------------------------------------------------------
       'Attempt to append to the central log file up to 10 times, as it may be locked by some other system.
       '-------------------------------------------------------------------------------------------------------------------------
       attempts = 0
       Do
          On Error Resume Next
             Set objLogFile = objFSO.OpenTextFile(logSpec, ForAppending, True)
             If Err.Number = 0 Then
                objLogFile.WriteLine message
                objLogFile.Close
                LogToCentralFile = True
                Exit Function
             End If
          On Error Goto 0
          Randomize
          Wscript.sleep 1000 + Rnd * 100
          attempts = attempts + 1
       Loop Until attempts >= 10
    End Function
    '----------------------------------------------------------------------------------------------------------------------------
    Wednesday, August 19, 2009 5:29 AM
    Moderator
  • Hi Matt,

    Thats brilliant - its all set up and working as expected - once again, massive thanks!

    I am on some workstations getting a "connection broken" error in the error log that is created, but I am sure this is something my end - unless you know otherwise.

    I will mark your above posting as the answer and sort out some bevvies for you :)

    Cheers
    Matt
    Thursday, August 20, 2009 10:08 AM
  • Hi Matt,

    Just testing this in our Dev environment and it looks like there is a potential problem with mass load when trying to log to the database - is there any way where you can stick in a "re-try" clause, smilar to the one you did for the log file so that if it cannot connect to the database the first time it will try again?

    There seams to be alot of "connection broken" and "timeout expired" errors.

    Cheers
    Matt
    Thursday, August 20, 2009 3:23 PM
  • Hi Matt

    The connection errors you are getting are probably related to SQL Server or you've edited my code again and taken out the error checking so the script will just log the error to a central log file if it can't connect to SQL and continue the logon\logoff process so the user's don't see any error messages and starting calling helpdesk.

    Again i really don't recommend use log directly to SQL at logon\logoff but if you can easily add a seperate function with that attempts to retry inserting the record if the initial insert fails for any reason. Just be aware that potentially you are increasing the users logon\logoff time by doing so. They probably won't notice an extra 10 seconds but I wouldn't increase it much further. Try the following code...I haven't tested it yet so let me know if it works for you.

    Function ProcessScript
       '
       '...Insert all the rest of the code here and replace the call to InsertDataBaseRecord with WriteToDataBase
       '
       'If Not InsertDatabaseRecord(sqlServerName, databaseName, tableName, tableFields, tableValues) Then
       '   Exit Function
       'End If
       '
       If Not WriteToDataBase(hostName, databaseName, tableName, tableFields, tableValues) Then
          LogError "Writing " & tableValues & " to the SQL database " & tableName & " on " & databaseName
       End If
    End Function
    '----------------------------------------------------------------------------------------------------------------------------
    'Name       : WriteToDataBase -> Attempts to insert the record into the database up to 10 times.
    'Parameters : hostName        -> String containing the Computer name of the SQL Server.
    '           : databaseName    -> String containing the name of the database to insert the recordset into.
    '           : tableName       -> String containing the table name within the SQL database.
    '           : tableFields     -> String containing the comma seperated table field\column names
    '           : tableValues     -> String containing the comma seperated and single quoted values to insert.
    'Return     : WriteToDataBase -> Returns True if Successfull otherwise False.
    '----------------------------------------------------------------------------------------------------------------------------
    Function WriteToDataBase(hostName, databaseName, tableName, tableFields, tableValues)
       Dim attempts
       WriteToDataBase = False
       '-------------------------------------------------------------------------------------------------------------------------
       'Attempt to insert the recordset into the database up to 10 times, as it may be locked by some other system.
       '-------------------------------------------------------------------------------------------------------------------------
       attempts = 0
       Do
          If InsertDatabaseRecord(hostName, databaseName, tableName, tableFields, tableValues) Then
             WriteToDatabase = True
             Exit Function
          Else
             Randomize
             Wscript.sleep 1000 + Rnd * 100
             attempts = attempts + 1
          End If
       Loop Until attempts >= 10
    End Function
    '----------------------------------------------------------------------------------------------------------------------------
    'Name       : InsertDatabaseRecord -> Attempts to insert the record into the database.
    'Parameters : hostName             -> String containing the Computer name of the SQL Server.
    '           : databaseName         -> String containing the name of the database to insert the recordset into.
    '           : tableName            -> String containing the table name within the SQL database.
    '           : tableFields          -> String containing the comma seperated table field\column names
    '           : tableValues          -> String containing the comma seperated and single quoted values to insert.
    'Return     : InsertDatabaseRecord -> Returns True if the record was Successfull inserted in the database otherwise False.
    '----------------------------------------------------------------------------------------------------------------------------
    Function InsertDatabaseRecord(hostName, databaseName, tableName, tableFields, tableValues)
       Dim objConnection, sqlStatement
       InsertDatabaseRecord = False
       sqlStatement         = "Insert Into " & tableName & "(" & tableFields & ") Values (" & tableValues & ")"
       On Error Resume Next
          Set objConnection = CreateObject("ADODB.Connection")
          If Err.Number <> 0 Then
             LogError "Creating ADO connection Object"
             Exit Function
          End If
          objConnection.Open "Provider=SQLOLEDB.1;Integrated Security=SSPI;" & _
                             "Persist Security Info=False;Initial Catalog=" & databaseName & ";" & _
                             "Data Source=" & hostName
          If Err.Number <> 0 Then
             LogError "Opening the " & DQ(databaseName) & " on " & DQ(hostName)
             Exit Function
          End If
          objConnection.execute sqlStatement
          If Err.Number <> 0 Then
             LogError "Executing SQL Statement " & DQ(sqlStatement)
             Exit Function
          End If
       On Error Goto 0
       InsertDatabaseRecord = True
    End Function
    '----------------------------------------------------------------------------------------------------------------------------
    
    Friday, August 21, 2009 3:05 AM
    Moderator
  • scheduled task? you mean SQL server agent?
    Thursday, October 07, 2010 4:41 AM
  • i have two problems with the script', first, the date 01/10/2010 apears on the csv as 01/0/2010 and it don't write the mac aderss's

    can you help-me

    Tuesday, October 19, 2010 10:14 AM
  •       objConnection.Open "Provider=SQLOLEDB.1;Integrated Security=SSPI;" & _
                             "Persist Security Info=False;Initial Catalog=" & databaseName & ";" & _
                             "Data Source=" & hostName

     

    missed "  ???

    Thursday, October 20, 2011 10:41 AM
  • i have two problems with the script', first, the date 01/10/2010 apears on the csv as 01/0/2010 and it don't write the mac aderss's

    can you help-me


    You need to start your own topic and ask a complete question.  If you are not a technician then you might find a user support forum more helpful.

     


    jv
    Thursday, October 20, 2011 11:50 AM