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
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
| Option Explicit
'******************************************************************************************************
' Run DcDiag and NetDiag. Report result of tests to Big Brother.
' save copy of output to current folder to help diagnose any errors.
' 17/08/06 Graeme Shea
' Added ignor of dc link test. 05/09/06 Graeme Shea
' Fixed capialisation problem with ignore of dc link test. 07/09/06 Graeme Shea
' V1.3 Added ignore of concerrent error msg with error of dc link test. 14/09/06 Graeme Shea
' V1.4 Added ignore of WAN test. 1/10/06 Graeme Shea
' V1.4.1 Added ignore of FRS events from previous 24hrs. 3/12/06 Graeme Shea
' V1.4.2 Added ignore of a syslog event from previous 24hrs. 20/02 Graeme Shea
' V1.5.0 BBWin compatable. 01/05/08 Graeme Shea
'*******************************************************************************************************
Dim oShell,oFile,FSO,ExtPath, szResult, szOutPut, szDelay, b64Bit
Const Version = "1.4.2"
Set FSO= CreateObject("Scripting.FileSystemObject")
Set oShell = WScript.CreateObject("WScript.Shell")
szDelay = "+27h" 'Sets the PURPLEDELAY for this service check - change to match frequency of defrag
szOutput = ""
' Retrieve path to big brother log files
ExtPath = GetBigBrotherPath
on Error GoTo 0
szResult = runoutput("cmd /C dcdiag.exe",1, "DcDiag.txt")
szResult = lCase(szResult)
if instr(szResult, "failed test frsevent")>0 Then
'If the FRS is not working now will still raise error. I'm not very concerned
' if there was an error of some sort in the last 24hrs.
szResult = Replace (szResult, "failed test frsevent", " ")
szResult = Replace (szResult, "failing sysvol replication", " ")
szOutPut = szOutPut & vbcrlf & "&yellow FRS Event Ignored. "
'MsgBox "in fail system log"
end If
if instr(szResult, "failed test systemlog")>0 Then
'If there are errors in the system log you have allready been advised
' no need to have a red dot for the whole day.
szResult = Replace (szResult, "failed test systemlog", " ")
szOutPut = szOutPut & vbcrlf & "&yellow System Log Error Ignored. "
'MsgBox "in fail system log"
if instr(szResult, "browser service has failed to retrieve the")>0 Then
'MsgBox "The browser service has failed to retrieve the"
szResult = replace (szResult, " failed to retrieve the", " ")
szOutPut = szOutPut & vbcrlf & "&yellow Browser Error Ignored. "
end If
if instr(szResult, "service failed to see a directory server")>0 Then
'MsgBox "The browser service has failed to retrieve the"
szResult = replace (szResult, "service failed to see a directory server", " ")
szResult = replace (szResult, "service failed to see a directory server", " ") 'Error often in pairs
szOutPut = szOutPut & vbcrlf & "&yellow Syslog reported a service couldnt see the directory server. "
end If
end If
' msgbox "szOutput = " & szOutPut
if instr(szResult, "fail") > 0 Then
szOutPut = szOutPut & VbCrLf & "&red DcDiag test failed. " & VbCrLf & VbCrLf
else szOutPut = szOutPut & VbCrLf & "&green DcDiag test passed. " & VbCrLf & VbCrLf
end If
szResult = runoutput("cmd /C netdiag.exe",1, "NetDiag.txt")
szResult = lCase(szResult)
if instr(szResult, "default gateway test . . . : failed")>0 then
'VicSmart Routers allways seem to fail gateway test so ignore
szResult = replace (szResult, "default gateway test . . . : failed", " ")
szResult = replace (szResult, "default gateway test . . . . . . . : failed", " ")
szOutPut = szOutPut & "&yellow NetDiag Default Gateway Test Failure Ignored. " & VbCrLf
end If
if instr(szResult, "domain membership test . . . . . . : failed")>0 Then
'When the Big Brother client is running under the system account it cannot access
' the network to check domain membership. If you run under another account you
' can comment this section out (I think)
szResult = replace (szResult, "domain membership test . . . . . . : failed", " ")
szOutPut = szOutPut & "&yellow NetDiag Domain Membership Test Failure Ignored. " & vbcrlf
end If
if instr(szResult, "dc list test . . . . . . . . . . . : failed")>0 Then
'When the Big Brother client is running under the system account it cannot access
' the network to check domain membership. If you run under another account you
' can comment this section out (I think)
szResult = replace (szResult, "dc list test . . . . . . . . . . . : failed", " ")
' This is an error message that occurs concurrntly and causes false detection of error
szResult = replace (szResult, "failed to enumerate dcs by using the browser.", " ")
szOutPut = szOutPut & "&yellow NetDiag DC list test Test Failure Ignored. " & VbCrLf
end If
if instr(szResult, "wan configuration test . . . . . . : failed")>0 Then
szResult = replace (szResult, "wan configuration test . . . . . . : failed", " ")
szOutPut = szOutPut & "&yellow NetDiag WAN configuration Test Failure Ignored. " & VbCrLf
end If
if instr(szResult, "getstats failed for")>0 Then
szResult = replace (szResult, "getstats failed for", " ")
szOutput = szOutput & "&yellow Netcard Test Failed Ignored. " & VbCrLf
end If
###########################################################################
dim tbl (1000)
Set monObjet = CreateObject("Scripting.FileSystemObject")
Set f = monObjet.OpenTextFile("c:\Progra~1\BBWin\bin\NetDiag.txt", 1, false)
Do Until f.AtEndOfStream
lu=f.readline
lu = lCase(lu)
if instr(lu,"fail") then
n=n+1
tbl(n)=lu
end if
loop
f.close
for i =1 to n
texte = texte & tbl(i) &vbcrlf
next
###########################################################################
if instr(szResult, "fail")> 0 Then
szOutPut = szOutPut & "&red NetDiag test failed. " & VbCrLf & VbCrLf
else szOutPut = szOutPut & "&green NetDiag test passed. " & vbcrlf
end If
if instr(szOutPut, "fail")>0 then
szOutPut = "red" & szDelay & " " & now & vbcrlf & vbcrlf & szOutPut
else szOutPut = "green" & szDelay & " " &Now & vbcrlf & vbcrlf & szOutPut
end if
Set oFile = FSO.OpenTextFile(ExtPath &"\dcdiags", 2, True)
oFile.write(szOutput)
oFile.WriteBlankLines(2)
oFile.WriteLine "DCDiags Check, BBDCDiags.vbs Version " & Version & vbcrlf & vbcrlf & texte
oFile.close
Function RunOutput( cProgram, nWindowType, szTempFileName )
' Run a program and save results to szTempFileName
' Got this routing of the net somewhere. Apologies to the orginal author
Dim oFS
Set oFS = CreateObject("Scripting.FileSystemObject")
Dim oShell
Set oShell = CreateObject( "WScript.Shell" )
oShell.Run cProgram & " > " & szTempFileName, nWindowType, True
Dim oFile
Set oFile = oFS.OpenTextFile(szTempFileName, 1, True)
RunOutput = oFile.ReadAll()
oFile.Close
Set oShell = Nothing
End Function
function Convert2Text(sTemp)
' Converts non printable characters to " " , so that Textfile is working
dim loopcount, tempwert, inttest
tempwert=""
for loopcount = 1 to len(sTemp) ' replace all unprintable characters maybe easier and faster with RegEx
inttest = ascw(mid(sTemp,loopcount,1))
'if ((inttest>=32) and (inttest<127)) or (inttest=10) or (inttest=13) or (inttest=9) then
if ((inttest>=32) and (inttest<127)) then
tempwert = tempwert & chr(inttest) ' printable Character or CR LF TAB
else
tempwert = tempwert & " "
end if
'tempwert = tempwert & chr(ascb(mid(sTemp,loopcount,1)))
next
Convert2Text = tempwert
end function
' Get path to external log files (for BB 1.08d)
Function GetBigBrotherPath()
Dim ExtPath
On Error Resume Next
ExtPath = oShell.RegRead("HKLM\SOFTWARE\Quest Software\BigBrother\bbnt\ExternalPath\")
If IsEmpty(ExtPath) Then
ExtPath = oShell.RegRead("HKLM\SOFTWARE\BBWin\tmppath")
End If
If Not IsEmpty (ExtPath) Then 'If not empty then we have 32bit machine
b64Bit = False
End If
If IsEmpty(ExtPath) Then
ExtPath = oShell.RegRead("HKLM\SOFTWARE\Wow6432node\Quest Software\BigBrother\bbnt\ExternalPath\")
End If
If IsEmpty(ExtPath) Then
ExtPath = oShell.RegRead("HKLM\SOFTWARE\Wow6432node\BBWin\tmppath")
End If
If Not IsEmpty(ExtPath) And isEmpty(b64Bit) Then
b64Bit = True
err.clear
End If
If IsEmpty(ExtPath) Then
'Put exit stuff here
End If
on Error GoTo 0
GetBigBrotherPath = ExtPath
End Function |
