[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!
8.2

test web interface for vbscripts

Asked by wildboy85 in VB Script, WebApplications

Tags: me, dynamic web interface vbscript, vbscript

can someone test this interface (at least computer info button)
(save it as VBS or WSH script)

and tell me if it work fine in:
firefox web browser, and of course suggest solution if there is a bug

i will also take any suggestions to ameliorate it, as open code always ;)
it's meant to be free and help the network admin have an interface to admin their network


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:

'=== Ultimate dynamic web interface
'=== by: SergeFournier(at)hotmail.com
 
'=== this script:
'=== generate dynamically a web interface to manage 
'=== control (left frame), input (middle frame), and output (bottom frame) from vbs/wsh (windows host scripts)
 
'=== tested on windows vista 64, internet explorer 7
 
'=== security: this script will lower security level with 4 register inscriptions to 
'=== allow the "mycomputer" zone to allow execution of local scrits in html page
 
Set objshe    = WScript.CreateObject("WScript.Shell")
Set objLoc    = CreateObject("WbemScripting.SWbemLocator")
set objEnv    = objshe.Environment("PROCESS")
Set objFSO    = wscript.CreateObject("Scripting.FileSystemObject")
Set objNet    = CreateObject("WScript.Network") 
'set objsheapp = wscript.CreateObject("Shell.Application")
'Set objaut    = WScript.CreateObject("AutoItX.Control")
 
Const hkcr = &H80000000 'HKEY_CLASSES_ROOT
Const HKCU = &H80000001 'HKEY_CURRENT_USER
Const hklm = &H80000002 'HKEY_LOCAL_MACHINE
Const hku  = &H80000003 'HKEY_USERS
Const hkcc = &H80000005 'HKEY_CURRENT_CONFIG
 
'=== allow execution of .exe from script in any internet explorer zone
objEnv("SEE_MASK_NOZONECHECKS") = 1
 
'=== actual drive, actual directory, and "\"
thepath=WScript.ScriptFullName
p = instrRev(thepath,"\")
basedir  = left(thepath,p)
   
Dim oIE, path ,Title, Text2, name, age, password, printer, screen, remark
dim typ(10),errdes(10,100)
 
'=== array that contain the html form
dim ara(10)
 
'HKCU \ Software \ Microsoft \ Internet Explorer \ Main \ FeatureControl \ FEATURE_LOCALMACHINE_LOCKDOWN
'In the right-pane, create a new REG_DWORD named iexplore.exe and set it to 0
'Values:
'0 - Allows a Web page to run active content in your computer
'1 - Disallows a Web page from running active content in your computer
 
'=== Allows a Web page to run active content in mycomputer zone (vista or winxp sp2)
 
'=== must reboot after this setting
reboot = regrea(0, hklm, "SOFTWARE\Microsoft\Internet Explorer\MAIN\FeatureControl\FEATURE_LOCALMACHINE_LOCKDOWN", "iexplore.exe")
reboot = reboot + regrea(0, hklm, "SOFTWARE\Microsoft\Internet Explorer\MAIN\FeatureControl\FEATURE_LOCALMACHINE_LOCKDOWN", "explore.exe")
reboot = reboot + regrea(0, hkcu, "SOFTWARE\Microsoft\Internet Explorer\MAIN\FeatureControl\FEATURE_LOCALMACHINE_LOCKDOWN", "iexplore.exe")
reboot = reboot + regrea(0, hkcu, "SOFTWARE\Microsoft\Internet Explorer\MAIN\FeatureControl\FEATURE_LOCALMACHINE_LOCKDOWN", "explore.exe")
 
a="HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Internet Explorer\MAIN\FeatureControl\FEATURE_LOCALMACHINE_LOCKDOWN\iexplore.exe"
d=regwri(a,0,"REG_DWORD")
'=== Allows a Web page to run active content in your computer
a="HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Internet Explorer\MAIN\FeatureControl\FEATURE_LOCALMACHINE_LOCKDOWN\explore.exe"
d=regwri(a,0,"REG_DWORD")
'=== Allows a Web page to run active content in your computer
a="HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\FeatureControl\FEATURE_LOCALMACHINE_LOCKDOWN\iexplore.exe"
d=regwri(a,0,"REG_DWORD")
'=== Allows a Web page to run active content in your computer
a="HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\FeatureControl\FEATURE_LOCALMACHINE_LOCKDOWN\explore.exe"
d=regwri(a,0,"REG_DWORD")
 
if reboot<>0 then
   '=== must reboot
   msgbox("you must reboot before this script can work in internet explorer from mycomputer zone, but it will run anyway to see if it work")
end if
 
 
'=== outils, options, Avances, Sécurité
'=== Cochez la case Autoriser le contenu actif à s'exécuter dans les fichiers de la zone Ordinateur
 
'oIE.resizable = 0 ' disable resizing
'oIE.navigate path & "Form01.htm" '=== Form
 
set oIE = CreateObject("InternetExplorer.Application")
oie.FullScreen = False
    '.ToolBar   = False
    '.RegisterAsDropTarget = True
    '.StatusBar = False
    '.Navigate("About:Blank")
    '.visible = true
 
oIE.left=0 ' window position
oIE.top = 0 ' and other properties
'.ParentWindow
'        .resizeto 640,300
'        .moveto (.screen.width
oIE.height = 500
oIE.width = 500
oIE.menubar = 0 '=== no menu
oIE.toolbar = 0
oIE.statusbar = 1
oIE.RegisterAsDropTarget = True
oie.Navigate("About:Blank")
oie.document.title = "test"
oie.document.parentwindow.resizeto oie.document.parentwindow.screen.width*.80,oie.document.parentwindow.screen.height*.90
        '.moveto (.screen.width-640)/2, (.screen.height-300)/2
oIE.visible = 1 '=== visible on
 
'=== on click
'<form  action="adduser1.php" method="POST">
'<input type="text" name="password" id="password" " />
' <input  type="button"        style="height:60px; font-size:18px;" id="button"  value="Add me to the website" onclick="this.form.submit();" />
'</form>
 
aratmp=array(_ 
"<HTML>",_ 
"<HEAD><TITLE>test</TITLE></HEAD>",_ 
"<FRAMESET COLS=""20%, *"">",_ 
"<FRAME SRC=""About:Blank"" NAME=""left"">",_ 
"<frameset rows=""50%,50%"">",_
"<FRAME SRC=""About:Blank"" NAME=""middle"">",_ 
"<FRAME SRC=""About:Blank"" NAME=""bottom"">",_ 
"</FRAMESET>",_ 
"</HTML>")
 
'oie.Navigate("About:Blank")
for i = 0 to UBound(aratmp, 1)
   oie.document.WriteLn(aratmp(i))
next
oie.refresh
Do While (oIE.Busy) 
   wscript.sleep 50
Loop
 
CreateObject("WScript.Shell").AppActivate "test" & " - M" 
 
set flef = oie.document.frames("left").document
set fmid = oie.document.frames("middle").document
set fbot = oie.document.frames("bottom").document
 
set flefl = oie.document.frames("left").location
set fmidl = oie.document.frames("middle").location
set fbotl = oie.document.frames("bottom").location
 
Chkbutlef="flef.Script.Chkbutlef()"
chkbutmid="fmid.Script.Chkbutmid()"
resbutlef=0
resbutmid=0
resbutlefstr=""
resbutmidstr=""
 
'=== main menu
'=== dyn control buttons generation ===============================================
 
arabut=array   ("stri",             "desarchive",   "infocomp",     "cretasks",    "clrframes",    "quit")
arabutdes=array("Crée Structure i:","Désarchivage", "Info computer","Create tasks","Clear Frames", "Quitter")
aradep=array   ("All",              "Informatique", "Informatique", "Informatique","All")
aradepcol=array("cccccc",           "6699ff",       "6699ff",       "6699ff",      "cccccc")
lasdep=""
 
'=== all the chek to be made in first page (1 at the moment, since ready have many values)
 
nbrbut=UBound(arabut, 1)
redim buttag(nbrbut)
form = "flef"
flef.WriteLn("<script language=""VBScript""> ")
flef.WriteLn("<!--")
flef.WriteLn("dim ready")
 
flef.WriteLn("Sub window_onload()")
'flef.WriteLn("   Set TheForm = Document.Form" & form)
 
'=== one unique ready for each button
flef.WriteLn("   ready = 0")
flef.WriteLn("End Sub")
 
flef.WriteLn("Public Function Chkbutlef()")
flef.WriteLn("   Chkbutlef = ready")
flef.WriteLn("End function")
 
for i=0 to ubound(arabut)
   flef.WriteLn("Sub " & arabut(i) & "_OnClick")
   flef.WriteLn("   ready=" & i+1)
   flef.WriteLn("End Sub")
next
flef.WriteLn("-->")
flef.WriteLn("</script>")
 
flef.WriteLn("<span class=SpellE>MENU</span></h3>")
flef.WriteLn("<div class=MsoNormal align=center style='text-align:center'>")
flef.WriteLn("</div>")
 
for i=0 to ubound(arabut)
   'style="background-color: #cc0000; color: #ffffff;" /
   b = "<input type=""button"" name=""" & arabut(i) & """ value=""" & arabutdes(i) & """"
   i2=i
   if i>ubound(aradep) then
      i2=ubound(aradep)
   else
      a=aradep(i2)
   end if
 
   if a<>lasdep then
      flef.WriteLn(a & "<br>")
      lasdep=a       
   end if
   b = b & " style=""background-color: #" & aradepcol(i2) & "; color: #000000;""><br>"
   flef.WriteLn(b)
next
 
'flef.WriteLn("<input type=""button"" style=""height:60px; font-size:12px;"" id=""button""  value=""commande04"" onclick=""this.form.submit()""")
flef.WriteLn("</div>")
flef.WriteLn("</body>")
flef.WriteLn("</html>")
 
