1

いくつか質問がありますが、これが正しい場所であることを願っています。

基本的に私がやりたいことは、ドメイン コンピューターに関する情報をリモートで取得できるようにすることです。

1（IP構成、コンプ名...）、2（インストールされたソフトウェア）、3（マップされたドライブ）を提供する3つの個別のスクリプトがあります。

最初の 2 つは IP/コンピューター名を要求し、3 つ目はそれをスクリプトに入力する必要があります... IP アドレスを 1 回入力するだけで、3 つすべてで機能するようにしたいと思います

次に、この情報が入れられる出力ファイルに、インストールされたソフトウェア スクリプトのように名前を付けてから、他の 2 つのスクリプトを既に作成された出力に追加 ( ammend ) させたいと思います。

私はvbsに非常に慣れていないので、どんな助けも素晴らしいでしょう

SCRIPT 1 (IP 構成を取得する)

dim strComputer 'for computer name or IP
dim colAdapters 'collection of adapters


Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.CreateTextFile("output.txt", True)


strComputer = ""

'open a dialog box asking for the computer name/IP
do
strComputer = inputbox( "Please enter a computername/IP, or . for local computer", "Input" )
Loop until strComputer <> "" 'run until a name/IP is entered


Set objWMIService = GetObject ("winmgmts:" & "!\\" & strComputer & "\root\cimv2") 'open the WMI service on the remote PC
Set colAdapters = objWMIService.ExecQuery ("Select * from Win32_NetworkAdapterConfiguration Where IPEnabled = True") 

'go through the list of adapters and gather data
For Each objAdapter in colAdapters 


objFile.Writeline "Host name: " & objAdapter.DNSHostName 
objFile.Writeline "DNS domain: " & objAdapter.DNSDomain 
objFile.Writeline "DNS suffix search list: " & objAdapter.DNSDomainSuffixSearchOrder 
objFile.Writeline "Description: " & objAdapter.Description 
objFile.Writeline "Physical address: " & objAdapter.MACAddress 
objFile.Writeline "DHCP enabled: " & objAdapter.DHCPEnabled 
If Not IsNull(objAdapter.IPAddress) Then 
For i = LBound(objAdapter.IPAddress) To UBound(objAdapter.IPAddress) 
objFile.Writeline "IP address: " & objAdapter.IPAddress(i) 
Next 
End If 
If Not IsNull(objAdapter.IPSubnet) Then 
For i = LBound(objAdapter.IPSubnet) To UBound(objAdapter.IPSubnet) 
objFile.Writeline "Subnet: " & objAdapter.IPSubnet(i) 
Next 
End If 
If Not IsNull(objAdapter.DefaultIPGateway) Then 
For i = LBound(objAdapter.DefaultIPGateway) To UBound(objAdapter.DefaultIPGateway) 
objFile.Writeline "Default gateway: " & objAdapter.DefaultIPGateway(i) 
Next 
End If 
objFile.Writeline "DHCP server: " & objAdapter.DHCPServer 
If Not IsNull(objAdapter.DNSServerSearchOrder) Then 
For i = LBound(objAdapter.DNSServerSearchOrder) To UBound(objAdapter.DNSServerSearchOrder) 
objFile.Writeline "DNS server: " & objAdapter.DNSServerSearchOrder(i) 
Next 
End If 
objFile.Writeline "Primary WINS server: " & objAdapter.WINSPrimaryServer 
objFile.Writeline "Secondary WINS server: " & objAdapter.WINSSecondaryServer 
objFile.Writeline "Lease obtained: " & objAdapter.DHCPLeaseObtained 
objFile.Writeline "Lease expires: " & objAdapter.DHCPLeaseExpires 
Next

SCRIPT 2 (インストールされたソフトウェアを取得する)

Option Explicit

Dim sTitle
sTitle = "InstalledPrograms.vbs by Bill James"
Dim StrComputer
strComputer = InputBox("Enter I.P. or name of computer to check for " & _
                       "installed software (leave blank to check " & _
                       "local system)." & vbcrlf & vbcrlf & "Remote " & _
                       "checking only from NT type OS to NT type OS " & _
                       "with same Admin level UID & PW", sTitle)
If IsEmpty(strComputer) Then WScript.Quit
strComputer = Trim(strComputer)
If strComputer = "" Then strComputer = "."

