Solved

VBS script out of range

Posted on 2011-03-22
11
567 Views
Last Modified: 2012-05-11
the way i run this is parse.vbs info.txt and i keep getting a subscript out of range error. (i), i am not the best with vbs and needed some help, i greatly appreciate it, Thanks
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Dim objFSO,objFile
Dim arrLines
Dim strLine
Dim objExcel,objWorkbook
Dim FileLoc
Dim intRow
Dim objDictionary

FileLoc = "C:\Users\ashields\Downloads\ipsec.xls"

Sub ExcelHeaders()
    Set objRange = objExcel.Range("A1","G1")
    objRange.Font.Size = 12
    objRange.Interior.ColorIndex=15

    objexcel.cells(1,1)="Filter Name"
    objexcel.cells(1,2)="Source"
    objexcel.cells(1,3)="Destination"
    objexcel.cells(1,4)="Source Port"
    objexcel.cells(1,5)="Destination Port"
    objexcel.cells(1,6)="Protocol"
    objexcel.cells(1,7)="Direction"
End Sub

Function RegExFind(strText,strPattern)
    Dim regEx
    Dim match, Matches
    Dim arrMatches
    Dim i : i = 0
    Set regEx = New RegExp
    regEx.IgnoreCase = True
    regEx.Global = True
    regEx.Pattern = strPattern

    Set matches = regEx.Execute(strText)
    ReDim arrMatches(Matches.Count)
    For Each match In Matches
        For Each SubMatch In match.Submatches
            arrMatches(i) = Submatch
            i = i + 1
        Next
    Next
    RegExFind = arrMatches
End Function


Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(WScript.Arguments(0),ForReading)

Set objExcel = CreateObject("excel.application")
Set objWorkbook = objExcel.Workbooks.Open(FileLoc)

objExcel.Visible = True

ExcelHeaders ' Create Excel Headers

rePolicy = "Policy Name\s+:\s(.+)"
reSRCAddr = "Source Address\s+:\s(.+)"
reDSTAddr = "Destination Address\s+:\s(.+)"
reProtocol = "Protocol\s+:\s(.+)"
reSRCPort = "Source Port\s+:\s(.+)"
reDSTPort = "Destination Port\s+:\s(.+)"
reDirection = "Direction\s+:\s(.+)"

strText = objFile.ReadAll
objFile.Close

Dim arrPolicy, arrSRCAddr, arrDSTAddr, arrProtocol, arrSRCPort, arrDSTPort, arrDirection

arrPolicy = RegExFind(strText, rePolicy)
arrSRCAddr = RegExFind(strText, reSRCAddr)
arrDSTAddr = RegExFind(strText, reDSTAddr)
arrProtocol = RegExFind(strText, reProtocol)
arrSRCPort = RegExFind(strText, reSRCPort)
arrDSTPort = RegExFind(strText, reDSTPort)
arrDirection = RegExFind(strText, reDirection)

intRow = 2

For i = 0 To UBound(arrPolicy)
    objExcel.Cells(introw,1) = arrPolicy(i)
    objExcel.Cells(introw,2) = arrSRCAddr(i)
    objExcel.Cells(introw,3) = arrDSTAddr(i)
    objExcel.Cells(introw,4) = arrSRCPort(i)
    objExcel.Cells(introw,5) = arrDSTPort(i)
    objExcel.Cells(introw,6) = arrProtocol(i)
    objExcel.Cells(introw,7) = arrDirection(i)

    intRow = intRow + 1
Next

objFile.Close
objWorkbook.save
'objExcel.Quit

Open in new window

info.txt
0
Comment
Question by:adamshields
  • 4
  • 4
  • 3
11 Comments
 
LVL 11

Expert Comment

by:JoeNuvo
ID: 35195924
Per your given info.txt,
It seem data to be found into each array will is not equal.
For ex, I couldn't find any of Source Port, Destination Port, Direction.

So, when you try to loop base on boundary of arrPolicy, you will encounter error from array of above mention search term.

Might need to check before put data into excel

for ex.

If i <= UBound(arrSRCPort) Then
   objExcel.Cells(introw,4) = arrSRCPort(i)
End If

Open in new window

0
 
LVL 65

Expert Comment

by:RobSampson
ID: 35195937
It looks like it will be due to the fact that you're not giving your arrMatches array enough room, because you're only giving it the Matches.Count, but assigning the SubMatches.Count, which will be more.

Try changing this:
    ReDim arrMatches(0)
    For Each match In Matches
        For Each SubMatch In match.Submatches
            arrMatches(i) = Submatch
            i = i + 1
        Next
    Next

Open in new window


to this:
    For Each match In Matches
        For Each SubMatch In match.Submatches
            i = i + 1
            ReDim Preserve arrMatches(i)
            arrMatches(i) = Submatch
        Next
    Next

Open in new window


Regards,

Rob.
0
 
LVL 3

Author Comment