'=== refresh the frame
flef.location.reload(true)
Do While (oIE.Busy) 
   wscript.sleep 20
Loop
 
'=== main loop
do while 0=0
 
resbutlefstr = waicli(chkbutlef)
 
'=== structure i =================================================================================
 
if resbutlefstr="stri" then
   tit="Creation Structure I"
   '=== refresh menu (chek button = 0)
   a = clefra(array("fmid","fbot"))
   '=== inputs to do before processing
 
   distmp=array("Login","Password","Numéro de contrat","Nom du contrat pour exchange/outlook")
   namtmp=array("login","password","connum","connam")
   deftmp=array("","","","")
   typtmp=array("textbox","password","textbox","textbox")
   errtmp=array("Facultatif","Facultatif","","Facultatif")
   buttmp=array("ok","cancel")
   
   a = dynforgen (distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)
   
   do
      err01=0
 
      button = waicli(chkbutlef & "+" & chkbutmid)
 
      '=== no main menu and no cancel
      'msgbox(resbutlef)
      if resbutlef=0 and button<>"cancel" then 
      
         '=== User has clicked the OK button, retrieve the values
         connum = fmid.form01.connum.Value
         
         if len(connum) < 5 then
            a = "error - contrat doit avec 5 caractères"
            err01=1
            errtmp(2)=a
            a = dynforgen (distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)
         else
            '=== all the data from the form is ok, we proceed to next step
         end if
      end if
   loop while err01<>0
   
   
   if resbutlef=0 and button<>"cancel" then
      '=== doing the job, all input are ok
      clefra(array("fmid"))
      fbot.WriteLn("structure i pas encore pret hahaha<br>")
      '=== clear main menu options to restart with a new option without reloading frames, so we can still see the results
      a = clrmenu
   elseif resbutlef=0 and button="cancel" then '=== cancel was pressed
      'fbot.WriteLn("cancelled<br>")
      a = clrmenu
      a = clefra(array("fmid","fbot"))
   end if
 
end if
 
'=== desarchivage
if resbutlefstr= "desarchive" then
   tit="Désarchivage"
   '=== refresh menu (chek button = 0)
   a = clefra(array("fmid","fbot"))
   '=== inputs to do before processing
   
   distmp=array("Login","Password","Numéro(s) de contrat")
   namtmp=array("login","password","connum")
   deftmp=array("","","")
   typtmp=array("textbox","password","textbox")
   errtmp=array("Facultatif","Facultatif","")
   buttmp=array("ok","cancel")
   
   a = dynforgen (distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)
   
   do
      err01=0
      button = waicli(chkbutlef & "+" & chkbutmid)
 
      'msgbox(a)
      if resbutlef=0 and button<>"cancel" then 
      
         '=== User has clicked the OK button, retrieve the values
         connum = fmid.form01.connum.Value
         
         if len(connum) < 5 then
            a = "error - contrat doit avec 5 caractères"
            err01=1
            errtmp(2)=a
            a = dynforgen (distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)
         else
            '=== all the data from the form is ok, we proceed to next step
         end if
      end if
   loop while err01<>0
   
   if resbutlef=0 and button<>"cancel" then
      '=== doing the job, all input are ok
      clefra(array("fmid"))
 
      a=desarchive(connum,fbot)
      
      '=== clear main menu options to restart with a new option without reloading frames, so we can still see the results
      a = clrmenu
   elseif resbutlef=0 and button="cancel" then '=== cancel was pressed
      'fbot.WriteLn("cancelled<br>")
      a = clrmenu
      a = clefra(array("fmid","fbot"))
   end if
 