'Wscript.Echo GetAddRemove(strComputer)

Dim sCompName : sCompName = GetProbedID(StrComputer)

Dim sFileName
sFileName = sCompName & "_" & GetDTFileName() & "_Software.txt"

Dim s : s = GetAddRemove(strComputer)

If WriteFile(s, sFileName) Then
  'optional prompt for display
  If MsgBox("Finished processing.  Results saved to " & sFileName & _
            vbcrlf & vbcrlf & "Do you want to view the results now?", _
            4 + 32, sTitle) = 6 Then
    WScript.CreateObject("WScript.Shell").Run sFileName, 9
  End If
End If

Function GetAddRemove(sComp)
  'Function credit to Torgeir Bakken
  Dim cnt, oReg, sBaseKey, iRC, aSubKeys
  Const HKLM = &H80000002 'HKEY_LOCAL_MACHINE
  Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
              sComp & "/root/default:StdRegProv")
  sBaseKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
  iRC = oReg.EnumKey(HKLM, sBaseKey, aSubKeys)

  Dim sKey, sValue, sTmp, sVersion, sDateValue, sYr, sMth, sDay

  For Each sKey In aSubKeys
    iRC = oReg.GetStringValue(HKLM, sBaseKey & sKey, "DisplayName", sValue)
    If iRC <> 0 Then
      oReg.GetStringValue HKLM, sBaseKey & sKey, "QuietDisplayName", sValue
    End If
    If sValue <> "" Then
      iRC = oReg.GetStringValue(HKLM, sBaseKey & sKey, _
                                "DisplayVersion", sVersion)
      If sVersion <> "" Then
        sValue = sValue & vbTab & "Ver: " & sVersion
      Else
        sValue = sValue & vbTab 
      End If
      iRC = oReg.GetStringValue(HKLM, sBaseKey & sKey, _
                                "InstallDate", sDateValue)
      If sDateValue <> "" Then
        sYr =  Left(sDateValue, 4)
        sMth = Mid(sDateValue, 5, 2)
        sDay = Right(sDateValue, 2)
        'some Registry entries have improper date format
        On Error Resume Next 
        sDateValue = DateSerial(sYr, sMth, sDay)
        On Error GoTo 0
        If sdateValue <> "" Then
          sValue = sValue & vbTab & "Installed: " & sDateValue
        End If
      End If
      sTmp = sTmp & sValue & vbcrlf
    cnt = cnt + 1
    End If
  Next
  sTmp = BubbleSort(sTmp)
  GetAddRemove = "INSTALLED SOFTWARE (" & cnt & ") - " & sCompName & _
                 " - " & Now() & vbcrlf & vbcrlf & sTmp 
End Function

Function BubbleSort(sTmp)
  'cheapo bubble sort
  Dim aTmp, i, j, temp
  aTmp = Split(sTmp, vbcrlf)  
  For i = UBound(aTmp) - 1 To 0 Step -1
    For j = 0 to i - 1
      If LCase(aTmp(j)) > LCase(aTmp(j+1)) Then
        temp = aTmp(j + 1)
        aTmp(j + 1) = aTmp(j)
        aTmp(j) = temp
      End if
    Next
  Next
  BubbleSort = Join(aTmp, vbcrlf)
End Function

Function GetProbedID(sComp)
  Dim objWMIService, colItems, objItem
  Set objWMIService = GetObject("winmgmts:\\" & sComp & "\root\cimv2")
  Set colItems = objWMIService.ExecQuery("Select SystemName from " & _
                                         "Win32_NetworkAdapter",,48)
  For Each objItem in colItems
    GetProbedID = objItem.SystemName
  Next
End Function

Function GetDTFileName()
  dim sNow, sMth, sDay, sYr, sHr, sMin, sSec
  sNow = Now
  sMth = Right("0" & Month(sNow), 2)
  sDay = Right("0" & Day(sNow), 2)
  sYr = Right("00" & Year(sNow), 4)
  sHr = Right("0" & Hour(sNow), 2)
  sMin = Right("0" & Minute(sNow), 2)
  sSec = Right("0" & Second(sNow), 2)
  GetDTFileName = sMth & sDay & sYr & "_" & sHr & sMin & sSec
End Function