by:adamshields
ID: 35195967
Rob with yours i am now getting  type mismatch arrMatches line 43, Joe where do i  insert your code, thanks
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 35195987
OK, try this:

    Set matches = regEx.Execute(strText)
    For Each match In Matches
        For j = 0 To match.Submatches.Count
            i = i + 1
            ReDim Preserve arrMatches(i)
            arrMatches(i) = match.subMatches(j)
        Next
    Next

Open in new window


Regards,

Rob.
0
 
LVL 3

Author Comment

by:adamshields
ID: 35196005
nope still the same thing, Line 42 char13 type mismatch arrMatches
0
Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

 
LVL 65

Expert Comment

by:RobSampson
ID: 35196085
OK, try this.

Regards,

Rob.
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Dim objFSO,objFile
Dim arrLines
Dim strLine
Dim objExcel,objWorkbook
Dim FileLoc
Dim intRow
Dim objDictionary

FileLoc = "C:\Users\ashields\Downloads\ipsec.xls"

Sub ExcelHeaders()
    Set objRange = objExcel.Range("A1","G1")
    objRange.Font.Size = 12
    objRange.Interior.ColorIndex=15

    objexcel.cells(1,1)="Filter Name"
    objexcel.cells(1,2)="Source"
    objexcel.cells(1,3)="Destination"
    objexcel.cells(1,4)="Source Port"
    objexcel.cells(1,5)="Destination Port"
    objexcel.cells(1,6)="Protocol"
    objexcel.cells(1,7)="Direction"
End Sub

Function RegExFind(strText,strPattern)
    Dim regEx
    Dim match, Matches
    ReDim arrMatches(0)
    Dim i : i = 0
    Set regEx = New RegExp
    regEx.IgnoreCase = True
    regEx.Global = True
    regEx.Pattern = strPattern

    Set matches = regEx.Execute(strText)
    For Each match In Matches
        For j = 0 To match.Submatches.Count - 1
            i = i + 1
            ReDim Preserve arrMatches(i)
            arrMatches(i) = match.subMatches(j)
        Next
    Next 
   	RegExFind = arrMatches
End Function


Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(WScript.Arguments(0),ForReading)

Set objExcel = CreateObject("excel.application")
Set objWorkbook = objExcel.Workbooks.Open(FileLoc)

objExcel.Visible = True

ExcelHeaders ' Create Excel Headers

rePolicy = "Policy Name\s+:\s(.+)"
reSRCAddr = "Source Address\s+:\s(.+)"
reDSTAddr = "Destination Address\s+:\s(.+)"
reProtocol = "Protocol\s+:\s(.+)"
reSRCPort = "Source Port\s+:\s(.+)"
reDSTPort = "Destination Port\s+:\s(.+)"
reDirection = "Direction\s+:\s(.+)"

strText = objFile.ReadAll
objFile.Close

Dim arrPolicy, arrSRCAddr, arrDSTAddr, arrProtocol, arrSRCPort, arrDSTPort, arrDirection

arrPolicy = RegExFind(strText, rePolicy)
arrSRCAddr = RegExFind(strText, reSRCAddr)
arrDSTAddr = RegExFind(strText, reDSTAddr)
arrProtocol = RegExFind(strText, reProtocol)
arrSRCPort = RegExFind(strText, reSRCPort)
arrDSTPort = RegExFind(strText, reDSTPort)
arrDirection = RegExFind(strText, reDirection)

intRow = 2

For i = 0 To UBound(arrPolicy)

    If i <= UBound(arrPolicy) Then objExcel.Cells(intRow,1) = arrPolicy(i)
    If i <= UBound(arrSRCAddr) Then objExcel.Cells(intRow,2) = arrSRCAddr(i)
    If i <= UBound(arrDSTAddr) Then objExcel.Cells(intRow,3) = arrDSTAddr(i)
    If i <= UBound(arrSRCPort) Then objExcel.Cells(intRow,4) = arrSRCPort(i)
    If i <= UBound(arrDSTPort) Then objExcel.Cells(introw,5) = arrDSTPort(i)
    If i <= UBound(arrProtocol) Then objExcel.Cells(introw,6) = arrProtocol(i)
    If i <= UBound(arrDirection) Then objExcel.Cells(introw,7) = arrDirection(i)

    intRow = intRow + 1
Next

objFile.Close
objWorkbook.save
'objExcel.Quit

Open in new window

0
 
LVL 11

Expert Comment

by:JoeNuvo
ID: 35196102
combine with bug pointing out by RobSampson
This is code for you to try

Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Dim objFSO,objFile
Dim arrLines
Dim strLine
Dim objExcel,objWorkbook
Dim FileLoc
Dim intRow
Dim objDictionary

FileLoc = "C:\Users\ashields\Downloads\ipsec.xls"

Sub ExcelHeaders()
    Set objRange = objExcel.Range("A1","G1")
    objRange.Font.Size = 12
    objRange.Interior.ColorIndex=15

    objexcel.cells(1,1)="Filter Name"
    objexcel.cells(1,2)="Source"
    objexcel.cells(1,3)="Destination"
    objexcel.cells(1,4)="Source Port"
    objexcel.cells(1,5)="Destination Port"
    objexcel.cells(1,6)="Protocol"
    objexcel.cells(1,7)="Direction"