end if
 
'=================================== info computer com01 ==========================================
if resbutlefstr="infocomp" then
   tit="Information Ordinateur"
   '=== refresh menu (chek button = 0)
   a = clefra(array("fmid","fbot"))
   '=== inputs to do before processing
   
   distmp=array("Login","Password","Computer name")
   namtmp=array("login","password","comnam")
   deftmp=array("","","")
   typtmp=array("textbox","password","textbox")
   errtmp=array("Facultatif","Facultatif","Si laissé vide, ordinateur local")
   buttmp=array("ok","cancel")
   
   a = dynforgen (distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)
   
   do
      err01=0
      
      button = waicli(chkbutlef & "+" & chkbutmid)
      'msgbox(a)
      if resbutlef=0 and button<>"cancel" then 
      
         '=== User has clicked the OK button, retrieve the values
         comnam = fmid.form01.comnam.Value
         
         '=== no computer name, we assume local computer "."
         if len(comnam) < 1 then
            comnam="."
         end if
      else
         '=== all the data from the form is ok, we proceed to next step
      end if
   loop while err01<>0
   
   if resbutlef=0 and button<>"cancel" then
      '=== doing the job, all input are ok
      clefra(array("fmid"))
      a = infcom(fbot,comnam)
      '=== clear main menu options to restart with a new option without reloading frames, so we can still see the results
      a = clrmenu
   elseif resbutlef=0 and button="cancel" then '=== cancel was pressed
      'fbot.WriteLn("cancelled<br>")
      a = clrmenu
      a = clefra(array("fmid","fbot"))
   end if
 
end if
 
if resbutlefstr="cretasks" then
   tit="Creation Tâches sur Host-01 dans scheduler windows"
   '=== refresh menu (chek button = 0)
   a = clefra(array("fmid","fbot"))
 
   '=== login dynamic data, used to execute the script with an admin authentication
   b=lcase(objnet.username)
   if b="wildboy" or b="fournier.serge" then
      c="admin3"
   elseif b="mancheron.jimmy" then
      c="admin2"
   elseif bb="paquet.yves" then
      c="admin1"
   elseif bb="fillion.mc" then
      c=b
   elseif bb="maltais.karine" then
      c=b
   elseif bb="bouchard.louis" then
      c="administrateur"
   else
      c=b
   end if
   
   '=== generate dynamic form
   '=== input matrix 1: text to be displayed for variables
   '=== input matrix 2: variable name of the data that will be returned on pressing OK
   '=== input matrix 3: default value of the data to be displayed in the form input
   '=== input matrix 4: type of the data (textbox, password)
   '=== input matrix 5: error message right side of box in case of input validation
   '=== input matrix 6: buttons at the end of form
   
   distmp=array("Login name","Password")
   namtmp=array("login","password")
   deftmp=array(c,"")
   typtmp=array("textbox","password")
   errtmp=array("","")
   buttmp=array("ok","cancel")
   
   a = dynforgen (distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)
   
   do
      err01=0
   
      button = waicli(chkbutlef & "+" & chkbutmid)
      
      if resbutlef=0 and button<>"cancel" then 
      
         '=== User has clicked the OK button, retrieve the values
      
         password = fmid.form01.password.Value
         login = fmid.form01.login.Value
      
         if len(password) < 7 then
            a = "error - password must be 8 char long"
            err01=1
            errtmp=array("",a)
            a = dynforgen (distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)
            'flef.location.reload(true)
         end if
         
         logpas01 = " /ru "& login &" /rp " & password
      else
         '=== all the data from the form is ok, we proceed to next step
         err01=0
      end if
   loop while err01<>0
   
   if resbutlef=0 and button<>"cancel" then
      clefra(array("fmid"))
      '=== doing the job, all input are ok
      fbot.WriteLn("pas encore pret hahaha<br>")
      '=== clear main menu options to restart with a new option without reloading frames, so we can still see the results
      a = clrmenu
   elseif resbutlef=0 and button="cancel" then '=== cancel was pressed
      'fbot.WriteLn("cancelled<br>")
      a = clrmenu
      a = clefra(array("fmid","fbot"))
   end if
 
   'msgbox("allok")
   
end if
 
'=================================== com03 ==========================================
if resbutlefstr="clrframes" then
 
   a = clefra(array("fmid","fbot"))
 
   'fbot.WriteLn("tried to clear middle frame")
 
end if
 
 
 
if resbutlefstr="quit" then
   
   oie.quit
   wscript.quit
end if
 
 
loop
 
 
 
'================================ debut main code
 
'=== arrêt magica
 
'les deux arrêts se font dans backup.bat
'le premier fait un arrêt normal et attend 120 secondes (2min)
'le deuxièmme fait un pskill sur tout ce qui reste de tâches magica
 
'=== MAGICA backup magica
'strComputer = "stas-magica-02"
'nomtache    = "backup"
'filetache   = "e:\Dunin\ServiceNT\backup.bat"
'process     = "schtasks.exe /delete /f /tn " & nomtache
'CreateProcessAndWait strComputer, process, tArea
'process     = "schtasks.exe /create /tn " & nomtache & " /tr " & filetache & " /sc DAILY /st 01:15:00" & logpas01
'CreateProcessAndWait strComputer, process, tArea
 
'=== MAGICA redémarre magica au cas ou il aurais pas bien redémarré après le backup
'strComputer = "stas-magica-01"
'nomtache    = "secondrestart"
'filetache   = "D:\Dunin\ServiceNT\startonly.bat"
'process     = "schtasks.exe /delete /f /tn " & nomtache
'CreateProcessAndWait strComputer, process, tArea
'process     = "schtasks.exe /create /tn " & nomtache & " /tr " & filetache & " /sc DAILY /st 05:00:00" & logpas01
'CreateProcessAndWait strComputer, process, tArea
 
'=== TACHES VENTES
'=== SQL mise à jour de la gestion des tâches des ventes - sylvain chabot beaulieu
'strComputer = "stas-host-01"
'strcomputer2= "\\stas-dc-02"
'nomtache    = "gestion_Tache_Envoi_Rappel"
'filetache   = strcomputer2 & "\netlogon\users\_taches_regulieres_serveur\gestion_Tache_Envoi_Rappel.vbs"
'process     = "schtasks.exe /delete /f /tn " & nomtache
'CreateProcessAndWait strComputer, process, tArea
'process     = "schtasks.exe /create /tn " & nomtache & " /tr " & filetache & " /sc DAILY /st 03:00:00" & logpas01
'CreateProcessAndWait strComputer, process, tArea
 
