Solved

Adding Files and VBscript

Posted on 2009-07-07
3
490 Views
Last Modified: 2012-05-07
Hello,

   I have a VBscript below that works well, it writes a .txt report file out to my server.  The only problem is that it over-writes on top of the existing .txt file.  How can I re-code this to write separate files each time the report is generated to that location.  These txt files are nothing more than to preserve the report just in case we need them for an audit or a later date.
Set objShell = CreateObject("Wscript.Shell")

Set objFSO = CreateObject("Scripting.FileSystemObject")

If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then

    strPath = Wscript.ScriptFullName

    strCommand = "%comspec% /k cscript  """ & strPath & """"

    objShell.Run(strCommand), 1, True

    Wscript.Quit

End If

 

strLogFolder = "\\test-server\logs\AuthFail\Logs\"

'strLogFolder = Replace(WScript.ScriptFullName, WScript.ScriptName, "")

 

' Set this to the maximum lockouts at which to trigger, inclusive

Const AuthFailThreshold = 100

 

' Email variables:

strServer = "mailhost.abc.com"

strTo = "john.doe@abc.com

strFrom = "john.doe@abc.com"

strSubject = "Threshold Report"

strBody = "Flagged accounts that have exceeded the 100 Authorization Fail threshold count in one day." & VbCrLf

 

Const ForReading = 1

Const adVarChar = 200

Const MaxCharacters = 255

Const adDouble = 5

 

boolThresholdReached = False

 

strShortDate = objShell.RegRead("HKCU\Control Panel\International\sShortDate")

If InStr(LCase(strShortDate), "d") < InStr(LCase(strShortDate), "m") Then

	strDateFormat = "dd/mm/yyyy"

Else

	strDateFormat = "mm/dd/yyyy"

End If

 

strDate = InputBox("Please enter the date of the files that you want to search" & VbCrLf & _

	"in " & strDateFormat & " format:", "Date to Search", strDateFormat)

 

If strDate <> "" And strDate <> strDateFormat Then

	

	dteDateFrom = CDate(strDate & " 00:00:00 AM")

	dteDateTo = CDate(strDate & " 11:59:59 PM")

	

	WScript.Echo "Parsing log folder " & strLogFolder & " for files created on " & strDate & VbCrLf & VbCrLf

	strReport = "Parsing log folder " & strLogFolder & " for files created on " & strDate & VbCrLf & VbCrLf

	

	' Create the recordset to hold the entire data from each file parsed

	Set objData = CreateObject("ADOR.Recordset")

	objData.Fields.Append "Username", adVarChar, MaxCharacters

	objData.Fields.Append "DateTime", adVarChar, MaxCharacters

	objData.Fields.Append "DC", adVarChar, MaxCharacters

	objData.Fields.Append "IPAddress", adVarChar, MaxCharacters

	objData.Open

	

	' Create the recordset to hold the information for each user once all of the files have been parsed

	Set objUsers = CreateObject("ADOR.Recordset")

	objUsers.Fields.Append "Username", adVarChar, MaxCharacters

	objUsers.Fields.Append "DistinguishedName", adVarChar, MaxCharacters

	objUsers.Fields.Append "IPAddress", adVarChar, MaxCharacters

	objUsers.Fields.Append "AuthFailCount", adDouble

	objUsers.Open

 

	For Each objFile In objFSO.GetFolder(strLogFolder).Files

		If CDate(objFile.DateLastModified) > dteDateFrom And CDate(objFile.DateLastModified) < dteDateTo And Right(LCase(objFile.Name), 4) <> ".vbs" Then

			WScript.Echo "Parsing file " & objFile.Name & VbCrLf & VbCrLf

			strReport = strReport & "Parsing file " & objFile.Name & VbCrLf & VbCrLf

			

			Set objFile = objFSO.OpenTextFile(objFile.Path, ForReading, False)

 

			strUsers = ";"

			 

			While Not objFile.AtEndOfStream

			    strLine = objFile.ReadLine

			    If strLine <> "" Then

				    arrLine = Split(LCase(strLine), ",")

				    objData.AddNew

				    objData("Username") = Trim(arrLine(0))

				    objData("DateTime") = Trim(arrLine(1)) & " " & Trim(arrLine(2))

				    objData("DC") = Trim(arrLine(3))

					objData("IPAddress") = Trim(arrLine(4))

				    objData.Update

				    If strUsers = "" Then

				    	strUsers = arrLine(0) & ";"

				    Else

				    	If InStr(strUsers, ";" & arrLine(0) & ";") = 0 Then strUsers = strUsers & arrLine(0) & ";"

				    End If

				End If

			Wend

			 

			objFile.Close

			 

			If Left(strUsers, 1) = ";" Then strUsers = Mid(strUsers, 2)

			If Right(strUsers, 1) = ";" Then strUsers = Left(strUsers, Len(strUsers) - 1)

 

		End If

	Next

	For Each strUser In Split(strUsers, ";")

		strUserDN = Get_LDAP_User_Properties("user", "samAccountName", strUser, "distinguishedName")

		objData.Filter = "Username='" & strUser & "'"

		objData.MoveFirst

		While Not objData.EOF

			objUsers.Filter = ""

			If Not objUsers.EOF Then objUsers.MoveFirst

			objUsers.Filter = "Username='" & strUser & "' AND DistinguishedName='" & strUserDN & "' AND IPAddress='" & objData("IPAddress") & "'"

			On error resume next

		    If objUsers.EOF Then

			    objUsers.AddNew

			    objUsers("Username") = strUser

			    objUsers("DistinguishedName") = strUserDN

			    objUsers("IPAddress") = objData("IPAddress")

			    objUsers("AuthFailCount") = 1

			    objUsers.Update

			Else

				objUsers("AuthFailCount") = objUsers("AuthFailCount") + 1

			End If

			objData.MoveNext

		Wend

	Next

	objUsers.Filter = ""

	If Not objUsers.EOF Then objUsers.MoveFirst

	While Not objUsers.EOF

		If objUsers("AuthFailCount") >= AuthFailThreshold Then

			boolThresholdReached = True

			strBody = strBody & VbCrLf & "WARNING: " & objUsers("Username") & " (" & objUsers("DistinguishedName") & ") has failed Authentication on " & objUsers("IPAddress") & " " & objUsers("AuthFailCount") & " times."

			WScript.Echo "WARNING: " & objUsers("Username") & " (" & objUsers("DistinguishedName") & ") has failed Authentication on " & objUsers("IPAddress") & " " & objUsers("AuthFailCount") & " times."

		Else

			WScript.Echo objUsers("Username") & " (" & objUsers("DistinguishedName") & ") has failed Authentication on " & objUsers("IPAddress") & " " & objUsers("AuthFailCount") & " times."

			strReport = strReport & objUsers("Username") & " (" & objUsers("DistinguishedName") & ") has failed Authentication on " & objUsers("IPAddress") & " " & objUsers("AuthFailCount") & " times."

		End If

		objUsers.MoveNext

	Wend

Else

	WScript.Echo VbCrLf & VbCrLf & "Invalid date entered. Exiting script."

	strReport = strReport & VbCrLf & VbCrLf & "Invalid date entered. Exiting script."

End If

' Now send the file

If boolThresholdReached = True Then

	SendEmail strServer, strTo, strFrom, strSubject, strBody

	WScript.Echo VbCrLf & VbCrLf & strBody & VbCrLf & VbCrLf

	strReport = strReport & VbCrLf & VbCrLf & strBody & VbCrLf & VbCrLf

	WScript.Echo "Email has been sent."

	strReport = strReport & "Email has been sent."

Else

	WScript.Echo "The Auth failure threshold has not been reached."

	strReport = strReport & "The Auth failure threshold has not been reached."

End If

 

'Creates results file

'//////////////////////////////////////////////////////////////////////////////////////

strReportFile = "\\test-server\logs\AuthFailure-ThresholdReports\Auth-Failure.Threshold.Report.txt"

 

' -- The heart of the create file script -------------

' -- Creates the file using the value of strReportFile

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

Set objFile = objFSO.CreateTextFile(strReportFile, False)

objFile.Write strReport

objFile.Close

WScript.Echo strReportFile & " has been created."

' End of FileSystemObject example: NewFile VBScript

'////////////////////////////////End Create Text File//////////////////////////////////

 

WScript.Echo VbCrLf & VbCrLf & "Done"

 

Function Get_LDAP_User_Properties(strObjectType, strSearchField, strObjectToGet, strCommaDelimProps)

      

      ' This is a custom function that connects to the Active Directory, and returns the specific

      ' Active Directory attribute value, of a specific Object.

      ' strObjectType: usually "User" or "Computer"

      ' strSearchField: the field by which to seach the AD by. This acts like an SQL Query's WHERE clause.

      '				It filters the results by the value of strObjectToGet

      ' strObjectToGet: the value by which the results are filtered by, according the strSearchField.

      '				For example, if you are searching based on the user account name, strSearchField

      '				would be "samAccountName", and strObjectToGet would be that speicific account name,

      '				such as "jsmith".  This equates to "WHERE 'samAccountName' = 'jsmith'"

      '	strCommaDelimProps: the field from the object to actually return.  For example, if you wanted

      '				the home folder path, as defined by the AD, for a specific user, this would be

      '				"homeDirectory".  If you want to return the ADsPath so that you can bind to that

      '				user and get your own parameters from them, then use "ADsPath" as a return string,

      '				then bind to the user: Set objUser = GetObject("LDAP://" & strReturnADsPath)

      

      ' Now we're checking if the user account passed may have a domain already specified,

      ' in which case we connect to that domain in AD, instead of the default one.

      If InStr(strObjectToGet, "\") > 0 Then

            arrGroupBits = Split(strObjectToGet, "\")

            strDC = arrGroupBits(0)

            strDNSDomain = strDC & "/" & "DC=" & Replace(Mid(strDC, InStr(strDC, ".") + 1), ".", ",DC=")

            strObjectToGet = arrGroupBits(1)

      Else

      ' Otherwise we just connect to the default domain

            Set objRootDSE = GetObject("LDAP://RootDSE")

            strDNSDomain = objRootDSE.Get("defaultNamingContext")

      End If

 

      strBase = "<LDAP://" & strDNSDomain & ">"

      ' Setup ADO objects.

      Set adoCommand = CreateObject("ADODB.Command")

      Set adoConnection = CreateObject("ADODB.Connection")

      adoConnection.Provider = "ADsDSOObject"

      adoConnection.Open "Active Directory Provider"

      adoCommand.ActiveConnection = adoConnection

 

 

      ' Filter on user objects.

      'strFilter = "(&(objectCategory=person)(objectClass=user))"

      strFilter = "(&(objectClass=" & strObjectType & ")(" & strSearchField & "=" & strObjectToGet & "))"

 

      ' Comma delimited list of attribute values to retrieve.

      strAttributes = strCommaDelimProps

      arrProperties = Split(strCommaDelimProps, ",")

 

      ' Construct the LDAP syntax query.

      strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"

      adoCommand.CommandText = strQuery

      ' Define the maximum records to return

      adoCommand.Properties("Page Size") = 100

      adoCommand.Properties("Timeout") = 30

      adoCommand.Properties("Cache Results") = False

 

      ' Run the query.

      Set adoRecordset = adoCommand.Execute

      ' Enumerate the resulting recordset.

      strReturnVal = ""

      Do Until adoRecordset.EOF

          ' Retrieve values and display.    

          For intCount = LBound(arrProperties) To UBound(arrProperties)

                If strReturnVal = "" Then

                      strReturnVal = adoRecordset.Fields(intCount).Value

                Else

                      strReturnVal = strReturnVal & VbCrLf & adoRecordset.Fields(intCount).Value

                End If

          Next

          ' Move to the next record in the recordset.

          adoRecordset.MoveNext

      Loop

 

      ' Clean up.

      adoRecordset.Close

      adoConnection.Close

      Get_LDAP_User_Properties = strReturnVal	  

End Function

 

'////////////////////////////////Mail Function/////////////////////////////////////////

Sub SendEmail(strServer, strTo, strFrom, strSubject, strBody)

	Dim objMessage

	

	Set objMessage = CreateObject("CDO.Message")

	objMessage.To = strTo

	objMessage.From = strFrom

	objMessage.Subject = strSubject

	objMessage.TextBody = strBody

 

	'==This section provides the configuration information for the remote SMTP server.

	objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2

	'Name or IP of Remote SMTP Server

	objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strServer

	'Server port (typically 25)

	objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25	

	objMessage.Configuration.Fields.Update

	'==End remote SMTP server configuration section==

 

	objMessage.Send

	Set objMessage = Nothing

End Sub

Open in new window

0
Comment
Question by:itsmevic
  • 2
3 Comments
 
LVL 92

Accepted Solution

by:
Patrick Matthews earned 500 total points
ID: 24799012
Something like this should do.  Replace:

strReportFile = "\\test-server\logs\AuthFailure-ThresholdReports\Auth-Failure.Threshold.Report.txt"

with:

strReportFile = "\\test-server\logs\AuthFailure-ThresholdReports\Auth-Failure.Threshold.Report." & TimeStamp(Now) & ".txt"

and then add this helper function:

Function TimeStamp(Dt)

    TimeStamp = Year(Dt) & Right("0" & Month(Dt), 2) & Right("0" & Day(Dt), 2) & _
        Right("0" & Hour(Dt), 2) & Right("0" & Minute(Dt), 2) & Right("0" & Second(Dt), 2)

End Function
0
 
LVL 92

Expert Comment

by:Patrick Matthews
ID: 24799017
That suggestion embeds the runtime into the name of results file.
0
 

Author Closing Comment

by:itsmevic
ID: 31600859
That worked, thanks man! ( :
0

Featured Post

Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

Join & Write a Comment

It is a general practice to get rid of old user profiles on a computer  in a LAN environment. As I have been working with a company in a LAN environment where users move from one place to some other place at times. This will make many user profil…
If you haven’t already, I encourage you to read the first article (http://www.experts-exchange.com/articles/18680/An-Introduction-to-R-Programming-and-R-Studio.html) in my series to gain a basic foundation of R and R Studio.  You will also find the …
This tutorial will teach you the core code needed to finalize the addition of a watermark to your image. The viewer will use a small PHP class to learn and create a watermark.
The viewer will learn how to create a basic form using some HTML5 and PHP for later processing. Set up your basic HTML file. Open your form tag and set the method and action attributes.: (CODE) Set up your first few inputs one for the name and …

762 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

20 Experts available now in Live!

Get 1:1 Help Now