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

  • 質問

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

    コマンドプロンプトで「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]で絞ってしまうと他のデータが入ってきますし…

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

    2015年2月4日 7:39

回答

  • 前回のように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!)

    2015年2月4日 12:36

すべての返信

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

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


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

    2015年2月4日 9:02
    モデレータ
  • 前回のように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!)

    2015年2月4日 12:36
  • ありがとうございます^^

    参考にしてみます!

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

    '=======================================================================================
    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")

    2015年2月5日 2:34