[x]
Posted via EE Mobile

Search, ask, and monitor your questions on the go with EE Mobile. Visit Experts Exchange from your mobile device and never be out of touch again.
Question
[x]
Attachment Details
[x]
The Solution Rating System

With so many solutions, how can you tell which solutions are most likely to help you and which ones are not? To provide you with a tool to use, we rate our solutions based on various elements that most accurately determine if a solution is a quality solution. To explain what factors affect the solution rating, here are the elements we take into consideration when formulating our solution rating.

  • The Grade of the Solution
  • The Zone Rank of the Expert Providing the Solution
  • The Number of Author and Expert Comments
  • The Number of Experts Contributing
  • The Feedback of the Community

Your Input Matters
Because of the way the system is set up, the most important variable in this equation is you. As a member of Experts Exchange, you are able to cast your vote on the quality of the solutions in regard to how complete, accurate, helpful and easy to understand each solution is. When you provide your feedback, each rating is adjusted accordingly. So, if you see a solution that has a poor rating that you think is a good solution, let us know by rating it. As you do, the rating will be adjusted and will become more accurate for other members of our site.

If you have any suggestions that you would like to make for our rating system, please ask a question in the Suggestions Zone of Community Support.

Thank you!
9.0

Adding a PING section and change of output name to below VB script?

Asked by montagu in VB Script, System Diagnostic Software

Tags: VB Script