Function WriteFile(sData, sFileName)
  Dim fso, OutFile, bWrite
  bWrite = True
  Set fso = CreateObject("Scripting.FileSystemObject")
  On Error Resume Next
  Set OutFile = fso.OpenTextFile(sFileName, 2, True)
  'Possibly need a prompt to close the file and one recursion attempt.
  If Err = 70 Then
    Wscript.Echo "Could not write to file " & sFileName & ", results " & _
                 "not saved." & vbcrlf & vbcrlf & "This is probably " & _
                 "because the file is already open."
    bWrite = False
  ElseIf Err Then
    WScript.Echo err & vbcrlf & err.description
    bWrite = False
  End If
  On Error GoTo 0
  If bWrite Then
    OutFile.WriteLine(sData)
    OutFile.Close
  End If
  Set fso = Nothing
  Set OutFile = Nothing
  WriteFile = bWrite
End Function

SCRIPT 3 (マップされたドライブを取得する)

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.CreateTextFile("mappedoutput.txt", True)
' List Mapped Network Drives


On Error Resume Next

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

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

For Each objItem in colItems
    objFile.Writeline "Compressed: " & objItem.Compressed
    objFile.Writeline "Description: " & objItem.Description
    objFile.Writeline "Device ID: " & objItem.DeviceID
    objFile.Writeline "File System: " & objItem.FileSystem
    objFile.Writeline "Free Space: " & objItem.FreeSpace
    objFile.Writeline "Maximum Component Length: " & objItem.MaximumComponentLength
    objFile.Writeline "Name: " & objItem.Name
    objFile.Writeline "Provider Name: " & objItem.ProviderName
    objFile.Writeline "Session ID: " & objItem.SessionID
    objFile.Writeline "Size: " & objItem.Size
    objFile.Writeline "Supports Disk Quotas: " & objItem.SupportsDiskQuotas
    objFile.Writeline "Supports File-Based Compression: " & _
        objItem.SupportsFileBasedCompression
    objFile.Writeline "Volume Name: " & objItem.VolumeName
    objFile.Writeline "Volume Serial Number: " & objItem.VolumeSerialNumber
    objFile.Writeline
Next

再びありがとう

4

1 に答える 1

2

3 つのスクリプトすべてを 1 つのスクリプトとしてまとめることはできますか? その場合、IP アドレスを 1 回だけ入力する必要があります。

または、IP アドレスを要求する別のスクリプトを作成し、cscript を使用して IP アドレスをパラメーターとして渡すことにより、これらのスクリプトを呼び出します。そのためにこのコードを試してください：

strcomputer = inputbox("Enter the IP address")
set obj1 = createobject("wscript.shell")
set obj2 = createobject("wscript.shell")
set obj3 = createobject("wscript.shell")
pgm1 = "cscript script1.vbs " & strcomputer
pgm2 = "cscript script2.vbs " & strcomputer
pgm3 = "cscript script3.vbs " & strcomputer
obj1.run pgm1,3,true
obj2.run pgm2,3,true
obj3.run pgm3,3,true
set obj1 = nothing
set obj2 = nothing
set obj3 = nothing

上記のコードでは、script1.vbs、script2.vbs、script3.vbs が 3 つのスクリプトであり、新しいスクリプトを使用して 1 つずつ実行しています。script1.vbs に、次のコード行を追加します。

strcomputer = wscript.Arguments.item(0)

新しいスクリプトから script1.vbs に渡した最初の引数を、変数「strcomputer」(この場合は IP アドレス) に格納します。同様に、script2.vbs と script3.vbs の両方にも、ステートメントを追加します。

strcomputer = wscript.Arguments.item(0)

出力ファイルに関して、何を求めているのかわかりません。多分これは助けることができます：

以下を使用してファイルに書き込みます (データが既に存在する場合は上書きします)。

Set fso1 = CreateObject("Scripting.FileSystemObject" )            
Set file1 = fso1.OpenTextFile("C:\New\textfile1.txt",2,true)

以下を使用して、データを追加するか、ファイルに追加します (上書きしません)。

Set fso1 = CreateObject("Scripting.FileSystemObject" )            
Set file1 = fso1.OpenTextFile("C:\New\textfile1.txt",8,true)

ファイルから読み取るには、以下を使用します。

Set fso1 = CreateObject("Scripting.FileSystemObject" )            
Set file1 = fso1.OpenTextFile("C:\New\textfile1.txt",1,true)
于 2013-04-10T08:03:29.310 に答える