У меня есть вот такая смесь 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>