Calling all experts......
I would like to add a ping section and an amendment to the output name of the script that was written so kindly and expertly by Rob Dunne of (http://www.vbshf.com/vbshf/forum/index.asp). If at all possible could we add the another section that details the information found when you ping a server e.g.
Pinging 127.0.0.1 with 32 bytes of data:
Reply from 127.0.0.1: bytes=32 time<1ms TTL=128
Reply from 127.0.0.1: bytes=32 time<1ms TTL=128
Reply from 127.0.0.1: bytes=32 time<1ms TTL=128
Reply from 127.0.0.1: bytes=32 time<1ms TTL=128

Ping statistics for 127.0.0.1:
    Packets: Sent = 4, Received = 4, Lost = 0 (0% loss),
Approximate round trip times in milli-seconds:
    Minimum = 0ms, Maximum = 0ms, Average = 0ms

Can this be added and also displayed neatly in the HTML file that is output on completion of the script with a colour to display if the ping time is above the threshold set and also have the output file name with the date of when the file was run to avoid overwritting the previous output results?

Thanks Paul 
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:
444:
445:
446:
447:
448:
449:
450:
451:
452:
453:
454:
455:
456:
457:
458:
459:
460:
461:
462:
463:
464:
465:
466:
467:
468:
469:
470:
471:
472:
473:
474:
475:
476:
477:
478:
479:
480:
481:
482:
483:
484:
485:
486:
487:
488:
489:
490:
491:
492:
493:
494:
495:
496:
497:
498:
499:
500:
501:
502:
503:
504:
505:
506:
507:
508:
509:
510:
511:
512:
513:
514:
515:
516:
517:
518:
519:
520:
521:
522:
523:
524:
525:
526:
527:
528:
529:
530:
531:
532:
533:
534:
535:
536:
537:
538:
539:
540:
541:
542:
543:
544:
545:
546:
547:
548:
549:
550:
551:
552:
553:
554:
555:
556:
557:
558:
559:
560:
561:
562:
563:
564:
565:
566:
567:
568:
569:
570:
571:
572:
573:
574:
575:
576:
577:
578:
579:
580:
581:
582:
583:
584:
585:
586:
587:
588:
589:
590:
591:
592:
593:
594:
595:
596:
597:
598:
599:
600:
601:
602:
603:
604:
605:
606:
607:
608:
609:
610:
611:
612:
613:
614:
615:
616:
617:
618:
619:
620:
621:
622:
623:
624:
625:
626:
627:
628:
629:
630:
631:
632:
633:
634:
635:
636:
637:
638:
639:
640:
641:
642:
643:
644:
645:
646:
647:
648:
649:
650:
651:
652:
653:
654:
655:
656:
657:
658:
659:
660:
661:
662:
663:
664:
665:
666:
667:
668:
669:
670:
671:
672:
673:
674:
675:
676:
677:
678:
679:
680:
681:
682:
683:
684:
685:
686:
687:
688:
689:
690:
691:
692:
693:
694:
695:
696:
697:
698:
699:
700:
701:
702:
703:
704:
705:
706:
707:
708:
709:
710:
711:
712:
713:
714:
715:
716:
717:
718:
719:
720:
721:
722:
723:
724:
725:
726:
727:
728:
729:
730:
731:
732:
733:
734:
735:
736:
737:
738:
739:
740:
741:
742:
743:
744:
745:
746:
747:
748:
749:
750:
751:
752:
753:
754:
755:
756:
757:
758:
759:
760:
761:
762:
763:
764:
765:
766:
767:
768:
769:
770:
771:
772:
773:
774:
775:
776:
777:
778:
779:
780:
781:
782:
783:
784:
785:
786:
787:
788:
789:
790:
791:
792:
793:
794:
795:
796:
797:
798:
799:
800:
801:
802:
803:
804:
805:
806:
807:
808:
809:
810:
811:
812:
813:
814:
815:
816:
817:
818:
819:
820:
821:
822:
823:
824:
825:
826:
827:
828:
829:
830:
831:
832:
833:
834:
835:
836:
837:
838:
839:
840:
841:
842:
843:
844:
845:
846:
847:
848:
849:
850:
851:
852:
853:
854:
855:
856:
857:
858:
859:
860:
861:
862:
863:
864:
865:
866:
867:
868:
869:
870:
871:
872:
873:
874:
875:
876:
877:
878:
879:
880:
881:
882:
883:
884:
885:
886:
887:
888:
889:
890:
891:
892:
893:
894:
895:
896:
897:
898:
899:
900:
901:
902:
903:
904:
905:
906:
907:
908:
909:
910:
911:
912:
913:
914:
915:
916:
917:
918:
919:
920:
921:
922:
923:
924:
925:
926:
927:
928:
929:
930:
931:
932:
933:
934:
935:
936:
937:
938:
939:
940:
941:
942:
943:
944:
945:
946:
947:
948:
949:
950:
951:
952:
953:
954:
955:
956:
957:
958:
959:
960:
961:
962:
963:
964:
965:
966:
967:
968:
969:
970:
971:
972:
973:
974:
975:
976:
977:
978:
979:
980:
981:
982:
983:
984:
985:
986:
987:
988:
989:
990:
991:
992:
993:
994:
995:
996:
997:
998:
999:
1000:
1001:
1002:
1003:
1004:
1005:
1006:
1007:
1008:
1009:
1010:
1011:
1012:
1013:
1014:
1015:
1016:
1017:
1018:
1019:
1020:
1021:
1022:
1023:
1024:
1025:
1026:
1027:
1028:
1029:
1030:
1031:
1032:
1033:
1034:
1035:
1036:
1037:
1038:
1039:
1040:
1041:
1042:
1043:
1044:
1045:
1046:
1047:
1048:
1049:
1050:
1051:
1052:
1053:
1054:
1055:
1056:
1057:
1058:
1059:
1060:
1061:
1062:
1063:
1064:
1065:
1066:
1067:
1068:
1069:
1070:
1071:
1072:
1073:
1074:
1075:
1076:
1077:
1078:
1079:
1080:
1081:
1082:
1083:
1084:
1085:
1086:
1087:
1088:
1089:
1090:
1091:
1092:
1093:
1094:
1095:
1096:
1097:
1098:
1099:
1100:
1101:
1102:
1103:
1104:
1105:
1106:
1107:
1108:
1109:
1110:
1111:
1112:
1113:
1114:
1115:
1116:
1117:
1118:
1119:
1120:
1121:
1122:
1123:
1124:
1125:
1126:
1127:
1128:
1129:
1130:
1131:
1132:
1133:
1134:
1135:
1136:
1137:
1138:
1139:
1140:
1141:
1142:
1143:
1144:
1145:
1146:
1147:
1148:
1149:
1150:
1151:
1152:
1153:
1154:
1155:
1156:
1157:
1158:
1159:
1160:
1161:
1162:
1163:
1164:
1165:
1166:
1167:
1168:
1169:
1170:
1171:
1172:
1173:
1174:
1175:
1176:
1177:
1178:
1179:
1180:
1181:
1182:
1183:
1184:
1185:
1186:
1187:
1188:
1189:
1190:
1191:
1192:
1193:
1194:
1195:
1196:
1197:
1198:
1199:
1200:
1201:
1202:
1203:
1204:
1205:
1206:
1207:
1208:
1209:
1210:
1211:
1212:
1213:
1214:
1215:
1216:
1217:
1218:
1219:
1220:
1221:
1222:
1223:
1224:
1225:
1226:
1227:
1228:
1229:
1230:
1231:
1232:
1233:
1234:
1235:
1236:
1237:
1238:
1239:
1240:
1241:
1242:
1243:
1244:
1245:
1246:
1247:
1248:
1249:
1250:
1251:
1252:
1253:
1254:
1255:
1256:
1257:
1258:
1259:
1260:
1261:
1262:
1263:
1264:
1265:
1266:
1267:
1268:
1269:
1270:
1271:
1272:
1273:
1274:
1275:
1276:
1277:
1278:
1279:
1280:
1281:
1282:
1283:
1284:
1285:
1286:
1287:
1288:
1289:
1290:
1291:
1292:
1293:
1294:
1295:
1296:
1297:
1298:
1299:
1300:
1301:
1302:
1303:
1304:
1305:
1306:
1307:
1308:
1309:
1310:
1311:
1312:
1313:
1314:
1315:
1316:
1317:
1318:
1319:
1320:
1321:
1322:
1323:
1324:
1325:
1326:
1327:
1328:
1329:
1330:
1331:
1332:
1333:
1334:
1335:
1336:
1337:
1338:
1339:
1340:
1341:
1342:
1343:
1344:
1345:
1346:
1347:
1348:
1349:
1350:
1351:
1352:
1353:
1354:
1355:
1356:
1357:
1358:
1359:
1360:
1361:
1362:
1363:
1364:
1365:
1366:
1367:
1368:
1369:
1370:
1371:
1372:
1373:
1374:
1375:
1376:
1377:
1378:
1379:
1380:
1381:
1382:
1383:
1384:
1385:
1386:
1387:
1388:
1389:
1390:
1391:
1392:
1393:
1394:
1395:
1396:
1397:
1398:
1399:
1400:
1401:
1402:
1403:
1404:
1405:
1406:
1407:
1408:
1409:
1410:
1411:
1412:
1413:
1414:
1415:
1416:
1417:
1418:
1419:
1420:
1421:
1422:
1423:
1424:
1425:
1426:
1427:
1428:
1429:
1430:
1431:
1432:
1433:
1434:
1435:
1436:
1437:
1438:
1439:
1440:
1441:
1442:
1443:
1444:
1445:
1446:
1447:
1448:
1449:
1450:
1451:
1452:
1453:
1454:
1455:
1456:
1457:
1458:
1459:
1460:
1461:
1462:
1463:
1464:
1465:
1466:
1467:
1468:
1469:
1470:
1471:
1472:
1473:
1474:
1475:
1476:
1477:
1478:
1479:
1480:
1481:
1482:
1483:
1484:
1485:
1486:
1487:
1488:
1489:
1490:
1491:
1492:
1493:
1494:
1495:
1496:
1497:
1498:
1499:
1500:
1501:

strScriptVer = "2.12a - 12/21/05"
'~~[author]~~
'Ariston Collander
'~~[/author]~~
 
'~~[emailAddress]~~
'ariston@coxcomputer.com
'~~[/emailAddress]~~
 
'~~[modified by]~~
'Rob Dunn
'~~[/modified by~~
 
'~~[emailAddress]~~
'uphold2001@hotmail.com
'~~[/emailAddress]~~
'
'~~[website]~~
'http://uphold2001.brinkster.net/vbshf/forum
'~~[/website]~~
'
'~~[scriptType]~~
'vbscript
'~~[/scriptType]~~
 
'~~[subType]~~
'SystemAdministration
'~~[/subType]~~
 
'~~[keywords]~~
'event, viewer, argument, arguments, text file, error logs, 
'~~[/keywords]~~
'
'~~[script version]~~
'version 2.1
'~~[/script version]~~
'
'~~[usage]~~
'shealth.vbs (manual mode)
'shealth.vbs list:"x:\folder\servers.txt" email:you@yourdomain.com
'shealth.vbs .\servers.txt' (this uses the email address specified here 
' in the SMTPmailto variable)
'~~[/usage]~~
'
'~~[comment]~~
'Original Author's text:
'This script is a modified version of Leslie's Automate Daily server checks script.  
' I have added more detailed comments and modified the script to read in arguments 
' from a text file which will allow for multiple servers to be checked (I've checked 
' up to 5 servers with this one file and a separate text file).  The text file 
' contains the list of server names to be checked.  Add each server followed by the 
' enter key, then run the script using the text file as an argument (click and 
' drag the text file over the VBS file).
'
'Rob's comments: 
'I have modified the antivirus information to pull data for McAfee VirusScan Versions.
'
'Single server checks:
' I included an inputbox if no command-line options are specified for running against a 
' single server and prompt for email address if you wanted to run it against a single 
' server and email to a recipient afterwards.
'
'Commandline functionality: 
' You can use either this format: 
' shealth.vbs list:"x:\pathto\servers.txt" email:you@yourdomain.com
' or this: 
' shealth.vbs x:\pathto\servers.txt
'
' The second option will automatically mail the results to the SMTPMailto recipient. (if 
' blnsendsummary = true).
 
'Email functionality: 
' I have added an email functionality to the script so that after completion
' email will be sent to the user(s) specified in strMailto.  You will receive an overview
' listing of servers and a column that will show 'warnings' - i.e. services that didn't start
' or if AV isn't installed and a column with the time that the particular server was scanned.
' Obviously, I could have gone much farther with this, but this is all I had time to do in 
' a pinch.
'
'Central output of summary files: 
' This also has been modified to write the output of each server to a file share, 
' (in addition to the files that are created (by default) to the 'results' folder where this 
' script resides.  When a summary email made against multiple servers is sent, it points 
' back to that folder for the output. You just need to make sure that everyone who will 
' be receiving the emails has permissions to the folder.
'
' The results folder is the central repository where each server summary is saved, prior
' to being copied to the remote share.  The script will copy the files out to the remote 
' share (strDestFolder) that you specify in the script if you select the email mode.
'
'Log file during script processing: 
' In the logs folder (which resides in the same folder that this script resides in), you'll
' find a log for each time the script was ran.  This is useful if the script is erroring out
' and you can't figure out why.
'
'If you run this in manual mode (only one server inputted by double-clicking the script),
' and select 'email', it will email the overall health page of the individual server 
' rather than a summary page.
'
'If you run this in manual mode and you don't choose the email mode, it will open up the
' health page upon completion.
'
'Some other changes:
'
'Event Log entries (how many days back): 
' Modified the event log listing to show both warnings and errors.  You can adjust the variable
' "IntDaysBack" to produce more event log entries... 
'
'Event Log entries (how many entries to show): 
' Also edit "strEventCount".  
'
'NOTE: If your query reports back the total amount of events specified in "strEventCount"
' before it is able to query all of the days specified in "IntDaysBack", then the script will
' move on to the next server, and you will only see the first "strEventCount" events found, 
' even though you know you have more events that aren't shown for days further back.  This
' is by design.
'
'Drive threshholds: 
' You can change the "intFreeSpaceThreshold" to determine what is a critical threshold
' - - - if the threshhold is reached, then it will produce a warning on the summary page that
' is emailed (if multiple servers are scanned).  If one server is scanned, it merely changes
' the color of the freespace text on the health page.
'
'Before your run this:
'Be sure to modify the SMTP server variable below with the IP address of the server that
' you are using.  Also, edit strMailto, strMailfrom, and sourcefile if you are running this 
' against a list of servers.  Some of these are superceded by command-line arguments.
'
'Other flavors of AV: 
' Check the function chkopsys(strComp) to find where to modify the reg keys values you are 
' checking for AV install status for other brands of AV.  You may need to play with this 
' a bit to get it to work with other flavors.
 
'Feel free to post if you have any trouble. 
'~~[/comment]~~
 
'~~[script]~~
'==========================================================================================
'
' Title: Server Check Script
'
' Filename: servchk.vbs
' Author: Leslie Maclachlan
' Modified by: Ariston Collander, Cox Computer Service
' Modified beyond all recognition by: Rob Dunn
'
'==========================================================================================
On Error GoTo 0
'=====System variables - dont change=====
Const HKEY_LOCAL_MACHINE = &H80000002
Const ForWriting = 2
Const ForReading = 1
Const ForAppending = 8
Const cdoSendUsingMethod = "http://schemas.microsoft.com/cdo/configuration/sendusing", _
      cdoSendUsingPort = 2, _
      cdoSMTPServer = "http://schemas.microsoft.com/cdo/configuration/smtpserver"
 
Dim strScriptPath, strMessage, Count, strBgcolor, IntDebug, blnErrors, strMsg, objargs, strWarnings
Dim blnServices, blnDiskSpace, blnAV, blnEvents, strValue, blnSend, strComputer, StrComp, blnOnline
Dim strReadFromFile, strEventCount, strSpace, strService, strAntiVirus, intVirusDefAge
Dim summaryfile, intAV, l, ws, strSourceFile, strBootTime
'below variables for progress indicators
 
Dim objShell, objProcessEnv, objSystemEnv, objNet, objFso, objSwitches, WShSysEnv, WshShell
Dim query, item, acounter, blnExtendedWMI, blnProcessEvents
Dim dlgBarWidth, dlgBarHeight, dlgBarTop, dlgBarLeft, dlgProgBarWidth, dlgProgBarHeight 
Dim dlgProgBarTop, dlgProgBarLeft
Dim dlgBar, dlgProgBar, wdBar, objPBar, objBar, blnSearchWildcard
Dim blnProgressMode, blnDebugMode, dbgTitle
Dim dbgToolBar, dbgStatusBar, dbgResizable
Dim IE, objDIV, objDBG, strMyDocPath, strSubFolder, strTempFile, f1, ts, File2Load, objFlash
Dim dbgWidth, dbgHeight, dbgLeft, dbgTop, dbgVisible, strDestFolder1, strHideRows
Dim strIPAddress
 
Set WshShell = WScript.CreateObject("WScript.Shell")
Set WshSysEnv = WshShell.Environment("PROCESS")
Set objArgs = WScript.Arguments
Set ws = wscript.CreateObject("Scripting.FileSystemObject")
 
strScriptPath = replace(wscript.scriptfullname,"\" & wscript.scriptname,"")
resultsfolder = strScriptPath & "\results"
logfolder = strScriptPath & "\logs"
logfile = logfolder & "\" & replace(Date,"/","_") & "-" & replace(Time,":","'") & " server health.txt"
MakeSureDirectoryTreeExists(logfolder)
'wscript.echo resultsfolder
MakeSureDirectoryTreeExists(resultsfolder)
Set l = ws.OpenTextFile (logfile, ForAppending, True)
l.writeline "************************************************"
l.writeline "Server Health script executed at " & Now
 
'above variables for progress indicators
 
IntDebug = 0
 
     
'=====Configure User defined Variables=====
CurrentDate = Now
strMailto = "paul.lamb@montagu.com" 	
 'who are you mailing to?  Input mode only.  Command-line 
 ' parameters take precedence
 
strMailFrom = "serverhealth@montagu.com" 	'reply address
strSMTPServer = "10.44.1.25"  	'set SMTP email server address here
 
SourceFile = "\\lonquest01\scripts\servers.txt"
 'Where is the master list of servers being pulled from?
 ' For input mode only.  Command-line parameters take precedence
 
bgcolor0 = "white"		'Colors for computer health page
bgcolor1 = "aliceblue"
strSummaryFileName = "summary.htm"
 
intAV = 0 			'0 = McAfee VirusScan Enterprise
				'1 = Norton Antivirus
				'2 = Trend Officescan
				'Need people to test this (NAV)
'Event Log variable(s)
IntDaysBack = 2 'how many days prior you would like to pull event log entries from
 
strEventCount = 50		'Amount of events you want to count.  If this number is 
	' exceeded, then the script will stop checking events and move on to the next 
	' server.  This is useful if you have a LOT of errors, but want to quickly 
	' scan the servers without holding up the entire process.  If you have more 
	' events that occurred in the last 2 days (for example) than what you have 
	' specified here, you will only see the most recent events that fall within
	' this count.
 
Set ws = CreateObject ("Scripting.FileSystemObject")
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
Set objDictionary = CreateObject("Scripting.Dictionary")
 
blnSendMail = false 'send individual mails for each server checked - server list mode only.
blnCopyFile = true  'copy the summary files to a remote path - server list mode only.
 
strDestFolder = "\\server\logs\serverhealth" 
			' add ---> & WeekdayName(weekday(now)) 'to retain daily backups
			' This is the remote path to copy files to, when run against server 
			' list ONLY
 
intFreeSpaceThreshold = 10 'set critical threshold for drive space (shows up in red if free
 			'percentage is lower than this number)
 
intVirusDefAge = 4 	'set how many days back you might consider the virus definitions to be 
			' too old.
 
blnSendSummary = true 	'send a single summary email after everything is all done? (when running
		      	' against server list ONLY
 
strCheckAccount = "yourolddomain" 	'type a string of text that you wish to check your services against.
				' for example, if you are phasing out old accounts or domains, the 
				' script will generate an alert if it finds that a service is starting
				' with credentials that contain this string.
				' If you don't want to process this value, just set the variable to ""
				
'------------------------------------------------------------------------
'End of User-configurable variables
'------------------------------------------------------------------------
 
'Finds name of computer running the script
strSourceComputer = WshShell.ExpandEnvironmentStrings("%computername%")
'Finds source credentials of account running the script
strSourceDomain = WshShell.ExpandEnvironmentStrings("%userdomain%")
strSourceUser = WshShell.ExpandEnvironmentStrings("%username%")
 
blnSkipComputer = false 'do not modify
strReadFromFile = "yes"
 
If objargs.count < 1 Then
	Call fctInput
Else
	'strSourceFile = Chr(34) & objargs(0) & Chr(34)
 
	'wscript.echo strSourceFile
 
  For I = 0 to objArgs.Count - 1
   
   If InStr(1,LCase(objargs(I)),"list:") Then
   	strMDArray = split(objargs(I),"list:") 
   	'set sourcefile to be what follows the ':'
   	SourceFile = replace(strMDArray(1),Chr(34),"")
	blnOK1 = true
        l.writeline time & " - Pulling source listing from " & SourceFile
        Set objTextFile = objFSO.OpenTextFile(sourcefile, ForReading)
 
   ElseIf InStr(1,LCase(objargs(I)),"computer:") Then
   	strMDArray = split(objargs(I),"computer:")
	strReadFromFile = "no"
	blnSendMail = true
	blnSend = true
	blnSendSummary = false
 
    	'set sourcefile to be what follows the ':'
   	strComputer = replace(strMDArray(1),Chr(34),"")
	blnOK1 = true
        l.writeline time & " - Server specified: " & strComputer
 
   ElseIf InStr(1,LCase(objargs(I)),"email:") Then
   	strMDArray = split(objargs(I),"email:") 
   	'set sourcefile to be what follows the ':'
   	strMailTo = strMDArray(1)
	blnOK2 = true
	l.writeline Time & " - Email recipient specified as " & strMailto
   Else
   	sourcefile = objargs(0)
        l.writeline time & " - Pulling source listing from " & SourceFile
        Set objTextFile = objFSO.OpenTextFile(sourcefile, ForReading)
 
   End If
  Next
  
End If
 
If IntDebug = 0 then On Error Resume Next
 
IntCopyCount = 0
CutOff = Date() - 1    
Count = 0
strHDRColor1 = "'#AACFE4'"
strHDRColor2 = "'#6E8BB6'"
strFontColor1 = "'white'"
strFontColor2 = "'black'"
strFontStyle = "'Tahoma'"
strBodyBGColor = "'aliceblue'"
blnProgressMode = true
 
 
'wscript.echo "Calling IEStatus - blnProgressMode is: " & blnProgressMode
 
If objargs.count < 1 Then Call IEStatus
 
'strServerTable = "<Table border=1 width='100%'><tr><td bgcolor=" & strHDRColor2 _
' & "><font color=" & strFontColor1 & " face=" & strFontStyle & " size='2'>Computer </font></td>" _
' & "<td bgcolor=" & strHDRColor2 & "><font color=" & strFontColor1 & " face=" & strFontStyle & " size='2'>Warnings</font></td>" _
' & "<td bgcolor=" & strHDRColor2 & "><font color=" & strFontColor1 & " face=" & strFontStyle & " size='2'>Booted</font></td>" _ 
' & "<td bgcolor=" & strHDRColor2 & "><font color=" & strFontColor1 & " face=" & strFontStyle & " size='2'>Scanned</font></tr>"
strServerTable = "<font face=" & strFontStyle & " size='3'><strong>Server Health Check " _
 & Now & "</strong></font><Table border=0 cellspacing=0 width='100%'><tr>" _
 & "<td colspan='33%' bgcolor=" & strHDRColor2 & "><font color=" & strFontColor1 & " face=" & strFontStyle & " size='2'><strong>Warnings</strong></font></td>" _
 & "<td colspan='33%' bgcolor=" & strHDRColor2 & "><font color=" & strFontColor1 & " face=" & strFontStyle & " size='2'><strong>Booted</strong></font></td>" _ 
 & "<td colspan='33%' bgcolor=" & strHDRColor2 & "><font color=" & strFontColor1 & " face=" & strFontStyle & " size='2'><strong>Scanned</strong></font></td></tr></table>"
 
strEndTable = "</table>"
strBeginLine = "<TD><font face=" & strFontStyle & " color=" & strFontColor2 & " size=1>"
strMiddleLine = "</TD><TD><font face=" & strFontStyle & " color=" & strFontColor2 & " size=1>"
strEndLine = "</FONT></TD>"
 
l.writeline time & " - Generating HTML for server tables..."
'wscript.echo strServertable
 
If IntDebug = 0 then On Error Resume Next
 
 
'wscript.echo strReadfromFile
If strReadFromFile = "yes" Then 
	Dim fso, MyFile
	Set fso = CreateObject("Scripting.FileSystemObject")
	
 
	Call ReadTextFile
Else
	objDictionary.Add 0, strComputer
End If
 
 
'=====Assign each item in the text file to the Dictionary object=====
For Each objItem in objDictionary
 
    '===Assign each item in Dictionary to strComputer variable===
    strWarnings = ""
    blnServices = false
    blnOnline = true
    blnDiskSpace = false
    blnEvents = false
    blnAV = false
    blnErrors = false
    strBootTime = ""
    strIPAddress = ""
    strComputer = objDictionary.Item(objItem)
    'wscript.echo strComputer
    blnSkipComputer = false
    strMsg = "<font face=" & strFontStyle & " color=" & strFontColor2 & ">Checking computer ["_
     & strComputer & "]</font> <br>"
    If dbgTitle <> "" Then objdiv.innerhtml = strMsg
    l.writeline time & " - Now running check against " & strComputer
    '===Assign results file===
    resultsfile = resultsfolder & "\" & strComputer & ".htm "
    
    '===Assign resultsfile to res variable===
    l.writeline time & " - Generating output file: " & resultsfile
    Set res = objFSO.CreateTextFile(resultsfile, True)
    
    '===Create the HTML code for results file===
    res.Writeline ("<html>")
    res.Writeline ("<body bgcolor=" & strBodyBGColor & ">")
    res.Writeline ("<h1><font face='arial' size='2'>Server check performed for computer [" & strComputer & "]: <font color='" & strFontColor1 & "'>" & Now & "</font></h1>")
    '===Run the checks function===
    Call checks(strComputer)
    l.writeline time & " - Now running main check routine"
 
  If blnSkipComputer = true Then
  	l.writeline Now & ": skipping " & strComputer & ".  This computer is either not accessible via " _
  	 & "this script or is not powered on."
 	l.writeline time & " - Generating warnings..."
 	Call fctWarnings
 	l.writeline time & " - Generating email body..."
  	Call WriteMail
  Else
  	If blnCopyFile = true then 
    	   strDestFolder1 = strDestFolder & "\" & strComputer
           l.writeline time & " - Verifying that " & strDestFolder1 & " exists..."
   
    	   MakeSureDirectoryTreeExists(strDestFolder1) 
           
           l.writeline time & " - Generating warnings..."
           Call fctWarnings
    	   
    	   l.writeline time & " - Copying file from " & resultsfile & " to " & strDestfolder1
    	   Call fctCopyFile(resultsfile,strDestFolder1)
 
  	Else
  		strServerTable = ""
  	End If
 
        If blnSend = true Then
 
       	    If blnSendMail = true then 
 
       	    	Call Sendmail(strMailTo,strMailFrom,"[Server health] - " & ucase(strComputer) & " health report",strMessage) 
       	        'strServerTable = ""
       	    End If
 
 
  	End If
  End If
  tempvar = split(sourcefile,"\")
  tempvar1 = UBound(tempvar) 
  'wscript.echo tempvar(tempvar1)
  On Error GoTo 0
  summaryfile = strDestFolder & "\" & replace(tempvar(tempvar1),".txt","") & "_" & strSummaryFileName
  'wscript.echo summaryfile
  Call WriteSummary
 
  blnskipcomputer = false
  
Next
 
'strServerTable = StrServerTable & StrEndTable
 
If blnSendSummary = true then 
 	If strReadFromFile = "no" Then 
 		SourceFile = "(computername specified: " & strComputer & ")"
 		
 	Else
 	 	SourceFile = "<a href='" & SourceFile & "'>" & SourceFile & "</a>"
 	End If
 	strServerTable = strServerTable & "<br><font face=" & strFontStyle & " size='2'>" _
 	 & "This file is also located here: <a href='" & summaryfile & "'>" & SummaryFile & "</a><br>" _
 	 & "<font face=" & strFontStyle & " size='1'>output generated by Server Health Script " & strScriptVer _
 	 & "</font>"
	strMessage = "<font face=" & strFontStyle & " size='2'> Server health script " _
	 & "completed at " & Now & ".  Please check <a href='" & strDestFolder & "'>" _
	 & strDestFolder & "</a> to view the server files. <br><br>You may also click the server name below to " _ 
	 & "review each server's health stats directly.<br><br><strong>Listing generated by: </strong><br>" _
	 & "Computer: " & strSourceComputer & "<br> User Credentials: " & strSourceDomain & "\" & strSourceUser _
	 & "<br>Script path: " & strScriptPath & "\" & wscript.scriptname & "<br><br>Source server listing " _ 
	 & "was pulled from " & replace(SourceFile,Chr(34),"") & "</font><br><br>" & strServerTable
	If InStr(sourcefile,"\") Then 
	   myarray = split(sourcefile,"\")
	   For i = 0 to UBound(myarray)
		
	   	sourcefile1 = replace(myarray(i),"</a>","")
	   Next
	Else 
	   sourcefile1 = strComputer
	End If
	Call SendMail(strMailFrom,strMailto,"[Server health] - " & sourcefile1,strMessage)
End If
'WScript.echo ("Complete")
If dbgTitle <> "" Then objDIV.InnerHTML = "<font face=" & strFontStyle & " color=" & strFontColor2& ">Server query completed at " & Now & "</font>" 
 
On Error GoTo 0
If blnSend = 0 and blnSendSummary = false Then
   l.writeline Now & " - no email will be sent, now running " & resultsfile
   WshShell.Run Chr(34) & ResultsFile & Chr(34),3,false	
End If
 
l.close
 
'#####################################################################
'FUNCTIONS
'#####################################################################
Function fctInput
        l.writeline time & " - Input mode requested, no command-line parameters given."
	strComputer = InputBox("Enter name of computer to query " _
         & "system stats from. " & vbcrlf & vbcrlf _
         & "Click 'OK' without entering a " _
	 & "computer name to pull server listing from: " _
	 & vbcrlf & SourceFile & " " & vbcrlf & vbcrlf & "use '" _
         & wscript.scriptname & " ?' for complete help.", "Query which computer?",strComputer)
         strReadFromFile = "no"
	
	If IsNull(strComputer) Then 
		wscript.quit
	ElseIf strComputer = "" or strComputer = null Then 
		strReadFromFile = "yes"
		l.writeline time & " - No computer entered to query, defaulting to " & SourceFile
	End If
	'wscript.echo strReadFromFile
	'strComputer = Trim(strComputer)
	strOutput = InputBox("Would you like to: " & vbcrlf & vbcrlf _
	 & "1 - send summary to email recipient(s) " & vbcrlf _
         & "2 - open summary after execution", "Output method","1")
         If strOutput = 1 Then strOutputdef = " - send summary to email recipient(s)"
         If strOutput = 2 Then strOutputdef = " - open summary after execution"
       
        'strReadFromFile = "no"
	If IsEmpty(strOutput) Then 
		wscript.quit
	End If
	l.writeline time & " - Output mode requested: " & strOutput & strOutputdef
	If strOutput > 0 and strOutput < 3 Then
	   If strOutput = 1 Then
	   	strMailto = InputBox("Type in a valid email address " _
	   	 & "to which you will send the output summary report." _
	   	 & vbcrlf & vbcrlf & "Multiple recipients can be entered, " _
	   	 & "but they must be separated by a semicolon (;).", "Enter recipient(s)" _
	   	 & "on SMTP host " & strSMTPServer,strMailto)
		If strMailto = "" Then
		   StrErr = "No email address provided.  Defaulting to display mode."
		   wscript.echo strErr
		   blnSend = false
		   blnSendSummary = false
		Else
		   strErr = "Summary email will be sent to " & strMailto
		   wscript.echo strErr
		   blnSend = true
		   blnSendMail = true
                   blnSendSummary = false
 
		   If strReadfromfile = "yes" Then 
		   	blnSendMail = false
		    	blnSendSummary = true
		   End If
		End If
	   ElseIf strOutput = 2 Then 
	   	blnSend = false
	   	blnSendSummary = false
	   End If			
	   l.writeline strErr
 
	End If
 
End Function
 
'=====Extract arguments from text file=====
Function ReadTextFile
 	i = 0
 	
 	If objargs.count = 0 Then Set objTextFile = objFSO.OpenTextFile(SourceFile, ForReading)
        l.writeline time & " - Now reading from " & sourcefile
	Do While objTextFile.AtEndOfStream <> True
  	  If objTextFile.AtEndOfStream <> True Then
  	  	strNextLine = objTextFile.Readline
		If Trim(strNextLine) <> "" Then objDictionary.Add i, Trim(strNextLine)
  	  	i = i + 1
  	  End If	
	Loop
End Function
 
Function fctWarnings
On Error GoTo 0
 
     If blnServices = true Then strWarnings = strWarnings & "<br><font size='1'><strong>" _
      & "Services that need attention</strong></font><br>" & strService 
     If blnDiskSpace = true Then strWarnings = strWarnings & "<br><font size='1'><strong>" _
     & "Locally attached drives with less than " _
      & intFreeSpaceThreshold & "% free <br></strong></font>" & strSpace 
     If blnEvents = true Then strWarnings = strWarnings  & "<br><font size='1'><strong>" _
      & " Event log errors were detected </strong></font><br>Check the server log file for details <br>"
     If blnAV = true Then strWarnings = strWarnings & "<br><font size='1'><strong>" _
      & "Antivirus warning detected</strong></font><br>" & strAntiVirus
     If blnOnline = false Then strWarnings = strWarnings & " <font size='1'><strong>" _
      & "System did not respond to WMI queries or may be offline</strong></font>"
     'wscript.echo "strWarnings: " & strWarnings	
     strSpace = ""
     strService= ""
     strAntiVirus = ""
End Function
 
 
Function fctCopyFile(strSource,strDestFolder)
     
     'wscript.echo strWarnings
        Dim indexfile
	Set MyFile = fso.GetFile(strSource)
	'wscript.echo strDestFolder & strComputer & "_health.htm"
	MyFile.Copy (strDestFolder1 & "\" & strComputer & "_health.htm")
	'If blnSkipComputer = false Then 
	Call WriteMail
	
	'End If
 
End Function
 
Function WriteMail
  If strWarnings <> "" Then 
  	strWarningColor = "#FFCC99"
  Else
  	strWarningColor = "#DBFFED"
  End If
  strServerTable = strServerTable & vbcrlf & "<table cellspacing=0 border=0 width='100%'><tr style='cursor:pointer' onclick='showrows(tbl" & strComputer & ")' bgcolor='" & strWarningColor & "'><td width='20%'>" _
   & "<strong><font face=" & strFontStyle & " size='2'><a href='" & resultsfile & "'>" & strComputer & "</a></strong></font></td><td><font size='1'>(" & strIPAddress & ")" _
   & "</font></td></tr><tr><td colspan='100%'>" _
   & "<table width='100%'><tr id='tbl" & strComputer & "'><td colspan='33%'><font face=" & strFontStyle & " size='1' color=" & strFontColor2 & ">" _
   & strWarnings & "</font></td><td colspan='33%'><font face=" & strFontStyle & " size='1'>" & strBootTime & "</td>" _
   & "<td colspan='33%'><font face=" & strFontStyle & " size='1' color=" & strFontColor2 & ">" _
   & Now & "</font></td></tr></table></td></tr></table>"
  
  strHideRows = strHideRows & "tbl" & strComputer & ".style.display = " & Chr(34) & "none" & Chr(34) & vbcrlf
  
End Function
 
Function WriteSummary
	Dim oldfile
	On Error GoTo 0 
	'Checks to see if the output file exists, then deletes it prior to making a new
	' one (otherwise it would append to the end of the file).
 
 
	If ReportFileStatus(summaryfile) = "exists" Then
		l.writeline time & " - Deleting " & summaryfile
		Set oldfile = ws.GetFile(summaryfile)
		If intDebug = 1 Then wscript.echo summaryfile & " exists.  Now deleting." 
		oldfile.Delete
		
	   If CStr(err.number) <> 0 Then
	   	strErr = "You do not have sufficient permissions to delete " & oldfile & "."
	   	l.writeline strErr 
		If intDebug = 1 Then wscript.echo strErr
	   End If
	
	End If
	'wscript.echo strDestFolder & "\summary.htm"
        l.writeline time & " - Generating summary file: " & summaryfile	
        'If intdebug = 0 Then wscript.echo summaryfile
	Set index = ws.OpenTextFile(summaryfile, ForAppending, True)
	If CStr(err.number) <> 0 Then 
		strMsg = "Error saving " & summaryfile & ".  Be sure that this " _
	 	 & "path exists." & vbcrlf & vbcrlf & "Actual error was - " & err.description
	 	l.writeline strMsg
	 	wscript.echo strMsg
	 	wscript.quit
	End If
	'Set indexfile = objFSO.CreateTextFile( & Chr(34), True)
	l.writeline time & " - Writing summary information for " & strComputer & " to " & summaryfile
	'wscript.echo strServerTable
	index.writeline strServerTable & "<table width='100%'><tr bgcolor='black'><td colspan='100%'><font face=" & strFontStyle & " color='white' size='1'>" _
	 & "Finished server indexing at " & Now & "</font></td></tr></table>"
	index.writeline "<script language=" & Chr(34) & "VBSCRIPT" & Chr(34) & ">" 
	index.writeline strHideRows
	index.writeline "Function ShowRows(strRow)" & vbcrlf
	index.writeline "if strRow.style.display = " & Chr(34) & "inline" & Chr(34) & " then" & vbcrlf
	index.writeline "  strRow.style.display = " & Chr(34) & "none" & Chr(34) & vbcrlf
	index.writeline "else" & vbcrlf
	index.writeline "  strRow.style.display = " & Chr(34) & "inline" & Chr(34) & vbclrf
	index.writeline "end if" & vbcrlf
	index.writeline "End Function" & vbcrlf
	index.writeline "</script></body></html>"
	index.close
End Function
 
'##########Main function for running server checks##########
Function checks (strComp)
  
  '=====Run the check subroutines/functions=====
 
  chkopsys(strComp) 'Func
  'wscript.echo "blnSkipComputer = " & blnSkipComputer
  If blnSkipComputer = False Then 
    chkComputer(strComp) 'Func
    chkdiskspace (strComp) 'Sub
    l.writeline time & " - Checking AV details."
    On Error Resume Next
    If intAV = 0 Then 
  	l.writeline time & " - McAfee VirusScan was specified (IntAV = " & intAV & ")."
 
  	begintable("McAfee Anti-Virus")
  	 chkav "Product Name:","Software\Network Associates\TVD\VirusScan Enterprise\CurrentVersion","Product", "string" 'Sub
  	 chkav "Product Version:","Software\Network Associates\TVD\VirusScan Enterprise\CurrentVersion","szProductVer", "string" 
  	 chkav "Virus Definition:","Software\Network Associates\TVD\VirusScan Enterprise\CurrentVersion","szVirDefVer", "string"
  	 chkav "Virus Definition Date:","Software\Network Associates\TVD\VirusScan Enterprise\CurrentVersion","szVirDefDate", "string"
  	 chkav "Product Engine:","Software\Network Associates\TVD\VirusScan Enterprise\CurrentVersion","szEngineVer", "string"
  	endtable
    ElseIf intAV = 1 Then 
    	l.writeline time & " - Norton Antivirus was specified (IntAV = " & intAV & ")."
        begintable("Norton Antivirus")
         chkav "NAV Definition Version:","SOFTWARE\Symantec\SharedDefs","DEFWATCH_10"
        endtable 
    ElseIf intAV = 2 Then 
    	l.writeline Time & " - Trend OfficeScan was specified (IntAV = " & intAV & ")."
    	begintable("Trend OfficeScan")
    		chkav "Product Version:","SOFTWARE\TrendMicro\PCCillinNTCorp\CurrentVersion\Misc.","ProgramVer", "string"
    		chkav "Internal Pattern Version:","SOFTWARE\TrendMicro\PCCillinNTCorp\CurrentVersion\Misc.","InternalPatternVer", "dword"
    		chkav "Pattern Date:","SOFTWARE\TrendMicro\PCCillinNTCorp\CurrentVersion\Misc.","PatternDate", "string"
    	endtable
    	
    End If
    
  	chkservices(strComp) 'Func
  	chkevents (strComp) 'Func
        
  	Set w = ws.OpenTextFile(resultsfile, ForReading, False, TristateUseDefault)
  	strMessage = w.ReadAll
  	'MsgBox strMessage
  	w.close
  Else
  
  End If
  	
  
  res.Writeline ("</html>")
  res.close
 
'=====End Function=====
End Function
 
'##########Check OS Version and Free Physical Memory##########
Function chkopsys (strComp)
If intDebug = 0 Then On Error Resume Next
l.writeline time & " - Checking OS details."
If dbgTitle <> "" Then objdiv.innerhtml = strMsg & "<font face=" & strFontStyle & " color=" & strFontColor2& ">"  _
 & "Checking Operating System...</font><br>"
 
'wscript.echo StrComp
'=====Connect to winmgmts=====
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComp & "\root\cimv2")
 
Call fctErrorHandling
    
Set colopsys = objWMIService.ExecQuery _
    ("Select Caption, CSDVersion, FreePhysicalMemory from Win32_OperatingSystem")
 
'=====Write header to htm file=====
res.Writeline ("<table bgcolor=" & strHDRColor2 & " BORDER=1 width=100% cellspacing=0 cellpadding=3>")
res.Writeline ("<tr>")
res.Writeline ("<th bgcolor=" & strHDRColor1 & " colspan=6 width=400>")
res.Writeline ("<p align=left>")
res.Writeline ("<b><font face=" & strFontStyle & " size=2 color=" & strFontColor2 & ">Operating System information</font></b></p>")
res.Writeline ("</th>")
res.Writeline ("</tr>")
res.Writeline ("<tr>")
res.Writeline ("<th bgcolor=" & strHDRColor2 & " width=59><font face=" & strFontStyle & " color=" & strFontColor1 & " size=1>Operating System</font></th>")
res.Writeline ("<th bgcolor=" & strHDRColor2 & " width=59><font face=" & strFontStyle & " color=" & strFontColor1 & " size=1>Last Booted</font></th>")
res.Writeline ("<th bgcolor=" & strHDRColor2 & " width=60><font face=" & strFontStyle & " color=" & strFontColor1 & " size=1>Service Pack</font></th>")
res.Writeline ("<th bgcolor=" & strHDRColor2 & " width=60><font face=" & strFontStyle & " color=" & strFontColor1 & " size=1>Free Memory</font></th>")
res.Writeline ("</tr>")
'endtable
 
'=====Write results to htm file=====
For each objopsys in colopsys
      res.Writeline ("<TR>" & strbeginline &  objopsys.Caption & strMiddleLine & GetBootTime(StrComp) & strEndLine)
      res.Writeline (strbeginline &  objopsys.CSDVersion & strEndline)
      res.Writeline (strbeginline &  round(objopsys.FreePhysicalMemory/1000,2) & "Mb" & strEndLine & "</TR>")
Next
 
	Set colAdapters = objWMIService.ExecQuery ("Select * from Win32_NetworkAdapterConfiguration Where IPEnabled = True")
	For Each objAdapter in colAdapters
		If Not IsNull(objAdapter.IPAddress) Then
		  For i = LBound(objAdapter.IPAddress) To UBound(objAdapter.IPAddress)
			'Wscript.Echo "IP address: " & objAdapter.IPAddress(i)
			strIPAddress = objAdapter.IPAddress(i) & ";" & strIPAddress 
		  Next
 
		End If
	Next
'round(objItem.FreeSpace/1000000000,2)
'=====End Function=====
End Function
 
'##########Check OS Version and Free Physical Memory##########
Function chkComputer (strComp)
If dbgTitle <> "" Then objdiv.innerhtml = strMsg & "<font face=" & strFontStyle & " color=" & strFontColor2& ">" _
 & "Checking computer hardware ...</font><br>"
'=====Connect to winmgmts=====
l.writeline time & " - Checking computer hardware details."
Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComp & "\root\cimv2")
 
Set colCompItems  = objWMIService.ExecQuery _
    ("Select Manufacturer, Model, Username from Win32_ComputerSystem")
 
'=====Write header to htm file=====
res.Writeline ("<table BORDER=1 width=100% cellspacing=0 cellpadding=3>")
res.Writeline ("<tr>")
res.Writeline ("<th bgcolor=" & strHDRColor1 & " colspan=6 width=400>")
res.Writeline ("<p align=left>")
res.Writeline ("<b><font face=" & strFontStyle & " size=2 color=" & strFontColor2 & ">Computer Hardware information</font></b></p>")
res.Writeline ("</th>")
res.Writeline ("</tr>")
res.Writeline ("<tr>")
res.Writeline ("<th bgcolor=" & strHDRColor2 & " width=59><font face=" & strFontStyle & " color=" & strFontColor1 & " size=1>Manufacturer</font></th>")
res.Writeline ("<th bgcolor=" & strHDRColor2 & " width=60><font face=" & strFontStyle & " color=" & strFontColor1 & " size=1>Model</font></th>")
res.Writeline ("<th bgcolor=" & strHDRColor2 & " width=60><font face=" & strFontStyle & " color=" & strFontColor1 & " size=1>Logged on User</font></th>")
res.Writeline ("</tr>")
 
'=====Write results to htm file=====
For each objItem in ColCompItems
      res.Writeline ("<TR>" & strbeginline &  objItem.Manufacturer & strEndLine)
      res.Writeline (strbeginline &  objItem.Model & strEndline)
      res.Writeline (strbeginline &  objItem.Username & strEndLine & "</TR>")
Next
 
'=====End Function=====
End Function
 
 
'##########Check started and stopped services##########
Function chkservices (strComp)
If dbgTitle <> "" Then objdiv.innerhtml = strMsg & "<font face=" & strFontStyle & " color=" & strFontColor2& ">" _
 & "Checking automatic services...</font><br>"
l.writeline time & " - Checking services."
'=====Connect to winmgmts=====
Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComp & "\root\cimv2")
 
 
'=====Run query to get all services with Auto start=====
Set colsvc = objWMIService.ExecQuery _
    ("Select DisplayName, StartMode, StartName, State from Win32_Service Where StartMode = 'Auto'")
 
'=====Write heard to htm file=====
res.Writeline ("<table border=1 width=100% cellspacing=0 cellpadding=3>")
res.Writeline ("<tr>")
res.Writeline ("<th bgcolor=" & strHDRColor1 & " colspan=6 width=400>")
res.Writeline ("<p align=left>")
res.Writeline ("<b><font face=" & strFontStyle & " size=2 color=" & strFontColor2 & ">Services alerts</font></b></p>")
res.Writeline ("</th>")
res.Writeline ("</tr>")
res.Writeline ("<tr>")
res.Writeline ("<th bgcolor=" & strHDRColor2 & " width=59><font face=" & strFontStyle & " color=" & strFontColor1 & " size=1>Service Name</font></th>")
res.Writeline ("<th bgcolor=" & strHDRColor2 & " width=59><font face=" & strFontStyle & " color=" & strFontColor1 & " size=1>Logon Account</font></th>")
res.Writeline ("<th bgcolor=" & strHDRColor2 & " width=59><font face=" & strFontStyle & " color=" & strFontColor1 & " size=1>Startup Method</font></th>")
res.Writeline ("<th bgcolor=" & strHDRColor2 & " width=59><font face=" & strFontStyle & " color=" & strFontColor1 & " size=1>Current State</font></th>")
res.Writeline ("</tr>")
 
'=====Write results to htm file=====
For each objsvc in colsvc
On Error GoTo 0
'wscript.echo objsvc.startname
 
Call bgcolor
  If InStr(objsvc.StartName,strCheckAccount) and strCheckAccount <> "" Then
     'wscript.echo objsvc.startname
     res.Writeline ("<TR bgcolor='" & strbgcolor & "'>" & strBeginLine &  objsvc.DisplayName & strMiddleLine _
       & "<font face=" & strFontStyle & " color='red' size='1'>" & objsvc.StartName & "</font>" _
       & strMiddleLine & objsvc.StartMode & "</td><td>" _
       & "<font face=" & strFontStyle & " color='red' size='1'>" & objsvc.State & strEndLine)
     strService = strService & objsvc.DisplayName & " is running via credentials: <strong>" & objsvc.StartName & "</strong><br>" 	
  End If
 
Call bgcolor 
  If LCase(objsvc.State) = "stopped" Then
 
     serviceerr = "failed"
     res.Writeline ("<TR bgcolor='" & strbgcolor & "'>" & strBeginLine &  objsvc.DisplayName & strMiddleLine _
       & objsvc.StartName & strMiddleLine & objsvc.StartMode & "</td><td>" _
       & "<font face=" & strFontStyle & " color='red' size='1'>" & objsvc.State & strEndLine)
     strService = strService & objsvc.DisplayName & " is currently " & objsvc.State & "<br>"
  Else
  End If
Next
 
 
 
If serviceerr = "failed" then
     blnErrors = true
     blnServices = true
Else
    res.Writeline ("<TR>"& strbeginline & "No services are in alarm status" & strendline)
End If
res.Writeline ("</table>")
 
'=====End Function=====
End Function
 
 
'*****************************************************************
'*    Get boot up time of the server
'*****************************************************************
Function GetBootTime(StrComp)
 
Const wbemFlagReturnImmediately = &h10
Const wbemFlagForwardOnly = &h20
 
   Set objWMIService = GetObject("winmgmts:\\" & StrComp & "\root\CIMV2")
   Set colOperatingSystems = objWMIService.ExecQuery("SELECT * FROM Win32_OperatingSystem", "WQL", _
                                          wbemFlagReturnImmediately + wbemFlagForwardOnly)
   On Error Resume Next
   'If CStr(err.number) <> "" Then Call fcterrorhandling
	
   For Each objOS in colOperatingSystems  
		dtmBootup = objOS.LastBootUpTime  
		Dim dtmTimeUp
		
		'wscript.echo dtmBootup
		
		dtmLastBootupTime = WMIDateStringToDate(dtmBootup)  
 
		dtmSystemUpTime = DateDiff("h", dtmLastBootUpTime, Now)
		
		If dtmSystemUptime > 24 Then 
			dtmTimeUp =  DateDiff("d",dtmLastBootUpTime, Now) & " day(s)" 
		Else
			dtmTimeUp = dtmSystemUptime & " hour(s)"
		End If
 
		strBootTime = dtmLastBootupTime & " (" & dtmTimeUp & " ago)"
		GetBootTime = strBootTime
 
		'dtmSystemUptimeHours 
		'Wscript.Echo "Last booted: " & dtmLastBootupTime & " (" & dtmSystemUptime & " hours)"
   Next  
End Function
 
 
'##########Check status of backups (To be writte)##########
Function chkbackups ()
 
'=====End Function=====
End Function
 
'##########Check event logs for warnings and errors##########
Function chkevents (strComp)
On Error Resume Next
l.writeline time & " - Checking the " & strEventCount & " last occurences of events during the last "  & IntDaysBack & " days."
Const CONVERT_TO_LOCAL_TIME = True
On Error GoTo 0
If dbgTitle <> "" Then objdiv.innerhtml = strMsg & "<font face=" & strFontStyle & " color=" & strFontColor2& ">" _
 & "Checking the " & strEventCount & " most recent entries occuring during the last " & IntDaysBack & " day(s) of event logs...</font><br>"
Set dtmStartDate = CreateObject("WbemScripting.SWbemDateTime")
Set dtmEndDate = CreateObject("WbemScripting.SWbemDateTime")
DateToCheck = Date
dtmStartDate.SetVarDate DateToCheck - IntDaysBack, CONVERT_TO_LOCAL_TIME 
dtmEndDate.SetVarDate DateToCheck + IntDaysBack, CONVERT_TO_LOCAL_TIME
Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate,(Security)}!\\" & StrComp & "\root\cimv2")
 
Set colEvents = objWMIService.ExecQuery _
    ("Select ComputerName, EventCode, Logfile, SourceName, TimeWritten, Type, Message from Win32_NTLogEvent Where " _
        & "TimeWritten >= '" _ 
        & dtmStartDate & "' and TimeWritten < '" & dtmEndDate & "' and Type = 'error' or TimeWritten >= '" _ 
        & dtmStartDate & "' and TimeWritten < '" & dtmEndDate & "' and Type = 'warning' and Type = 'failure'") 
 
'=====Run query to get errors and warnings=====
'Set colLoggedEvents = objWMIService.ExecQuery _
'   ("Select ComputerName, EventCode, SourceName, TimeGenerated, Type, Message from Win32_NTLogEvent where Type = 'error' or Type = 'warning'")
 
'=====Write header to htm file=====
res.Writeline ("<table border=1 width=100% cellspacing=0 cellpadding=3>")
res.Writeline ("<tr colspan='100%'>")
res.Writeline ("<th bgcolor=" & strHDRColor1 & " colspan='100%'>")
res.Writeline ("<p align=left>")
res.Writeline ("<b><font face=" & strFontStyle & " size=2 color=" & strFontColor2 & ">Last " & strEventCount & " events occurring within the previous " & IntDaysBack & " day(s)</font></b></p>")
res.Writeline ("</th>")
res.Writeline ("</tr>")
res.Writeline ("<tr>")
res.Writeline ("<td bgcolor=" & strHDRColor2 & " width=60><font face=" & strFontStyle & " color=" & strFontColor1 & " size=1>Computer Name</font></td>")
res.Writeline ("<td bgcolor=" & strHDRColor2 & " width=200><font face=" & strFontStyle & " color=" & strFontColor1 & " size=1>Logfile</font></td>")
res.Writeline ("<td bgcolor=" & strHDRColor2 & " width=200><font face=" & strFontStyle & " color=" & strFontColor1 & " size=1>Event Code/Log</font></td>")
res.Writeline ("<td bgcolor=" & strHDRColor2 & " width=60><font face=" & strFontStyle & " color=" & strFontColor1 & " size=1>Source Name</font></td>")
res.Writeline ("<td bgcolor=" & strHDRColor2 & " width=60><font face=" & strFontStyle & " color=" & strFontColor1 & " size=1>Time Written</font></td>")
res.Writeline ("<td bgcolor=" & strHDRColor2 & " width=60><font face=" & strFontStyle & " color=" & strFontColor1 & " size=1>Type</font></td>")
res.Writeline ("<td bgcolor=" & strHDRColor2 & " width=60><font face=" & strFontStyle & " color=" & strFontColor1 & " size=1>Message</font></td>")
res.Writeline ("</tr>")
 
'=====Write results to htm file=====
 
Dim strEventCount1
strEventCount1 = -1
 
For Each objEvent in colEvents
 
    Call bgcolor
    On Error GoTo 0
 
    res.Writeline ("<TR bgcolor='" & strbgcolor & "'>")
    'res.Writeline (strbeginline & objEvent.Category & strendline)
    res.Writeline (strbeginline & objEvent.ComputerName & strendline)
    res.Writeline (strbeginline & objEvent.logfile & strendline)
 
    res.Writeline (strbeginline & "<a href='http://www.google.com/search?hl=en&q=%22event%22+%22" _
     & objEvent.EventCode & "%22+%22ID%22+%22windows%22+%22" & objEvent.SourceName & "%22' target='_blank'>" & objEvent.EventCode & "</a>" & strendline)
 
    res.Writeline (strbeginline & objEvent.SourceName & strendline)
    res.Writeline (strbeginline & WMIDateStringToDate(objEvent.TimeWritten) & strendline)
    strEventCount1 = strEventCount1 + 1
 
    If LCase(objEvent.Type) = "error" Then
 
    	res.Writeline ("<TD><font face=" & strFontStyle & " color='red' size=1>" & objEvent.Type & strendline)
    	blnErrors = true
	blnEvents = true
        
    Else
    	res.Writeline (strbeginline & objEvent.Type & strendline)
    End If
    res.Writeline (strbeginline & objEvent.Message & strendline)
    res.Writeline ("</TR>")
    
    If strEventCount1 > strEventCount Then 
    	'wscript.echo "Count is " & strEventCount1
        Exit For
    End If
Next
res.Writeline ("<tr><td colspan='100%' bgcolor='black'><font color='white' size='1'>Health check finished at: " & Now & "</font>" & strendline)
 
'=====End Function=====
End Function
 
Function BGColor
	If Count = 0 or IntCopyCount = 0 Then	
		strbgcolor = bgcolor0
		Count = 1
		IntCopyCount = 1
	ElseIf Count = 1 or IntCopyCount = 1 Then
		strbgcolor = bgcolor1
		Count = 0
		IntCopyCount = 0
	End If
End Function
 
Function fctErrorHandling
 If cstr(err.number) <> 0 then
	'wscript.echo err.number & " - " & err.description
	l.writeline Time & " - Error: " & err.number & " " & err.description 
	blnOnline = false
	blnSkipComputer = true
        
	Exit Function
  End If
End Function
 
 
'------------------------------------------------------------------------
'Function EmailFile - email the warning file
'------------------------------------------------------------------------
Function SendMail(strFrom,strTo,strSubject,strMessage)
Dim iMsg, iConf, Flds
 
l.writeline time & " - Calling sendmail routine"
l.writeline time & " - To: " & strMailto
l.writeline time & " - From: " & strMailFrom
l.writeline time & " - Subject: " & strSubject
l.writeline time & " - SMTP Server: " & strSMTPServer
 
If dbgTitle <> "" Then objdiv.innerhtml = "<font face=" & strFontStyle & " color=" & strFontColor2& ">" _
 & "sending mail to " & strMailTo & "...</font><br>"
 
'//  Create the CDO connections.
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
Set Flds = iConf.Fields
 
 
'//  SMTP server configuration.
With Flds
    .Item(cdoSendUsingMethod) = cdoSendUsingPort
    
    '//  Set the SMTP server address here.
    .Item(cdoSMTPServer) = strSMTPServer
    .Update
End With
 
'//  Set the message properties.
With iMsg
    Set .Configuration = iConf
        .To       = strMailTo
        .From     = strMailFrom
        .Subject  = strSubject
        '.TextBody = strMessage
End With
 
 
iMsg.HTMLBody = strMessage
 
 
'//  Send the message.
On Error Resume Next 
iMsg.Send ' send the message.
If CStr(err.number) <> 0 Then
	l.writeline Time & " - Problem sending mail to " & strSMTPServer & "."
	l.writeline Time & " - Error: " & err.description
Else
	l.writeline Time & " - Connected successfully to " & strSMTPServer
End If
End Function
 
'######################################################################
' SUBROUTINES
'######################################################################
 
'##########Check disk space subroutine##########
Sub chkdiskspace (strComp)
 
If dbgTitle <> "" Then objdiv.innerhtml = strMsg & "<font face=" & strFontStyle & " color=" & strFontColor2& ">" _
 & "Checking disk space...</font><br>"
l.writeline time & " - Checking disk space."
'=====Connect to winmgmts=====
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComp & "\root\cimv2")
 
 
'=====Run query to identify logical disks=====
Set colDisks = objWMIService.ExecQuery _
    ("Select Freespace, Name, Size from Win32_LogicalDisk where DriveType = 3")
Call fctErrorHandling
 
'=====Write header to htm file=====
res.Writeline ("<table border=1 width=100% cellspacing=0 cellpadding=3>")
res.Writeline ("<tr>")
res.Writeline ("<th bgcolor=" & strHDRColor1 & " colspan=6 width=200>")
res.Writeline ("<p align=left>")
res.Writeline ("<b><font face=" & strFontStyle & " size=2 color=" & strFontColor2 & ">Disk space</font></b></p>")
res.Writeline ("</th>")
res.Writeline ("</tr>")
res.Writeline ("<tr>")
res.Writeline ("<th bgcolor=" & strHDRColor2 & " width=60><font face=" & strFontStyle & " color=" & strFontColor1 & " size=1>Disk ID</font></th>")
res.Writeline ("<th bgcolor=" & strHDRColor2 & " width=60><font face=" & strFontStyle & " color=" & strFontColor1 & " size=1>Percentage Free Space</font></th>")
res.Writeline ("<th bgcolor=" & strHDRColor2 & " width=60><font face=" & strFontStyle & " color=" & strFontColor1 & " size=1>Free Space</font></th>")
res.Writeline ("<th bgcolor=" & strHDRColor2 & " width=60><font face=" & strFontStyle & " color=" & strFontColor1 & " size=1>Total Space</font></th>")
res.Writeline ("</tr>")
 
'=====Write results to htm file=====
For each objDisk in colDisks
      Call bgcolor
      res.Writeline ("<TR bgcolor='" & strbgcolor & "'><TD><font face=" & strFontStyle & " color=" & strFontColor2 & " size=1> " & objDisk.Name & strendline)
 
      If (objDisk.Freespace/objDisk.Size)*100 <=10 Then
 
        fontcol = "#FF0000"
      Else
        fontcol = "#666666"
      End If
      If objDisk.Freespace > 10000 Then
      	strUnit = "GB"
      	strDiskSize = FormatNumber(objDisk.Freespace / 1073741824,2)
      	strDiskTotal = FormatNumber(objDisk.Size / 1073741824,2)
      ElseIf objDisk.Freespace < 1 Then
      	strUnit = "KB"
      	strDiskSize = FormatNumber(objDisk.Freespace / 1024,2)
      	strDiskTotal = FormatNumber(objDisk.Size / 1024,2)
      ElseIf objDisk.Freespace < 1000 Then
      	strUnit = "MB"
      	strDiskSize = FormatNumber(objDisk.Freespace/1048576,2)
      	strDiskTotal = FormatNumber(objDisk.Size / 1048576,2)
      End If
      strPercentFree = round((objDisk.Freespace/objDisk.Size)*100,2)
      
      If strPercentFree < intFreeSpaceThreshold then
        'wscript.echo strPercentFree
        strSpace = strSpace & objDisk.Name & " - " & round((objDisk.Freespace/objDisk.Size)*100,2) _
         & "% free (" & FormatNumber(objDisk.Freespace / 1073741824,2) & "Gb remaining)<br>"
      	res.Writeline ("<TD><font face=" & strFontStyle & " color='red' size=1>"  & strPercentFree & "%" & strendline)
      	blnErrors = true
      	blnDiskSpace = true
      Else
      	res.Writeline ("<TD><font face=" & strFontStyle & " color=" & strfontcolor2 & " size=1>"  & strPercentFree & "%" & strendline)
      End If
 
      res.Writeline ("<TD><font face=" & strFontStyle & " color=" & strfontcolor2 & " size=1>"  & strDiskSize & strUnit & strendline)
      res.Writeline ("<TD><font face=" & strFontStyle & " color=" & strfontcolor2 & " size=1>"  & strDiskTotal & strUnit & strendline & "</TR>")
 
Next
 
'=====End Subroutine=====
End sub
 
'##########Check for AV definition files##########
Function chkav (strDescription, strKeyPath, strValueName, strRegType)
On Error Resume Next
 
'wscript.echo strValueName
 
If dbgTitle <> "" Then objdiv.innerhtml = strMsg & "<font face=" & strFontStyle & " color=" & strFontColor2 & ">" _
 & "Checking AV status...</font><br>"
 
'=====Connect to winmgmts=====
Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" &_
 strComputer & "\root\default:StdRegProv")
 
 
'=====Get definition version from registry=====
If strRegType = "dword" Then 
	oReg.GetDWordValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,strValue
ElseIf strRegType = "string" Then 
	oReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,strValue
End If
 
'wscript.echo strValue
 
If strValueName = "szVirDefDate" or  strValueName = "PatternDate" Then
	If strValueName = "PatternDate" Then 
		
		defRest = Right(strValue,4)
		strValue = Left(defRest,2) & "/" & Right(defRest,2) & "/" & Left(strValue,4)
 
	End If
	strDiff = Date - CDate(strValue)
	If strDiff > intVirusDefAge Then 
		strAntivirus = "AV definitions last updated: " & CDate(strValue) _
		  & " - Virus definitions appear to be " _
	 	  & "more than " & intVirusDefAge & " days old."
		strTempColor = "'red'"
		blnAV = true
	Else
		strTempColor = strFontColor2
		blnAV = false
	End If			 
	
	res.Writeline ("<TR><TD><font face=" & strFontStyle & " color=" & strFontColor2 & " size=1> " & strDescription _
	  & "</td><td><font face=" & strFontStyle & " color=" & strTempColor & " size=1> " & strValue & "</font></TD></TR>")
 
ElseIf strValueName <> "" Then 
	res.Writeline ("<TR><TD><font face=" & strFontStyle & " color=" & strFontColor2 & " size=1> " & strDescription _
	  & "</td><td><font face=" & strFontStyle & " color=" & strFontColor2 & " size=1> " & strValue & "</font></TD></TR>")
 
End If
 
On Error Resume Next
If strValue = "" Then 
  strAntiVirus = "The defined virus software may not be installed on this computer."
  blnAV = true
Else
  'wscript.echo "no av..."
 
  strValue = "n/a"
End If
'wscript.quit
 
'=====Write results to htm file=====
 
 
 
'=====End subroutine=====
End Function
'~~[/script]~~
 
Sub BeginTable(strTableHeader)
	res.Writeline ("<table border=1 width=100% cellspacing=0 cellpadding=3>")
	res.Writeline ("<tr>")
	res.Writeline ("<th bgcolor=" & strHDRColor1 & " colspan=6 width=400>")
	res.Writeline ("<p align=left>")
	res.Writeline ("<b><font face=" & strFontStyle & " size=2 color=" & strFontColor2 & ">" & strTableHeader & "</font></b></p>")
	res.Writeline ("</th>")
	res.Writeline ("</tr>")
End Sub
 
Sub EndTable
	res.Writeline ("</table>")
End Sub
 
Function WMIDateStringToDate(dtmDate)  
'wscript.echo dtmBootup
 'Thanks to Piers Dickinson!
	WMIDateStringToDate = CDate(Mid(dtmDate, 5, 2) & "/" & _
	Mid(dtmDate, 7, 2) & "/" & Left(dtmDate, 4) _
	& " " & Mid (dtmDate, 9, 2) & ":" & Mid(dtmDate, 11, 2) & ":" & Mid(dtmDate,13, 2))
	If CStr(err.number) <> "0" Then Call fcterrorhandler
	
End Function  
 
' The MakeSureDirectoryTreeExists Function
 
' Although the FSO model doesn't have a direct method to create nested
' folders, you can use the following function. This VBScript function uses
' VBScript's Split function to break the folder path it receives into
' components. From those components, the MakeSureDirectoryTreeExists
' creates subfolders, one at a time. Because the function checks for the
' folder's existence before proceeding, you can pass it any tree, as long as
' you make sure that, after it returns, the entire tree exists as you specified.
' With the MakeSureDirectoryTreeExists function, a call such as
 
'	MakeSureDirectoryTreeExists "C:\one\two\three"
 
' is legitimate and won't result in an error message.
 
' The MakeSureDirectoryTreeExists Function
 
' Although the FSO model doesn't have a direct method to create nested
' folders, you can use the following function. This VBScript function uses
' VBScript's Split function to break the folder path it receives into
' components. From those components, the MakeSureDirectoryTreeExists
' creates subfolders, one at a time. Because the function checks for the
' folder's existence before proceeding, you can pass it any tree, as long as
' you make sure that, after it returns, the entire tree exists as you specified.
' With the MakeSureDirectoryTreeExists function, a call such as
 
'	MakeSureDirectoryTreeExists "C:\one\two\three"
 
' is legitimate and won't result in an error message.
 
Function MakeSureDirectoryTreeExists(dirName)
Dim aFolders, newFolder
	dim delim
	' Creates the FSO object.
	Set fso = CreateObject("Scripting.FileSystemObject")
 
	' Checks the folder's existence.
	If Not fso.FolderExists(dirName) Then
 
		' Splits the various components of the folder name.
		If instr(dirname,"\\") then
		    delim = "-_-_-_-"
			dirname = replace(dirname,"\\",delim)
			'wscript.echo dirname
		End if
 
		aFolders = split(dirName, "\")
 
		If InStr(dirname,delim) Then
			dirname = replace(aFolders(0),delim,"\\")
			'wscript.echo "aFolders = " & dirname
		End if
 
		' Obtains the drive's root folder.
		
		newFolder = fso.BuildPath(dirname, "\")
	
		' Scans each component in the array, and create the appropriate folder.
		For i=1 to UBound(aFolders)
			If IntDebug = 1 Then 
				strTempVar = "Checking to see if " & newfolder _
			 	 & " exists..."
				Call writedebug(strtempvar)
			End If
			newFolder = fso.BuildPath(newFolder, aFolders(i))
			'wscript.echo newfolder
			
			
			If Not fso.FolderExists(newFolder) Then
				If IntDebug = 1 Then 
					strTempVar = "Creating " & newfolder
					Call writedebug(strTempVar)
				End If
				fso.CreateFolder newFolder
				err.clear
			End If
		Next
	End If
End Function
 
'-----------------------------------------------------------
'Function IE Status
'-----------------------------------------------------------
Function IEStatus
 
'added by Rob - IE status indicator code
If blnProgressMode = true Then
	If blnDebugMode Then
		dbgTitle = "Server Health Check"
	Else
		dbgTitle = "Server Health Check"
	End If	
	dbgToolBar = False
	dbgStatusBar = False
	If blnDebugMode Then
		dbgResizable = True
	Else
		dbgResizable = False
	End If
	dbgWidth = 500
	dbgHeight = 320
	dbgLeft = 0
	dbgTop = 0
	dbgVisible = True
	dlgBarWidth = 380
	dlgBarHeight = 23 
	dlgBarTop = 80
	dlgBarLeft = 50
	dlgProgBarWidth = 0
	dlgProgBarHeight = 18 
	dlgProgBarTop = 82
	dlgProgBarLeft = 50
	dlgBar = "left: " & dlgBarLeft & "; top: " & dlgBarTop & "; width: " & dlgBarWidth _
	 & "; height: " & dlgBarHeight & ";"
	dlgProgBar = "left: " & dlgProgBarLeft & "; top: " & dlgProgBarTop & "; width: " _
	 & dlgProgBarWidth & "; height: " & dlgProgBarHeight & ";"
	wdBar = 1 * dlgBarWidth
End If
 
If blnProgressMode = true Then
	Set IE = CreateObject("InternetExplorer.Application")
	'strScriptVer = "version would go here"
 
	strTempFile = WshSysEnv("TEMP") & "\progress.htm"
	ws.CreateTextFile (strTempFile)
        Set f1 = ws.GetFile(strTempFile)
        Set ts = f1.OpenAsTextStream(2, True)
        ts.WriteLine("<!-- saved from url=(0014)about:internet -->")
        ts.WriteLine("<html><head><title>" & dbgTitle & " " & strScriptVer & " </title>")
        ts.WriteLine("<style>.errortext {color:red}")
     	ts.WriteLine(".hightext {color:blue}</style>")
	ts.WriteLine("</head>")
	ts.WriteLine(strHDRCode & " <br><strong><font size='2' color='" & fcolor & "' face='" & fstyle & "'>" _
	 	& "&nbsp Querying <font color'=" & fcolor & ">" & strComputer & "...</font></strong><br>" _
	 	& "&nbsp &nbsp<br>")
	ts.WriteLine("<center><table width='100%' bgcolor='" & bgcolor1 & "'><tr><td>")
	If blnDebugMode Then
		ts.WriteLine("<body bgcolor ='" & stsBGColor & "' scroll='yes' topmargin='0' leftmargin='0'"_
		& " style='font-family: " & fstyle & "; font-size: 0.6em color: #000000;"_
		& " font-weight: bold; text-align: left'><center><font face=" & fstyle & ">"_
		& " <font size='0.8em'> <hr color='blue'>")
	Else
		ts.WriteLine("<body bgcolor = '" & stsBGColor & "' scroll='no' topmargin='0' leftmargin='0' "_
		& " style='font-family: " & fstyle & "; font-size: 0.6em color: #000000;"_
		& " font-weight: bold; text-align: left'><center><font face=" & fstyle & ">"_
		& " <font size='0.8em'> <hr color='blue'>")
	End If
	ts.WriteLine("<div id='ProgObject' align='left'align='left' style='width: 450px;height: 140px;overflow:scroll'></div><hr color='blue'>")			
	If blnDebugMode Then
		ts.WriteLine("<div id='ProgDebug' align='left'></div>")
	End If
 
	ts.WriteLine("<script LANGUAGE='JavaScript1.2'>")
	ts.WriteLine("<!-- Begin")
	ts.WriteLine("function initArray() {")
	ts.WriteLine("this.length = initArray.arguments.length;")
	ts.WriteLine("for (var i = 0; i < this.length; i++) {")
	ts.WriteLine("this[i] = initArray.arguments[i];")
	ts.WriteLine("   }")
	ts.WriteLine("}")
	ts.WriteLine("var ctext = ' ';")
	ts.WriteLine("var speed = 1000;")
	ts.WriteLine("var x = 0;")
	ts.WriteLine("var color = new initArray(")
	ts.WriteLine("'red',")
	ts.WriteLine("'blue'")
	ts.WriteLine(");")
	ts.WriteLine("document.write('<div id=" & Chr(34) & "ProgFlash" & Chr(34) & ">"_
	 & "<center>'+ctext+'</center></div>');")
	ts.WriteLine("function chcolor(){")
	ts.WriteLine("document.all.ProgFlash.style.color = color[x];")
	ts.WriteLine("(x < color.length-1) ? x++ : x = 0;")
	ts.WriteLine("}")
	ts.WriteLine("setInterval('chcolor()',1000);")
	ts.WriteLine("// End -->")
	ts.WriteLine("</script>")
	ts.WriteLine("<div id='ProgBarId' align='left'></div>")
	ts.WriteLine("</font></center>")
	ts.WriteLine("</tr></td>")
	ts.WriteLine("</table></center>")
	ts.WriteLine("</body></html>")
	ts.Close
	fctSetupIE(strTempFile)
	Set objDIV = IE.Document.All("ProgObject")
	If blnDebugMode Then
		Set objDBG = IE.Document.All("ProgDebug")
	End If
	Set objFlash = IE.Document.All("ProgFlash")
	Set objPBar = IE.Document.All("ProgBarId")
	Set objBar = IE.Document
End If
End Function
 
'*******************************************************************
'*	Name:	fctSetupIE
'*	Function:	Setup an IE windows of 540 x 200 to display 
'* 	progress information.
'*******************************************************************
Sub fctSetupIE(File2Load)
	IE.Navigate File2Load
	IE.ToolBar = dbgToolBar
	IE.StatusBar = dbgStatusBar
	IE.Resizable = dbgResizable
	Do
	Loop While IE.Busy
	IE.Width = dbgWidth
	IE.Height = dbgHeight
	IE.Left = dbgLeft
	IE.Top = dbgTop
	IE.Visible = dbgVisible
	wshshell.AppActivate("Microsoft Internet Explorer")
End Sub
 
'===================================================================
'Function to see if outputfile already exists
'===================================================================
 
Function ReportFileStatus(filespec)
 
   Dim fso, msg
   Set fso = CreateObject("Scripting.FileSystemObject")
   If (fso.FileExists(filespec)) Then
      msg = "exists"
   Else
      msg = "does not exist"
   End If
 
   ReportFileStatus = msg
   If IntDebug = 1 Then wscript.echo filespec & " " & msg
 
End Function
[+][-]12/27/08 05:12 PM, ID: 23250040Accepted Solution

View this solution now by starting your 30-day free trial. Setting up your free trial is quick, easy, and secure. We will return you to this solution, unlocked, when you're done.

About this solution

Zones: VB Script, System Diagnostic Software
Tags: VB Script
Sign Up Now!
Solution Provided By: RobSampson
Participating Experts: 1
Solution Grade: A
 
[+][-]12/21/08 12:55 PM, ID: 23223156Expert Comment

At Experts Exchange, members can ask their questions to thousands of technology professionals, also known as Experts. Experts compete and collaborate to answer those questions by leaving comments like this one.

Start your 30-day free trial to view this Expert Comment or ask the Experts your question.

 
[+][-]12/21/08 07:35 PM, ID: 23224539Expert Comment

At Experts Exchange, members can ask their questions to thousands of technology professionals, also known as Experts. Experts compete and collaborate to answer those questions by leaving comments like this one.

Start your 30-day free trial to view this Expert Comment or ask the Experts your question.

 
[+][-]12/24/08 10:32 AM, ID: 23241375Author Comment

Often, when Experts are collaborating with members who have asked questions, they will request additional information about the problem. Askers respond with an author comment like this one.

Start your 30-day free trial to view this Author Comment or ask the Experts your question.

 
[+][-]12/25/08 02:49 PM, ID: 23243973Expert Comment

At Experts Exchange, members can ask their questions to thousands of technology professionals, also known as Experts. Experts compete and collaborate to answer those questions by leaving comments like this one.

Start your 30-day free trial to view this Expert Comment or ask the Experts your question.

 
[+][-]12/25/08 02:49 PM, ID: 23243974Expert Comment

At Experts Exchange, members can ask their questions to thousands of technology professionals, also known as Experts. Experts compete and collaborate to answer those questions by leaving comments like this one.

Start your 30-day free trial to view this Expert Comment or ask the Experts your question.

 
[+][-]12/27/08 08:37 AM, ID: 23248708Author Comment

Often, when Experts are collaborating with members who have asked questions, they will request additional information about the problem. Askers respond with an author comment like this one.

Start your 30-day free trial to view this Author Comment or ask the Experts your question.

 
[+][-]01/02/09 08:47 AM, ID: 23280559Author Comment

Often, when Experts are collaborating with members who have asked questions, they will request additional information about the problem. Askers respond with an author comment like this one.

Start your 30-day free trial to view this Author Comment or ask the Experts your question.

 
[+][-]01/02/09 02:48 PM, ID: 23282961Expert Comment

At Experts Exchange, members can ask their questions to thousands of technology professionals, also known as Experts. Experts compete and collaborate to answer those questions by leaving comments like this one.

Start your 30-day free trial to view this Expert Comment or ask the Experts your question.

 
 
Loading Advertisement...
20091111-EE-VQP-92 - Hierarchy / EE_QW_3_20080625