'=== 1 task to rule them all !!! ================================================
 
'=== ALL TASKS === serveur 2003 ldap --> sql
'nomtache    = "_01_alltask"
'filetache   = strcomputer2 & "\netlogon\users\_taches_regulieres_serveur\_01_alltask.vbs"
'process     = "schtasks.exe /delete /f /tn " & nomtache
'CreateProcessAndWait strComputer, process, tArea
'process     = "schtasks.exe /create /tn " & nomtache & " /tr " & filetache & " /sc DAILY /st 01:30:00" & logpas01
'CreateProcessAndWait strComputer, process, tArea
 
 
'======================== fin main code
 
fbot.WriteLn("doing my job<br>")
fbot.WriteLn("Script Complete!<br>")
'=== exchange folder creation
 
 
msgfin = msgfin & vbcrlf
aa=0
typ(0)="succès "
typ(1)="warning"
typ(2)="error  "
 
for i=0 to tottyp
   for ii=0 to 100
      if errdes(i,ii)<>"" then
         msgfin = msgfin & typ(i) & " "
         msgfin = msgfin & "Qte:   " & errtot(i,ii) & "   Msg:   " & errdes(i,ii) & vbcrlf
         aa=aa+1
         'msgbox(errdes(i,aa))
      end if
   next
next
 
msgfin = msgfin & vbcrlf & "Fin" & vbcrlf
 
fbot.WriteLn("Rapport final: <br>" & msgfin & "<br>")
 
wscript.quit
'============================= extract environement variable
 
Function Environ(VarName)
    Dim wss, env 
    Set wss = CreateObject("WScript.Shell") 
    Set env = wss.environment("process") 
    Environ = env(VarName) 
    If Environ = "" Then 
        Set env = wss.environment("system") 
        Environ = env(VarName) 
    End If 
End Function
 
'========================== create a task on a distant computer and wait for it to finish
 
Function CreateProcessAndWait(DestinationComputer, ExecutableFullPath, OutPutText) 
   Dim lretVal 
   strComputer= DestinationComputer
   
   on error resume next
   Set objWMIService2 = objLoc.ConnectServer(strComputer, "\root\cimv2",adminlog, adminpass)
   if err<>0 then
      OutPutText.Value = OutPutText.Value & "   mauvais login et pass: " & adminlog & " Pass: " & adminpass
      OutPutText.Value = OutPutText.Value & "   error: " & err.description
      wscript.quit
   end if
   on error goto 0
   Set objWMIService = objWMIService2.Get("Win32_Process")
   'Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2:Win32_Process")
   Set objWMIServicestart2 = objLoc.ConnectServer(strComputer, "\root\cimv2", adminlog, adminpass)
   Set objWMIServicestart = objWMIServicestart2.Get("Win32_ProcessStartup")
   'Set objWMIServiceStart= GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2:Win32_ProcessStartup")
 
   Set objConfig = objWMIServiceStart.SpawnInstance_
 
   objConfig.ShowWindow = 16 'show window or use HIDDEN_WINDOW 
 
   lretVal= objWMIService.Create(ExecutableFullPath, null, objConfig, intProcessID) 
   if lretVal=0 then 
      OutPutText.Value = OutPutText.Value & "   Démarrage Process: " & intProcessID & " on " & DestinationComputer & vbcrlf
      OutPutText.Value = OutPutText.Value & "   Commande.........: " & ExecutableFullPath & vbcrlf 
 
      WaitForPID strComputer, intProcessID, OutPutText
      OutPutText.Value = OutPutText.Value & "   Terminé" & vbcrlf & vbcrlf
   else 
      OutPutText.Value = OutPutText.Value & "   Unable to start process " & ExecutableFullPath & " on " & DestinationComputer & vbcrlf
   end if 
 
End Function 
 
'========================= task management ===================
 
'=== process, wait for it to be created on remote computer
Function WaitForPID(ComputerName,PIDNUMBER,OutPutText) 
Dim ProcessNumber 
 
Set objWMIServiceq = objLoc.ConnectServer(strComputer, "\root\cimv2",adminlog, adminpass)
'Set objWMIServiceq = objWMIServiceq2.Get("Win32_Process")
'Set objWMIServiceQ = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & ComputerName & "\root\cimv2") 
Set colItems = objWMIServiceQ.ExecQuery("Select * from Win32_Process",,48) 
For Each objItem in colItems 
  '===check if this process is the one we are waiting for 
  if objItem.ProcessID=PIDNUMBER then 
      'OutPutText.Value = OutPutText.Value & "Process Info:" & vbcrlf 
      OutPutText.Value = OutPutText.Value & "   Trouvé sur ordi de destination: " & objItem.Description & vbcrlf 
      'OutPutText.Value = OutPutText.Value & " ExecutablePath: " & objItem.ExecutablePath & vbcrlf 
      'OutPutText.Value = OutPutText.Value & " Name: " & objItem.Name & vbcrlf 
      'OutPutText.Value = OutPutText.Value & " Status: " & objItem.Status & vbcrlf 
      'OutPutText.Value = OutPutText.Value & " ThreadCount: " & objItem.ThreadCount & vbcrlf 
      ProcessNumber=objItem.ProcessID 
   end if
Next
 
PidWaitSQL="SELECT TargetInstance.ProcessID " & " FROM __InstanceDeletionEvent WITHIN 4 " _ 
& "WHERE TargetInstance ISA 'Win32_Process' AND " _ 
& "TargetInstance.ProcessID= '" & ProcessNumber & "'" 
 
Set Events = objLoc.ConnectServer(strComputer, "\root\cimv2",adminlog, adminpass).ExecNotificationQuery (PidWaitSQL)
'Set Events = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & ComputerName & "\root\cimv2").ExecNotificationQuery (PidWaitSQL)
 
'Set TerminationEvent = Events.nextevent
'OutPutText.Value = OutPutText.Value & "Program " & TerminationEvent.TargetInstance.ProcessID & " terminated. " & vbcrlf
'set TerminationEvent=Nothing 
 
End Function 
 
