alur2005
Advanced Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
'********************************************************************
'*
'* File: InfoPC.vbs
'* Created: 2007.17.04
'* Version: 1.0
'*
'********************************************************************-->
'Процедура запуска внешней программы
Set WshNetwork = WScript.CreateObject("WScript.Network")
Sub NetSend(Application, Wait)
Set WSHShell = WScript.CreateObject("WScript.Shell")
X = WSHShell.Run(Application, 0, Wait)
End Sub
'_________________________________________________________________________
'Подождем на всякий случай 5 секунд
WScript.Sleep 5000
InfoUser = "Имя пользователя : " & WshNetwork.UserName
'Chr(10) - это переход на новую строку
info = InfoUser & Chr(10)
info = info & "Имя компьютера : " & WshNetwork.ComputerName
info = info & Chr(10)
info = info & "Вход в домен : " & WshNetwork.UserDomain
'____________________________Работа с ключом Windows_____________________________________________
Set WshShell = WScript.CreateObject("WScript.Shell")
strDigitalProductId="HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\DigitalProductId"
'strOffXPRU="HKLM\SOFTWARE\Microsoft\Office\10.0\Registration\{91110419-6000-11D3-8CFE-0050048383C9}\DigitalProductId"
strXPKey=GetKey(WshShell.RegRead(strDigitalProductId))
'strOffXPRUKey=GetKey(WshShell.RegRead(strOffXPRU))
'CopytoClipboard
set ie=CreateObject("internetExplorer.application")
ie.navigate "about:blank"
do until ie.readystate=4: wscript.sleep 1: loop
ie.document.parentwindow.clipboardData.setData "Text", strXPKey
'MsgBox "WinXP:"&strXPKey&chr(13)&_
'"key in clipboard"
' "OffXP:"&strOffXPRUKey
Function GetKey(rpk)
Const rpkOffset=52:i=28
szPossibleChars="BCDFGHJKMPQRTVWXY2346789"
Do 'Rep1
dwAccumulator=0 : j=14
Do
dwAccumulator=dwAccumulator*256
dwAccumulator=rpk(j+rpkOffset)+dwAccumulator
rpk(j+rpkOffset)=(dwAccumulator\24) and 255
dwAccumulator=dwAccumulator Mod 24
j=j-1
Loop While j>=0
i=i-1 : szProductKey=mid(szPossibleChars,dwAccumulator+1,1)&szProductKey
if (((29-i) Mod 6)=0) and (i<>-1) then
i=i-1 : szProductKey="-"&szProductKey
End If
Loop While i>=0 'Goto Rep1
GetKey=szProductKey
End Function
'____________________________Работа с ключом Windows ID _____________________________________________
Set SNSet = GetObject("winmgmts:").InstancesOf ("Win32_OperatingSystem")
for each SN in SNSet
'_________Запись значений в файл Имя пользователя,Домен,Имя компьютера,Серийный номер,ID продукт_________
Set fso = CreateObject("Scripting.FileSystemObject")
Set file = fso.OpenTextFile("c:\PCinfo.txt", 8, true)
file.WriteLine(info)
file.Write("Ключ продукта :")
file.WriteLine(strXPKey)
file.Write("ID продукта :")
file.WriteLine(SN.SerialNumber)
file.WriteBlankLines(2)
file.Close
next
'InfoUserSend = "net send ComputeName" & " User :" & WshNetwork.UserName & Chr(10) & " ..."
'Call NetSend(InfoUserSend, True)
|
Всего записей: 824 | Зарегистр. 06-09-2005 | Отправлено: 14:27 16-04-2007 | Исправлено: alur2005, 13:58 17-04-2007 |
|
