1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
| Const ForReading = 1, ForWriting = 8
Dim oFSO, oSh, WSHShell, WSHNetwork
Dim Fichier_Rapport, Message, Date_Heure
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set WSHShell = WScript.CreateObject("WScript.Shell")
Set WSHNetwork = CreateObject("WScript.Network")
Public StrComputer, onlinestate, i, pathfile
date_heure = now
' *****************************
' Saisissez le profil recherché
' *****************************
usrprofil = InputBox("Saisissez le profil recherché")
MyFolder = "Z:\Users\" & usrprofil
' ******************
' Fichier de données
' ******************
Fichier_pc_txt = "LISTE_PC.txt"
Fichier_tmp = "LISTE_TMP.txt"
Fichier_Rapport = "RAPPORT_RECHERCHE.txt"
' **************************************
' Test Fichier_pc_txt existe et non-vide
' **************************************
If oFSO.FileExists(Fichier_pc_txt) = False Then MsgBox"Liste des postes non-trouvée :" & VbCrLf & Fichier_pc_txt & VbCrLf & VbCrLf & "FIN DU SCRIPT", vbOkOnly : Wscript.Quit
Set oFl = oFSO.GetFile(Fichier_pc_txt)
If oFl.Size = 0 Then MsgBox"Aucun poste dans la liste :" & VbCrLf & Fichier_pc_txt & VbCrLf & VbCrLf & "FIN DU SCRIPT", vbOkOnly : Wscript.Quit
If oFSO.FileExists(Fichier_Rapport) Then oFSO.DeleteFile Fichier_Rapport, True
' ******************************
' Ecriture du fichier temporaire
' ******************************
Set Var_tmp = oFSO.CreateTextFile(Fichier_tmp) : Var_tmp.close
Set lect = oFSO.OpenTextFile(Fichier_pc_txt, ForReading)
Set ecr = oFSO.OpenTextFile(Fichier_tmp, ForWriting)
While Not lect.AtEndOfStream
Texte = lect.ReadLine
Texte = Trim(Texte)
If len(Texte) > 0 Then
ecr.WriteLine Texte
End if
Wend
lect.close
ecr.close
' ****************
' Lecture liste PC
' ****************
Set f = oFSO.OpenTextFile(Fichier_tmp, ForReading)
ts = f.ReadAll
nbr_pc = f.Line
f.close
Set f = oFso.OpenTextFile(Fichier_tmp, ForReading)
Dim list_pc()
Redim list_pc(nbr_pc,3)
i = 1
Do While Not f.AtEndOfStream
list_pc(i,1) = f.Readline
i = i + 1
Loop
f.close
If oFSO.FileExists(Fichier_tmp) Then oFSO.DeleteFile Fichier_tmp, True
if list_pc(nbr_pc,1) = "" Then nbr_pc = nbr_pc - 1
' *******************
' Ajout date et heure
' *******************
If oFso.FileExists(Fichier_Rapport) = False then oFso.CreateTextFile(Fichier_Rapport)
set myfile = oFso.OpenTextFile(Fichier_Rapport, ForWriting) : myfile.Write("Début du test : " & date_heure & vbNewLine & vbNewLine) : myfile.Close
' *********************
' Test online / Offline
' *********************
For i = 1 to nbr_pc
StrComputer = list_pc(i,1)
Call online
' *** Poste inaccessible ***
If list_pc(i,2) = 0 Then
Set myfile = oFso.OpenTextFile(Fichier_Rapport, ForWriting) : Message = StrComputer & " : *** Inaccessible ***" & vbNewLine : myfile.Write(Message) : myfile.Close
Else
' *** Mapping poste accessible ***
if oFSO.DriveExists("Z:") Then WSHNetwork.RemoveNetworkDrive("Z:")
WScript.Sleep 2000
chem = "\\" & StrComputer & "\c$"
WSHNetwork.MapNetworkDrive "Z:", chem
WScript.Sleep 2000
' *** Répertoire recherché existe ***
if oFSO.FolderExists(MyFolder) Then
Set oFL = oFSO.GetFolder(Myfolder)
Message = StrComputer & " : Profil trouvé " & oFL.DateLastModified & vbNewLine
Else
' *** Répertoire recherché n'existe pas ***
Message = StrComputer & " : " & "Profil inexistant" & vbNewLine
end if
' écriture dans le rapport
Set myfile = oFso.OpenTextFile(Fichier_Rapport, ForWriting)
myfile.Write(Message) : myfile.Close
end if
Next
' **************************************************
' Ouverture du fichier de rapport & fin du programme
' **************************************************
date_heure = now
set myfile = oFso.OpenTextFile(Fichier_Rapport, ForWriting) : myfile.Write(vbNewLine & "Fin du test : " & date_heure & vbNewLine & vbNewLine & "___________________________________" & vbNewLine & vbNewLine) : myfile.Close
if oFSO.DriveExists("Z:") Then WSHNetwork.RemoveNetworkDrive("Z:")
MsgBox "Traitement terminé !" & vbNewLine & "Consulter " & Fichier_Rapport
WScript.Quit
' *****************************
' Sous fonction ping des postes
' *****************************
Sub online
Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}!\\").ExecQuery("select * from Win32_PingStatus where address = '" & StrComputer & "'")
For Each objStatus in objPing
If objStatus.Statuscode = 0 Then list_pc(i,2) = 1 else list_pc(i,2) = 0
Next
End Sub |
