I'm needing do a query on Google Chrome database SQLite3 for capture of all urls visited without use ODBC Driver or any other type of packet where is necessary your installation by final user.
Then I found that the way more near for this is using SQLite3.exe utilitary and SQLite3.dll (C:\Windows\System32\sqlite3.dll) in my opinion.
So I want know how I can list these urls based in code below?
Const LOCAL_APPLICATION_DATA = &H1c&
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(LOCAL_APPLICATION_DATA)
Set objFolderItem = objFolder.Self
Set colItems = objFolder.Items
Dim sCurDir
Dim sFina
For Each objItem in colItems
If InStr(1, objItem.Name, "Google") > 0 Then
sCurDir = objFolderItem.Path + "\" + objItem.Name + "\Chrome\User Data\Default\"
sFina = "History"
Exit For
End If
Next
'Location of SQLite
strSQLlite = "sqlite3.exe"
strCommand = strSQLlite & " " & sCurDir + sFina & " " & "SELECT * FROM urls;"
Set objOutput = objShell.Exec (strCommand)
You need a shell to start the sqlite3.exe and to capture the output. As in:
Option Explicit
Function qq(s) : qq = """" & s & """" : End Function
Const cnHidden = 0
Const cbWait = True
Dim sCmd : sCmd = Join(Array( _
"%comspec%" _
, "/c" _
, "sqlite3.exe" _
, "-csv" _
, qq("..\data\History") _
, qq("SELECT id, url FROM urls LIMIT 5") _
, ">.\urls.csv" _
))
WScript.Echo sCmd
CreateObject("WScript.Shell").Run sCmd, cnHidden, cbWait
WScript.Echo "Done"
output:
cscript 36346886.vbs
%comspec% /c sqlite3.exe -csv "..\data\History" "SELECT id, url FROM urls LIMIT 5" >.\urls.csv
Done
type urls.csv
25,https://de.add-ons.mozilla.com/de/firefox/bookmarks/
31,http://public.fh-wolfenbuettel.de/~hoeppnef/hanserSWE.html
33,http://cartan.cas.suffolk.edu/moin/OopDocbookWiki
34,http://book.realworldhaskell.org/read/
35,http://book.realworldhaskell.org/read/types-and-functions.html
I made some effort to isolate the components of a successful command line. So make sure you understand the whats and whys of each part before you start to adapt the demo code to your specs and circumstances.
Related
I want to see all the processes running on my computer but the cmd command only gives the applications, not any scripts or smaller files. I am trying to figure out a way to list all the processes in a more advanced way that will list EVERYTHING currently running. Does anyone know a way to do that with vbscript? Or if there is a better way to do this what is it?
Using TaskList Command
TaskList Command can be used to display a list of all running applications and services with their details and Process IDs(PIDs).
Dim ProTFPath, ProTF, StrPrInfo, StrPrInfoA, PrInfo
Set WshShell = WScript.CreateObject("Wscript.Shell")
Set FSO = WScript.CreateObject("Scripting.FileSystemObject")
ProTFPath = "C:\PROCESSES.txt"
WshShell.Run "CMD /C TASKLIST /V /FO LIST > """ + ProTFPath + """", 0, True
' Here Run is used instead Exec to avoid console window flashes.
If FSO.FileExists(ProTFPath) Then
Set ProTF = FSO.OpenTextFile(ProTFPath, 1, False)
End If
StrPrInfoA = ProTF.ReadAll
PrInfo = Split(StrPrInfoA, VbCrLf + VbCrLf)
For I = 0 To UBound(PrInfo)
WScript.Echo PrInfo(I)
Next
Erase PrInfo
ProTF.Close
If you no longer need this file, add following lines to the end of the script:
If FSO.FileExists(ProTFPath) Then
FSO.DeleteFile(ProTFPath, True)
End If
See more information about TaskList here.
EXE_Process = AllProcessRunningEXE(".")
Vbs_Process = AllProcessRunningVBS (".")
Function AllProcessRunningEXE( strComputerArg )
strProcessArr = ""
Dim Process, strObject
strObject = "winmgmts://" & strComputerArg
For Each Process in GetObject( strObject ).InstancesOf( "win32_process" )
strProcessArr = strProcessArr & ";" & vbNewLine & Process.name
Next
AllProcessRunningEXE = Mid(strProcessArr,3,Len(strProcessArr))
End Function
Function AllProcessRunningVBS (strComputerArg)
strProcessArr = ""
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputerArg & "\root\cimv2")
Set colItems = objWMIService.ExecQuery ("Select * from Win32_Process Where Name = 'cscript.exe' OR Name = 'wscript.exe'")
For Each objItem in colItems
strProcessArr = strProcessArr & ";" & vbNewLine & objItem.CommandLine
Next
AllProcessRunningVBS = Mid(strProcessArr,3,Len(strProcessArr))
Set objWMIService = Nothing
Set colItems = Nothing
End Function
MsgBox ("Do you want to start the autoclicker?", vbOkOnly, "Autoclicker")
CreateObject("WScript.Shell").Run("""C:\Users\Henry\Desktop\Fun.vbs""")
MsgBox ("Do you want to stop the autoclicker?", vbOkOnly, "Autoclicker")
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * From Win32_Process")
For Each objItem in colItems
'msgbox objItem.ProcessID & " " & objItem.CommandLine
If objItem.name = "Calculator.exe" then objItem.terminate
Next
This kills calculator.exe. Change it to wscript.exe. You might want to check command line if you just want to kill fun.vbs.
The following routine kills all processes whose command lines contain a specified string. The 3 lines below the routine are for testing it. We pause the routine by showing a message box and when you dismiss the message box, we kill the script instance, so the second message box doesn't show up. When you use it, you want to replace the last 3 lines with
KillProcesses "Fun.vbs"
I'd be careful using this and specify as much of the command line as possible to make sure I absolutely, positively match only the processes I want to terminate. You can modify the Task Manager and add a column to show the command line for every running process. In the routine below, the search in command line is case-insensitive.
Option Explicit
Sub KillProcesses(strPartOfCommandLine)
Dim colProcesses
Dim objProcess
Dim lReturn
' Get list of running processes using WMI
Set colProcesses = GetObject("winmgmts:\\.\root\cimv2").ExecQuery("Select * From Win32_Process")
For Each objProcess in colProcesses
If (Instr(1, objProcess.Commandline, strPartOfCommandLine, vbTextCompare) <> 0) Then
lReturn = objProcess.Terminate(0)
End If
Next
End Sub
Msgbox "Before being killed"
KillProcesses "KillProcesses.vbs"
Msgbox "After being killed"
I made before a script that ask you what vbscript did you want to kill and log the result into file.
So just, give a try :
Option Explicit
Dim Titre,Copyright,fso,ws,NomFichierLog,temp,PathNomFichierLog,OutPut,Count,strComputer
Copyright = "[© Hackoo © 2014 ]"
Titre = " Process "& DblQuote("Wscript.exe") &" running "
Set fso = CreateObject("Scripting.FileSystemObject")
Set ws = CreateObject( "Wscript.Shell" )
NomFichierLog="Process_WScript.txt"
temp = ws.ExpandEnvironmentStrings("%temp%")
PathNomFichierLog = temp & "\" & NomFichierLog
Set OutPut = fso.CreateTextFile(temp & "\" & NomFichierLog,1)
Count = 0
strComputer = "."
Call Find("wscript.exe")
Call Explorer(PathNomFichierLog)
'***************************************************************************************************
Function Explorer(File)
Dim ws
Set ws = CreateObject("wscript.shell")
ws.run "Explorer "& File & "\",1,True
end Function
'***************************************************************************************************
Sub Find(MyProcess)
Dim colItems,objItem,Processus,Question
Set colItems = GetObject("winmgmts:").ExecQuery("Select * from Win32_Process " _
& "Where Name like '%"& MyProcess &"%' AND NOT commandline like '%" & wsh.scriptname & "%'",,48)
For Each objItem in colItems
Count= Count + 1
Processus = Mid(objItem.CommandLine,InStr(objItem.CommandLine,""" """) + 2) 'Extraction of the commandline script path
Processus = Replace(Processus,chr(34),"")
Question = MsgBox ("Did you want to stop this script : "& DblQuote(Processus) &" ?" ,VBYesNO+VbQuestion,Titre+Copyright)
If Question = VbYes then
objItem.Terminate(0)'Kill this process
OutPut.WriteLine DblQuote(Processus)
else
Count= Count - 1 'decrement the counter -1
End if
Next
OutPut.WriteLine String(100,"*")
OutPut.WriteLine count & Titre & " were stopped !"
End Sub
'**********************************************************************************************
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'**********************************************************************************************
I have a several text files that have thousands of lines each with this being an example of a typical line:
PCI\VEN_10EC&DEV_8168&REV_09 Realtek\5x64\FORCED\PCIe_5.810.1218.2012\ Netrtle.inf Realtek 1 12/18/2012,5.810.1218.2012 Realtek PCIe GBE Family Controller
The script I'm working on does a string search for that first segment of text:
PCI\VEN_10EC&DEV_8168&REV_09
My script narrows down which files have this string, but what I really need is for it then to return the next string on that same line:
Realtek\5x64\FORCED\PCIe_5.810.1218.2012\
Once I have this string I can continue on with the rest of the script which is just extracting the Realtek folder from a 7zip.
I've seen this has been done with other languages on Stack but I can't find anything for VBS. I could probably find an answer if I knew how to phrase the task better. I'd really appreciate some advise on grabbing that second string.
For background, this is the script I'm working on. It looks through all the text files in C:\scripts\ for a string returned by a WMI query for CompatibleID of device drivers with code 28 (no driver installed):
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Wscript.Shell")
Set objNet = CreateObject("WScript.Network")
Set objWMIService = GetObject("winmgmts:\\" & "." & "\root\CIMV2")
Set colItems = objWMIService.ExecQuery _
("Select * from Win32_PnPEntity " _
& "WHERE ConfigManagerErrorCode = 28")
For Each objItem in colItems
Dim arrCompatibleIDs
aarCompatibleIDs = objItem.CompatibleID
for each objComp in aarCompatibleIDs
Dim FirstID
FirstID = objComp
Exit For
Next
Next
strSearchFor = firstID
objStartFolder = "C:\scripts"
Set objFolder = objFSO.GetFolder(objStartFolder)
Set colFiles = objFolder.Files
For Each objFile in colFiles
'Wscript.Echo objFile.Name
strFile = "C:\scripts\" & objFile.Name
set objFile = objFSO.getFile(strFile)
if objFile.size > 0 then
If InStr(objFSO.OpenTextFile(strFile).ReadAll, strSearchFor) > 0 Then
msgbox(objfile.name)
Else
WScript.Sleep (100)
End If
End If
Next
If you need to search for a fixed needle and a variable thread in a haystack, you can use some InStr()s or a RegExp. To get you started:
Dim sHaystack : sHaystack = Join(Array( _
"hay hay" _
, "fixed_needle variable_thread hay" _
, "hay hay" _
), vbCrLf)
Dim sNeedle : sNeedle = "fixed_needle" & " "
Dim nPosN : nPosN = Instr(sHaystack, sNeedle)
If 0 < nPosN Then
nPosN = nPosN + Len(sNeedle)
Dim nPosT : nPosT = Instr(nPosN, sHaystack, " ")
If 0 < nPosN Then
WScript.Echo "Instr()", qq(Mid(sHaystack, nPosN, nPosT - nPosN))
Else
WScript.Echo "no thread"
End If
Else
WScript.Echo "no needle"
End If
Dim reNT : Set reNT = New RegExp
reNT.Pattern = sNeedle & "(\S+) "
Dim oMTS : Set oMTS = reNT.Execute(sHayStack)
If 1 = oMTS.Count Then
WScript.Echo "RegExp ", qq(oMTS(0).SubMatches(0))
Else
WScript.Echo "no match"
End If
output:
Instr() "variable_thread"
RegExp "variable_thread"
If you change the haystack to
Dim sHaystack : sHaystack = Join(Array( _
"hay hay" _
, "fixed_needle no_variable_thread_hay" _
, "hay hay" _
), vbCrLf)
output:
Instr() "no_variable_thread_hay
hay"
no match
you see that there is more work needed to make the Instr() approach bulletproof.
Since your input file seems to be tab-separated, you could do something like this:
Set wmi = GetObject("winmgmts://./root/cimv2")
qry = "SELECT * FROM Win32_PnPEntity WHERE ConfigManagerErrorCode = 28"
For Each entity In wmi.ExecQuery(qry)
For Each cid In entity.CompatibleID
firstID = cid
Exit For
Next
Next
Set fso = CreateObject("Scripting.FileSystemObject")
For Each f In objFSO.GetFolder(objStartFolder).Files
If f.Size > 0 Then
For line In Split(f.OpenAsTextStream.ReadAll, vbNewLine)
arr = Split(line, vbTab)
If arr(0) = firstID Then MsgBox arr(1)
Next
End If
Next
On a more general note, you shouldn't do stuff like this:
Set colFiles = objFolder.Files
For Each objFile in colFiles
strFile = "C:\scripts\" & objFile.Name
set objFile = objFSO.getFile(strFile)
if objFile.size > 0 then
If InStr(objFSO.OpenTextFile(strFile).ReadAll, strSearchFor) > 0 Then
...
The Files collection already contains File objects, so it's utterly pointless to build a pathname from the object's properties (which BTW include a Path property that gives you the full path) only to obtain the exact same object you already have. Plus, file objects have a method OpenAsTextStream, so you can directly open them as text files without taking a detour like objFSO.OpenTextFile(f.Path).
I need to write a script that fetches the list of members in the Administrators group of a Windows server for audit purposes. I also need to show the domain name of the user/group if it is not local.
The following script will work even on a domain controller:
Sub GetAdministrators(strComputerName)
Dim objWMIService, strQuery, colItems, Path, strMembers
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
strQuery = "select * from Win32_GroupUser where GroupComponent = " & chr(34) & "Win32_Group.Domain='" & strComputerName & "',Name='Administrators'" & Chr(34)
Set ColItems = objWMIService.ExecQuery(strQuery)
strMembers = ""
For Each Path In ColItems
Dim strMemberName, NamesArray, strDomainName, DomainNameArray
NamesArray = Split(Path.PartComponent,",")
strMemberName = Replace(Replace(NamesArray(1),Chr(34),""),"Name=","")
DomainNameArray = Split(NamesArray(0),"=")
strDomainName = Replace(DomainNameArray(1),Chr(34),"")
If strDomainName <> strComputerName Then
strMemberName = strDomainName & "\" & strMemberName
End If
WScript.Echo strMemberName
Next
End Sub
Function GetComputerName()
Set objWMISvc = GetObject( "winmgmts:\\.\root\cimv2" )
Set colItems = objWMISvc.ExecQuery( "Select * from Win32_ComputerSystem", , 48 )
For Each objItem in colItems
strComputerName = objItem.Name
GetComputerName = strComputerName
Next
End Function
GetAdministrators GetComputerName
To execute it, simply run this a command prompt window:
cscript //nologo script.vbs.
I have this VBScript which runs however, while it is processing, it will randomly stop and require a user to hit the spacebar for it to display the rest of its ongoing output.
How do I figure out why this is happening?
Here is a copy of the script:
'On Error Resume Next
Dim arrFolders()
intSize = 0
Function StampNow()
Dim Hr, Mn, Yr, Mon, Dy, Date1
Date1=Now()
Hr=DatePart("h",Date1)
Mn=DatePart("n",Date1)
Yr = DatePart("yyyy",Date1)
Mon = DatePart("m",Date1)
Dy = DatePart("d",Date1)
StampNow = Yr & "-" & Mon & "-" & Dy
end function
'Output log info.
Function OutputToLog (strToAdd)
Dim strDirectory,strFile,strText, objFile,objFolder,objTextFile,objFSO
strDirectory = "c:\log"
strFile = "\dpadmin_copy2run-"& StampNow & ".bat"
'strText = "dpadmin_copy2"
strText = strToAdd
' Create the File System Object.
Set objFSO = CreateObject("Scripting.FileSystemObject")
' Check that the strDirectory folder exists.
If objFSO.FolderExists(strDirectory) Then
Set objFolder = objFSO.GetFolder(strDirectory)
Else
Set objFolder = objFSO.CreateFolder(strDirectory)
'WScript.Echo "Just created " & strDirectory
End If
If objFSO.FileExists(strDirectory & strFile) Then
Set objFolder = objFSO.GetFolder(strDirectory)
Else
Set objFile = objFSO.CreateTextFile(strDirectory & strFile)
'Wscript.Echo "Just created " & strDirectory & strFile
End If
set objFile = nothing
set objFolder = nothing
' OpenTextFile Method needs a Const value
' ForAppending = 8 ForReading = 1, ForWriting = 2
Const ForAppending = 8
Set objTextFile = objFSO.OpenTextFile _
(strDirectory & strFile, ForAppending, True)
' Writes strText every time you run this VBScript.
objTextFile.WriteLine(strText)
objTextFile.Close
End Function
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
strFolderName = "D:\1\production\Openjobs"
Set colSubfolders = objWMIService.ExecQuery _
("Associators of {Win32_Directory.Name='" & strFolderName & "'} " _
& "Where AssocClass = Win32_Subdirectory " _
& "ResultRole = PartComponent")
dim diffindates
'Init vars for regex.
Dim retVal, retVal2
Dim Lastprop
Dim objRegExpr 'regex variable
Set objRegExpr = New regexp
Set objRegExprX31 = New regexp
objRegExpr.Pattern = "[0-9][0-9][0-9][0-9][0-9][0-9][A-Z][A-Z][A-Z]"
objRegExprX31.Pattern = "[0-9][0-9][0-9][0-9][0-9][0-9]X31"
objRegExpr.Global = True
objRegExprX31.Global = True
objRegExpr.IgnoreCase = True
objRegExprX31.IgnoreCase = True
'Variables for getting last accessed property.
Dim fs, f
Set fs = CreateObject("Scripting.FileSystemObject")
'Current time vars.
Dim currenttime
currenttime = Now()
ParentFolder = "D:\1\Production\Openjobs\ClosedJobs"
For Each objFolder in colSubfolders
intSize = intSize + 1
retVal = objRegExpr.Test(objFolder.Name)
retVal2 = objRegExprX31.Test(objFolder.Name)
if (retVal OR retVal2 ) then
'set filename to array
strFolderName = objFolder.Name
'Get last modified date.
Set f = fs.GetFolder(objFolder.Name)
Lastprop = f.DateLastModified
'MsgBox(Lastprop)
if ( DateDiff("m", f.DateLastModified, Now()) > 4) then
diffindates = DateDiff("m", f.DateLastModified, Now())
Set objShell = CreateObject("Shell.Application")
Set objCopyFolder = objShell.NameSpace(ParentFolder)
OutputToLog("rem " & f.DateLastModified & ":" & objFolder.Name )
outputtolog("move /Y """ & objFolder.Name & """ " & ParentFolder)
wscript.echo(diffindates & ":" & objFolder.Name & vbCr)
end if
end if
Next
Update
It stops at the line:
Set objTextFile = objFSO.OpenTextFile _
(strDirectory & strFile, ForAppending, True)
with the error Microsoft VBScript runtime error: Permission denied
I'm a little confusd by this. The logfile was only 356kb
I was able to run your script several times without it pausing for input. Run your script with the //X flag to start it in the debugger:
>cscript //nologo //X dpadmin_copy2.vbs"
You should be able to then step through the code.
You can also start putting in wscript.echo trace statements everywhere and see if you can narrow down what it's waiting on.
One thing that's gotten me in the past; If your command console is in QuickEdit mode and you accidentally click anywhere in the console window, the console will hang while it waits for you to press a key.
Well the first step is to remove any global On Error Resume Next statements. Better feedback would come if we could see the script.
You usually get an Permission denied when trying to write to a text file when the text file already has an open handle from some other process or because you have previously opened a handle earlier in you code which you have not closed. I haven't tried this but I don't know why this wouldn't work, you can look at using Handle from Sysinternals (Microsoft) to tell you what process has the open handle for the file. Please see here for a further reference of how to use Handle: http://www.orcsweb.com/blog/post/Closing-open-file-handles.aspx You could also write a second script which runs in a loop to monitor the main script. The second script can verify the first script by doing a WMI Process query which returns only processes that match a defined command line. The second script could then restart the main it stops, alert you, log a file, launch a handle search, etc.