Comment j’en suis arrivé à me poser cette question ? J’ai commencé avec un script vbs, j’aurai pu le faire en powershell, mais je devais être capable de tout lancer avec des droits user pour reproduire les droits d’un utilisateur standard. J’ai codé pas mal d’année en VB, je me sentais plus à faire ce script en VBS.
Je devais trouver des fichiers sur un réseau d’ordinateur complet. Mon premier script prenait trop de temps car je scannais les ordinateurs un à un et parfois le nombre de fichier était très important ; je me suis donc posé la question comment faire du multithread. L’idée était d’avoir un script qui contenait une boucle avec les ordinateurs à scanner et celui-ci lancerait en parallèle un certain nombre de scan.
Je ne vous cache rien, j’ai pris comme exemple le script présenté dans ce site (https://gallery.technet.microsoft.com/scriptcenter/32e0146a-83fc-4ee1-af7b-52a57d57466c). Le concept est vraiment intéressant par rapport à d’autre script que j’ai pu trouver, car il ne se contente pas de lancer un certain nombre de thread en parallèle, il attends que l’un d’entre eux se termine pour en relancer un nouveau. D’accord rien de nouveau par rapport à ce l’on peut faire par ailleurs, mais pour du scripting c’est vraiment pas mal !
Passons maintenant à la bête !
Le script principal, dans mon utilisation, liste tous les objets de type « Computer » de l’Active Directory qui est en cours d’utilisation par l’utilisateur lanceur du script. Puis pour chaque objet il lancera le script qui ira chercher le fichier souhaité, ce script est appelé avec le nom de l’ordinateur en paramètre.
Le nombre de thread est réglable dans les constantes du script.
'* -----------------------------------------------------------------------------
'* Define Constants
'*
Const ForReading = 1
Const ForAppending = 8
Const adVarChar = 200
Const adInteger = 3
Const adFilterNone = ""
Const MaxCharacters = 255
'* change MaxThreads to the number of cscripts you want to be running simultaneously
'* NOTE: there can actually be a MaxThreads + 2 script engines running
Const ADS_SCOPE_SUBTREE = 2
Const MaxThreads = 12
'* -----------------------------------------------------------------------------
'* Declare variables
'*
dim g_ador
dim g_fso
dim g_ts
dim infile
dim oWshShell
dim uargs
dim sTarget
dim cThread
dim aExec()
dim logFile
dim i
'* the output
logFile = "C:\temp\myLog.log"
set g_fso = createobject("scripting.filesystemobject")
Set g_ts = g_fso.OpenTextFile(logFile, ForAppending, true)
'*********************** AD Query
Set Root = GetObject("LDAP://RootDSE")
DomainPath = Root.Get("DefaultNamingContext")
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
objCommand.CommandText = "<LDAP://" & DomainPath & ">;(&(objectCategory=computer)(sAMAccountName=*)); sAMAccountName ;subtree"
Set objRecordSet = objCommand.Execute
'*********************** End AD Query
'* create Disconnected RS
Set g_ador = CreateObject("ADOR.Recordset")
g_ador.Fields.Append "ComputerName", adVarChar, MaxCharacters
g_ador.Fields.Append "ExecStatus", adInteger, 5
g_ador.Fields.Append "hExec", adInteger, 5
g_ador.Open
Set oWshShell = WScript.CreateObject("WScript.Shell")
'* count of script engines executing
cThread = 0
i = 0
objRecordSet.MoveFirst
Do Until objRecordSet.EOF
redim preserve aExec(i)
wscript.echo ComputerName
ComputerName = objRecordSet.Fields("sAMAccountName")
ComputerName = LEFT(ComputerName,LEN(ComputerName)-1)
'* script.vbs is a script that returns and exit code using wscript.quit(1) or wscript.quit(0)
'* the value of the exit code will be used as the results for logging
'* the call to the script will be script.vbs arg
'* this script could do anything such as return a ping result or check a machine for a certian
'* software. I suppose you could even build a sort of enum and depending on your exit codes
'* return certian strings from the main script in a select case statment
set aExec(i) = oWshShell.Exec("cscript.exe /nologo "".\My_Script.vbs"" " & ComputerName)
g_ador.addnew
g_ador("ComputerName") = sTarget
g_ador("ExecStatus") = 0
g_ador("hExec") = i
g_ador.Update
cThread = cThread + 1
if cThread > MaxThreads then
WaitForThreads(MaxThreads)
g_ador.MoveLast
end if
i = i + 1
objRecordSet.MoveNext
Loop
'* wait for the remaining threads to quit
WaitForThreads(0)
g_ts.close
g_ador.Close
'* -----------------------------------------------------------------------------
'* Sub: WaitForThreads
'*
'* Purpose: Wait for number of executions to drop under MAX before
'* executing another thread (script engine)
'*
'* Input: [in] Max the number of threads running
'*
'* Output: none
'*
'* -----------------------------------------------------------------------------
Public Sub WaitForThreads(byVal Max)
dim n '* the handle number of the still running oWshShell.Exec
'* once the cThread drops below max the main loop will continue and start
'* executing more script engines
do while cThread > Max
'* give scripts a moment to return results
wscript.sleep 200
'* filter ador for records that we do not have results for yet
'* when a result is recieved the ExecStatus is changed to 1
g_ador.Filter = "ExecStatus = 0"
g_ador.MoveFirst
while not g_ador.EOF
n = g_ador("hExec")
if aExec(n).Status <> 0 then
'* update status to complete
g_ador("ExecStatus") = aExec(n).Status
g_ts.writeline Now & " | " & g_ador("ComputerName") & " | Return: " & aExec(n).ExitCode
end if
g_ador.MoveNext
wend
cThread = g_ador.RecordCount
loop
'* remove filter
g_ador.Filter = adFilterNone
end sub
Et voici le deuxième script qui parcours les partages disponibles en écriture à la recherche du fichier ! J’ai dû utiliser un simple Net View pour lister les partages car je n’avais pas les droits nécessaire pour utiliser le CIMV2.
Il y a certainement mieux à faire, mais sur le moment c’est la méthode que j’ai trouvé le plus rapidement !
on error resume next
'* use argument as the file path for input
set uargs = wscript.arguments.unnamed
if uargs.count = 0 then
wscript.quit(0)
end if
ComputerName = uargs(0)
Set fs = CreateObject("Scripting.FileSystemObject")
Set fich = fs.OpenTextFile("C:\TEMP\log_" & ComputerName & ".txt", 8, true)
fich.writeline ComputerName & " - " & now
'wscript.echo ComputerName
Set shell=Wscript.CreateObject("Wscript.Shell")
Set oExec = shell.Exec ("%comspec% /c net view \\" & ComputerName)
i=1
Do while not oExec.StdOut.AtEndOfStream
result = oExec.StdOut.ReadLine
if i >= 8 then
share = Split(result, " ", -1, 1)
if Ubound(share) > 0 then
'wscript.echo (share(0)) & " - " & i
If WriteAccess("\\" & ComputerName & "\" & share(0)) then
Wscript.echo "Droit écriture : \\" & ComputerName & "\" & share(0)
fich.writeline "Droit écriture : \\" & ComputerName & "\" & share(0)
Set fso = CreateObject("Scripting.FileSystemObject")
result_fl = Find_File(fso.GetFolder("\\" & ComputerName & "\" & share(0)))
if result_fl then
Wscript.echo "******* Fichier détecté : " & "\\" & ComputerName & "\" & share(0) & " *****"
fich.writeline "**************************************************************************"
fich.writeline "**************************************************************************"
fich.writeline "******* Fichier détecté : " & "\\" & ComputerName & "\" & share(0) & " *****"
fich.writeline "**************************************************************************"
fich.writeline "**************************************************************************"
Set fich_rg = fs.OpenTextFile("C:\TEMP\Scan_report.txt", 8, true)
fich_rg.writeline "******* Fichier détecté : " & "\\" & ComputerName & "\" & share(0) & " *****"
fich_rg.close
end if
End If
end if
end if
'dump = dump & vbcrlf & oExec.StdOut.ReadLine
i=i+1
Loop
fich.writeline "Fin - " & now
fich.close
wscript.quit
function Find_File(fldr)
fich.Write "."
For Each f In fldr.Files
If LCase(f.Name) = "_File_instructions.txt" Then
Find_Locky = True
End If
Next
For Each sf In fldr.SubFolders
Find_File sf
Next
End function
Function WriteAccess(strFolderPath)
Set objFso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
strTmpFile = objFso.GetTempName
Set objTmpFile = objFso.CreateTextFile(strFolderPath & "\" & strTmpFile)
If Err.Number <> 0 Then
WriteAccess = False
Err.Clear
Else
WriteAccess = True
objTmpFile.Close
objFso.DeleteFile strFolderPath & "\" & strTmpFile
End If
End Function
Je partage le code car j’ai été confronté à une problématique que je ne dois pas être seul à rencontrer, j’ai passé un certain temps à chercher la solution et le script pourrait servir à différente personne (à quand un label « utilité publique » pour les scripts !).
Amusez vous bien ! 😀