none
Gerar Log das informações coletadas RRS feed

  • Pergunta

  • Boa tarde.

    Caros, tenho um script que coleta as informações do monitor (em rede), eu gostaria de gerar um log com as informações Coletadas, seria importante que o nome do log fosse "nome_do_computador.log".

    Segue script que tenho:

    Option Explicit
    Dim WshShell
    Set WshShell = WScript.CreateObject("WScript.Shell")
    Dim strComputer, message

    Dim intMonitorCount
    Dim oRegistry, sBaseKey, sBaseKey2, sBaseKey3, skey, skey2, skey3
    Dim sValue
    dim i, iRC, iRC2, iRC3
    Dim arSubKeys, arSubKeys2, arSubKeys3, arrintEDID
    Dim strRawEDID
    Dim ByteValue, strSerFind, strMdlFind
    Dim intSerFoundAt, intMdlFoundAt, findit
    Dim tmp, tmpser, tmpmdl, tmpctr
    Dim batch, bHeader
    batch = False

    If WScript.Arguments.Count = 1 Then
    strComputer = WScript.Arguments(0)
    ' batch = True
    Else
    strComputer = wshShell.ExpandEnvironmentStrings("")
    strComputer = ""
    strComputer = InputBox("Digite o Nome do Computador: ","Infomações do Monitor",strComputer)
    End If

    If strcomputer = "" Then WScript.Quit
    strComputer = UCase(strComputer)

    If batch Then
    Dim fso,logfile, appendout
    'msgbox ("teste")
    'logfile = wshShell.ExpandEnvironmentStrings("%userprofile%") & "\Downloads\MonitorInfo.csv"
    'arquivoLog.WriteLine("C:\Temp\")

    'setup Log
    Const ForAppend = 8
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FileExists(logfile) Then bHeader = True
    set appendout = fso.OpenTextFile(logfile, ForAppend, True)

    If bHeader Then
    appendout.writeline "Computer,Model,Serial #,Vendor ID,Manufacture Date,Messages"
    End If
    End If

    Dim strarrRawEDID()
    intMonitorCount=0
    Const HKLM = &H80000002 'HKEY_LOCAL_MACHINE
    'get a handle to the WMI registry object
    On Error Resume Next
    Set oRegistry = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "/root/default:StdRegProv")

    If Err <> 0 Then
    If batch Then
    EchoAndLog strComputer & ",,,,," & Err.Description
    Else
    Wscript.Echo "Failed. " & Err.Description,vbCritical + vbOKOnly,strComputer
    WScript.Quit
    End If
    End If


    sBaseKey = "SYSTEM\CurrentControlSet\Enum\DISPLAY\"
    'enumerate all the keys HKLM\SYSTEM\CurrentControlSet\Enum\DISPLAY\
    iRC = oRegistry.EnumKey(HKLM, sBaseKey, arSubKeys)
    For Each sKey In arSubKeys
    'we are now in the registry at the level of:
    'HKLM\SYSTEM\CurrentControlSet\Enum\DISPLAY\<VESA_Monitor_ID\
    'we need to dive in one more level and check the data of the "HardwareID" value
    sBaseKey2 = sBaseKey & sKey & "\"
    iRC2 = oRegistry.EnumKey(HKLM, sBaseKey2, arSubKeys2)
    For Each sKey2 In arSubKeys2
    'now we are at the level of:
    'HKLM\SYSTEM\CurrentControlSet\Enum\DISPLAY\<VESA_Monitor_ID\<PNP_ID>\
    'so we can check the "HardwareID" value
    oRegistry.GetMultiStringValue HKLM, sBaseKey2 & sKey2 & "\", "HardwareID", sValue
    for tmpctr=0 to ubound(svalue)
    If lcase(left(svalue(tmpctr),8))="monitor\" then
    'If it is a monitor we will check for the existance of a control subkey
    'that way we know it is an active monitor
    sBaseKey3 = sBaseKey2 & sKey2 & "\"
    iRC3 = oRegistry.EnumKey(HKLM, sBaseKey3, arSubKeys3)
    For Each sKey3 In arSubKeys3
    'Kaplan edit
    strRawEDID = ""
    If skey3="Control" Then
    'If the Control sub-key exists then we should read the edid info
    oRegistry.GetBinaryValue HKLM, sbasekey3 & "Device Parameters\", "EDID", arrintEDID
    If vartype(arrintedid) <> 8204 then 'and If we don't find it...
    strRawEDID="EDID Not Available" 'store an "unavailable message
    else
    for each bytevalue in arrintedid 'otherwise conver the byte array from the registry into a string (for easier processing later)
    strRawEDID=strRawEDID & chr(bytevalue)
    Next
    End If
    'now take the string and store it in an array, that way we can support multiple monitors
    redim preserve strarrRawEDID(intMonitorCount)
    strarrRawEDID(intMonitorCount)=strRawEDID
    intMonitorCount=intMonitorCount+1
    End If
    Next
    End If
    Next
    Next
    Next
    '*****************************************************************************************
    'now the EDID info for each active monitor is stored in an array of strings called strarrRawEDID
    'so we can process it to get the good stuff out of it which we will store in a 5 dimensional array
    'called arrMonitorInfo, the dimensions are as follows:
    '0=VESA Mfg ID, 1=VESA Device ID, 2=MFG Date (M/YYYY),3=Serial Num (If available),4=Model Descriptor
    '5=EDID Version
    '*****************************************************************************************
    On Error Resume Next
    dim arrMonitorInfo()
    redim arrMonitorInfo(intMonitorCount-1,5)
    dim location(3)
    for tmpctr=0 to intMonitorCount-1
    If strarrRawEDID(tmpctr) <> "EDID Not Available" then
    '*********************************************************************
    'first get the model and serial numbers from the vesa descriptor
    'blocks in the edid. the model number is required to be present
    'according to the spec. (v1.2 and beyond)but serial number is not
    'required. There are 4 descriptor blocks in edid at offset locations
    '&H36 &H48 &H5a and &H6c each block is 18 bytes long
    '*********************************************************************
    location(0)=mid(strarrRawEDID(tmpctr),&H36+1,18)
    location(1)=mid(strarrRawEDID(tmpctr),&H48+1,18)
    location(2)=mid(strarrRawEDID(tmpctr),&H5a+1,18)
    location(3)=mid(strarrRawEDID(tmpctr),&H6c+1,18)

    'you can tell If the location contains a serial number If it starts with &H00 00 00 ff
    strSerFind=chr(&H00) & chr(&H00) & chr(&H00) & chr(&Hff)
    'or a model description If it starts with &H00 00 00 fc
    strMdlFind=chr(&H00) & chr(&H00) & chr(&H00) & chr(&Hfc)

    intSerFoundAt=-1
    intMdlFoundAt=-1
    for findit = 0 to 3
    If instr(location(findit),strSerFind)>0 then
    intSerFoundAt=findit
    End If
    If instr(location(findit),strMdlFind)>0 then
    intMdlFoundAt=findit
    End If
    Next

    'If a location containing a serial number block was found then store it
    If intSerFoundAt<>-1 then
    tmp=right(location(intSerFoundAt),14)
    If instr(tmp,chr(&H0a))>0 then
    tmpser=trim(left(tmp,instr(tmp,chr(&H0a))-1))
    Else
    tmpser=trim(tmp)
    End If
    'although it is not part of the edid spec it seems as though the
    'serial number will frequently be preceeded by &H00, this
    'compensates for that
    If left(tmpser,1)=chr(0) then tmpser=right(tmpser,len(tmpser)-1)
    else
    tmpser="Not Found"
    End If

    'If a location containing a model number block was found then store it
    If intMdlFoundAt<>-1 then
    tmp=right(location(intMdlFoundAt),14)
    If instr(tmp,chr(&H0a))>0 then
    tmpmdl=trim(left(tmp,instr(tmp,chr(&H0a))-1))
    else
    tmpmdl=trim(tmp)
    End If
    'although it is not part of the edid spec it seems as though the
    'serial number will frequently be preceeded by &H00, this
    'compensates for that
    If left(tmpmdl,1)=chr(0) then tmpmdl=right(tmpmdl,len(tmpmdl)-1)
    else
    tmpmdl="Not Found"
    End If

    '**************************************************************
    'Next get the mfg date
    '**************************************************************
    Dim tmpmfgweek,tmpmfgyear,tmpmdt
    'the week of manufacture is stored at EDID offset &H10
    tmpmfgweek=asc(mid(strarrRawEDID(tmpctr),&H10+1,1))

    'the year of manufacture is stored at EDID offset &H11
    'and is the current year -1990
    tmpmfgyear=(asc(mid(strarrRawEDID(tmpctr),&H11+1,1)))+1990

    'store it in month/year format
    tmpmdt=month(dateadd("ww",tmpmfgweek,datevalue("1/1/" & tmpmfgyear))) & "/" & tmpmfgyear

    '**************************************************************
    'Next get the edid version
    '**************************************************************
    'the version is at EDID offset &H12
    Dim tmpEDIDMajorVer, tmpEDIDRev, tmpVer
    tmpEDIDMajorVer=asc(mid(strarrRawEDID(tmpctr),&H12+1,1))

    'the revision level is at EDID offset &H13
    tmpEDIDRev=asc(mid(strarrRawEDID(tmpctr),&H13+1,1))

    'store it in month/year format
    tmpver=chr(48+tmpEDIDMajorVer) & "." & chr(48+tmpEDIDRev)

    '**************************************************************
    'Next get the mfg id
    '**************************************************************
    '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
    Dim tmpEDIDMfg, tmpMfg
    dim Char1, Char2, Char3
    Dim Byte1, Byte2
    tmpEDIDMfg=mid(strarrRawEDID(tmpctr),&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)

    '**************************************************************
    'Next get the device id
    '**************************************************************
    '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
    Dim tmpEDIDDev1, tmpEDIDDev2, tmpDev

    tmpEDIDDev1=hex(asc(mid(strarrRawEDID(tmpctr),&H0a+1,1)))
    tmpEDIDDev2=hex(asc(mid(strarrRawEDID(tmpctr),&H0b+1,1)))
    If len(tmpEDIDDev1)=1 then tmpEDIDDev1="0" & tmpEDIDDev1
    If len(tmpEDIDDev2)=1 then tmpEDIDDev2="0" & tmpEDIDDev2
    tmpdev=tmpEDIDDev2 & tmpEDIDDev1

    '**************************************************************
    'finally store all the values into the array
    '**************************************************************
    'Kaplan adds code to avoid duplication...

    If Not InArray(tmpser,arrMonitorInfo,3) Then
    arrMonitorInfo(tmpctr,0)=tmpmfg
    arrMonitorInfo(tmpctr,1)=tmpdev
    arrMonitorInfo(tmpctr,2)=tmpmdt
    arrMonitorInfo(tmpctr,3)=tmpser
    arrMonitorInfo(tmpctr,4)=tmpmdl
    arrMonitorInfo(tmpctr,5)=tmpVer
    End If
    End If
    Next

    'For now just a simple screen print will suffice for output.
    'But you could take this output and write it to a database or a file
    'and in that way use it for asset management.
    i = 0
    for tmpctr = 0 to intMonitorCount-1
    If arrMonitorInfo(tmpctr,1) <> "" And arrMonitorInfo(tmpctr,0) <> "PNP" Then
    If batch Then
    EchoAndLog strComputer & "," & arrMonitorInfo(tmpctr,4) & "," & _
    arrMonitorInfo(tmpctr,3)& "," & arrMonitorInfo(tmpctr,0) & "," & _
    arrMonitorInfo(tmpctr,2)
    Else
    message = message & "Monitor " & chr(i+65) & ")" & VbCrLf & _
    "Model Name: " & arrMonitorInfo(tmpctr,4) & VbCrLf & _
    "Serial Number: " & arrMonitorInfo(tmpctr,3)& VbCrLf & _
    "VESA Manufacturer ID: " & arrMonitorInfo(tmpctr,0) & VbCrLf & _
    "Manufacture Date: " & arrMonitorInfo(tmpctr,2) & VbCrLf & VbCrLf
    'wscript.echo ".........." & "Device ID: " & arrMonitorInfo(tmpctr,1)
    'wscript.echo ".........." & "EDID Version: " & arrMonitorInfo(tmpctr,5)
    i = i + 1
    End If
    End If
    Next

    If not batch Then
    Wscript.Echo message, vbInformation + vbOKOnly,strComputer & " Monitor Info"
    End If

    Function InArray(strValue,List,Col)
    Dim i
    For i = 0 to UBound(List)
    If List(i,col) = cstr(strValue) Then
    InArray = True
    Exit Function
    End If
    Next
    InArray = False
    End Function

    Sub EchoAndLog (message)
    'Echo output and write to log
    Wscript.Echo message
    AppendOut.WriteLine message
    End Sub


    Obrigado.









    quarta-feira, 6 de fevereiro de 2013 17:47

Respostas

  • André,

    Bom, tem esta linha:

    'logfile = wshShell.ExpandEnvironmentStrings("%userprofile%") & "\Downloads\MonitorInfo.csv"


    Parece ser a linha que define o arquivo de log, está comentada então não funciona. Troque ela por isto

    logfile = wshShell.ExpandEnvironmentStrings("%userprofile%") & "\Downloads\" & strComputer & ".log"

    Dica:

    Procure indentar o código, fica muito dificil ler o código do jeito que está, ainda mais com muitas linhas. Eu só li o inicio do código nem procurei ver como o arquivo é escrito.

    Indentação

    http://pt.wikipedia.org/wiki/Indenta%C3%A7%C3%A3o


    Fábio de Paula Junior

    • Marcado como Resposta andre080310 quinta-feira, 7 de fevereiro de 2013 12:07
    quarta-feira, 6 de fevereiro de 2013 20:29
    Moderador
  • Tem mais uma coisa:

    Altere a linha

    batch = False

    por

    batch = True

    Senão não gera o arquivo. Tem outras formas de fazer mas o código está muito mexido.


    Fábio de Paula Junior

    • Marcado como Resposta andre080310 quinta-feira, 7 de fevereiro de 2013 12:07
    quarta-feira, 6 de fevereiro de 2013 20:38
    Moderador
  • Ba André, segue o mostrinho tche......

    obs. no message = message & _ vc controla tche o que vai sair no log, é só comentar a linha do que vc não quer.


    Const HKLM = &H80000002
    OnErrorResumeNext

    Dim WshShell, strComputer, message, tmpmfgweek, tmpmfgyear, tmpmdt, tmpEDIDMajorVer, tmpEDIDRev, tmpVer
    Dim arrMonitorInfo(), strarrRawEDID(), intMonitorCount, oRegistry, sBaseKey, sBaseKey2, sBaseKey3, skey, skey2, skey3
    Dim sValue, i, iRC, iRC2, iRC3, arSubKeys, arSubKeys2, arSubKeys3, arrintEDID, strRawEDID, ByteValue, strSerFind
    Dim intSerFoundAt, intMdlFoundAt, findit, tmp, tmpser, tmpmdl, tmpctr, batch, bHeader, location(3), strMdlFind
    Dim Char1, Char2, Char3, Byte1, Byte2, tmpEDIDDev1, tmpEDIDDev2, tmpDev, tmpEDIDMfg, tmpMfg

    Set WshShell = WScript.CreateObject("WScript.Shell")
    batch = False

        If WScript.Arguments.Count = 1Then
            strComputer = WScript.Arguments(0)
            batch = True
        Else
            strComputer = wshShell.ExpandEnvironmentStrings("")
            strComputer = ""
            strComputer = InputBox("Digite o Nome do Computador: ","Infomações do Monitor",strComputer)
        EndIf
    '--------------------------------------------------------------------------------------------------------
    intMonitorCount=0
    Set oRegistry = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "/root/default:StdRegProv")

        IfErr <> 0Then
            If batchThen
                    EchoAndLog strComputer & ",,,,," & Err.Description
                Else
                    WScript.Echo"Failed. " & Err.Description,vbCritical + vbOKOnly,strComputer
                    WScript.Quit
            EndIf
        EndIf

    sBaseKey = "SYSTEM\CurrentControlSet\Enum\DISPLAY\"
    iRC = oRegistry.EnumKey(HKLM, sBaseKey, arSubKeys)

        ForEach sKeyIn arSubKeys
            sBaseKey2 = sBaseKey & sKey & "\"
            iRC2 = oRegistry.EnumKey(HKLM, sBaseKey2, arSubKeys2)
        ForEach sKey2In arSubKeys2
            oRegistry.GetMultiStringValue HKLM, sBaseKey2 & sKey2 & "\", "HardwareID", sValue
        For tmpctr=0toubound(svalue)
                    Iflcase(left(svalue(tmpctr),8))="monitor\"then
                        sBaseKey3 = sBaseKey2 & sKey2 & "\"
                        iRC3 = oRegistry.EnumKey(HKLM, sBaseKey3, arSubKeys3)
        ForEach sKey3In arSubKeys3
            strRawEDID = ""
                        If skey3="Control"Then
                            oRegistry.GetBinaryValue HKLM, sbasekey3 & "Device Parameters\", "EDID", arrintEDID
                            Ifvartype(arrintedid) <> 8204then
                                    strRawEDID="EDID Not Available"
                                Else
                                Foreach bytevaluein arrintedid
                                    strRawEDID=strRawEDID & chr(bytevalue)
                                Next
                            EndIf
        ReDimpreserve strarrRawEDID(intMonitorCount)
            strarrRawEDID(intMonitorCount)=strRawEDID
            intMonitorCount=intMonitorCount+1
                        EndIf
                    Next
                EndIf
            Next
        Next
    Next
    '*****************************************************************************************
    '*****************************************************************************************
    'On Error Resume Next
        redim arrMonitorInfo(intMonitorCount-1,5)

        For tmpctr=0to intMonitorCount-1
        If strarrRawEDID(tmpctr) <> "EDID Not Available"Then
            location(0)=mid(strarrRawEDID(tmpctr),&H36+1,18)
            location(1)=mid(strarrRawEDID(tmpctr),&H48+1,18)
            location(2)=mid(strarrRawEDID(tmpctr),&H5a+1,18)
            location(3)=mid(strarrRawEDID(tmpctr),&H6c+1,18)
            strSerFind=chr(&H00) & chr(&H00) & chr(&H00) & chr(&Hff)
            strMdlFind=chr(&H00) & chr(&H00) & chr(&H00) & chr(&Hfc)
            intSerFoundAt=-1
            intMdlFoundAt=-1
        For findit = 0to3
        Ifinstr(location(findit),strSerFind)>0then
            intSerFoundAt=findit
        EndIf
        Ifinstr(location(findit),strMdlFind)>0then
            intMdlFoundAt=findit
        EndIf
    Next

        If intSerFoundAt<>-1then
            tmp=right(location(intSerFoundAt),14)
        Ifinstr(tmp,chr(&H0a))>0then
            tmpser=trim(left(tmp,instr(tmp,chr(&H0a))-1))
        Else
            tmpser=trim(tmp)
        EndIf
        
        Ifleft(tmpser,1)=chr(0) then tmpser=right(tmpser,len(tmpser)-1)
        Else
            tmpser="Not Found"
        EndIf

        If intMdlFoundAt<>-1then
            tmp=right(location(intMdlFoundAt),14)
        Ifinstr(tmp,chr(&H0a))>0then
            tmpmdl=trim(left(tmp,instr(tmp,chr(&H0a))-1))
        Else
            tmpmdl=trim(tmp)
        EndIf

        Ifleft(tmpmdl,1)=chr(0) then tmpmdl=right(tmpmdl,len(tmpmdl)-1)
        Else
            tmpmdl="Not Found"
        EndIf

    '**************************************************************
    'Coleta data do MFG
    '**************************************************************
        tmpmfgweek=asc(mid(strarrRawEDID(tmpctr),&H10+1,1))
        tmpmfgyear=(asc(mid(strarrRawEDID(tmpctr),&H11+1,1)))+1990
        tmpmdt=month(dateadd("ww",tmpmfgweek,datevalue("1/1/" & tmpmfgyear))) & "/" & tmpmfgyear

    '**************************************************************
    'Coleta a versão do Edid
    '**************************************************************
        tmpEDIDMajorVer=asc(mid(strarrRawEDID(tmpctr),&H12+1,1))
        tmpEDIDRev=asc(mid(strarrRawEDID(tmpctr),&H13+1,1))
        tmpver=chr(48+tmpEDIDMajorVer) & "." & chr(48+tmpEDIDRev)

    '**************************************************************
    'Coleta o ID do mfg
    '**************************************************************
        tmpEDIDMfg=mid(strarrRawEDID(tmpctr),&H08+1,2)
            Char1=0 : Char2=0 : Char3=0
            Byte1=asc(left(tmpEDIDMfg,1))
            Byte2=asc(right(tmpEDIDMfg,1))

        If (Byte1and64) > 0then Char1=Char1+16
        If (Byte1and32) > 0then Char1=Char1+8
        If (Byte1and16) > 0then Char1=Char1+4
        If (Byte1and8) > 0then Char1=Char1+2
        If (Byte1and4) > 0then Char1=Char1+1
        If (Byte1and2) > 0then Char2=Char2+16
        If (Byte1and1) > 0then Char2=Char2+8
        If (Byte2and128) > 0then Char2=Char2+4
        If (Byte2and64) > 0then Char2=Char2+2
        If (Byte2and32) > 0then Char2=Char2+1
            Char3=Char3+(Byte2and16)
            Char3=Char3+(Byte2and8)
            Char3=Char3+(Byte2and4)
            Char3=Char3+(Byte2and2)
            Char3=Char3+(Byte2and1)
            tmpmfg=chr(Char1+64) & chr(Char2+64) & chr(Char3+64)

    '**************************************************************
    'Coleta o ID do monitor
    '**************************************************************
        tmpEDIDDev1=hex(asc(mid(strarrRawEDID(tmpctr),&H0a+1,1)))
        tmpEDIDDev2=hex(asc(mid(strarrRawEDID(tmpctr),&H0b+1,1)))
        
            Iflen(tmpEDIDDev1)=1then tmpEDIDDev1="0" & tmpEDIDDev1
            Iflen(tmpEDIDDev2)=1then tmpEDIDDev2="0" & tmpEDIDDev2
                tmpdev=tmpEDIDDev2 & tmpEDIDDev1

    '**************************************************************
    'Memoriza na matriz os valores coletados.
    '**************************************************************
            IfNot InArray(tmpser,arrMonitorInfo,3) Then
                arrMonitorInfo(tmpctr,0)=tmpmfg
                arrMonitorInfo(tmpctr,1)=tmpdev
                arrMonitorInfo(tmpctr,2)=tmpmdt
                arrMonitorInfo(tmpctr,3)=tmpser
                arrMonitorInfo(tmpctr,4)=tmpmdl
                arrMonitorInfo(tmpctr,5)=tmpVer
            EndIf
        EndIf
    Next

    '************************************************************************************
    '************************************************************************************ 
    i = 0
        For tmpctr = 0to intMonitorCount-1
        If arrMonitorInfo(tmpctr,1) <> ""And arrMonitorInfo(tmpctr,0) <> "PNP"Then
            If batchThen
                EchoAndLog strComputer & "," & arrMonitorInfo(tmpctr,4) & "," & _
                arrMonitorInfo(tmpctr,3)& "," & arrMonitorInfo(tmpctr,0) & "," & _
                arrMonitorInfo(tmpctr,2)
            Else
                message = message & _
                "Computer: " & strComputer & vbCrLf & _
                "Model Name: " & arrMonitorInfo(tmpctr,4) & VbCrLf & _
                "Serial Number: " & arrMonitorInfo(tmpctr,3)& VbCrLf & _
                "VESA Manufacturer ID: " & arrMonitorInfo(tmpctr,0)& VbCrLf & _
                "Manufacture Date: " & arrMonitorInfo(tmpctr,2) & VbCrLf & _
                "Device ID: " & arrMonitorInfo(tmpctr,1) & VbCrLf & _
                "EDID Version: " & arrMonitorInfo(tmpctr,5)
    i = i + 1
            EndIf
        EndIf
    Next

    '************************************************************************************
    'display / log
    '************************************************************************************
    'Wscript.Echo message

            strArquivo = "c:\temp\" & strComputer & ".log"
            Set objFSO = CreateObject("Scripting.FileSystemObject")
            Set objTextFile = objFSO.OpenTextFile(strArquivo, 8, True)
                objTextFile.WriteLine"*********************************"        
                objTextFile.WriteLine message
                objTextFile.WriteLine"*********************************"
                objTextFile.WriteLine" "
            objTextFile.Close

    '************************************************************************************
    'Função
    '************************************************************************************
    Function InArray(strValue,List,Col)
        For i = 0toUBound(List)
            If List(i,col) = cstr(strValue) Then
                InArray = True
                    ExitFunction
            EndIf
        Next
        InArray = False
    EndFunction


    • Editado Marcelo TI quinta-feira, 7 de fevereiro de 2013 21:06
    • Marcado como Resposta andre080310 sexta-feira, 8 de fevereiro de 2013 13:35
    quinta-feira, 7 de fevereiro de 2013 21:02

Todas as Respostas

  • André,

    Bom, tem esta linha:

    'logfile = wshShell.ExpandEnvironmentStrings("%userprofile%") & "\Downloads\MonitorInfo.csv"


    Parece ser a linha que define o arquivo de log, está comentada então não funciona. Troque ela por isto

    logfile = wshShell.ExpandEnvironmentStrings("%userprofile%") & "\Downloads\" & strComputer & ".log"

    Dica:

    Procure indentar o código, fica muito dificil ler o código do jeito que está, ainda mais com muitas linhas. Eu só li o inicio do código nem procurei ver como o arquivo é escrito.

    Indentação

    http://pt.wikipedia.org/wiki/Indenta%C3%A7%C3%A3o


    Fábio de Paula Junior

    • Marcado como Resposta andre080310 quinta-feira, 7 de fevereiro de 2013 12:07
    quarta-feira, 6 de fevereiro de 2013 20:29
    Moderador
  • Tem mais uma coisa:

    Altere a linha

    batch = False

    por

    batch = True

    Senão não gera o arquivo. Tem outras formas de fazer mas o código está muito mexido.


    Fábio de Paula Junior

    • Marcado como Resposta andre080310 quinta-feira, 7 de fevereiro de 2013 12:07
    quarta-feira, 6 de fevereiro de 2013 20:38
    Moderador
  • Fábio Jr, bom dia.

    Primeiramente, obrigado pelo retorno, funcionou.

    Queria dizer que não fui eu que criei esse código, não sei programar, por isso pedi ajuda aqui no Fórum.

    Agora que o log esta sendo gerado, gostaria e já tentei mudar, mas sem sucesso, o modelo de saída, queria que ficasse um pouco mais "apresentável":

    Segue como esta o resultado no momento:

    Computer: PBR001001-TESTE
    Model 
    Serial # 
    Vendor ID 
    Manufacture Date 
    Messages
    PBR001001-TESTE,SyncMaster,HQAP805108,SAM,8/2007

    Como gostaria que ficasse:

    Computer: PBR001001-TESTE
    Model: SyncMaster
    Serial: HQAP805108

    Pra mim é importante apenas o Hostname / Modelo e Serial.

    Segue o código como esta no momento:

    Option Explicit
    Dim WshShell
    Set WshShell = WScript.CreateObject("WScript.Shell")
    Dim strComputer, message

    Dim intMonitorCount
    Dim oRegistry, sBaseKey, sBaseKey2, sBaseKey3, skey, skey2, skey3
    Dim sValue
    dim i, iRC, iRC2, iRC3
    Dim arSubKeys, arSubKeys2, arSubKeys3, arrintEDID
    Dim strRawEDID
    Dim ByteValue, strSerFind, strMdlFind
    Dim intSerFoundAt, intMdlFoundAt, findit
    Dim tmp, tmpser, tmpmdl, tmpctr
    Dim batch, bHeader
    batch = True

    If WScript.Arguments.Count = 1 Then
    strComputer = WScript.Arguments(0)
    ' batch = True
    Else
    strComputer = wshShell.ExpandEnvironmentStrings("")
    strComputer = ""
    strComputer = InputBox("Digite o Nome do Computador: ","Infomações do Monitor",strComputer)
    End If

    If strcomputer = "" Then WScript.Quit
    strComputer = UCase(strComputer)

    If batch Then
    Dim fso,logfile, appendout
    'msgbox ("teste")
    logfile = wshShell.ExpandEnvironmentStrings("%userprofile%") & "\Downloads\" & strComputer & ".log"
    'arquivoLog.WriteLine("C:\Temp\")

    'setup Log
    Const ForAppend = 8
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FileExists(logfile) Then bHeader = True
    set appendout = fso.OpenTextFile(logfile, ForAppend, True)

    If bHeader Then

    appendout.writeline "Computer: " & strComputer & VbCrLf & "Model " & VbCrLf & "Serial # "  & VbCrLf & "Vendor ID "  & VbCrLf & "Manufacture Date "  & VbCrLf & "Messages"

    End If
    End If

    Dim strarrRawEDID()
    intMonitorCount=0
    Const HKLM = &H80000002 'HKEY_LOCAL_MACHINE
    'get a handle to the WMI registry object
    On Error Resume Next
    Set oRegistry = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "/root/default:StdRegProv")

    If Err <> 0 Then
    If batch Then
    EchoAndLog strComputer & ",,,,," & Err.Description
    Else
    Wscript.Echo "Failed. " & Err.Description,vbCritical + vbOKOnly,strComputer
    WScript.Quit
    End If
    End If


    sBaseKey = "SYSTEM\CurrentControlSet\Enum\DISPLAY\"
    'enumerate all the keys HKLM\SYSTEM\CurrentControlSet\Enum\DISPLAY\
    iRC = oRegistry.EnumKey(HKLM, sBaseKey, arSubKeys)
    For Each sKey In arSubKeys
    'we are now in the registry at the level of:
    'HKLM\SYSTEM\CurrentControlSet\Enum\DISPLAY\<VESA_Monitor_ID\
    'we need to dive in one more level and check the data of the "HardwareID" value
    sBaseKey2 = sBaseKey & sKey & "\"
    iRC2 = oRegistry.EnumKey(HKLM, sBaseKey2, arSubKeys2)
    For Each sKey2 In arSubKeys2
    'now we are at the level of:
    'HKLM\SYSTEM\CurrentControlSet\Enum\DISPLAY\<VESA_Monitor_ID\<PNP_ID>\
    'so we can check the "HardwareID" value
    oRegistry.GetMultiStringValue HKLM, sBaseKey2 & sKey2 & "\", "HardwareID", sValue
    for tmpctr=0 to ubound(svalue)
    If lcase(left(svalue(tmpctr),8))="monitor\" then
    'If it is a monitor we will check for the existance of a control subkey
    'that way we know it is an active monitor
    sBaseKey3 = sBaseKey2 & sKey2 & "\"
    iRC3 = oRegistry.EnumKey(HKLM, sBaseKey3, arSubKeys3)
    For Each sKey3 In arSubKeys3
    'Kaplan edit
    strRawEDID = ""
    If skey3="Control" Then
    'If the Control sub-key exists then we should read the edid info
    oRegistry.GetBinaryValue HKLM, sbasekey3 & "Device Parameters\", "EDID", arrintEDID
    If vartype(arrintedid) <> 8204 then 'and If we don't find it...
    strRawEDID="EDID Not Available" 'store an "unavailable message
    else
    for each bytevalue in arrintedid 'otherwise conver the byte array from the registry into a string (for easier processing later)
    strRawEDID=strRawEDID & chr(bytevalue)
    Next
    End If
    'now take the string and store it in an array, that way we can support multiple monitors
    redim preserve strarrRawEDID(intMonitorCount)
    strarrRawEDID(intMonitorCount)=strRawEDID
    intMonitorCount=intMonitorCount+1
    End If
    Next
    End If
    Next
    Next
    Next
    '*****************************************************************************************
    'now the EDID info for each active monitor is stored in an array of strings called strarrRawEDID
    'so we can process it to get the good stuff out of it which we will store in a 5 dimensional array
    'called arrMonitorInfo, the dimensions are as follows:
    '0=VESA Mfg ID, 1=VESA Device ID, 2=MFG Date (M/YYYY),3=Serial Num (If available),4=Model Descriptor
    '5=EDID Version
    '*****************************************************************************************
    On Error Resume Next
    dim arrMonitorInfo()
    redim arrMonitorInfo(intMonitorCount-1,5)
    dim location(3)
    for tmpctr=0 to intMonitorCount-1
    If strarrRawEDID(tmpctr) <> "EDID Not Available" then
    '*********************************************************************
    'first get the model and serial numbers from the vesa descriptor
    'blocks in the edid. the model number is required to be present
    'according to the spec. (v1.2 and beyond)but serial number is not
    'required. There are 4 descriptor blocks in edid at offset locations
    '&H36 &H48 &H5a and &H6c each block is 18 bytes long
    '*********************************************************************
    location(0)=mid(strarrRawEDID(tmpctr),&H36+1,18)
    location(1)=mid(strarrRawEDID(tmpctr),&H48+1,18)
    location(2)=mid(strarrRawEDID(tmpctr),&H5a+1,18)
    location(3)=mid(strarrRawEDID(tmpctr),&H6c+1,18)

    'you can tell If the location contains a serial number If it starts with &H00 00 00 ff
    strSerFind=chr(&H00) & chr(&H00) & chr(&H00) & chr(&Hff)
    'or a model description If it starts with &H00 00 00 fc
    strMdlFind=chr(&H00) & chr(&H00) & chr(&H00) & chr(&Hfc)

    intSerFoundAt=-1
    intMdlFoundAt=-1
    for findit = 0 to 3
    If instr(location(findit),strSerFind)>0 then
    intSerFoundAt=findit
    End If
    If instr(location(findit),strMdlFind)>0 then
    intMdlFoundAt=findit
    End If
    Next

    'If a location containing a serial number block was found then store it
    If intSerFoundAt<>-1 then
    tmp=right(location(intSerFoundAt),14)
    If instr(tmp,chr(&H0a))>0 then
    tmpser=trim(left(tmp,instr(tmp,chr(&H0a))-1))
    Else
    tmpser=trim(tmp)
    End If
    'although it is not part of the edid spec it seems as though the
    'serial number will frequently be preceeded by &H00, this
    'compensates for that
    If left(tmpser,1)=chr(0) then tmpser=right(tmpser,len(tmpser)-1)
    else
    tmpser="Not Found"
    End If

    'If a location containing a model number block was found then store it
    If intMdlFoundAt<>-1 then
    tmp=right(location(intMdlFoundAt),14)
    If instr(tmp,chr(&H0a))>0 then
    tmpmdl=trim(left(tmp,instr(tmp,chr(&H0a))-1))
    else
    tmpmdl=trim(tmp)
    End If
    'although it is not part of the edid spec it seems as though the
    'serial number will frequently be preceeded by &H00, this
    'compensates for that
    If left(tmpmdl,1)=chr(0) then tmpmdl=right(tmpmdl,len(tmpmdl)-1)
    else
    tmpmdl="Not Found"
    End If

    '**************************************************************
    'Next get the mfg date
    '**************************************************************
    Dim tmpmfgweek,tmpmfgyear,tmpmdt
    'the week of manufacture is stored at EDID offset &H10
    tmpmfgweek=asc(mid(strarrRawEDID(tmpctr),&H10+1,1))

    'the year of manufacture is stored at EDID offset &H11
    'and is the current year -1990
    tmpmfgyear=(asc(mid(strarrRawEDID(tmpctr),&H11+1,1)))+1990

    'store it in month/year format
    tmpmdt=month(dateadd("ww",tmpmfgweek,datevalue("1/1/" & tmpmfgyear))) & "/" & tmpmfgyear

    '**************************************************************
    'Next get the edid version
    '**************************************************************
    'the version is at EDID offset &H12
    Dim tmpEDIDMajorVer, tmpEDIDRev, tmpVer
    tmpEDIDMajorVer=asc(mid(strarrRawEDID(tmpctr),&H12+1,1))

    'the revision level is at EDID offset &H13
    tmpEDIDRev=asc(mid(strarrRawEDID(tmpctr),&H13+1,1))

    'store it in month/year format
    tmpver=chr(48+tmpEDIDMajorVer) & "." & chr(48+tmpEDIDRev)

    '**************************************************************
    'Next get the mfg id
    '**************************************************************
    '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
    Dim tmpEDIDMfg, tmpMfg
    dim Char1, Char2, Char3
    Dim Byte1, Byte2
    tmpEDIDMfg=mid(strarrRawEDID(tmpctr),&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)

    '**************************************************************
    'Next get the device id
    '**************************************************************
    '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
    Dim tmpEDIDDev1, tmpEDIDDev2, tmpDev

    tmpEDIDDev1=hex(asc(mid(strarrRawEDID(tmpctr),&H0a+1,1)))
    tmpEDIDDev2=hex(asc(mid(strarrRawEDID(tmpctr),&H0b+1,1)))
    If len(tmpEDIDDev1)=1 then tmpEDIDDev1="0" & tmpEDIDDev1
    If len(tmpEDIDDev2)=1 then tmpEDIDDev2="0" & tmpEDIDDev2
    tmpdev=tmpEDIDDev2 & tmpEDIDDev1

    '**************************************************************
    'finally store all the values into the array
    '**************************************************************
    'Kaplan adds code to avoid duplication...

    If Not InArray(tmpser,arrMonitorInfo,3) Then
    arrMonitorInfo(tmpctr,0)=tmpmfg
    arrMonitorInfo(tmpctr,1)=tmpdev
    arrMonitorInfo(tmpctr,2)=tmpmdt
    arrMonitorInfo(tmpctr,3)=tmpser
    arrMonitorInfo(tmpctr,4)=tmpmdl
    arrMonitorInfo(tmpctr,5)=tmpVer
    End If
    End If
    Next

    'For now just a simple screen print will suffice for output.
    'But you could take this output and write it to a database or a file
    'and in that way use it for asset management.
    i = 0
    for tmpctr = 0 to intMonitorCount-1
    If arrMonitorInfo(tmpctr,1) <> "" And arrMonitorInfo(tmpctr,0) <> "PNP" Then
    If batch Then
    EchoAndLog strComputer & "," & arrMonitorInfo(tmpctr,4) & "," & _
    arrMonitorInfo(tmpctr,3)& "," & arrMonitorInfo(tmpctr,0) & "," & _
    arrMonitorInfo(tmpctr,2)
    Else
    message = message & "Monitor " & chr(i+65) & ")" & VbCrLf & _
    "Model Name: " & arrMonitorInfo(tmpctr,4) & VbCrLf & _
    "Serial Number: " & arrMonitorInfo(tmpctr,3)& VbCrLf & _
    "VESA Manufacturer ID: " & arrMonitorInfo(tmpctr,0) & VbCrLf & _
    "Manufacture Date: " & arrMonitorInfo(tmpctr,2) & VbCrLf & VbCrLf
    'wscript.echo ".........." & "Device ID: " & arrMonitorInfo(tmpctr,1)
    'wscript.echo ".........." & "EDID Version: " & arrMonitorInfo(tmpctr,5)
    i = i + 1
    End If
    End If
    Next

    If not batch Then
    Wscript.Echo message, vbInformation + vbOKOnly,strComputer & " Monitor Info"
    End If

    Function InArray(strValue,List,Col)
    Dim i
    For i = 0 to UBound(List)
    If List(i,col) = cstr(strValue) Then
    InArray = True
    Exit Function
    End If
    Next
    InArray = False
    End Function

    Sub EchoAndLog (message)
    'Echo output and write to log
    Wscript.Echo message
    AppendOut.WriteLine message
    End Sub

    Obrigado.








    quinta-feira, 7 de fevereiro de 2013 12:14
  • Andre

    Tente assim tche, acho que seria melhor para te atender o que vc necessita tche.


    Onerrorresumenext

    strComputer = "."
        If strComputer <> ""Then
            Set objWMIService = GetObject("winmgmts:" & _
                "!\\" & strComputer & "\root\cimv2")
            Set colAdapters = objWMIService.ExecQuery _
                ("Select * from Win32_NetworkAdapterConfiguration Where IPEnabled = True")

            Set colBIOS = objWMIService.ExecQuery("Select * from Win32_BIOS")
            Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_ComputerSystem")
            Set colOSes = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")

    '-------------------------------------------------------------------------------------------------------------------------------------
            ForEach objAdapterin colAdapters
            ForEach objOSin colOSes
            ForEach objbiosIn colBIOS
            ForEach objItemIn colItems
            
    '-------------------------------------------------------------------------------------------------------------------------------------
    'log de escrita.

            strArquivo = "c:\temp\log.log"
            Set objFSO = CreateObject("Scripting.FileSystemObject")
            Set objTextFile = objFSO.OpenTextFile(strArquivo, 2, True)

            objTextFile.WriteLine"*********************************"        
            objTextFile.WriteLineTrim(ucase("Computer: " & objAdapter.DNSHostName))
            objTextFile.WriteLineTrim(ucase("Fabricante: " & objItem.Manufacturer))
            objTextFile.WriteLineTrim(ucase("Model: " & objItem.Model))
            objTextFile.WriteLineTrim(ucase("Serial: " & objbios.SerialNumber))
            objTextFile.WriteLine"*********************************"
            objTextFile.WriteLine" "
            objTextFile.Close
                        Next
                    Next
                Next
            Next

    EndIf

    • Editado Marcelo TI quinta-feira, 7 de fevereiro de 2013 14:27
    quinta-feira, 7 de fevereiro de 2013 14:26
  • Marcelo Boa tarde.

    As informações estão num layout bom, é desse jeito mesmo que preciso, mas tenho algumas observações:

    Preciso do Modelo e Serial do monitor - No seu veio da CPU

    Preciso coletar essas informações em rede - No seu esta localmente

    Preciso que o nome do Log seja Hostname.log

    Conseguiria implantar no seu script acima?

    Obrigado desde já.

    quinta-feira, 7 de fevereiro de 2013 15:04
  • Ba André, pensei que estava falando da CPU, vou tentar fazer aqui tche e já te passo.
    quinta-feira, 7 de fevereiro de 2013 19:24
  • Ba André, segue o mostrinho tche......

    obs. no message = message & _ vc controla tche o que vai sair no log, é só comentar a linha do que vc não quer.


    Const HKLM = &H80000002
    OnErrorResumeNext

    Dim WshShell, strComputer, message, tmpmfgweek, tmpmfgyear, tmpmdt, tmpEDIDMajorVer, tmpEDIDRev, tmpVer
    Dim arrMonitorInfo(), strarrRawEDID(), intMonitorCount, oRegistry, sBaseKey, sBaseKey2, sBaseKey3, skey, skey2, skey3
    Dim sValue, i, iRC, iRC2, iRC3, arSubKeys, arSubKeys2, arSubKeys3, arrintEDID, strRawEDID, ByteValue, strSerFind
    Dim intSerFoundAt, intMdlFoundAt, findit, tmp, tmpser, tmpmdl, tmpctr, batch, bHeader, location(3), strMdlFind
    Dim Char1, Char2, Char3, Byte1, Byte2, tmpEDIDDev1, tmpEDIDDev2, tmpDev, tmpEDIDMfg, tmpMfg

    Set WshShell = WScript.CreateObject("WScript.Shell")
    batch = False

        If WScript.Arguments.Count = 1Then
            strComputer = WScript.Arguments(0)
            batch = True
        Else
            strComputer = wshShell.ExpandEnvironmentStrings("")
            strComputer = ""
            strComputer = InputBox("Digite o Nome do Computador: ","Infomações do Monitor",strComputer)
        EndIf
    '--------------------------------------------------------------------------------------------------------
    intMonitorCount=0
    Set oRegistry = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "/root/default:StdRegProv")

        IfErr <> 0Then
            If batchThen
                    EchoAndLog strComputer & ",,,,," & Err.Description
                Else
                    WScript.Echo"Failed. " & Err.Description,vbCritical + vbOKOnly,strComputer
                    WScript.Quit
            EndIf
        EndIf

    sBaseKey = "SYSTEM\CurrentControlSet\Enum\DISPLAY\"
    iRC = oRegistry.EnumKey(HKLM, sBaseKey, arSubKeys)

        ForEach sKeyIn arSubKeys
            sBaseKey2 = sBaseKey & sKey & "\"
            iRC2 = oRegistry.EnumKey(HKLM, sBaseKey2, arSubKeys2)
        ForEach sKey2In arSubKeys2
            oRegistry.GetMultiStringValue HKLM, sBaseKey2 & sKey2 & "\", "HardwareID", sValue
        For tmpctr=0toubound(svalue)
                    Iflcase(left(svalue(tmpctr),8))="monitor\"then
                        sBaseKey3 = sBaseKey2 & sKey2 & "\"
                        iRC3 = oRegistry.EnumKey(HKLM, sBaseKey3, arSubKeys3)
        ForEach sKey3In arSubKeys3
            strRawEDID = ""
                        If skey3="Control"Then
                            oRegistry.GetBinaryValue HKLM, sbasekey3 & "Device Parameters\", "EDID", arrintEDID
                            Ifvartype(arrintedid) <> 8204then
                                    strRawEDID="EDID Not Available"
                                Else
                                Foreach bytevaluein arrintedid
                                    strRawEDID=strRawEDID & chr(bytevalue)
                                Next
                            EndIf
        ReDimpreserve strarrRawEDID(intMonitorCount)
            strarrRawEDID(intMonitorCount)=strRawEDID
            intMonitorCount=intMonitorCount+1
                        EndIf
                    Next
                EndIf
            Next
        Next
    Next
    '*****************************************************************************************
    '*****************************************************************************************
    'On Error Resume Next
        redim arrMonitorInfo(intMonitorCount-1,5)

        For tmpctr=0to intMonitorCount-1
        If strarrRawEDID(tmpctr) <> "EDID Not Available"Then
            location(0)=mid(strarrRawEDID(tmpctr),&H36+1,18)
            location(1)=mid(strarrRawEDID(tmpctr),&H48+1,18)
            location(2)=mid(strarrRawEDID(tmpctr),&H5a+1,18)
            location(3)=mid(strarrRawEDID(tmpctr),&H6c+1,18)
            strSerFind=chr(&H00) & chr(&H00) & chr(&H00) & chr(&Hff)
            strMdlFind=chr(&H00) & chr(&H00) & chr(&H00) & chr(&Hfc)
            intSerFoundAt=-1
            intMdlFoundAt=-1
        For findit = 0to3
        Ifinstr(location(findit),strSerFind)>0then
            intSerFoundAt=findit
        EndIf
        Ifinstr(location(findit),strMdlFind)>0then
            intMdlFoundAt=findit
        EndIf
    Next

        If intSerFoundAt<>-1then
            tmp=right(location(intSerFoundAt),14)
        Ifinstr(tmp,chr(&H0a))>0then
            tmpser=trim(left(tmp,instr(tmp,chr(&H0a))-1))
        Else
            tmpser=trim(tmp)
        EndIf
        
        Ifleft(tmpser,1)=chr(0) then tmpser=right(tmpser,len(tmpser)-1)
        Else
            tmpser="Not Found"
        EndIf

        If intMdlFoundAt<>-1then
            tmp=right(location(intMdlFoundAt),14)
        Ifinstr(tmp,chr(&H0a))>0then
            tmpmdl=trim(left(tmp,instr(tmp,chr(&H0a))-1))
        Else
            tmpmdl=trim(tmp)
        EndIf

        Ifleft(tmpmdl,1)=chr(0) then tmpmdl=right(tmpmdl,len(tmpmdl)-1)
        Else
            tmpmdl="Not Found"
        EndIf

    '**************************************************************
    'Coleta data do MFG
    '**************************************************************
        tmpmfgweek=asc(mid(strarrRawEDID(tmpctr),&H10+1,1))
        tmpmfgyear=(asc(mid(strarrRawEDID(tmpctr),&H11+1,1)))+1990
        tmpmdt=month(dateadd("ww",tmpmfgweek,datevalue("1/1/" & tmpmfgyear))) & "/" & tmpmfgyear

    '**************************************************************
    'Coleta a versão do Edid
    '**************************************************************
        tmpEDIDMajorVer=asc(mid(strarrRawEDID(tmpctr),&H12+1,1))
        tmpEDIDRev=asc(mid(strarrRawEDID(tmpctr),&H13+1,1))
        tmpver=chr(48+tmpEDIDMajorVer) & "." & chr(48+tmpEDIDRev)

    '**************************************************************
    'Coleta o ID do mfg
    '**************************************************************
        tmpEDIDMfg=mid(strarrRawEDID(tmpctr),&H08+1,2)
            Char1=0 : Char2=0 : Char3=0
            Byte1=asc(left(tmpEDIDMfg,1))
            Byte2=asc(right(tmpEDIDMfg,1))

        If (Byte1and64) > 0then Char1=Char1+16
        If (Byte1and32) > 0then Char1=Char1+8
        If (Byte1and16) > 0then Char1=Char1+4
        If (Byte1and8) > 0then Char1=Char1+2
        If (Byte1and4) > 0then Char1=Char1+1
        If (Byte1and2) > 0then Char2=Char2+16
        If (Byte1and1) > 0then Char2=Char2+8
        If (Byte2and128) > 0then Char2=Char2+4
        If (Byte2and64) > 0then Char2=Char2+2
        If (Byte2and32) > 0then Char2=Char2+1
            Char3=Char3+(Byte2and16)
            Char3=Char3+(Byte2and8)
            Char3=Char3+(Byte2and4)
            Char3=Char3+(Byte2and2)
            Char3=Char3+(Byte2and1)
            tmpmfg=chr(Char1+64) & chr(Char2+64) & chr(Char3+64)

    '**************************************************************
    'Coleta o ID do monitor
    '**************************************************************
        tmpEDIDDev1=hex(asc(mid(strarrRawEDID(tmpctr),&H0a+1,1)))
        tmpEDIDDev2=hex(asc(mid(strarrRawEDID(tmpctr),&H0b+1,1)))
        
            Iflen(tmpEDIDDev1)=1then tmpEDIDDev1="0" & tmpEDIDDev1
            Iflen(tmpEDIDDev2)=1then tmpEDIDDev2="0" & tmpEDIDDev2
                tmpdev=tmpEDIDDev2 & tmpEDIDDev1

    '**************************************************************
    'Memoriza na matriz os valores coletados.
    '**************************************************************
            IfNot InArray(tmpser,arrMonitorInfo,3) Then
                arrMonitorInfo(tmpctr,0)=tmpmfg
                arrMonitorInfo(tmpctr,1)=tmpdev
                arrMonitorInfo(tmpctr,2)=tmpmdt
                arrMonitorInfo(tmpctr,3)=tmpser
                arrMonitorInfo(tmpctr,4)=tmpmdl
                arrMonitorInfo(tmpctr,5)=tmpVer
            EndIf
        EndIf
    Next

    '************************************************************************************
    '************************************************************************************ 
    i = 0
        For tmpctr = 0to intMonitorCount-1
        If arrMonitorInfo(tmpctr,1) <> ""And arrMonitorInfo(tmpctr,0) <> "PNP"Then
            If batchThen
                EchoAndLog strComputer & "," & arrMonitorInfo(tmpctr,4) & "," & _
                arrMonitorInfo(tmpctr,3)& "," & arrMonitorInfo(tmpctr,0) & "," & _
                arrMonitorInfo(tmpctr,2)
            Else
                message = message & _
                "Computer: " & strComputer & vbCrLf & _
                "Model Name: " & arrMonitorInfo(tmpctr,4) & VbCrLf & _
                "Serial Number: " & arrMonitorInfo(tmpctr,3)& VbCrLf & _
                "VESA Manufacturer ID: " & arrMonitorInfo(tmpctr,0)& VbCrLf & _
                "Manufacture Date: " & arrMonitorInfo(tmpctr,2) & VbCrLf & _
                "Device ID: " & arrMonitorInfo(tmpctr,1) & VbCrLf & _
                "EDID Version: " & arrMonitorInfo(tmpctr,5)
    i = i + 1
            EndIf
        EndIf
    Next

    '************************************************************************************
    'display / log
    '************************************************************************************
    'Wscript.Echo message

            strArquivo = "c:\temp\" & strComputer & ".log"
            Set objFSO = CreateObject("Scripting.FileSystemObject")
            Set objTextFile = objFSO.OpenTextFile(strArquivo, 8, True)
                objTextFile.WriteLine"*********************************"        
                objTextFile.WriteLine message
                objTextFile.WriteLine"*********************************"
                objTextFile.WriteLine" "
            objTextFile.Close

    '************************************************************************************
    'Função
    '************************************************************************************
    Function InArray(strValue,List,Col)
        For i = 0toUBound(List)
            If List(i,col) = cstr(strValue) Then
                InArray = True
                    ExitFunction
            EndIf
        Next
        InArray = False
    EndFunction


    • Editado Marcelo TI quinta-feira, 7 de fevereiro de 2013 21:06
    • Marcado como Resposta andre080310 sexta-feira, 8 de fevereiro de 2013 13:35
    quinta-feira, 7 de fevereiro de 2013 21:02
  • Marcelo TI.

    Bom dia.

    Muito obrigado, é isso mesmo que eu precisava, esta perfeito.

    Mais uma vez. muito obrigado.

    sexta-feira, 8 de fevereiro de 2013 13:35