'====== write a value in registry, trap error
function regwri(regkey, value, type01)
   on error resume next
   if type01<>"" then
      objshe.RegWrite regkey,value,type01
   else
      objshe.RegWrite regkey,""
   end if
   if err.number<>0 then
      'msgfin = msgfin & "`n" & regkey & "`n"
      toterrcop = toterrcop + 1
      msgfin03 = msgfin03 & vbcrlf & "error - register base not written: " & vbcrlf & regkey & vbcrlf & err.description & vbcrlf
      if usenam = debugname then
         msgbox("cannot write key" & vbcrlf & regkey & vbcrlf & value & vbcrlf & err.description)
      end if
   end if
   on error goto 0
end function
 
'=== make folder
function makfol(ffil01, array02)
 
if objfso.folderexists(ffil01) then
   cc= errman(1,"i - le dossier existait déjà")
else
   a=OBJfso.CreateFolder(ffil01)
   if err.number=0 then
      cc= errman(0,"i - dossier crée")
   else
      cc= errman(2,"i - " & err.description)
   end if
end if
 
end function
 
'=== error manager
function errman(ttyp,des01)
   '=== dynamic error management
   '=== will expand an array everytime a new error code occur
   '=== add 1 to this array counter if error type exist already
   aa=0
   found01=0
   for each bb in errdes
      if bb="" then
         exit for
      else
 
         if bb=des01 then
            errtot(ttyp,aa)=errtot(ttyp,aa)+1
            found01=1
         end if
      end if
   next
 
   IF FOUND01=0 then
      'msgbox(Aa)
      errdes(ttyp,aa)=des01
      'msgbox(ttyp & vbcrlf & aa & vbcrlf & errdes(ttyp,aa))
      errtot(ttyp,aa)=errtot(ttyp,aa)+1
   end if
   
end function
 
'=== form dynamically generated
 
function dynforgen (distmp, namtmp,deftmp,typtmp,errtmp,buttmp,title)
 
   '=== dynamic form generation, all in an array where we can insert anything inbetween
   '=== input matrix 1: text to be displayed for variables
   '=== input matrix 2: variable name of the data that will be returned on pressing OK
   '=== input matrix 3: default value of the data to be displayed in the form input
   '=== input matrix 4: type of the data (textbox, password)
   '=== input matrix 5: error message right side of box in case of input validation
   '=== input matrix 6: buttons at the end of form
 
