IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

VBScript Discussion :

Serial Number Monitor en WMI


Sujet :

VBScript

  1. #1
    Membre émérite

    Homme Profil pro
    Ingénieur Réseaux
    Inscrit en
    Juin 2012
    Messages
    877
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 32
    Localisation : France, Rhône (Rhône Alpes)

    Informations professionnelles :
    Activité : Ingénieur Réseaux
    Secteur : Conseil

    Informations forums :
    Inscription : Juin 2012
    Messages : 877
    Points : 2 427
    Points
    2 427
    Par défaut Serial Number Monitor en WMI
    Bonjour le Forum,

    J'ai besoin de votre aide.

    Je me casse les dents sur un moyen de récupérer le serial number d'un écran via WMI.

    J'ai testé la classe root\WMI\WMIMonitorID et le serial number et d'autres trouvés sur Internet.

    La chose étrange est que je ne retrouve pas ce serial number dans HKLM\SYSTEM\CurrentControlSet\Enum\DISPLAY\ au niveau du registre.

    Des idées ?

    Cordialement,


    Miistik
    Si la réponse vous a été donnée, pensez au Tag .
    Un petit aide à se sentir utile. Merci.

    "La folie. C'est de faire et refaire la même chose en espérant que le résultat sera différent."
    Albert Einstein

  2. #2
    Expert éminent
    Avatar de hackoofr
    Homme Profil pro
    Enseignant
    Inscrit en
    Juin 2009
    Messages
    3 839
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 48
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : Juin 2009
    Messages : 3 839
    Points : 9 222
    Points
    9 222
    Par défaut

    WmiMonitorID
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    On error resume next
    Set objWMIService = GetObject("winmgmts:\\.\root\WMI")
     
    Set colItems = objWMIService.ExecQuery("Select * From WmiMonitorID")
     
    For Each objItem in colItems
        Msg = Msg & "Active:" & objItem.Active
        Msg = Msg & VbCrlf & "InstanceName:" & objItem.InstanceName
        Msg = Msg & VbCrlf & "ManufacturerName:" & Join(objItem.ManufacturerName)
        Msg = Msg & VbCrlf & "ProductCodeID:" & Join(objItem.ProductCodeID)
        Msg = Msg & VbCrlf & "SerialNumberID:" & Join(objItem.SerialNumberID)
        Msg = Msg & VbCrlf & "UserFriendlyName:" & Join(objItem.UserFriendlyName)
        Msg = Msg & VbCrlf & "UserFriendlyNameLength:" & objItem.UserFriendlyNameLength
        Msg = Msg & VbCrlf & "WeekOfManufacture:" & objItem.WeekOfManufacture
        Msg = Msg & VbCrlf & "YearOfManufacture:" & objItem.YearOfManufacture
    Next
     
    MsgBox Msg
    Getting monitor info
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
     strComputer = "."
     
    'Some notes on the general function....
    '
    'Monitors are stored in HKLM\SYSTEM\CurrentControlSet\Enum\DISPLAY\
    '
    'Unfortunately, not only monitors are stored here but 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\<VESA_Monitor_ID>\<PNP_ID>\
    '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\<VESA_Monitor_ID\<PNP_ID>\
    'if the device is a monitor then the "HardwareID" value will contain the data "Monitor\<VESA_Monitor_ID>"
    '
    '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"
    '****************************************
    '
    'On with the code...
    '
    '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
    'The ForceCscript subroutine forces execution under CSCRIPT.EXE/Prevents execution
    'under WSCRIPT.EXE -- useful when debugging
    'ForceCscript
     
    DebugOut "Execution Started " & cstr(now)
    wscript.echo GetMonitorInfo() 'just write the output to screen
    DebugOut "Execution Completed " & cstr(now)
     
    'This is the main function. It calls everything else
    'in the correct order.
    Function GetMonitorInfo()
    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
    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
    Function GetFormattedMonitorInfo(arrParsedMonitorInfo)
    for tmpctr=0 to ubound(arrParsedMonitorInfo)
    tmpResult=split(arrParsedMonitorInfo(tmpctr),"|||")
    tmpOutput=tmpOutput & "[Monitor_" & cstr(tmpctr+1) & "]" & vbcrlf
    tmpOutput=tmpOutput & "EDID_VESAManufacturerID=" & tmpResult(1) & vbcrlf
    tmpOutput=tmpOutput & "EDID_SerialNumber=" & tmpResult(0) & vbcrlf
    tmpOutput=tmpOutput & "EDID_ModelName=" & tmpResult(2) & vbcrlf
    next
    GetFormattedMonitorInfo=tmpOutput
     
     
     
     
    End Function
     
    '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))
    strModel=GetModelFromEDID(arrActiveEDID(tmpctr))
    redim preserve arrResult(tmpctr)
    arrResult(tmpctr)=arrResult(tmpctr) & strSerial & "|||"
    arrResult(tmpctr)=arrResult(tmpctr) & strMfg & "|||"
    arrResult(tmpctr)=arrResult(tmpctr) & strModel & "|||"
    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()
    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="~{{<ERROR>}}~"
    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()
    strKeyPath = right(RegKey,len(RegKey)-instr(RegKey,"\"))
    tmpreturn=objReg.GetMultiStringValue(Hive, strKeyPath, RegValueName, RegValue)
    if tmpreturn=0 then
    RegGetMultiStringValue=RegValue
    else
    RegGetMultiStringValue="~{{<ERROR>}}~"
    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()
    strKeyPath = right(RegKey,len(RegKey)-instr(RegKey,"\"))
    tmpreturn=objReg.GetBinaryValue(Hive, strKeyPath, RegValueName, RegValue)
    if tmpreturn=0 then
    RegGetBinaryValue=RegValue
    else
    RegGetBinaryValue="~{{<ERROR>}}~"
    end if
    End Function
     
    'simple function to provide a wmi registry provider
    'to all the other registry functions (regenumkeys, reggetstringvalue, etc...)
    Function GetWMIRegProvider()
    'strComputer = "."
     
    Set GetWMIRegProvider=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
    End Function
     
    '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

  3. #3
    Membre émérite

    Homme Profil pro
    Ingénieur Réseaux
    Inscrit en
    Juin 2012
    Messages
    877
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 32
    Localisation : France, Rhône (Rhône Alpes)

    Informations professionnelles :
    Activité : Ingénieur Réseaux
    Secteur : Conseil

    Informations forums :
    Inscription : Juin 2012
    Messages : 877
    Points : 2 427
    Points
    2 427
    Par défaut
    Bonjour,

    Merci pour ta réponse hackoofr.

    Cependant, j'ai déjà testé le premier script et j'ai fait la même démarche que ton second.
    Sans résultat.

    EDIT : en fait, ton second script retourne bien le EDID_SerialNumber qui correspond à ce que je recherche.
    Je m'excuse donc pour avoir lu trop vite ton script (pour ma défense j'en ai lu et testé un bon paquet).

    Reste plus qu'à le simplifier pour extraire que EDID_SerialNumber
    Si la réponse vous a été donnée, pensez au Tag .
    Un petit aide à se sentir utile. Merci.

    "La folie. C'est de faire et refaire la même chose en espérant que le résultat sera différent."
    Albert Einstein

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. [WS 2008] serial number HDD et WMI ?
    Par snooky147 dans le forum Windows Serveur
    Réponses: 0
    Dernier message: 28/06/2012, 14h30
  2. récuperer le Serial Number de mon hard Disk
    Par mikky dans le forum Composants
    Réponses: 4
    Dernier message: 15/10/2009, 12h59
  3. recup serial number disque physique
    Par ighost dans le forum Débuter
    Réponses: 8
    Dernier message: 31/07/2008, 17h23
  4. Set serial Number sur une disquette
    Par Cpet dans le forum Composants VCL
    Réponses: 4
    Dernier message: 01/12/2004, 10h24

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo