Const HKLM = &H80000002 'HKEY_LOCAL_MACHINE

strKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"

strEntry1a = "DisplayName"



Const ADS_UF_DONT_EXPIRE_PASSWD = &h10000

Const FOR_APPENDING = 8



strFecha = Date()

strHora = Time()

Set objComputer = CreateObject("WScript.NetWork")

strComputer =  objComputer.ComputerName

strSN = "na"

strType = "na"





Function FindUser(ByVal UserName, Byval Domain)

    on error resume Next



    set cn = createobject("ADODB.Connection")

    set cmd = createobject("ADODB.Command")

    set rs = createobject("ADODB.Recordset")



    cn.open "Provider=ADsDSOObject;"



    cmd.activeconnection=cn

    cmd.commandtext="SELECT ADsPath FROM 'LDAP://" & Domain & _

             "' WHERE sAMAccountName = '" & UserName & "'"



    set rs = cmd.execute



    if err<>0 then

        FindUser="Error connecting to Active Directory Database:" & err.description

    else

        if not rs.BOF and not rs.EOF then

                rs.MoveFirst

                FindUser = rs(0)

        else

            FindUser = "Not Found"

        end if

    end if

    cn.close

end Function





Function GetType (ByVal computerName)

On Error Resume Next

    If InStr (computerName,"WN")=0 Then

        GetType = DESKTOP

        Else

        GetType = NOTEBOOK

    End If

End Function





'Obtenemos la(s) IP(s)

Set objWMIService = GetObject("winmgmts:" _

    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")



Set IPConfigSet = objWMIService.ExecQuery _

    ("Select * from Win32_NetworkAdapterConfiguration Where IPEnabled=TRUE")



For Each IPConfig in IPConfigSet

    If Not IsNull(IPConfig.IPAddress) Then

        For i=LBound(IPConfig.IPAddress) To UBound(IPConfig.IPAddress)

            If IPConfig.IPAddress(i) <> "0.0.0.0" then

            strIPs=strIPs & " " & IPConfig.IPAddress(i)

            End if

        Next

    End If

Next



strLogPath = "\\2.13.76.31\deploy\inventory2011_dsc.xls"



'Sacamos informacion de Marca y modelo

Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")

Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_ComputerSystem")

For Each objItem In colItems



  strManufacturer = objItem.Manufacturer

  strModel = objItem.Model

  strRAM = objItem.TotalPhysicalMemory

  Next



'Sacamos informacion de SerialNumber

Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")

Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_ComputerSystemProduct")

For Each objItem In colItems

strSN = objItem.IdentifyingNumber

Next







'Sacamos el tipo de CPU

Set objWMIService = GetObject("winmgmts:" _

   & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

Set colItems = objWMIService.ExecQuery("Select * from Win32_Processor")



For Each objItem in colItems

strCPU = objItem.Name

Next



'Sacamos datos de SO

Set colOperatingSystems = objWMIService.ExecQuery _

    ("Select * from Win32_OperatingSystem")

For Each objOperatingSystem In colOperatingSystems

strOsver = objOperatingSystem.Version

strSP =objOperatingSystem.ServicePackMajorVersion

strOSInstallDate= objOperatingSystem.InstallDate



Next



'Sacamos datos del usuario

    strADPath=FindUser(objComputer.UserName,"prg-dc.dhl.com")

    On Error Resume Next

     Set objUser = GetObject _

     (strADPath)

      strEmail= objUser.userPrincipalName

      strDisplayName= objUser.displayName



'Comprobamos si tiene kea instalado



Set objReg = GetObject("winmgmts://" & strComputer & _

 "/root/default:StdRegProv")

objReg.EnumKey HKLM, strKey, arrSubkeys

strKeaInstalled = "NONE"

strTinyInstalled = "NONE"



For Each strSubkey In arrSubkeys

  intRet1 = objReg.GetStringValue(HKLM, strKey & strSubkey, _

   strEntry1a, strValue1)

  If intRet1 <> 0 Then

    objReg.GetStringValue HKLM, strKey & strSubkey, _

     strEntry1b, strValue1

  End If

  If strValue1 <> "" Then

    If InStr (strValue1,"KEAVT")=0 Then

       Else

       strKeaInstalled = "YES"

     End If



    If InStr (strValue1,"Tiny")=0 Then

       Else

       strTinyInstalled = "YES"

     End If



  End If

Next

'Preparamos el fichero de log





strContent=strComputer & vbTab & strManufacturer & vbTab & strModel & vbTab & strSN & vbTab & strIPs & vbTab & strCPU &vbTab& strRAM &vbTab& objComputer.UserDomain & vbTab & objComputer.UserName & vbTab

strContent=strContent & strDisplayName & vbTab &  strEmail & vbTab

strContent=strContent & strOsver &vbTab& strSP &vbTab& strOSInstallDate &vbTab& strFecha &vbTab& strKeaInstalled & vbTab & strTinyInstalled & vbLf



' Escribimos en el fichero

Set objFS = CreateObject("Scripting.FileSystemObject")

On Error Resume Next

Set objTS = objFS.OpenTextFile(strLogPath,FOR_APPENDING)

On Error Resume Next

objTS.Write strContent

On Error Resume Next