yazzi
Junior Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Код:
Option Explicit
Dim Name
Dim Version
Dim InstallDate
Dim HelpLink
Dim HelpTelephone
Dim Publisher
Dim StrTemp
Dim a
Dim Flag
Dim StrComputer
Dim objReg
Const HKEY_LOCAL_MASHINE=&H80000002
Const ForWriting = 2
' On Error Resume Next
StrComputer=InputBox("ВВедите имя компьютера", "ВВод имени компьютера")
StrTemp=""
Set objReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\"& strcomputer &"\root\default:StdRegProv")
GetSoftInfo "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"
Name=Split(Name,";",-1,1)
Version=Split(Version,";",-1,1)
InstallDate=Split(InstallDate,";",-1,1)
HelpLink=Split(HelpLink,";",-1,1)
HelpTelephone=Split(HelpTelephone,";",-1,1)
Publisher=Split(Publisher,";",-1,1)
StrTemp=""
a=0
Flag=False
While Flag <> True
If Name(a)="" Then
Flag=True
Else
StrTemp=StrTemp & "[InstalledProducts" & a & "]" & vbCrLf &_
"ProductName=" & Name(a) & vbCrLf &_
"Version=" & Version(a) & vbCrLf &_
"Publisher=" & Publisher(a) & vbCrLf &_
"ProductID=?" & vbCrLf &_
"ProductKey=?" & vbCrLf &_
"HelpLink=" & HelpLink(a) & vbCrLf &_
"HelpTelephone=" & HelpTelephone(a) & vbCrLf &_
"InstallDate=" & InstallDate(a) & vbCrLf &_
"RegCompany=?" & vbCrLf &_
"RegOwner=" & vbCrLf & vbCrLf
a =a +1
End If
Wend
TextOut StrTemp, "D:\temp\123\out.txt"
WScript.Echo "End"
'-----------------------------------------------------------------
Function GetSoftInfo(strKey)
Dim intRes
Dim sNames
Dim Types
Dim Param
Dim Val
Dim strSubKey
Dim i
Dim j
Dim TimeCounter
Dim CountName
Dim CountVersion
Dim CountHelpLink
Dim CountInstallDate
Dim CountHelpTelephone
Dim CountPublisher
CountName=0
CountVersion=0
CountHelpLink=0
CountInstallDate=0
CountHelpTelephone=0
CountPublisher=0
On Error Resume Next
'Чтение параметров раздела
intRes=objReg.EnumValues(HKEY_LOCAL_MASHINE, strKey, sNames, Types)
If intRes <> 0 Then
StrERROR= StrERROR & ": не удалась прочитать раздел ""HKEY_LOCAL_MASHINE\" & strKey & """" & vbCrLf
ErrorCounter=1
End If
If IsArray(sNames) Then
i=0
For Each Param In sNames
If Types(i)=1 Then
intRes=objReg.GetStringValue(HKEY_LOCAL_MASHINE, strKey, Param, Val)
Elseif Types(i)=2 Then
intRes=objReg.GetExpandedStringValue(HKEY_LOCAL_MASHINE, strKey, Param, Val)
Elseif Types(i)=3 Then
intRes=objReg.GetBinaryValue(HKEY_LOCAL_MASHINE, strKey, Param, Val)
Elseif Types(i)=4 Then
intRes=objReg.GetDWORDValue(HKEY_LOCAL_MASHINE, strKey, Param, Val)
Elseif Types(i)=7 Then
intRes=objReg.GetMultiStringValue(HKEY_LOCAL_MASHINE, strKey, Param, Val)
End If
If intRes <> 0 Then
StrERROR= StrERROR & ": не удалась прочитать значение параметра ""HKEY_CURRENT_USER\" & _
strKey & "\" & Param & """" & vbCrLf
End If
If Types(i)=3 Then
For j=0 To UBound(Val)
Val(j)=Right("00" & Hex(Val(j)), 2)
Next
Val=Join(Val)
Elseif Types(i)=7 Then
Val=vbCrLf & Join(Val, vbCrLf)
End If
If Param="DisplayName" Then
Name=Name & Val & ";"
CountName=1
ElseIf Param="DisplayVersion" Then
Version=Version & Val & ";"
CountVersion=1
ElseIf Param="HelpLink" Then
HelpLink=HelpLink & Val & ";"
CountHelpLink=1
ElseIf Param="InstallDate" Then
InstallDate=InstallDate & Val & ";"
CountInstallDate=1
ElseIf Param="HelpTelephone" Then
HelpTelephone=HelpTelephone & Val & ";"
CountHelpTelephone=1
ElseIf Param="Publisher" Then
Publisher=Publisher & Val & ";"
CountPublisher=1
End If
i=i + 1
If TimeCounter=4 Then
TimeCounter=0
End If
TimeCounter=TimeCounter + 1
Next
If CountName=1 Then
If CountVersion=0 Then
Version=Version & ";"
End If
If CountHelpLink=0 Then
HelpLink=HelpLink & ";"
End If
If CountInstallDate=0 Then
InstallDate=InstallDate & ";"
End If
If CountHelpTelephone=0 Then
HelpTelephone=HelpTelephone & ";"
End If
If CountPublisher=0 Then
Publisher=Publisher & ";"
End If
End If
End If
'Обход подразделов
intRes=objReg.EnumKey(HKEY_LOCAL_MASHINE, strKey, sNames)
If intRes <> 0 Then
StrERROR= StrERROR & ": не удалась прочитать подразделы ""HKEY_CURRENT_USER\" & strKey & """" & vbCrLf
ErrorCounter=1
End If
If IsArray(sNames) Then
For Each strSubKey In sNames
GetSoftInfo strKey & "\" & strSubKey
Next
End If
If Err.Number <> 0 Then
StrERROR=StrERROR & "GetSoftInfo: Number: " & Err.Number & " Description: " & Err.Description & vbCrLf
Err.Clear
ErrorCounter=1
End If
End Function
'-----------------------------------------------------------------
' Процедура для записи информации в файл
Sub TextOut (Text, File)
' Объявляем переменные
Dim objFSO, FOut
' Создаем объект FileSystemObject
Set objFSO=WScript.CreateObject("Scripting.FileSystemObject")
' Открываем выходной файл для записи
Set FOut=objFSO.OpenTextFile (File,ForWriting,true)
' Записываем текстовую строку в файл
FOut.WriteLine Text
' Закрываем выходной файл
FOut.Close
End Sub
|
|
Всего записей: 98 | Зарегистр. 14-08-2007 | Отправлено: 10:49 18-07-2008 | Исправлено: yazzi, 11:03 18-07-2008 |
|
