リモート先に接続して、内部（ローカル）IPアドレスを取得したい[systeminfo]

Question

前回はとてもお世話になりました！
今回もまた、似たような質問になってしまいます。
申し訳ありません。

コマンドプロンプトで「systeminfo」を入力すると
パソコンの情報一覧が出力されるかと思います。

リモート先のパソコンでは、そのデータをテキストファイルとして保存してます。
（リモート先のパソコン　C:\systeminfo.txt)

リモート先のパソコンの
「ドメイン名」「IPアドレス[01]」の値を取得したいと思っております。

Function GetSystemInfo(ip,IP_Work)
    Dim shl
    Dim ex
    Dim reg
    Dim matches
    Dim line
        
    Set shl = CreateObject("WScript.Shell")
    Set ex = shl.Exec("systeminfo " & ip)
    Set reg = CreateObject("VBScript.RegExp")
    If IP_Work="IP" then'IPアドレスの場合
         reg.Pattern = ""

    Else'ドメイン名の場合
         reg.Pattern = ""

   End if
End Function

Dim HostIP
HostIP=Inputbox("IPアドレスを入力してください","IPアドレス")
If IsEmpty(HostIP)=TRUE or HostIP="" then
  msgbox "終了します"
  WScript.Quit
End if

msgbox GetSystemInfo(HostIP,IP)
msgbox GetSystemInfo(HostIP,Work)

ドメイン名は頑張れば取得できそうですが、IPアドレスが良く分かりません。[01]で絞ってしまうと他のデータが入ってきますし…

以上、よろしくお願いいたします！　私のほうでも徹底的に調べていきます！

Answer 1

検索しただけで申し訳ありませんが、以下が参考になるかもしれません。

API: Perform IP Lookups and resolve addresses
http://access.mvps.org/access/api/api0067.htm

---

★良い回答には回答済みマークを付けよう！ MVP - .NET 　http://d.hatena.ne.jp/trapemiya/

Answer 2

前回のように1行ずつではなく、全行取得してから複数行の判定をするとできると思う

Function GetSystemInfo(ip,IP_Work)
    Dim shl
    Dim ex
    Dim reg
    Dim matches
    Dim line
    dim all
    Set shl = CreateObject("WScript.Shell")
    Set ex = shl.Exec("systeminfo /s " & ip) 'これであってるのかな？

    Set reg = CreateObject("VBScript.RegExp")
    If IP_Work="IP" then'IPアドレスの場合
         reg.Pattern = "^ネットワーク\s*カード:(.|\r|\n)*?\[01\]:\s*((\d+\.){3}\d{1,3})"
         reg.Multiline = true
    Else'ドメイン名の場合
         reg.Pattern = "^ドメイン:\s+(.*)$"
         reg.Multiline = true
    End if

    all= ""
    Do While Not ex.StdOut.AtEndOfStream
        all = all & ex.StdOut.ReadLine & vbLF 'CRLFではなくLF($がLFだけだから)
    Loop

    If (reg.test(all)) Then
       Set matches = reg.Execute(all)
       If (matches.Count >= 1) Then 
            '複数のLANアダプタがあると複数の結果が見つかるけど最初の1個
            GetSystemInfo =Trim(matches(0).SubMatches(1))
            Exit Function
       End If
    End If
    GetSystemInfo= "Not Found"
End Function

Dim HostIP
HostIP=Inputbox("IPアドレスを入力してください","IPアドレス")
If IsEmpty(HostIP)=TRUE or HostIP="" then
  msgbox "終了します"
  WScript.Quit
End if

msgbox GetSystemInfo(HostIP,"IP")　'2個目の引数を文字列指定に
msgbox GetSystemInfo(HostIP,"Work")

---

個別に明示されていない限りgekkaがフォーラムに投稿したコードにはフォーラム使用条件に基づき「MICROSOFT LIMITED PUBLIC LICENSE」が適用されます。(かなり自由に使ってOK!)

Answer 3

ありがとうございます＾＾

参考にしてみます！

Answer 4

上手く行かなかったため、色々確認しつつ組んでみました。
ちょっとスマートじゃありませんが…

'=======================================================================================
Function GetSystemInfo(Byval SysteminfoPath,ip,IP_Work)
    Dim shl
    Dim ex
    Dim reg
    Dim matches
    Dim line
    Dim all
    Dim strOpenFile
    Dim objTextStream

   Set objFileSys = CreateObject("Scripting.FileSystemObject")

   strOpenFile =objFileSys.BuildPath(SysteminfoPath ,"systeminfo.txt")
   Set objTextStream = objFileSys.OpenTextFile(strOpenFile, 1)

   If objTextStream.AtEndOfStream = False Then
    all = objTextStream.ReadAll
   End If

   objTextStream.Close

    Set reg = CreateObject("VBScript.RegExp")
    If IP_Work="IP" then'IPアドレスの場合
         reg.Pattern = "^ネットワーク\s*カード:(.|\r|\n)*?\[01\]:\s*((\d+\.){3}\d{1,3})"
         reg.Multiline = true
    Else'ドメイン名の場合
         reg.Pattern = "^ドメイン:\s+(.*)$"
         reg.Multiline = true
    End if

 '   all= ""
 '   Do While Not ex.StdOut.AtEndOfStream
 '       all = all & ex.StdOut.ReadLine & vbLF 'CRLFではなくLF($がLFだけだから)
 '   Loop

    If (reg.test(all)) Then
       Set matches = reg.Execute(all)
       If (matches.Count >= 1 and IP_Work="IP") Then
            '複数のLANアダプタがあると複数の結果が見つかるけど最初の1個
            GetSystemInfo =Trim(matches(0).SubMatches(1))
            Exit Function
       elseif (matches.Count >= 1) then
           GetSystemInfo =Trim(Replace(Replace(Replace(matches(0).SubMatches(0),vbcrlf,""),vbcr,""),vblf,""))
           Exit Function
       End If
    End If
    GetSystemInfo= "Not Found"
End Function
'=======================================================================================
まず、ドメイン名が上手く取得できず、エラーになっていました。
ドライブ名時は　matches(0).SubMatches(0)　になっているからエラーなのだと思い
そのように編集。
また、ドライブ名取得の際に　不明な改行が入りました。
良い方法が分からなかったため、全パターンReplace　で改行除去。

Functionの引数？には、SysteminfoPathを新しく追加しました。
systeminfo.txtがあるファイルの場所を指定します。

Dim TESTPATH

TESTPATH="\\" & HostIP & "\c$\TEST"'C\のTESTフォルダを指定します。　※C:\TEST\systeminfo.txt があります。
LocalIP=GetSystemInfo(OCNEOLOG,HostIP,"IP")
WORKGROUPNAME=GetSystemInfo(OCNEOLOG,HostIP,"Work")