Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations bkrike on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Input & code included -- reset array not working

Status
Not open for further replies.

LuckyDuck528

Programmer
Dec 21, 2004
65
US
Below I have included sample input and my full code to help solve this issue. If you run the program it shoul be self explanitory where the problem is. For each line in the code, the script:

1. Makes a copy of the registry
2. Opens the copy and pull out everything has to do w. the
input string
3. Goes through the filtered info and searches for key
items that are always present in the strings I am
looking at
4. Filter those key items into array values that are pulled
out and used to find the location of the .dll
corresponding to the string name.

It works perfectly the first time through. After that, I can't seem to get the array values to reset, they keep adding on to the original, therefore, I never get the location of the next string. The script will tell me the name of the next string and give me the .dll location of the first string.

I had alot of echo statements in there showing me what the values of variables and arrays were at different palces but I took most of them out and just left the ReDim's at the bottom of the code b/c they seemed to be working when I checked them w/ echo's. Maybe my problem is somewhere else? I am not very advanced in vbs so could easily be missing something.

Please help, I think I just need another pair of eyes to see what I am missing.

Thank you sincerely for your time. It's very appreciated.

Find_Input.txt
Scripting.FileSystemObject
Microsoft.XMLDOM
MSXML2.DOMDocument
ConnectionInfo.clsConnectionInfo
ADODB.Recordset
ADODB.Command
ADODB.Connection
Scripting.Dictionary
MSWC.BrowserType
SMTPsvg.Mailer
CDONTS.NewMail
DERuntime.DERuntime

Code:
[COLOR=red] '*******FindString.vbs********* [/color]
Option Explicit

Dim objWS, objFSO, string, LogFile, ObjTextFile, strLine, arrKey, UseHive, strKeyPath
Dim sRegTmp, eRegLine, sRegKey, aRegFileLines, strValueName, strComputer
Dim objReadInput, strValue, Hive, inth, objReg, Return, arrLine2, Path, arrFinal

const HKEY_LOCAL_MACHINE = &H80000002 

Const ForReading = 1, ForWriting = 2, ForAppending = 8
'***********************************************************
Set objWS = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")

Set LogFile = ObjFSO.OpenTextFile("C:\Temp\Results.txt", ForWriting, True)

Set objReadInput = objFSO.OpenTextFile("C:\Sysapps\batch\Find_Input.txt", ForReading, True)

Do Until objReadInput.AtEndOfStream

string = objReadInput.ReadLine

If string = "DERuntime.DERuntime" Then
	Wscript.Echo string & "   ?"
