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
| ID user:
Script :
Set wshnetwork = WScript.CreateObject("WScript.Network" )
user = wshnetwork.username
domain = wshnetwork.userdomain
pc = wshnetwork.computername
Wscript.echo "Utilisateur : " & user
Wscript.echo "Domaine : " & domain
Wscript.echo "PC : " & computer
Nom de la machine
Marque de la machine
Modéle de la machine
Numero de serie de la machine
Script :
@echo off
Setlocal
For /F %%a in ('wmic bios get serialnumber /value^|find "SerialNumber"') do Set %%a
For /F %%a in ('wmic csproduct get vendor /value^|find "Vendor"') do Set %%a
for /f "tokens=2 delims==" %%D in ('wmic csproduct get name /value') do set MODEL=%%D
@echo %computername% %Vendor% %MODEL% %SerialNumber%
pause
Modéle de l'ecran
Numéro de serie de l'écran ou des écrans
script:
'*****************************************************************************
' Monitor EDID Information v2.1'
' coded by Michael Baird
' modified by Maxime bouchard
'
' Creation : 20-September-2005
' Modification : 16 january 2006
'
' Add-on by Maxime Bouchard, Technologist In System Processed
'
' - Network Range Computer Scan
' - Generate Rapport in Plain text format
' - Generate Rapport in HTML format
' - Local scan
' - clear some useless code
' - user interface (popup dialog box)
' - add logo
' - time out management
' - time out error logged
'
'All code here in is copyleft 2006
'and is released under the terms of the GNU open source
'license agreement
'******************************************************************************
' START INFORMATION
'******************************************************************************
'If you are trying to customize the output for your specific needs
'check the function named ""
'It is probably all you need to change
'
'
'This is a complete re-write of the script I originally relased 17-June-2004
'It should function much more reliably and work better with multiple monitors
'The code has been modularized and streamlined for easier readability and debugging
'several bugs have been eliminated.
'There was really no excuse for the sheer ugliness of the original code.
'I will only say that I was figuring it out as I went along and I was really tired
'because SWMBO was out of town and I tend to pull all-nighters when she's not around
'to resue me from my PC and myself.
'
'Please give me credit if you use my code
'Please don't profit financially from my code (at least not ridiculously)
'
'
'this code is based on the EEDID spec found at <a href="http://www.vesa.org" target="_blank">http://www.vesa.org</a>
'and by my hacking around in the windows registry
'the code was tested on WINXP,WIN2K and WIN2K3
'it should work on WINME and WIN98SE
'It should work with multiple monitors, but that hasn't been tested either.
'
'
'It should be noted that this code is not 100% reliable (what is?)
'I have witnessed occasions where for one reason or another windows
'can't or doesn't read the EDID info at boot (example would be someone
'booting with the monitor turned off) and so windows changes the active
'monitor to "Default_Monitor"
'Another reason for reliability problems is that there is no
'requirement in the EDID spec that a manufacture include the
'serial number in the EDID data AND only EDIDv1.2 and beyond
'have a requirement that the EDID contain a descriptive
'model name
'That being said, here goes....
'
'
'Some notes on the general function....
'
'Monitors are stored in HKLM\SYSTEM\CurrentControlSet\Enum\DISPLAY\
'
'Unfortunately, not only monitors are stored here Video Chipsets and maybe some other stuff
'is also here.
'
'Monitors in "HKLM\SYSTEM\CurrentControlSet\Enum\DISPLAY\" are organized like this:
' HKLM\SYSTEM\CurrentControlSet\Enum\DISPLAY\\\
'Since not only monitors will be found under DISPLAY sub key you need to find out which
'devices are monitors.
'This can be deterimined by looking at the value "HardwareID" located
'at HKLM\SYSTEM\CurrentControlSet\Enum\DISPLAY\\
'if the device is a monitor then the "HardwareID" value will contain the data "Monitor\"
'
'The next difficulty is that all monitors are stored here not just the one curently plugged in.
'So, if you ever switched monitors the old one(s) will still be in the registry.
'You can tell which monitor(s) are active because they will have a sub-key named "Control"
'******************************************************************************
' END INFORMATION - THE CODE START HERE
'*******************************************************************************
' GLOBALE VARIABLE AND CONSTANTE - DON'T ERASE IT !!!!!!!
'*******************************************************************************
'DISPLAY_REGKEY sets the regkey where displays are found. Don't change except for debugging
'I only change it when I am looking at a .REG file that someone sent me saying that the
'code doesn't work.
Const DISPLAY_REGKEY="HKLM\SYSTEM\CurrentControlSet\Enum\DISPLAY\"
'sets the debug outfile (use format like c:\debug.txt)
Const DEBUGFILE="NUL"
'if set to 1 then output debug info to DEBUGFILE (also writes debug to screen if running under cscript.exe)
Const DEBUGMODE=0
'*******************************************************************************
' GLOBALE VARIABLE AND CONSTANTE - DON'T ERASE IT !!!!!!!
' by Maxime Bouchard - 11 january 2006
' Do not erase - GLOBAL VARIBLE - DO NOT MODIFIE !!!!!!!!!!!
'used by GetMonitorInfo() and GetWMIRegProvider()
'*******************************************************************************
strGPN = "localhost" ' Name of computer
GenererRapport = 0 ' toggle for rapport
file = "C:\\Monitor" ' dorectory to stock rapport
xpc = 0 ' number of PC to scan
abort = 0 ' abort the process
OutputFormat = ".txt" ' Output format
genererHTML = 0 ' generate HTML File or TXT file
Dim myArrays() ' Arrays list with PC computer name
Const GENERATED_MAIN_LIST_NAME = "COMPUTERLIST.html"
' startup logo and licence
logo = "************************************************************************" & VbCrLf & _
"Monitor EDID Information v2 coded by Michael Baird" & VbCrLf & _
"Modified by Maxime bouchard" & VbCrLf
licence = "All code herein is copyleft 2006" & vbcrlf & _
"and is released under the terms of the GNU open source license agreement" & VbCrLf & _
"************************************************************************"
'*******************************************************************************
' CALL OF FUNCTION HERE
'*******************************************************************************
'The ForceCscript subroutine forces execution under CSCRIPT.EXE
call ForceCScript
' start the main Sub
' modified by Maxime Bouchard - 11 january 2006
DebugOut "Execution Started " & cstr(now)
WScript.Echo logo
WScript.Echo licence
call Start(RemoteLocalChoice())
DebugOut "Execution Completed " & cstr(now)
'*******************************************************************************
' ALL FUNCTION AND SUB START HERE
'*******************************************************************************
'===================================================================
'This is the start Sub
'
' by Maxime Bouchard
' 13 january 2006 - for a network scan loop support
'===================================================================
Sub Start(myArrays)
If abort = 0 Then
Call RapportChoice
If abort = 1 Then Wscript.Quit ' quit if user choose Cancel in rapportChoice
'WScript.Echo "Please Wait..." & VbCrLf
On Error Resume Next
' On erreur or no reponse the GPN is skiped
For Each strComputer In myArrays
If strComputer <> lastComputer Then ' Duplicata are skipped
If strComputer <> "" Then
WScript.Echo "Please wait...trying to contact computer : " & strComputer
wscript.echo GetMonitorInfo(strComputer)
lastcomputer = strcomputer
End if
End If
Next
If genererrapport = 0 Then
WScript.Echo "programme terminated"
Pause()
Else
WScript.Echo "Generate the Rapport...Please Wait"
MainRapport ' Generate a list of computer
WScript.Echo "programme terminated"
End If
Else WScript.Echo "Abort by user !"
End If
End Sub
'===================================================================
'This is the Sub to chose if it is a Remote or local connection
'
' by Maxime Bouchard
' 13 january 2006 - for a network scan loop support
'===================================================================
function RemoteLocalChoice
Set WshNetwork = WScript.CreateObject("WScript.Network")
strCname = WshNetwork.ComputerName 'catch local computer name
strCname2 = ""
ypc = 0
answer = MsgBox("Hi " & WshNetwork.UserName & VbCrLf & _
"Do you would like execute a remote scan ?" _
,vbYesNo,"Serial Number for Monitor Scan")
If answer = vbYes Then ' if remote
answer2 = MsgBox("WARNING - this procedure can be VERY long if you" & _
"enter a large range of computer" & VbCrLf & _
"Do you would like start it ?",vbYesNo,"WARNING")
If answer2 = vbYes Then ' if proceed
strx = inputbox("How many computer do you would like scan ?","Number of computer","1")
If strx = "" Then abort = 1 'abort
xpc = CInt(strx)
ReDim Preserve myArrays(xpc - 1)
While ypc < xpc
strcomputername = (inputbox("Enter a Computer name :" & VbCrLf & strCname2, ypc & _
" of " & xpc & " computers",strCname))
If cstr(strcomputername) <> "" Then
strCname2 = strCname2 & ypc + 1 & ". " & strcomputername & VbCrLf
myArrays(ypc) = strcomputername
ypc = ypc + 1
Else abort = 1 'abort
ypc = xpc ' for exit of the loop
End if
Wend
Else ' abort
abort = 1
End If
Else ' if local
ReDim myArrays(1)
myArrays(0) = strCname
End If
RemoteLocalChoice=myArrays
End Function
'===================================================================
'This is the Rapport Sub
'
' by Maxime Bouchard
' 13 january 2006 - for a network scan loop support
'===================================================================
Sub Rapport(tmpOutput,strGPN)
Dim fso, MyFile
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FolderExists(file) = False Then
fso.CreateFolder(File)
End If
Set MyFile= fso.CreateTextFile(File & "\\" & strGPN & OutputFormat,true)
MyFile.Writeline(tmpOutput)
MyFile.Close
End Sub
'===================================================================
'This is the RapportChoice Sub
'
' by Maxime Bouchard
' 13 january 2006 - for a network scan loop support
'===================================================================
Sub RapportChoice
answer = MsgBox("do you would like generate log files ?",vbYesNo,"GENERATE LOG ?")
if answer = vbYes Then
genererRapport = 1
answer = MsgBox("generate it in HTML or TXT Format ?" & VbCrLf & _
"YES = HTML" & VbCrLf & "NO = TXT",vbYesNo,"HTML or TXT ?")
If answer = vbYes Then
genererHTML = 1
OutputFormat = ".html"
End If
file = InputBox("Enter a directory to stock log files","Which Directory ?",file)
If file = "" Then abort = 1 'abort
End If
End Sub
'===================================================================
'This is the main function. It calls everything else
'in the correct order.
'
' modified by Maxime Bouchard
' 11 january 2006 - for a network scan loop support
'===================================================================
Function GetMonitorInfo(strComputer)
' an Array to stock GPN Name
'On Error Resume Next ' On erreur or no reponse the GPN is skiped
'For Each strComputer In myArrays
'used by GetWMIRegProvider()
strGPN = cstr(strComputer)
debugout "Getting all display devices"
arrAllDisplays=GetAllDisplayDevicesInReg()
debugout "Filtering display devices to monitors"
arrAllMonitors=GetAllMonitorsFromAllDisplays(arrAllDisplays)
debugout "Filtering monitors to active monitors"
arrActiveMonitors=GetActiveMonitorsFromAllMonitors(arrAllMonitors)
if ubound(arrActiveMonitors)=0 and arrActiveMonitors(0)="{ERROR}" Then
debugout "No active monitors found"
strFormattedMonitorInfo="[Monitor_1]" & vbcrlf & "Monitor=Not Found" & VbCrLf & VbCrLf
else
debugout "Found active monitors"
debugout "Retrieving EDID for all active monitors"
arrActiveEDID=GetEDIDFromActiveMonitors(arrActiveMonitors)
debugout "Parsing EDID/Windows data"
arrParsedMonitorInfo=GetParsedMonitorInfo(arrActiveEDID,arrActiveMonitors)
debugout "Formatting parsed data"
strFormattedMonitorInfo=GetFormattedMonitorInfo(arrParsedMonitorInfo)
end If
debugout "Data retrieval completed"
GetMonitorInfo=strFormattedMonitorInfo
'Next
end Function
'===================================================================
'this function formats the parsed array for display
'this is where the final output is generated
'it is the one you will most likely want to
'customize to suit your needs
'
'modified by Maxime Bouchard
' 13 january 2006 - add txt rapport Function
' 14 january 2006 - add HTML rapport function
'===================================================================
Function GetFormattedMonitorInfo(arrParsedMonitorInfo)
Dim tmpallout
Dim pcArrays()
' For Console and TXT FORMAT
tmpOutput=tmpOutput & "********************************" & VbCrLf
tmpOutput=tmpOutput & "Computer : " & strGPN & " in date of :" & cstr(Date) & " " & CStr(time) & VbCrLf
tmpOutput=tmpOutput & "********************************" & VbCrLf
' FOR HTML RAPPORT
strHTML = strHTML & "<html>" & VbCrLf
strHTML = strHTML & "<head>" & VbCrLf
strHTML = strHTML & "<title>" & "Computer: " & strGPN & " in date of :"& cstr(Date) & " " & CStr(time) & "</title>" & VbCrLf
strHTML = strHTML & "</head>" & VbCrLf
strHTML = strHTML & "<body>" & VbCrLf
strHTML = strHTML & "<p><font size='5'>Computer: " & strGPN & " in date of :" & cstr(Date) & " " & CStr(time) & "</font></p>" & VbCrLf
For tmpctr=0 To ubound(arrParsedMonitorInfo)
tmpResult=split(arrParsedMonitorInfo(tmpctr),"|||")
' FOR HTML RAPPORT
strHTML = strHTML & "<p><font size='5'>[ Monitor_" & cstr(tmpctr+1) & "]</font></p>" & VbCrLf
strHTML = strHTML & "<table border='1' width='44%' id='table1'>"
strHTML = strHTML & "<tr>" & VbCrLf
strHTML = strHTML & "<td width='199'>EDID_VESAManufacturerID</td>" & VbCrLf
strHTML = strHTML & "<td>" & tmpResult(1) & "</td>" & VbCrLf
strHTML = strHTML & "</tr>" & VbCrLf
strHTML = strHTML & "<tr>" & VbCrLf
strHTML = strHTML & "<td width='199'>EDID_DeviceID</td>" & VbCrLf
strHTML = strHTML & "<td>" & tmpResult(3) & "</td>" & VbCrLf
strHTML = strHTML & "</tr>" & VbCrLf
strHTML = strHTML & "<tr>" & VbCrLf
strHTML = strHTML & "<td width='199'>EDID_ManufactureDate</td>" & VbCrLf
strHTML = strHTML & "<td>" & tmpResult(2) & "</td>" & VbCrLf
strHTML = strHTML & "</tr>" & VbCrLf
strHTML = strHTML & "<tr>" & VbCrLf
strHTML = strHTML & "<td width='199'>EDID_SerialNumber :</td>" & VbCrLf
strHTML = strHTML & "<td>" & tmpResult(0) & "</td>" & VbCrLf
strHTML = strHTML & "</tr>" & VbCrLf
strHTML = strHTML & "<tr>" & VbCrLf
strHTML = strHTML & "<td width='199'>EDID_ModelName :</td>" & VbCrLf
strHTML = strHTML & "<td>" & tmpResult(4) & "</td>" & VbCrLf
strHTML = strHTML & "</tr>" & VbCrLf
strHTML = strHTML & "<tr>" & VbCrLf
strHTML = strHTML & "<td width='199'>EDID_Version :</td>" & VbCrLf
strHTML = strHTML & "<td>" & tmpResult(5) & "</td>" & VbCrLf
strHTML = strHTML & "</tr>" & VbCrLf
strHTML = strHTML & "<tr>" & VbCrLf
strHTML = strHTML & "<td width='199'>Windows_VESAID :</td>" & VbCrLf
strHTML = strHTML & "<td>" & tmpResult(6) & "</td>" & VbCrLf
strHTML = strHTML & "</tr>" & VbCrLf
strHTML = strHTML & "<tr>" & VbCrLf
strHTML = strHTML & "<td width='199'>Windows_PNPID :</td>" & VbCrLf
strHTML = strHTML & "<td>" & tmpResult(7) & "</td>" & VbCrLf
strHTML = strHTML & "</tr>" & VbCrLf
strHTML = strHTML & "</table>" & VbCrLf
strHTML = strHTML & "</body>" & VbCrLf
strHTML = strHTML & "</html>" & VbCrLf
' For Console and TXT FORMAT
tmpOutput=tmpOutput & "[ Monitor_" & cstr(tmpctr+1) & " ]" & VbCrLf & VbCrLf
tmpOutput=tmpOutput & "EDID_VESAManufacturerID : " & tmpResult(1) & VbCrLf
tmpOutput=tmpOutput & "EDID_DeviceID : " & tmpResult(3) & VbCrLf
tmpOutput=tmpOutput & "EDID_ManufactureDate : " & tmpResult(2) & VbCrLf
tmpOutput=tmpOutput & "EDID_SerialNumber : " & tmpResult(0) & VbCrLf
tmpOutput=tmpOutput & "EDID_ModelName : " & tmpResult(4) & VbCrLf
tmpOutput=tmpOutput & "EDID_Version : " & tmpResult(5) & VbCrLf
tmpOutput=tmpOutput & "Windows_VESAID : " & tmpResult(6) & VbCrLf
tmpOutput=tmpOutput & "Windows_PNPID : " & tmpResult(7) & VbCrLf & VbCrLf
Next
' For Console and TXT FORMAT
tmpOutput=tmpOutput & "****** END INFO ON " & strGPN & " ******" & VbCrLf & VbCrLf
' Call for rapport generation
If GenererRapport = 1 Then
If genererHTML = 0 Then
Rapport tmpOutput,strGPN ' PLAIN TEXT
Else
Rapport strHTML,strGPN ' HTML FORMAT
End If
End If
GetFormattedMonitorInfo=tmpOutput
End Function
'===================================================================
'This is the sub to generate HTML list of computer scanned and open it
'
' by Maxime Bouchard
' 14 january 2006
'===================================================================
Sub MainRapport
Dim fso, MyFile
dim lastComputer
' create MainRapport
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FolderExists(file) = False Then
fso.CreateFolder(File)
End If
Set MyFile= fso.CreateTextFile(File & "\\" & GENERATED_MAIN_LIST_NAME,true)
MyFile.Writeline("<html>")
MyFile.Writeline("<head>")
MyFile.WriteLine("<meta http-equiv='Content-Type' content='text/html; charset=windows-1252'>")
MyFile.WriteLine("<title>HTMLRapport</title>")
MyFile.WriteLine("</head>")
MyFile.WriteLine("<body>")
MyFile.WriteLine("<p><font size='5'>The Last Computer Scanned in date of :" & Date & "</font></p>")
For Each strComputer In myArrays
If strComputer <> lastComputer Then
MyFile.WriteLine("<p><a href='file:///" & file & "/" & strComputer & Outputformat & "'> Computer : " & strComputer & "</a></p>")
End If
lastComputer = strComputer
Next
MyFile.WriteLine("</body>")
MyFile.WriteLine("</html>")
MyFile.Close
' execute Rapport
If (MsgBox("Do you would like open the rapport ?",vbYesNo,"Open Rapport ?") = vbYes) Then
WScript.Echo File & "\\" & GENERATED_MAIN_LIST_NAME '
set Wshshell= WScript.createobject("wscript.shell")
retcode = Wshshell.run (File & "\\" & GENERATED_MAIN_LIST_NAME, 1, TRUE)
Else
WScript.Echo File & "\\" & GENERATED_MAIN_LIST_NAME
Pause()
End If
End Sub
'===================================================================
'This function returns an array of all subkeys of the
'regkey defined by DISPLAY_REGKEY
'(typically this should be "HKLM\SYSTEM\CurrentControlSet\Enum\DISPLAY")
'===================================================================
Function GetAllDisplayDevicesInReg()
dim arrResult()
redim arrResult(0)
intArrResultIndex=-1
arrtmpkeys=RegEnumKeys(DISPLAY_REGKEY)
if vartype(arrtmpkeys)<>8204 then
arrResult(0)="{ERROR}"
GetAllDisplayDevicesInReg=false
debugout "Display=Can't enum subkeys of display regkey"
else
for tmpctr=0 to ubound(arrtmpkeys)
arrtmpkeys2=RegEnumKeys(DISPLAY_REGKEY & arrtmpkeys(tmpctr))
for tmpctr2 = 0 to ubound(arrtmpkeys2)
intArrResultIndex=intArrResultIndex+1
redim preserve arrResult(intArrResultIndex)
arrResult(intArrResultIndex)=DISPLAY_REGKEY & arrtmpkeys(tmpctr) & "\" & arrtmpkeys2(tmpctr2)
debugout "Display=" & arrResult(intArrResultIndex)
next
next
end if
GetAllDisplayDevicesInReg=arrResult
End Function
'===================================================================
'This function is passed an array of regkeys as strings
'and returns an array containing only those that have a
'hardware id value appropriate to a monitor.
'===================================================================
Function GetAllMonitorsFromAllDisplays(arrRegKeys)
dim arrResult()
redim arrResult(0)
intArrResultIndex=-1
for tmpctr=0 to ubound(arrRegKeys)
if IsDisplayDeviceAMonitor(arrRegKeys(tmpctr)) then
intArrResultIndex=intArrResultIndex+1
redim preserve arrResult(intArrResultIndex)
arrResult(intArrResultIndex)=arrRegKeys(tmpctr)
debugout "Monitor=" & arrResult(intArrResultIndex)
end if
next
if intArrResultIndex=-1 then
arrResult(0)="{ERROR}"
debugout "Monitor=Unable to locate any monitors"
end if
GetAllMonitorsFromAllDisplays=arrResult
End Function
'===================================================================
'this function is passed a regsubkey as a string
'and determines if it is a monitor
'returns boolean
'===================================================================
Function IsDisplayDeviceAMonitor(strDisplayRegKey)
arrtmpResult=RegGetMultiStringValue(strDisplayRegKey,"HardwareID")
strtmpResult="|||" & join(arrtmpResult,"|||") & "|||"
if instr(lcase(strtmpResult),"|||monitor\")=0 then
debugout "MonitorCheck='" & strDisplayRegKey & "'|||is not a monitor"
IsDisplayDeviceAMonitor=False
else
debugout "MonitorCheck='" & strDisplayRegKey & "'|||is a monitor"
IsDisplayDeviceAMonitor=true
end if
End Function
'===================================================================
'This function is passed an array of regkeys as strings
'and returns an array containing only those that have a
'subkey named "Control"...establishing that they are current.
'===================================================================
Function GetActiveMonitorsFromAllMonitors(arrRegKeys)
dim arrResult()
redim arrResult(0)
intArrResultIndex=-1
for tmpctr=0 to ubound(arrRegKeys)
if IsMonitorActive(arrRegKeys(tmpctr)) then
intArrResultIndex=intArrResultIndex+1
redim preserve arrResult(intArrResultIndex)
arrResult(intArrResultIndex)=arrRegKeys(tmpctr)
debugout "ActiveMonitor=" & arrResult(intArrResultIndex)
end if
next
if intArrResultIndex=-1 then
arrResult(0)="{ERROR}"
debugout "ActiveMonitor=Unable to locate any active monitors"
end if
GetActiveMonitorsFromAllMonitors=arrResult
End Function
'===================================================================
'this function is passed a regsubkey as a string
'and determines if it is an active monitor
'returns boolean
'===================================================================
Function IsMonitorActive(strMonitorRegKey)
arrtmpResult=RegEnumKeys(strMonitorRegKey)
strtmpResult="|||" & join(arrtmpResult,"|||") & "|||"
if instr(lcase(strtmpResult),"|||control|||")=0 then
debugout "ActiveMonitorCheck='" & strMonitorRegKey & "'|||is not active"
IsMonitorActive=false
else
debugout "ActiveMonitorCheck='" & strMonitorRegKey & "'|||is active"
IsMonitorActive=true
end if
End Function
'===================================================================
'This function is passed an array of regkeys as strings
'and returns an array containing the corresponding contents
'of the EDID value (in string format) for the "Device Parameters"
'subkey of the specified key
'===================================================================
Function GetEDIDFromActiveMonitors(arrRegKeys)
dim arrResult()
redim arrResult(0)
intArrResultIndex=-1
for tmpctr=0 to ubound(arrRegKeys)
strtmpResult=GetEDIDForMonitor(arrRegKeys(tmpctr))
intArrResultIndex=intArrResultIndex+1
redim preserve arrResult(intArrResultIndex)
arrResult(intArrResultIndex)=strtmpResult
debugout "GETEDID=" & arrRegKeys(tmpctr) & "|||EDID,Yes"
next
if intArrResultIndex=-1 then
arrResult(0)="{ERROR}"
debugout "EDID=Unable to retrieve any edid"
end if
GetEDIDFromActiveMonitors=arrResult
End Function
'===================================================================
'given the regkey of a specific monitor
'this function returns the EDID info
'in string format
'===================================================================
Function GetEDIDForMonitor(strMonitorRegKey)
arrtmpResult=RegGetBinaryValue(strMonitorRegKey & "\Device Parameters","EDID")
if vartype(arrtmpResult) <> 8204 then
debugout "GetEDID=No EDID Found|||" & strMonitorRegKey
GetEDIDForMonitor="{ERROR}"
else
for each bytevalue in arrtmpResult
strtmpResult=strtmpResult & chr(bytevalue)
next
debugout "GetEDID=EDID Found|||" & strMonitorRegKey
debugout "GetEDID_Result=" & GetHexFromString(strtmpResult)
GetEDIDForMonitor=strtmpResult
end if
End Function
'===================================================================
'passed a given string this function
'returns comma seperated hex values
'for each byte
'===================================================================
Function GetHexFromString(strText)
for tmpctr=1 to len(strText)
tmpresult=tmpresult & right( "0" & hex(asc(mid(strText,tmpctr,1))),2) & ","
next
GetHexFromString=left(tmpresult,len(tmpresult)-1)
End Function
'===================================================================
'this function should be passed two arrays with the same
'number of elements. array 1 should contain the
'edid information that corresponds to the active monitor
'regkey found in the same element of array 2
'Why not use a 2D array or a dictionary object?.
'I guess I'm just lazy
'===================================================================
Function GetParsedMonitorInfo(arrActiveEDID,arrActiveMonitors)
dim arrResult()
for tmpctr=0 to ubound(arrActiveEDID)
strSerial=GetSerialFromEDID(arrActiveEDID(tmpctr))
strMfg=GetMfgFromEDID(arrActiveEDID(tmpctr))
strMfgDate=GetMfgDateFromEDID(arrActiveEDID(tmpctr))
strDev=GetDevFromEDID(arrActiveEDID(tmpctr))
strModel=GetModelFromEDID(arrActiveEDID(tmpctr))
strEDIDVer=GetEDIDVerFromEDID(arrActiveEDID(tmpctr))
strWinVesaID=GetWinVESAIDFromRegKey(arrActiveMonitors(tmpctr))
strWinPNPID=GetWinPNPFromRegKey(arrActiveMonitors(tmpctr))
redim preserve arrResult(tmpctr)
arrResult(tmpctr)=arrResult(tmpctr) & strSerial & "|||"
arrResult(tmpctr)=arrResult(tmpctr) & strMfg & "|||"
arrResult(tmpctr)=arrResult(tmpctr) & strMfgDate & "|||"
arrResult(tmpctr)=arrResult(tmpctr) & strDev & "|||"
arrResult(tmpctr)=arrResult(tmpctr) & strModel & "|||"
arrResult(tmpctr)=arrResult(tmpctr) & strEDIDVer & "|||"
arrResult(tmpctr)=arrResult(tmpctr) & strWinVesaID & "|||"
arrResult(tmpctr)=arrResult(tmpctr) & strWinPNPID
debugout arrResult(tmpctr)
next
GetParsedMonitorInfo=arrResult
End Function
'===================================================================
'this is a simple string function to break the VESA monitor ID
'from the registry key
'===================================================================
Function GetWinVESAIDFromRegKey(strRegKey)
if strRegKey="{ERROR}" then
GetWinVESAIDFromRegKey="Bad Registry Info"
exit Function
end if
strtmpResult=right(strRegKey,len(strRegkey)-len(DISPLAY_REGKEY))
strtmpResult=left(strtmpResult,instr(strtmpResult,"\")-1)
GetWinVESAIDFromRegKey=strtmpResult
End Function
'===================================================================
'this is a simple string function to break windows PNP device id
'from the registry key
'===================================================================
Function GetWinPNPFromRegKey(strRegKey)
if strRegKey="{ERROR}" then
GetWinPNPFromRegKey="Bad Registry Info"
exit function
end if
strtmpResult=right(strRegKey,len(strRegkey)-len(DISPLAY_REGKEY))
strtmpResult=right(strtmpResult,len(strtmpResult)-instr(strtmpResult,"\"))
GetWinPNPFromRegKey=strtmpResult
End Function
'===================================================================
'utilizes the GetDescriptorBlockFromEDID function
'to retrieve the serial number block
'from the EDID data
'===================================================================
Function GetSerialFromEDID(strEDID)
'a serial number descriptor will start with &H00 00 00 ff
strTag=chr(&H00) & chr(&H00) & chr(&H00) & chr(&Hff)
GetSerialFromEDID=GetDescriptorBlockFromEDID(strEDID,strTag)
End Function
'===================================================================
'utilizes the GetDescriptorBlockFromEDID function
'to retrieve the model description block
'from the EDID data
'===================================================================
Function GetModelFromEDID(strEDID)
'a model number descriptor will start with &H00 00 00 fc
strTag=chr(&H00) & chr(&H00) & chr(&H00) & chr(&Hfc)
GetModelFromEDID=GetDescriptorBlockFromEDID(strEDID,strTag)
End Function
'===================================================================
'This function parses a string containing EDID data
'and returns the information contained in one of the
'4 custom "descriptor blocks" providing the data in the
'block is tagged wit a certain prefix
'if no descriptor is tagged with the specified prefix then
'function returns "Not Present in EDID"
'otherwise it returns the data found in the descriptor
'trimmed of its prefix tag and also trimmed of
'leading NULLs (chr(0)) and trailing linefeeds (chr(10))
'===================================================================
Function GetDescriptorBlockFromEDID(strEDID,strTag)
if strEDID="{ERROR}" then
GetDescriptorBlockFromEDID="Bad EDID"
exit Function
End If
'There are 4 descriptor blocks in edid at offset locations
'&H36 &H48 &H5a and &H6c each block is 18 bytes long
'the model and serial numbers are stored in the vesa descriptor
'blocks in the edid.
dim arrDescriptorBlock(3)
arrDescriptorBlock(0)=mid(strEDID,&H36+1,18)
arrDescriptorBlock(1)=mid(strEDID,&H48+1,18)
arrDescriptorBlock(2)=mid(strEDID,&H5a+1,18)
arrDescriptorBlock(3)=mid(strEDID,&H6c+1,18)
if instr(arrDescriptorBlock(0),strTag)>0 then
strFoundBlock=arrDescriptorBlock(0)
elseif instr(arrDescriptorBlock(1),strTag)>0 then
strFoundBlock=arrDescriptorBlock(1)
elseif instr(arrDescriptorBlock(2),strTag)>0 then
strFoundBlock=arrDescriptorBlock(2)
elseif instr(arrDescriptorBlock(3),strTag)>0 then
strFoundBlock=arrDescriptorBlock(3)
else
GetDescriptorBlockFromEDID="Not Present in EDID"
exit function
end if
strResult=right(strFoundBlock,14)
'the data in the descriptor block will either fill the
'block completely or be terminated with a linefeed (&h0a)
if instr(strResult,chr(&H0a))>0 then
strResult=trim(left(strResult,instr(strResult,chr(&H0a))-1))
else
strResult=trim(strResult)
end if
'although it is not part of the edid spec (as far as i can tell) it seems as though the
'information in the descriptor will frequently be preceeded by &H00, this
'compensates for that
if left(strResult,1)=chr(0) then strResult=right(strResult,len(strResult)-1)
GetDescriptorBlockFromEDID=strResult
End Function
'===================================================================
'This function parses a string containing EDID data
'and returns the VESA manufacturer ID as a string
'the manufacturer ID is a 3 character identifier
'assigned to device manufacturers by VESA
'I guess that means you're not allowed to make an EDID
'compliant monitor unless you belong to VESA.
'===================================================================
Function GetMfgFromEDID(strEDID)
if strEDID="{ERROR}" then
GetMfgFromEDID="Bad EDID"
exit function
end If
'the mfg id is 2 bytes starting at EDID offset &H08
'the id is three characters long. using 5 bits to represent
'each character. the bits are used so that 1=A 2=B etc..
'
'get the data
tmpEDIDMfg=mid(strEDID,&H08+1,2)
Char1=0 : Char2=0 : Char3=0
Byte1=asc(left(tmpEDIDMfg,1)) 'get the first half of the string
Byte2=asc(right(tmpEDIDMfg,1)) 'get the first half of the string
'now shift the bits
'shift the 64 bit to the 16 bit
if (Byte1 and 64) > 0 then Char1=Char1+16
'shift the 32 bit to the 8 bit
if (Byte1 and 32) > 0 then Char1=Char1+8
'etc....
if (Byte1 and 16) > 0 then Char1=Char1+4
if (Byte1 and 8) > 0 then Char1=Char1+2
if (Byte1 and 4) > 0 then Char1=Char1+1
'the 2nd character uses the 2 bit and the 1 bit of the 1st byte
if (Byte1 and 2) > 0 then Char2=Char2+16
if (Byte1 and 1) > 0 then Char2=Char2+8
'and the 128,64 and 32 bits of the 2nd byte
if (Byte2 and 128) > 0 then Char2=Char2+4
if (Byte2 and 64) > 0 then Char2=Char2+2
if (Byte2 and 32) > 0 then Char2=Char2+1
'the bits for the 3rd character don't need shifting
'we can use them as they are
Char3=Char3+(Byte2 and 16)
Char3=Char3+(Byte2 and 8)
Char3=Char3+(Byte2 and 4)
Char3=Char3+(Byte2 and 2)
Char3=Char3+(Byte2 and 1)
tmpmfg=chr(Char1+64) & chr(Char2+64) & chr(Char3+64)
GetMfgFromEDID=tmpmfg
End Function
'===================================================================
'This function parses a string containing EDID data
'and returns the manufacture date in mm/yyyy format
'===================================================================
Function GetMfgDateFromEDID(strEDID)
if strEDID="{ERROR}" then
GetMfgDateFromEDID="Bad EDID"
exit function
end if
'the week of manufacture is stored at EDID offset &H10
tmpmfgweek=asc(mid(strEDID,&H10+1,1))
'the year of manufacture is stored at EDID offset &H11
'and is the current year -1990
tmpmfgyear=(asc(mid(strEDID,&H11+1,1)))+1990
'store it in month/year format
tmpmdt=month(dateadd("ww",tmpmfgweek,datevalue("1/1/" & tmpmfgyear))) & "/" & tmpmfgyear
GetMfgDateFromEDID=tmpmdt
End Function
'===================================================================
'This function parses a string containing EDID data
'and returns the device ID as a string
'===================================================================
Function GetDevFromEDID(strEDID)
if strEDID="{ERROR}" then
GetDevFromEDID="Bad EDID"
exit function
end if
'the device id is 2bytes starting at EDID offset &H0a
'the bytes are in reverse order.
'this code is not text. it is just a 2 byte code assigned
'by the manufacturer. they should be unique to a model
tmpEDIDDev1=hex(asc(mid(strEDID,&H0a+1,1)))
tmpEDIDDev2=hex(asc(mid(strEDID,&H0b+1,1)))
if len(tmpEDIDDev1)=1 then tmpEDIDDev1="0" & tmpEDIDDev1
if len(tmpEDIDDev2)=1 then tmpEDIDDev2="0" & tmpEDIDDev2
tmpdev=tmpEDIDDev2 & tmpEDIDDev1
GetDevFromEDID=tmpdev
End Function
'===================================================================
'This function parses a string containing EDID data
'and returns the EDID version number as a string
'I should probably do this first and then not return any other data
'if the edid version exceeds 1.3 since most if this code probably
'won't work right if they change the spec drastically enough (which they probably
'won't do for backward compatability reasons thus negating my need to check and
'making this comment somewhat redundant)
'===================================================================
Function GetEDIDVerFromEDID(strEDID)
if strEDID="{ERROR}" then
GetEDIDVerFromEDID="Bad EDID"
exit function
end if
'the version is at EDID offset &H12
tmpEDIDMajorVer=asc(mid(strEDID,&H12+1,1))
'the revision level is at EDID offset &H13
tmpEDIDRev=asc(mid(strEDID,&H13+1,1))
tmpver=chr(48+tmpEDIDMajorVer) & "." & chr(48+tmpEDIDRev)
GetEDIDVerFromEDID=tmpver
End Function
'===================================================================
'simple function to provide an
'easier interface to the wmi registry functions
'===================================================================
Function RegEnumKeys(RegKey)
hive=SetHive(RegKey)
set objReg=GetWMIRegProvider(strGPN)
strKeyPath = right(RegKey,len(RegKey)-instr(RegKey,"\"))
objReg.EnumKey Hive, strKeyPath, arrSubKeys
RegEnumKeys=arrSubKeys
End Function
'===================================================================
'simple function to provide an
'easier interface to the wmi registry functions
'===================================================================
Function RegGetStringValue(RegKey,RegValueName)
hive=SetHive(RegKey)
set objReg=GetWMIRegProvider()
strKeyPath = right(RegKey,len(RegKey)-instr(RegKey,"\"))
tmpreturn=objReg.GetStringValue(Hive, strKeyPath, RegValueName, RegValue)
if tmpreturn=0 then
RegGetStringValue=RegValue
else
RegGetStringValue="~{{}}~"
end if
End Function
'===================================================================
'simple function to provide an
'easier interface to the wmi registry functions
'===================================================================
Function RegGetMultiStringValue(RegKey,RegValueName)
hive=SetHive(RegKey)
set objReg=GetWMIRegProvider(strGPN)
strKeyPath = right(RegKey,len(RegKey)-instr(RegKey,"\"))
tmpreturn=objReg.GetMultiStringValue(Hive, strKeyPath, RegValueName, RegValue)
if tmpreturn=0 then
RegGetMultiStringValue=RegValue
else
RegGetMultiStringValue="~{{}}~"
end if
End Function
'===================================================================
'simple function to provide an
'easier interface to the wmi registry functions
'===================================================================
Function RegGetBinaryValue(RegKey,RegValueName)
hive=SetHive(RegKey)
set objReg=GetWMIRegProvider(strGPN)
strKeyPath = right(RegKey,len(RegKey)-instr(RegKey,"\"))
tmpreturn=objReg.GetBinaryValue(Hive, strKeyPath, RegValueName, RegValue)
if tmpreturn=0 then
RegGetBinaryValue=RegValue
else
RegGetBinaryValue="~{{}}~"
end if
End Function
'===================================================================
'simple function to provide a wmi registry provider
'to all the other registry functions (regenumkeys, reggetstringvalue, etc...)
'
' modified by Maxime Bouchard
' 16 january 2006 - Error log support
'===================================================================
Function GetWMIRegProvider(strGPN)
strComputer = strGPN
If strcomputer <> "" Then
On Error Resume Next
Set GetWMIRegProvider=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & _
"\root\default:StdRegProv")
If Err <> 0 Then
Wscript.Echo "Error : " & Err.Number & ": The connection to computer named " & _
strComputer & " : FAILED !" & VbCrLf
If GenererRapport = 1 Then ErrorLog strComputer
End If
End If
End Function
'===================================================================
'sub create an error log file for report
'
' by Maxime Bouchard
' 16 janvier 2006
'===================================================================
sub ErrorLog(strComputer)
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FolderExists(file) = False Then
fso.CreateFolder(File)
End If
Set MyFile= fso.CreateTextFile(File & "\\" & strComputer & outputformat,true)
MyFile.Writeline(date & " " & Time & " ERROR - THE CONNECTION TO " & _
strComputer & " : FAILED ! ")
MyFile.Close
End Sub
'===================================================================
'function to parse the specified hive
'from the registry functions above
'to all the other registry functions (regenumkeys, reggetstringvalue, etc...)
'===================================================================
Function SetHive(RegKey)
HKEY_CLASSES_ROOT=&H80000000
HKEY_CURRENT_USER=&H80000001
HKEY_CURRENT_CONFIG=&H80000005
HKEY_LOCAL_MACHINE=&H80000002
HKEY_USERS=&H80000003
strHive=left(RegKey,instr(RegKey,"\"))
if strHive="HKCR\" or strHive="HKR\" then SetHive=HKEY_CLASSES_ROOT
if strHive="HKCU\" then SetHive=HKEY_CURRENT_USER
if strHive="HKCC\" then SetHive=HKEY_CURRENT_CONFIG
if strHive="HKLM\" then SetHive=HKEY_LOCAL_MACHINE
if strHive="HKU\" then SetHive=HKEY_USERS
End Function
'===================================================================
'this sub forces execution under cscript
'it can be useful for debugging if your machine's
'default script engine is set to wscript
'===================================================================
Sub ForceCScript
strCurrScriptHost=lcase(right(wscript.fullname,len(wscript.fullname)-len(wscript.path)-1))
if strCurrScriptHost<>"cscript.exe" then
set objFSO=CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("WScript.Shell")
Set objArgs = WScript.Arguments
strExecCmdLine=wscript.path & "\cscript.exe //nologo " & objfso.getfile(wscript.scriptfullname).shortpath
For argctr = 0 to objArgs.Count - 1
strExecArg=objArgs(argctr)
if instr(strExecArg," ")>0 then strExecArg=chr(34) & strExecArg & chr(34)
strExecAllArgs=strExecAllArgs & " " & strExecArg
Next
objShell.run strExecCmdLine & strExecAllArgs,1,false
set objFSO = nothing
Set objShell = nothing
Set objArgs = nothing
wscript.quit
end if
End Sub
'===================================================================
'allows for a pause at the end of execution
'currently used only for debugging
'===================================================================
Sub Pause
set objStdin=wscript.stdin
set objStdout=wscript.stdout
objStdout.write "Press ENTER to continue..."
strtmp=objStdin.readline
end Sub
'===================================================================
'if debugmode=1 the writes dubug info to the specified
'file and if running under cscript also writes it to screen.
'===================================================================
Sub DebugOut(strDebugInfo)
if DEBUGMODE=0 then exit sub
strCurrScriptHost=lcase(right(wscript.fullname,len(wscript.fullname)-len(wscript.path)-1))
if strCurrScriptHost="cscript.exe" then wscript.echo "Debug: " & strDebugInfo
AppendFileMode=8
set objDebugFSO=CreateObject("Scripting.FileSystemObject")
set objDebugStream=objDebugFSO.OpenTextFile(DEBUGFILE,AppendFileMode,True,False)
objDebugStream.writeline strDebugInfo
objDebugStream.Close
set objDebugStream=Nothing
set objDebugFSO=Nothing
End Sub |
