サンプル投稿用掲示板 VB2005 〜 用トップページ VB6.0 用 トップページ
- 日時： 2009/04/15 09:19
- 名前： 花ちゃん
- ***********************************************************************************
* カテゴリー：[通信][インターネット][] *
* キーワード：接続ルート,逆探知,プロバイダ,追跡,, *
***********************************************************************************
タイトル ： インターネット
記 事 No ： 8720
投 稿 日 ： 2009/02/12(Thu) 00:23
元質問者 ： レオ♪
VisualBasic2008で接続ルートを逆探知するプログラムはつくれますか？
例えば
ＮＴＴ⇒プロバイダー（ソニー）⇒最終接続先
みたいな感じで。
-----------------------------------------------------------------------------------
記事No ： 8727
投稿日 ： 2009/02/14(Sat) 03:00
回答者 ： 魔界の仮面弁士
-----------------------------------------------------------------------------------
とりあえず、第3案の実装例を作ってみました。VB2008 用。
フォームに TextBox, Button, BackgroundWorker, ListBox を貼っておいてください。
Option Strict Off 'エラーが表示されるようなら取り敢えずこれで --By 花ちゃん --
Imports System.ComponentModel
Imports System.Net
Imports System.Net.NetworkInformation
Public Class Form1
Private Sub Form1_Load() Handles MyBase.Load
TextBox1.Text = "www.google.co.jp"
Button1.Text = "経路追跡"
BackgroundWorker1.WorkerReportsProgress = True
End Sub
Private Sub Button1_Click() Handles Button1.Click
Button1.Enabled = False
ListBox1.Items.Clear()
BackgroundWorker1.RunWorkerAsync(TextBox1.Text)
End Sub
Private Sub BackgroundWorker1_ProgressChanged(ByVal bgw As BackgroundWorker, _
ByVal e As ProgressChangedEventArgs) Handles BackgroundWorker1.ProgressChanged
ListBox1.Items.Add(e.UserState.ToString())
End Sub
Private Sub BackgroundWorker1_RunWorkerCompleted(ByVal bgw As BackgroundWorker, _
ByVal e As RunWorkerCompletedEventArgs) Handles BackgroundWorker1.RunWorkerCompleted
Button1.Enabled = True
End Sub
Private Sub BackgroundWorker1_DoWork(ByVal bgw As BackgroundWorker, _
ByVal e As DoWorkEventArgs) Handles BackgroundWorker1.DoWork
Dim target As String = e.Argument.ToString()
Dim msg As String
Dim targetIP As IPAddress = Nothing
Dim targetName As String
If IPAddress.TryParse(target, targetIP) Then
Dim host As IPHostEntry = Dns.GetHostEntry(targetIP)
targetName = Nothing
Else
Dim host As IPHostEntry = Dns.GetHostEntry(target)
targetName = host.HostName
If host.AddressList.Length > 0 Then
targetIP = host.AddressList(0)
Else
targetIP = IPAddress.None
End If
End If
msg = targetIP.ToString()
If targetName IsNot Nothing Then
msg = targetName & "[" & msg & "]"
End If
bgw.ReportProgress(0, msg & " への経路を追跡しています。")
Using pinger As New Ping()
Dim maxHops As Integer = 30 '最大30経路まで追跡する
Dim timeout As Integer = 3000 '3秒応答が無ければスキップ
Dim timeToLive As Integer = 1
Dim finished As Boolean = False
Dim emptyBinary() As Byte = {}
Do
Dim reply As PingReply
reply = pinger.Send(targetIP, timeout, emptyBinary, _
New PingOptions(timeToLive, True))
msg = String.Format("{0, 3}", timeToLive)
timeToLive += 1
Dim replyAddress As IPAddress = reply.Address
If reply.Status = IPStatus.Success Then
finished = True
ElseIf reply.Status = IPStatus.TimedOut Then
bgw.ReportProgress(0, msg & ": 要求がタイムアウトしました。")
Continue Do
End If
bgw.ReportProgress(0, msg & ": " & replyAddress.ToString())
Loop Until finished OrElse timeToLive > maxHops
If finished Then
msg = "経路の追跡が完了しました。"
Else
msg = String.Format("ホップ数が {0} を超えたため中止しました。", maxHops)
End If
bgw.ReportProgress(100, msg)
End Using
End Sub
End Class
上記実行結果の画像(質問者は30経路を超えたそうですが私の場合は...。)
 |