fmid.WriteLn("<script language=""VBScript""> ")
fmid.WriteLn("<!--")
fmid.WriteLn("dim ready")
fmid.WriteLn("Sub window_onload()")
fmid.WriteLn("   ' Here we may initialize the form")
fmid.WriteLn("   Set TheForm = Document.Form01")
for ii=0 to ubound(namtmp)
   '=== value returned
   fmid.WriteLn("   TheForm." & namtmp(ii) & ".Value=""" & deftmp(ii) & """")
next
fmid.WriteLn("   ready = 0 '=== User input not ready")   
'=== button click values (exemples: readyok readycancel)
fmid.WriteLn("End Sub")
'=== one value for each button pressed
fmid.WriteLn("Public Function Chkbutmid()")
fmid.WriteLn("   ' This is called from the host to check whether the user has clicked the OK-button")
fmid.WriteLn("   Chkbutmid = ready")
fmid.WriteLn("End function")
for ii=0 to ubound(buttmp)
   fmid.WriteLn("Sub button" & buttmp(ii) & "_OnClick")
   fmid.WriteLn("   ready=" & ii+1000)
   fmid.WriteLn("End Sub")
next
'fmid.WriteLn("sub fPassw_OnChange")
'fmid.WriteLn("   ready=1 ")
'fmid.WriteLn("End Sub")
fmid.WriteLn("-->")
fmid.WriteLn("</script>")
fmid.WriteLn("<h3><span class=SpellE>" & title & "</span></h3>")
'=== default focus on empty field (with no default value)
deffoc=0
for ii=0 to ubound(namtmp)
   if deftmp(ii)="" then
      if instr(lcase(errtmp(ii)),"facultatif")=0 then
         fmid.WriteLn("<BODY onLoad=""document.form01." & namtmp(ii) & ".focus()"">")
         deffoc=1
      end if
   end if
   '=== no default value empty, we focus on first field
next
if deffoc=0 then
   fmid.WriteLn("<BODY onLoad=""document.form01." & namtmp(0) & ".focus()"">")
end if
fmid.WriteLn("<div class=MsoNormal align=center style='text-align:center'>")
fmid.WriteLn("</div>")
fmid.WriteLn("<form name=form01>")
 
'=== button and error message
for ii=0 to ubound(namtmp)
'fmid.WriteLn("<p>" & distmp(ii) & ":")
   fmid.WriteLn("<br>" & distmp(ii) & ": ")
   fmid.WriteLn("<input type=""" & typtmp(ii) & """ id=" & namtmp(ii) & " NAME=""" & namtmp(ii) & """ value=""" & deftmp(ii) & """>")
   'fmid.WriteLn("")
   if instr(lcase(errtmp(ii)),"error")<>0 or instr(lcase(errtmp(ii)),"erreur")<>0 then
      col="red"
   else
      col="blue"
   end if
   fmid.WriteLn("&nbsp; <b><span style='color:" & col & "'>" & errtmp(ii) & "</span></b><br style='mso-special-character:line-break'>")
 
next
'fmid.WriteLn("<p><span class=SpellE>Password</span>:&nbsp; ")
'fmid.WriteLn("<INPUT TYPE=""password"" id=Domain MAXLENGTH=""20"" SIZE=""12"" NAME=""fPassw"">&nbsp;")
fmid.WriteLn("<![if !supportLineBreakNewLine]><br style='mso-special-character:line-break'>")
fmid.WriteLn("<![endif]></p>")
'fmid.WriteLn("<p>Ce <span class=SpellE>password</span> sera utilis&eacute; par les t&acirc;ches")
'fmid.WriteLn("sur le serveur<o:p></o:p></p>")
fmid.WriteLn("</form>")
for ii=0 to ubound(buttmp)
   fmid.WriteLn("<input type=""button"" name=""button" & buttmp(ii) & """ value=""&nbsp;" & buttmp(ii) & "&nbsp;"">")
   fmid.WriteLn("&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp")
next
'fmid.WriteLn("<input type=""button"" name=""button02"" value=""CANCEL"">")
fmid.WriteLn("</div>")
fmid.WriteLn("</body>")
fmid.WriteLn("</html>")
 
   '=== separator line
   '"<hr size=2 width=""100%"" align=center>", _
   'oie.Navigate("About:Blank")
   'oie.visible=0
 
   'http://www.themssforum.com/VBscripts/populate-form/
 
   fmid.location.reload(true)
 
   Do While (oIE.Busy) 
      wscript.sleep 50
   Loop
   'fmid.focus
end function
 
'=== register read in 32 bits, if nothing, read in 64 bits
function regrea(r2egrea_mode, r2egrea_clef01, r2egrea_clef02, r2egrea_clef03)
   if regrea_mode=0 then
      r2egrea_mode=32
   end if
   regrea = regrea2(r2egrea_mode, r2egrea_clef01, r2egrea_clef02, r2egrea_clef03)
   IF ISNULL(regrea) THEN
      r2egrea_mode=64
      regrea = regrea2(r2egrea_mode, r2egrea_clef01, r2egrea_clef02, r2egrea_clef03)
   end if
end function
 
'=== register read in regrea_mode (32 or 64 bits)
function regrea2(regrea_mode, regrea_clef01, regrea_clef02, regrea_clef03)
 
   Set objCtx = CreateObject("WbemScripting.SWbemNamedValueSet")
   on error resume next
   objCtx.Add "__ProviderArchitecture", regrea_mode
   
   if err.number<>0 then
      toterrcop = toterrcop +1
      msgfin03 = msgfin03 & vbcrlf & "error - __ProviderArchitecture: " & vbcrlf
      if usenam=debugname then
         'msgbox("erreur __ProviderArchitecture" & vbcrlf & err.description & vbcrlf & path01 & vbcrlf & key)
      end if
   end if
   Set objLocator = CreateObject("Wbemscripting.SWbemLocator")
   Set objServices = objLocator.ConnectServer("","root\default","","",,,,objCtx)
   Set objStdRegProv = objServices.Get("StdRegProv") 
 
   Set Inparams = objStdRegProv.Methods_("GetStringValue").Inparameters
   Inparams.Hdefkey = regrea_clef01
   Inparams.Ssubkeyname = regrea_clef02
   Inparams.Svaluename = regrea_clef03
   set Outparams = objStdRegProv.ExecMethod_("GetStringValue", Inparams,,objCtx)
 
   '=== show output parameters object and the registry value HKLM\SOFTWARE\
   'WScript.Echo Outparams.GetObjectText_
   'WScript.Echo "WMI Logging is set to  " & Outparams.SValue
   regrea2 = Outparams.SValue
   on error goto 0
end function
 
 
'=== wait for a button from web page to be clicked
'=== the button variable names are in an array as input
 
function waicli(test)
   bb=0
   cc="bb = " & test
 
   on error resume next
 
   Do
      '=== dynamic code execution
      Execute cc
      If err <> 0 Then
         '=== form was closed or there was an error, but ok was not pressed
         wscript.quit
      End if
      '=== leave some cpu time for others applications
      wscript.sleep 100
   
   Loop While (bb=0)
   
   On Error Goto 0 ' switch error handling off
   
   '=== generate the name of the sub we will call if a button is pressed by number
   if bb<1000 then
      waicli = arabut(bb - 1)
      resbutlef=bb
   elseif bb<2000 then
      waicli = buttmp(bb - 1000)
      resbutmid=bb
   end if
   
   'waicli = cc
   
end function
 
'=== add two array togheter
'=== mainly to chek the button on menu AND on input page (middle)
function addara(aara01,aara02)
   
   original = ubound(aara02) + 1
   aa=original + Ubound(Aara01)
   
   reDim addara2(aa)
   yy=0
   for ii = 0 to ubound(aara01)
      addara2(yy) = aara01(ii)
      'msgbox(aara01(i) & ubound(aara01))
      yy=yy+1
   next
   for ii = 0 to ubound(aara02)
      addara2(yy) = aara02(ii)
      'msgbox(aara01(i) & ubound(aara01))
      yy=yy+1
   next
   
   addara=addara2
   
end function
 
'=== chek all main menu buttons values to see if switch to another task
function chkmenu()
   a = "chkmenu = " & chkbutlef
   execute a
end function
 
'=== frames clear content by navigating to a blank
'=== input is an array containing name of frames as "flef" = frame left
function clefra(aara)
   cc=""
   for each aa in aara
      'cc = cc & aa & "l.href=""about:blank""" & vbcrlf
      cc = cc & aa & ".location.reload(true)" & vbcrlf
      cc = cc & "Do While (oIE.Busy) " & vbcrlf
      cc = cc & "   wscript.sleep 20" & vbcrlf
      cc = cc & "Loop" & vbcrlf
      cc = cc & aa & ".WriteLn(""&nbsp;"")" & vbcrlf
      cc = cc & aa & ".location.reload(true)" & vbcrlf
      cc = cc & "Do While (oIE.Busy) " & vbcrlf
      cc = cc & "   wscript.sleep 20" & vbcrlf
      cc = cc & "Loop" & vbcrlf
   next
   
   a = clrmenu
   'msgbox("clear" & vbcrlf & cc)
   execute cc
   
   'clefra=cc
   
end function
      
      'printer = "Printer: " & oIE.Document.ValidForm.fPrinter.Value & " Status: " & oIE.Document.ValidForm.fPrinter.Checked
      'screen = "Screen: " & oIE.Document.ValidForm.fScreen.Value & " Status: " & oIE.Document.ValidForm.fScreen.Checked
      'remark = "Printer: " & oIE.Document.ValidForm.fRemark.Value
      'MsgBox Text2 + vbCRLF + name + vbCRLF + age & vbCRLF & password & vbCRLF & printer & vbCRLF & screen & vbCRLF & remark, vbOKOnly + vbInformation, Title
 
'=== clear menu variables
function clrmenu()
   flef.location.reload(true)
   Do While (oIE.Busy)
      wscript.sleep 20
   Loop
   resbutlef=0
   resbutlefstr=""
end function
 
'=== free hard disk space convert in gigabytes
function infcom(ffra,comnam)
 
   Const GBCONVERSION= 1073741824 
   if comnam="." then
      sysnam = lcase(objnet.computername)
   end if
   ffra.WriteLn("Requesting info from computer: " & sysnam & "<br><br>")
   
   '=== local info
   if comnam="." then
      ffra.WriteLn("Last logon name: " & lcase(objNet.UserName) & "<br><br>")
   end if
   
   'ofile.writeline "Computer,Drive,Disk Size,GBFreeSpace,%"
   'Do until ifile.AtEndOfLine
   'Computer = ifile.ReadLine
   on error resume next
   Set objWMIService = GetObject("winmgmts://" & comnam) 
   if err=0 then
 
      '=== hardware mem etc
      Set colLogicalDisk = objWMIService.InstancesOf("Win32_LogicalDisk") 
      For Each objLogicalDisk In colLogicalDisk
         if objLogicalDisk.drivetype=3 Then
            aa= Computer & " Drive: " & objLogicalDisk.DeviceID &_
            " Size: " &  Round(objLogicalDisk.size/GBCONVERSION) & " Free GB: " &_
            Round(objLogicalDisk.freespace/GBCONVERSION) & " Free%: " &_
            Round(((objLogicalDisk.freespace/GBCONVERSION)/(objLogicalDisk.size/GBCONVERSION))*100) & "%"
            ffra.WriteLn(aa & "<br>")
         end If
        set objWMISerivce = nothing
         Set colLogicalDisk = nothing
      next
      ffra.WriteLn("<br>")
   on error goto 0   
 
      '=== cpu ram
      Set colItems = objWMIService.ExecQuery("Select * from Win32_ComputerSystem",,48)
   For Each objItem in colItems
      system_model = objItem.Model
      system_name = objItem.Name
      system_num_processors = objItem.NumberOfProcessors
      system_part_of_domain = objItem.PartOfDomain
      system_primary_owner_name = objItem.PrimaryOwnerName
      system_memory = int(objItem.TotalPhysicalMemory /1024 /1024)
      domain_role = objItem.DomainRole
   Next
      Set colItems = objWMIService.ExecQuery("Select * from Win32_Processor",,48)
   count = 0
   For Each objItem in colItems
   count = count + 1
   if count > int(system_num_processors) then
      Exit For
   end if
   sql = "INSERT INTO processor ( processor_mac_address, processor_caption, " _
   & "processor_current_clock_speed, processor_current_voltage, processor_device_id, " _
   & "processor_ext_clock, processor_manufacturer, processor_max_clock_speed, " _
   & "processor_name, processor_power_management_supported, processor_socket_designation) " _
   & "VALUES ('" _
   & net_mac_address & "','" _
   & objItem.Caption & "','" _
   & objItem.CurrentClockSpeed & "','" _
   & objItem.CurrentVoltage & "','" _
   & objItem.DeviceID & "','" _
   & objItem.ExtClock & "','" _
   & objItem.Manufacturer & "','" _
   & objItem.MaxClockSpeed & "','" _
   & LTrim(objItem.Name) & "','" _
   & objItem.PowerManagementSupported & "','" _
   & objItem.SocketDesignation & "')"
   'create_sql sql, objTextFile, database
   
   ffra.WriteLn("Processor: " & objItem.Manufacturer & "<br>")
   ffra.WriteLn("External clock: " & objItem.ExtClock & "<br>")
   
   ffra.WriteLn("Speed max: " & objItem.MaxClockSpeed & "<br>")
   ffra.WriteLn("Socket: " & objItem.SocketDesignation & "<br>")
   
   Next
 
      ffra.WriteLn("# Processor: " & system_num_processors & "<br>")
      ffra.WriteLn("Memory: " & system_memory & "<br><br>")
      '=== video
      Set colItems = objWMIService.ExecQuery("Select * from Win32_VideoController",,48)
      For Each objItem in colItems
   If Instr(objItem.Caption, "vnc") = 0 then
   video_adapter_ram = objItem.AdapterRAM
   video_caption = objItem.Caption
   video_current_horizontal_res = objItem.CurrentHorizontalResolution
   video_current_number_colours = objItem.CurrentNumberOfColors
   video_current_refresh_rate = objItem.CurrentRefreshRate
   video_current_vertical_res = objItem.CurrentVerticalResolution
   video_description = objItem.Description
   LeftString = Left(objItem.DriverDate, 8)
   DDInstallYear = Left(LeftString, 4)
   DDInstallMonth = Mid(LeftString, 5, 2)
   DDInstallDay = Right(LeftString, 2)
   video_driver_date = DDInstallYear & "/" & DDInstallMonth & "/" & DDInstallDay
   video_driver_version = objItem.DriverVersion
   video_max_refresh_rate = objItem.MaxRefreshRate
   video_min_refresh_rate = objItem.MinRefreshRate
   end if
   Next
      ffra.WriteLn("Video: " & video_description & "<br>")
      ffra.WriteLn("Video driver date: " & video_driver_date & "<br>")
      ffra.WriteLn("Video driver version: " & video_driver_version & "<br>")
      ffra.WriteLn("Video ram: " & video_adapter_ram & "<br><br>")
      '=== windows
      
      Set colItems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem",,48)
   For Each objItem in colItems
      OSInstall = objItem.InstallDate
      OSInstall = Left(OSInstall, 8)
      OSInstallYear = Left(OSInstall, 4)
      OSInstallMonth = Mid(OSInstall, 5, 2)
      OSInstallDay = Right(OSInstall, 2)
      'OSInstall = OSInstallYear & "/" & OSInstallMonth & "/" & OSInstallDay
      '=== date internagtional plz
      OSInstall = OSInstallYear & "/" & OSInstallDay & "/" & OSInstallMonth
 
      OSType = objItem.OSType
      ServicePack = objItem.ServicePackMajorVersion
      OSLang = objItem.OSLanguage
      SystemBuildNumber = objItem.BuildNumber
      sys_version = objItem.Version
   next
      ffra.WriteLn("Windows install date: " & OSInstall & "<br>")
      ffra.WriteLn("Windows sys_version: " & sys_version & "<br>")
      ffra.WriteLn("Windows ServicePack: " & ServicePack & "<br>")
      ffra.WriteLn("SystemBuildNumber: " & SystemBuildNumber & "<br>")
      ffra.WriteLn("Windows OSType: " & OSType & "<br><br>")
      '=== antivirus
      Set objWMIService_AV = GetObject("winmgmts:\\" & comnam & "\root\SecurityCenter")
      Set colItems = objWMIService_AV.ExecQuery("Select * from AntiVirusProduct")
      if colItems.count<>0 then
           For Each objAntiVirusProduct In colItems
              ffra.WriteLn("Antivirus: " & OSInstall & "<br>")
              if isnull(objAntiVirusProduct.companyName) then av_prod = "" else av_prod = objAntiVirusProduct.companyName end if
	          if isnull(objAntiVirusProduct.displayName) then av_disp = "" else av_disp = objAntiVirusProduct.displayName end if
	          if isnull(objAntiVirusProduct.productUptoDate) then av_up2d = "" else av_up2d = objAntiVirusProduct.productUptoDate end if
	          if isnull(objAntiVirusProduct.versionNumber) then av_vers = "" else av_vers = objAntiVirusProduct.versionNumber end if
	          ffra.WriteLn("Antivirus av_prod: " & av_prod & "<br>")
	          ffra.WriteLn("Antivirus av_disp name: " & av_disp & "<br>")
	          ffra.WriteLn("Antivirus av_up2d up to date: " & av_up2d & "<br>")
	          ffra.WriteLn("Antivirus av_vers version: " & av_vers & "<br><br>")
           next
      end if
 
      '=== network
      
      '=== shares
      Set colItems = objWMIService.ExecQuery("Select * from Win32_Share",,48)
   For Each objItem in colItems
      sql = "INSERT INTO shares ( shares_mac_address, shares_caption, " _
      & "shares_name, shares_path  ) VALUES ('" _
      & net_mac_address & "','" _
      & objItem.Caption & " ','" _
      & objItem.Name & " ','" _
      & objItem.Path & " ')"
      'create_sql sql, objTextFile, database
      ffra.WriteLn("Shares caption: " & objItem.Caption & "<br>")
      ffra.WriteLn("Shares name: " & objItem.Name & "<br>")
      ffra.WriteLn("Shares path: " & objItem.Path & "<br><br>")
   Next
 
   else
      ffra.WriteLn("ERROR - Requesting info from: <br>" & comnam & "<br>")
      ffra.WriteLn(err.description & "<br>")
      
   end if
   on error goto 0
end function
 
function desarchive(con,ffra)
 
   all=""
   con3 = con
   do
      con2=mid(con,1,5)
      
      ffra.WriteLn(con2 & "<br><br>")
      
      valid02=1
      
      sou = "\\corp.stas.local\stas\archives" & "\" & mid(con2,1,3) & "\" & mid(con2,4,2)
      des = "\\corp.stas.local\stas\temporaire\ARCHIVES_AEF" & "\" & con2
      
      ffra.WriteLn("Source: " & sou & "<br>")
      ffra.WriteLn("Destination: " & des & "<br><br>")
      
      If objFSO.FOLDEREXISTS(sou)=FALSE Then
         col = "red"
         aa = "ERREUR - source introuvable: " & sou
         ffra.WriteLn("<b><span style='color:" & col & "'>" & aa & "</span></b><br><br>")
         valid02 = 0
         all = all & "ERREUR - Source introuvable: " & sou
      end if
   
      if valid02<>0 then
         If objFSO.FOLDEREXISTS(des)=FALSE Then
            a=OBJfso.CreateFolder(des)
            if err.number<>0 then
               col = "red"
               aa = "ERREUR - pas capable de créer le dossier de destination: " & con2
               ffra.WriteLn("<b><span style='color:" & col & "'>" & aa & "</span></b><br>")
               aa = con2
               ffra.WriteLn("<b><span style='color:" & col & "'>" & aa & "</span></b><br><br>")
 
               all = all & "ERREUR - pas capable de créer le dossier de destination: " & con2 & " <br>"
               valid02=0
            end if
         else
            desexi=1
         end if
      end if
      a=basedir & "robocopy.exe """ & sou & "\ "" """ & des & " "" /R:0 /s"
      'msgbox(a)
   
      if valid02<>0 then
         objshe.Run A,, true
      end if
 
      if valid02=1 then
         all=all & "<a href=""file://T:\ARCHIVES_AEF\" & con2 & """> file://T:\ARCHIVES_AEF\" & con2 & "</a>"
         if desexi = 1 then
            aa="la destination existait déjà, mise-à-jour faite"
            ffra.WriteLn(aa & "<br><br>")
            all=all & "  " & aa & "<br>"
         else
            all=all & " <br>"
         end if
      end if
 
      if len(con)>10 then
         con = mid(con,7,len(Con)-6)
      else
         con =""
      end if
   
   LOoP UNTIL len(CON)<5
   
   if (instr(lcase(all),"erreur")=0 or instr(lcase(all),"file://")<>0) then
   
      all = "<br>Bonjour,<br><br>Voici un lien pour accéder aux fichiers désarchivés:<br><br>" & all & "<br><br>"
   
      all = all & "Les fichiers désarchivés sont effacés lorsqu'ils ne sont plus consultés<br>"
      if instr(lcase(aa),"erreur")<>0 then col="red" else col="blue"
   
      aa="Il est interdit de modifier des fichiers désarchivés"
      all = all & "<b><span style='color:" & col & "'>" & aa & "</span></b><br>"
      all = all & "Si vous devez quand même modifier des fichiers, veuillez les copier dans un autre lecteur réseau avant de les modifier<br><br>"
   
      all = all & "Merci de votre collaboration<br><br>"
   
      all = all & "Le Département Informatique<br>"
   
      wricli(all)
 
      '=== Sub SendMailOutlook(aTo, Subject, TextBody, aFrom)
      
      'Create an Outlook object
      Dim Outlook 'As New Outlook.Application
      Set Outlook = CreateObject("Outlook.Application")
   
      'Create e new message
      Dim Message 'As Outlook.MailItem
      Set Message = Outlook.CreateItem(olMailItem)
      With Message
         'You can display the message To debug And see state
         '.Display
         '.BodyFormat = 0
         '.MailFormat = 0
         .Subject = "desarchivage " & con3
         .HTMLBody = all
         '  myitem.HTMLBody = str
   
         'Set destination email address
         '.Recipients.Add (aTo)
      
         'Set sender address If specified.
         'Const olOriginator = 0
         'If Len(aFrom) > 0 Then .Recipients.Add(aFrom).Type = olOriginator
      
         'Send the message
         .display
         '.Send
      End With
   else
      'msgbox(all)
   end if
   
   'aa="outlook.exe /f V:\224211_INFORMATIQUE\_programmation\prog_archives_move\Désarchivage.oft"
   'objshe.Run Aa,, false
   
   desarchive=all
   
end function
 
'====================================================================
' Requires IE v4.0+ write a data to the clipboard (copy to clipboard)
sub wricli(sText)
   set aa=wscript.CreateObject("InternetExplorer.Application")
   With aa
      .Navigate "about:blank"
      Do Until .ReadyState = 4 : WScript.Sleep 50 : Loop
      With .document
         .open
         .write(sText)
         .close
         Do Until .ReadyState = "complete" : WScript.Sleep 50 : Loop
         .execcommand "SelectAll"
         .execcommand "Copy"
      end with ' document
 
   end with ' IE
   aa.quit
   set aa=nothing
End Sub
[+][-]07/28/08 09:43 AM, ID: 22104707Accepted 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, WebApplications
Tags: me, dynamic web interface vbscript, vbscript
Sign Up Now!
Solution Provided By: purplepomegranite
Participating Experts: 1
Solution Grade: A
 
 
Loading Advertisement...
20091111-EE-VQP-92 / EE_QW_2_20070628