+ Ответить в теме
Показано с 1 по 2 из 2

Тема: WMI VBScript

  1. #1
    Новичок Ton4arik на пути к лучшему Аватар для Ton4arik
    Регистрация
    20.11.2011
    Адрес
    Россия, г. Казань
    Сообщений
    10

    Печаль WMI VBScript

    У меня есть вот такая смесь vbs+html в hta. Она собирает информацию о железе и отправляет её на сайт get'ом. Моя проблема заключается в том, чтобы этот кусочек кода:
    On Error Resume Next Set objService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\CIMV2") If Err.Number <> 0 Then     WScript.Echo Err.Number & ": " & Err.Description     WScript.Quit End If For Each objVideo In objService.ExecQuery("SELECT * FROM Win32_VideoController")     WScript.Echo objVideo.CurrentBitsPerPixel 'качество цветопередачи (количество бит на пиксель) Next

    Вставить в этот hta (код будет ниже). И качество цветопередачи приравнять к gpu. Вместо этого отправляется пустая get переменная.

    <html>
    <head>
    <meta http-equiv="Content-Type" content="text/html; charset=windows-1251" />
    <title>1</title>

    <hta:application id="hta"
    applicationName="check"
    showInTaskbar="yes"
    windowState="normal"
    navigable="yes"
    singleInstance="yes"
    contextMenu="no"
    selection="yes"
    version="1.0" />

    <style>
    <!--
    body {
    padding: 8px;
    font-family: Arial, Helvetica, sans-serif;
    background: #918d1d; /* Old browsers */
    background: -moz-radial-gradient(center, ellipse cover, #918d1d 0%, #b2ce35 28%, #b2ce35 32%, #696b19 100%); /* FF3.6+ */
    background: -webkit-gradient(radial, center center, 0px, center center, 100%, color-stop(0%,#918d1d), color-stop(28%,#b2ce35), color-stop(32%,#b2ce35), color-stop(100%,#696b19)); /* Chrome,Safari4+ */
    background: -webkit-radial-gradient(center, ellipse cover, #918d1d 0%,#b2ce35 28%,#b2ce35 32%,#696b19 100%); /* Chrome10+,Safari5.1+ */
    background: -o-radial-gradient(center, ellipse cover, #918d1d 0%,#b2ce35 28%,#b2ce35 32%,#696b19 100%); /* Opera 12+ */
    background: -ms-radial-gradient(center, ellipse cover, #918d1d 0%,#b2ce35 28%,#b2ce35 32%,#696b19 100%); /* IE10+ */
    background: radial-gradient(ellipse at center, #918d1d 0%,#b2ce35 28%,#b2ce35 32%,#696b19 100%); /* W3C */
    filter: progid:DXImageTransform.Microsoft.gradient( startColorstr='#918d1d', endColorstr='#696b19',GradientType=1 ); /* IE6-9 fallback on horizontal gradient */
    }
    h2
    {
    font-family: "Trebuchet MS", Helvetica, sans-serif;
    font-weight: normal;
    font-size: 20px;
    color: #6B8F00;
    }

    #but
    {
    border: 1px solid #9FB909;
    background: #A4BF09;
    font-size: 15px;
    padding: 5px 7px;
    color:#628000;
    margin-top: 5px;

    border-left: 4px solid #819707;
    }
    .main
    {
    padding: 10px;
    border: 1px solid green;
    background-image: url(http://localhost/site/css/bg.png);
    }

    -->
    </style>

    <script language="VBScript">
    <!--

    Sub OnLoad()
    Window.ResizeTo 420, 220
    Window.MoveTo (Screen.Width \ 2) - 320, (Screen.Height \ 2) - 280
    End Sub

    dim ozu,vozu,gpu,cpu,os
    'Set objComputer = CreateObject("Shell.LocalMachine")

    Set objWMIService = GetObject( "winmgmts://./root/cimv2" )

    Set colItems = objWMIService.ExecQuery( "Select * from Win32_ComputerSystem", "WQL", 48 )

    For Each objItem in colItems

    strComputer = objItem.Name

    Next



    Set colItems = objWMIService.ExecQuery("SELECT TotalVisibleMemorySize FROM Win32_OperatingSystem")

    If Err Then ShowError

    For Each objItem in colItems

    ozu = "ozu=" & round((((objItem.TotalVisibleMemorySize +1023) / 1024) / 1024),0)

    Next

    Dim sho, n, s
    Set sho = CreateObject("WScript.Shell")
    Const KEY = "HKLM\HARDWARE\DESCRIPTION\System\CentralProcessor\"
    On Error Resume Next
    n = 0 'номер процессора
    cpu = "" 'название процессора
    Do
    s = Trim(sho.RegRead(KEY & n & "\ProcessorNameString"))
    If Err.Number <> 0 Then Exit Do
    If s <> cpu Then cpu = s
    n = n + 1
    Loop
    'к названию процессора добавляется количество ядер
    If Len(cpu) > 0 Then
    If n > 1 Then cpu = cpu & "&cores=" & n
    frm.cpu.Value = cpu
    End If
    cpu = "&cpu=" & cpu




    '#######################################################################################################

    Set WshShell = CreateObject("WScript.Shell")
    regKey = "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\"
    DigitalProductId = WshShell.RegRead(regKey & "DigitalProductId")

    Win8ProductName = "Windows Product Name: " & WshShell.RegRead(regKey & "ProductName") & vbNewLine
    Win8ProductID = "Windows Product ID: " & WshShell.RegRead(regKey & "ProductID") & vbNewLine
    Win8ProductKey = ConvertToKey(DigitalProductId)
    strProductKey ="Windows 8 Key: " & Win8ProductKey
    Win8ProductID = Win8ProductName & Win8ProductID & strProductKey

    on error resume next

    Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

    Set colOperatingSystems = objWMIService.ExecQuery ("Select * from Win32_OperatingSystem")

    For Each objOperatingSystem in colOperatingSystems

    os = "&os=" & ltrim(objOperatingSystem.Caption)
    Next
    On Error Resume Next
    Set objService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\CIMV2")
    If Err.Number <> 0 Then
    WScript.Echo Err.Number & ": " & Err.Description
    WScript.Quit
    End If
    For Each objVideo In objService.ExecQuery("SELECT * FROM Win32_VideoController")
    gpu = "gpu=" & objVideo.CurrentBitsPerPixel 'качество цветопередачи (количество бит на пиксель)
    Next
    Sub Openlink
    Dim beg, clo, objWshShell
    cpu = Replace(cpu," ","%20")
    os = Replace(os," ","%20")
    Set objWshShell = CreateObject("WScript.Shell")
    beg ="http://localhost/site/ent.php?"
    clo= "'"
    objWshShell.Run beg & ozu & gpu & cpu & os, 1, False
    Set objWshShell = Nothing

    End Sub
    -->
    </script>
    </head>
    <body onload="OnLoad()">
    <div class="main">
    <h2>Сбор информации завершен!</h2>
    <input type='button' id="but" name='fRunLoad' value='Отправить' onclick='Openlink()'>
    </div>
    </body>
    </html>

  2. #2
    Sonu-Exchange is captivated to advance specific online coin exchange advantages despite dispatching a respectable and centered rates of exchange.. http://goo.gl/ILJMp9

+ Ответить в теме

Похожие темы

  1. Ответов: 2
    Последнее сообщение: 05.01.2014, 10:13
  2. VBscript
    от User2012 в разделе Прочие языки
    Ответов: 0
    Последнее сообщение: 28.07.2012, 14:13

Социальные закладки

Социальные закладки

Ваши права

  • Вы не можете создавать новые темы
  • Вы не можете отвечать в темах
  • Вы не можете прикреплять вложения
  • Вы не можете редактировать свои сообщения