Else
	sRegTmp = objWS.Environment("Process")("Temp") & "\RegTmp.tmp "

	objWS.Run "regedit /e /a " & sRegTmp, , True 

	With objFSO.GetFile(sRegTmp)
		aRegFileLines = Split(.OpenAsTextStream(1, 0).Read(.Size), vbcrlf)
	End With

	For Each eRegLine in aRegFileLines
    		If InStr(1, eRegLine, "[", 1) > 0 Then sRegKey = eRegLine
    			If InStr(1, eRegLine, string, 1) >  0 Then
      				If sRegKey <> eRegLine Then
        					LogFile.WriteLine (vbcrlf & sRegKey) & vbcrlf & eRegLine
	      			Else
        					LogFile.WriteLine (vbcrlf & sRegKey)
      				End If
	    		End If 
	Next
	'***************************************************
	Dim arrLine, TempLine, arrPath

	Set ObjTextFile = objFSO.OpenTextFile("C:\Temp\Results.txt", ForReading, True)

	Do Until ObjTextFile.AtEndOfStream

		strLine = ObjTextFile.ReadLine
	
		If InStr(1, strLine, "}", 1) Then

			If InStr(1, strLine, "CLSID",1) Then

				If Instr(1, strLine, "ProgID", 1) Then

					arrLine = Split(strLine, "}")		

					If InStr(1, arrLine(0), "]", 1) Then			

						arrLine2 = Split(arrLine(0), "]")
						TempLine =  arrLine2(0) & "\InprocServer32\"
						arrPath = Split(TempLine, "[")	
						arrKey = Split(arrPath(1), "\")
							Hive = arrKey(0)
							For inth = 1 To UBound(arrKey)					
								Path = Path & arrKey(inth) & "\"
							Next	
					Else	
						TempLine =  arrLine(0) & "}\InprocServer32\"
						arrPath = Split(TempLine, "[")	
						arrKey = Split(arrPath(1), "\")
							Hive = arrKey(0)
							For inth = 1 To UBound(arrKey)					
								Path = Path & arrKey(inth) & "\"
							Next
						Wscript.Echo Path
					End If 
				End If 
			End If 
		End If 
	Loop
	arrFinal = Split(Path, "\\")
	Wscript.Echo arrFinal(0)
	strKeyPath = arrFinal(0) & "\"
	'***************************************************
	strComputer = "."

	Set objReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
	
	strValueName = ""

	Return = objReg.GetExpandedStringValue(HKEY_LOCAL_MACHINE,strKeyPath,strValueName,strValue)
	
	If (Return = 0) And (Err.Number = 0) Then   
		WScript.Echo  string & " is at: " & strValue
	Else
		Wscript.Echo "GetExpandedStringValue failed. Error = " & Err.Number
	End If

	Set Hive = Nothing
	Set strValue = Nothing
	Set strKeyPath = Nothing

	ReDim arrFinal(-1)
	ReDim arrKey(-1)
	ReDim arrLine(-1)
	ReDim arrLine2(-1)
End If	
Loop
'***********************************************************
 
Why do you need to export the entire thing every time through the loop?

The size of the registry can be huge... Easily 30 megabytes, probably a lot more! Why not just export it once and then use the same file for every search.

Same goes really for creating the array of lines... no need to do this every time through the loop.

Anyway, I saw that nobody else replied so I decided to give it a shot... the problem is a variable named Path is not being reset to an empty string where it should be.

I copied your code into regular VB6 so I had to change a few things to get it going, but here is my version of your code: (I moved those things out of the loop that I mentioned above)
Code:
Option Explicit

Private Sub Command1_Click()
    Dim objWS, objFSO, myString, LogFile, strLine, arrKey, UseHive, strKeyPath
    Dim sRegTmp, eRegLine, sRegKey, aRegFileLines, strValueName, strComputer
    Dim objReadInput, strValue, Hive, inth, objReg, sReturn, arrLine2, Path, arrFinal
    
    Const HKEY_LOCAL_MACHINE = &H80000002
    
    Const ForReading = 1, ForWriting = 2, ForAppending = 8
    
    
    Set objWS = CreateObject("WScript.Shell")
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objReadInput = objFSO.OpenTextFile("C:\Temp\Find_Input.txt", ForReading, True)
    
    
    sRegTmp = objWS.Environment("Process")("Temp") & "\RegTmp.tmp "

    objWS.Run "regedit /e /a " & sRegTmp, , True
    
    With objFSO.GetFile(sRegTmp)
        aRegFileLines = Split(.OpenAsTextStream(1, 0).Read(.Size), vbCrLf)
    End With

    Dim arrLine, TempLine, arrPath
    Do Until objReadInput.AtEndOfStream
        myString = objReadInput.ReadLine
        
        If myString = "DERuntime.DERuntime" Then
            Debug.Print myString & "   ?"
        Else
            Set LogFile = objFSO.OpenTextFile("C:\Temp\Results.txt", ForWriting, True)
            For Each eRegLine In aRegFileLines
                If InStr(1, eRegLine, "[", 1) > 0 Then sRegKey = eRegLine
                
                If InStr(1, eRegLine, myString, 1) > 0 Then
                      If sRegKey <> eRegLine Then
                            LogFile.WriteLine (vbCrLf & sRegKey) & vbCrLf & eRegLine
                      Else
                            LogFile.WriteLine (vbCrLf & sRegKey)
                      End If
                End If
            Next
            LogFile.Close
            
            ReDim arrLine(0)
            ReDim TempLine(0)
            ReDim arrPath(0)
        
            Set LogFile = objFSO.OpenTextFile("C:\Temp\Results.txt", ForReading, True)
            Do Until LogFile.AtEndOfStream
                strLine = LogFile.ReadLine
                
                
                If InStr(1, strLine, "}", 1) Then
                    If InStr(1, strLine, "CLSID", 1) Then
                        If InStr(1, strLine, "ProgID", 1) Then
                            [b][red]Path = ""[/red][/b]
                            arrLine = Split(strLine, "}")
                            If InStr(1, arrLine(0), "]", 1) Then
                                arrLine2 = Split(arrLine(0), "]")
                                TempLine = arrLine2(0) & "\InprocServer32\"
                                arrPath = Split(TempLine, "[")
                                arrKey = Split(arrPath(1), "\")
                                
                                Hive = arrKey(0)
                                For inth = 1 To UBound(arrKey)
                                    Path = Path & arrKey(inth) & "\"
                                Next
                            Else
                                TempLine = arrLine(0) & "}\InprocServer32\"
                                arrPath = Split(TempLine, "[")
                                arrKey = Split(arrPath(1), "\")
                                
                                Hive = arrKey(0)
                                For inth = 1 To UBound(arrKey)
                                    Path = Path & arrKey(inth) & "\"
                                Next
                                Debug.Print Path
                            End If
                        End If
                    End If
                End If
            Loop
            LogFile.Close
            
            arrFinal = Split(Path, "\\")
            Debug.Print arrFinal(0)
            strKeyPath = arrFinal(0) & "\"
            '***************************************************
            strComputer = "."
        
            Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
            
            strValueName = ""
        
            sReturn = objReg.GetExpandedStringValue(HKEY_LOCAL_MACHINE, strKeyPath, strValueName, strValue)
            
            If (sReturn = 0) And (Err.Number = 0) Then
                Debug.Print myString & " is at: " & strValue
            Else
                Debug.Print "GetExpandedStringValue failed. Error = " & Err.Number
            End If
        
            Set Hive = Nothing
            Set strValue = Nothing
            Set strKeyPath = Nothing
        
'            ReDim arrFinal(-1)
'            ReDim arrKey(-1)
'            ReDim arrLine(-1)
'            ReDim arrLine2(-1)
        End If
    Loop
End Sub

If you want to try to actually run that then open a new Standard EXE project and draw one command button on the form... put some breakpoints in, like at the top of the main loop is good... so you can see the output in the immediate window... I used Debug.Print instead of the .Echo thingy.

Anyway, here is some partial output from the immediate window:
Code:
SOFTWARE\Classes\CLSID\{0D43FE01-F093-11CF-8940-00A0C9054228}\InprocServer32\\
SOFTWARE\Classes\CLSID\{0D43FE01-F093-11CF-8940-00A0C9054228}\InprocServer32
Scripting.FileSystemObject is at: C:\WINDOWS\System32\scrrun.dll
SOFTWARE\Classes\CLSID\{2933BF90-7B36-11d2-B20E-00C04F983E60}\InprocServer32\\
SOFTWARE\Classes\CLSID\{2933BF90-7B36-11d2-B20E-00C04F983E60}\InprocServer32\\
SOFTWARE\Classes\CLSID\{2933BF90-7B36-11d2-B20E-00C04F983E60}\InprocServer32
Microsoft.XMLDOM is at: C:\WINDOWS\System32\msxml3.dll
SOFTWARE\Classes\CLSID\{88D969C0-F192-11D4-A65F-0040963251E5}\InprocServer32\\
SOFTWARE\Classes\CLSID\{f5078f1b-c551-11d3-89b9-0000f81fe221}\InprocServer32\\
SOFTWARE\Classes\CLSID\{f5078f1b-c551-11d3-89b9-0000f81fe221}\InprocServer32\\
SOFTWARE\Classes\CLSID\{f5078f32-c551-11d3-89b9-0000f81fe221}\InprocServer32\\
SOFTWARE\Classes\CLSID\{f5078f32-c551-11d3-89b9-0000f81fe221}\InprocServer32\\
SOFTWARE\Classes\CLSID\{F6D90F11-9C73-11D3-B32E-00C04F990BB4}\InprocServer32\\
SOFTWARE\Classes\CLSID\{F6D90F11-9C73-11D3-B32E-00C04F990BB4}\InprocServer32\\
SOFTWARE\Classes\CLSID\{F6D90F11-9C73-11D3-B32E-00C04F990BB4}\InprocServer32
MSXML2.DOMDocument is at: C:\WINDOWS\System32\msxml3.dll
SOFTWARE\Classes\CLSID\{F6D90F11-9C73-11D3-B32E-00C04F990BB4}\InprocServer32
ConnectionInfo.clsConnectionInfo is at: C:\WINDOWS\System32\msxml3.dll
SOFTWARE\Classes\CLSID\{00000281-0000-0010-8000-00AA006D2EA4}\InprocServer32\\
SOFTWARE\Classes\CLSID\{00000535-0000-0010-8000-00AA006D2EA4}\InprocServer32\\
SOFTWARE\Classes\CLSID\{00000535-0000-0010-8000-00AA006D2EA4}\InprocServer32\\
SOFTWARE\Classes\CLSID\{00000535-0000-0010-8000-00AA006D2EA4}\InprocServer32
ADODB.Recordset is at: C:\Program Files\Common Files\System\ADO\msado15.dll
SOFTWARE\Classes\CLSID\{0000022C-0000-0010-8000-00AA006D2EA4}\InprocServer32\\
SOFTWARE\Classes\CLSID\{00000507-0000-0010-8000-00AA006D2EA4}\InprocServer32\\
SOFTWARE\Classes\CLSID\{00000507-0000-0010-8000-00AA006D2EA4}\InprocServer32\\
SOFTWARE\Classes\CLSID\{00000507-0000-0010-8000-00AA006D2EA4}\InprocServer32
ADODB.Command is at: C:\Program Files\Common Files\System\ADO\msado15.dll
SOFTWARE\Classes\CLSID\{00000293-0000-0010-8000-00AA006D2EA4}\InprocServer32\\
SOFTWARE\Classes\CLSID\{00000514-0000-0010-8000-00AA006D2EA4}\InprocServer32\\
SOFTWARE\Classes\CLSID\{00000514-0000-0010-8000-00AA006D2EA4}\InprocServer32\\
SOFTWARE\Classes\CLSID\{00000514-0000-0010-8000-00AA006D2EA4}\InprocServer32
ADODB.Connection is at: C:\Program Files\Common Files\System\ADO\msado15.dll


 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top