End Sub

Function RegExFind(strText,strPattern)
    Dim regEx
    Dim match, SubMatch, Matches
    Dim arrMatches
    Dim i : i = 0
    Set regEx = New RegExp
    regEx.IgnoreCase = True
    regEx.Global = True
    regEx.Pattern = strPattern

    Set Matches = regEx.Execute(strText)
    For Each match In Matches
        i = i + match.Submatches.Count
    Next

    ReDim arrMatches(i)
    i = 0
    For Each match In Matches
        For Each SubMatch In match.Submatches
            arrMatches(i) = SubMatch
            i = i + 1
        Next
    Next

    RegExFind = arrMatches
End Function


Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(WScript.Arguments(0),ForReading)

Set objExcel = CreateObject("excel.application")
Set objWorkbook = objExcel.Workbooks.Open(FileLoc)

objExcel.Visible = True

ExcelHeaders ' Create Excel Headers

rePolicy = "Policy Name\s+:\s(.+)"
reSRCAddr = "Source Address\s+:\s(.+)"
reDSTAddr = "Destination Address\s+:\s(.+)"
reProtocol = "Protocol\s+:\s(.+)"
reSRCPort = "Source Port\s+:\s(.+)"
reDSTPort = "Destination Port\s+:\s(.+)"
reDirection = "Direction\s+:\s(.+)"

strText = objFile.ReadAll
objFile.Close

Dim arrPolicy, arrSRCAddr, arrDSTAddr, arrProtocol, arrSRCPort, arrDSTPort, arrDirection

arrPolicy = RegExFind(strText, rePolicy)
arrSRCAddr = RegExFind(strText, reSRCAddr)
arrDSTAddr = RegExFind(strText, reDSTAddr)
arrProtocol = RegExFind(strText, reProtocol)
arrSRCPort = RegExFind(strText, reSRCPort)
arrDSTPort = RegExFind(strText, reDSTPort)
arrDirection = RegExFind(strText, reDirection)

intRow = 2

For i = 0 To UBound(arrPolicy)
    objExcel.Cells(introw,1) = arrPolicy(i)
    If i <= UBound(arrSRCAddr) Then
        objExcel.Cells(introw,2) = arrSRCAddr(i)
    End If
    If i <= UBound(arrDSTAddr) Then
        objExcel.Cells(introw,3) = arrDSTAddr(i)
    End If
    If i <= UBound(arrSRCPort) Then
        objExcel.Cells(introw,4) = arrSRCPort(i)
    End If
    If i <= UBound(arrDSTPort) Then
        objExcel.Cells(introw,5) = arrDSTPort(i)
    End If
    If i <= UBound(arrProtocol) Then
        objExcel.Cells(introw,6) = arrProtocol(i)
    End If
    If i <= UBound(arrDirection) Then
        objExcel.Cells(introw,7) = arrDirection(i)
    End If

    intRow = intRow + 1
Next

objFile.Close
objWorkbook.save
'objExcel.Quit

Open in new window

0
 
LVL 3

Author Comment

by:adamshields
ID: 35196135
well it works but still has some other issues, when i have another info.txt file from a real server wilt alot more info,  it just stops at line 8 in excel, also the Source port and destination ports are not in the correct column, i cant send you the real info.txt file cause it has confidential data, why would this script just stop working? any ideas, there are times that within the info file the same ip address and server names etc... come up. do you think that is the issue?
0
 
LVL 11

Expert Comment

by:JoeNuvo
ID: 35196142
try change this line

rePolicy = "Policy Name\s+:\s(.+)"

to be

rePolicy = "Filter name\s+:\s(.+)"

I guess this may help.
0
 
LVL 3

Author Comment

by:adamshields
ID: 35196164
Joe That Worked! now the only thing is now 3 things Protocol should be TCP and SRC port and DEST ports, currently the are all in the same column, any thoughts, Thanks so much for your help
0
 
LVL 11

Accepted Solution

by:
JoeNuvo earned 500 total points
ID: 35196205
ok, try following change

strText = objFile.ReadAll
objFile.Close


change to be

strText = objFile.ReadAll
objFile.Close

strText = Replace(strText , "Src Port" , Char(13) & "Source Port")
strText = Replace(strText , "Dest Port", Char(13) & "Destination Port")

this should do the trick
0

Featured Post

Free Trending Threat Insights Every Day

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

Suggested Solutions

This article is meant to give a basic understanding of how to use R Sweave as a way to merge LaTeX and R code seamlessly into one presentable document.
If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
In this fifth video of the Xpdf series, we discuss and demonstrate the PDFdetach utility, which is able to list and, more importantly, extract attachments that are embedded in PDF files. It does this via a command line interface, making it suitable …
In this seventh video of the Xpdf series, we discuss and demonstrate the PDFfonts utility, which lists all the fonts used in a PDF file. It does this via a command line interface, making it suitable for use in programs, scripts, batch files — any pl…

757 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

17 Experts available now in Live!

Get 1:1 Help Now