form1.vb

本书源码主要针对目前流行的FTP、HTTP、E-mail、Telnet、ICMP、Modem串口通信编程、拨号网络编程等内容进行详细的讲解

Option Strict Off
Option Explicit On
Friend Class Form1
	Inherits System.Windows.Forms.Form
#Region "Windows 窗体设计器生成的代码"
	Public Sub New()
		MyBase.New()
		If m_vb6FormDefInstance Is Nothing Then
			If m_InitializingDefInstance Then
				m_vb6FormDefInstance = Me
			Else
				Try 
					'对于启动窗体，所创建的第一个实例为默认实例。
					If System.Reflection.Assembly.GetExecutingAssembly.EntryPoint.DeclaringType Is Me.GetType Then
						m_vb6FormDefInstance = Me
					End If
				Catch
				End Try
			End If
		End If
		'此调用是 Windows 窗体设计器所必需的。
		InitializeComponent()
	End Sub
	'窗体重写处置，以清理组件列表。
	Protected Overloads Overrides Sub Dispose(ByVal Disposing As Boolean)
		If Disposing Then
			If Not components Is Nothing Then
				components.Dispose()
			End If
		End If
		MyBase.Dispose(Disposing)
	End Sub
	'Windows 窗体设计器所必需的
	Private components As System.ComponentModel.IContainer
	Public ToolTip1 As System.Windows.Forms.ToolTip
	Public WithEvents Command1 As System.Windows.Forms.Button
	Public WithEvents TxtIp As System.Windows.Forms.TextBox
	Public WithEvents TxtCmpName As System.Windows.Forms.TextBox
	Public WithEvents Label2 As System.Windows.Forms.Label
	Public WithEvents Label1 As System.Windows.Forms.Label
	'注意: 以下过程是 Windows 窗体设计器所必需的
	'可以使用 Windows 窗体设计器来修改它。
	'不要使用代码编辑器修改它。
	<System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
		Dim resources As System.Resources.ResourceManager = New System.Resources.ResourceManager(GetType(Form1))
		Me.components = New System.ComponentModel.Container()
		Me.ToolTip1 = New System.Windows.Forms.ToolTip(components)
		Me.ToolTip1.Active = True
		Me.Command1 = New System.Windows.Forms.Button
		Me.TxtIp = New System.Windows.Forms.TextBox
		Me.TxtCmpName = New System.Windows.Forms.TextBox
		Me.Label2 = New System.Windows.Forms.Label
		Me.Label1 = New System.Windows.Forms.Label
		Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedSingle
		Me.Text = "根据域名获得ip地址"
		Me.ClientSize = New System.Drawing.Size(239, 166)
		Me.Location = New System.Drawing.Point(3, 22)
		Me.MaximizeBox = False
		Me.StartPosition = System.Windows.Forms.FormStartPosition.CenterScreen
		Me.AutoScaleBaseSize = New System.Drawing.Size(6, 14)
		Me.BackColor = System.Drawing.SystemColors.Control
		Me.ControlBox = True
		Me.Enabled = True
		Me.KeyPreview = False
		Me.MinimizeBox = True
		Me.Cursor = System.Windows.Forms.Cursors.Default
		Me.RightToLeft = System.Windows.Forms.RightToLeft.No
		Me.ShowInTaskbar = True
		Me.HelpButton = False
		Me.WindowState = System.Windows.Forms.FormWindowState.Normal
		Me.Name = "Form1"
		Me.Command1.TextAlign = System.Drawing.ContentAlignment.MiddleCenter
		Me.Command1.Text = "获取"
		Me.Command1.Size = New System.Drawing.Size(92, 27)
		Me.Command1.Location = New System.Drawing.Point(79, 109)
		Me.Command1.TabIndex = 2
		Me.Command1.BackColor = System.Drawing.SystemColors.Control
		Me.Command1.CausesValidation = True
		Me.Command1.Enabled = True
		Me.Command1.ForeColor = System.Drawing.SystemColors.ControlText
		Me.Command1.Cursor = System.Windows.Forms.Cursors.Default
		Me.Command1.RightToLeft = System.Windows.Forms.RightToLeft.No
		Me.Command1.TabStop = True
		Me.Command1.Name = "Command1"
		Me.TxtIp.AutoSize = False
		Me.TxtIp.Size = New System.Drawing.Size(94, 26)
		Me.TxtIp.Location = New System.Drawing.Point(82, 66)
		Me.TxtIp.TabIndex = 1
		Me.TxtIp.AcceptsReturn = True
		Me.TxtIp.TextAlign = System.Windows.Forms.HorizontalAlignment.Left
		Me.TxtIp.BackColor = System.Drawing.SystemColors.Window
		Me.TxtIp.CausesValidation = True
		Me.TxtIp.Enabled = True
		Me.TxtIp.ForeColor = System.Drawing.SystemColors.WindowText
		Me.TxtIp.HideSelection = True
		Me.TxtIp.ReadOnly = False
		Me.TxtIp.Maxlength = 0
		Me.TxtIp.Cursor = System.Windows.Forms.Cursors.IBeam
		Me.TxtIp.MultiLine = False
		Me.TxtIp.RightToLeft = System.Windows.Forms.RightToLeft.No
		Me.TxtIp.ScrollBars = System.Windows.Forms.ScrollBars.None
		Me.TxtIp.TabStop = True
		Me.TxtIp.Visible = True
		Me.TxtIp.BorderStyle = System.Windows.Forms.BorderStyle.Fixed3D
		Me.TxtIp.Name = "TxtIp"
		Me.TxtCmpName.AutoSize = False
		Me.TxtCmpName.Size = New System.Drawing.Size(93, 24)
		Me.TxtCmpName.Location = New System.Drawing.Point(83, 32)
		Me.TxtCmpName.TabIndex = 0
		Me.TxtCmpName.AcceptsReturn = True
		Me.TxtCmpName.TextAlign = System.Windows.Forms.HorizontalAlignment.Left
		Me.TxtCmpName.BackColor = System.Drawing.SystemColors.Window
		Me.TxtCmpName.CausesValidation = True
		Me.TxtCmpName.Enabled = True
		Me.TxtCmpName.ForeColor = System.Drawing.SystemColors.WindowText
		Me.TxtCmpName.HideSelection = True
		Me.TxtCmpName.ReadOnly = False
		Me.TxtCmpName.Maxlength = 0
		Me.TxtCmpName.Cursor = System.Windows.Forms.Cursors.IBeam
		Me.TxtCmpName.MultiLine = False
		Me.TxtCmpName.RightToLeft = System.Windows.Forms.RightToLeft.No
		Me.TxtCmpName.ScrollBars = System.Windows.Forms.ScrollBars.None
		Me.TxtCmpName.TabStop = True
		Me.TxtCmpName.Visible = True
		Me.TxtCmpName.BorderStyle = System.Windows.Forms.BorderStyle.Fixed3D
		Me.TxtCmpName.Name = "TxtCmpName"
		Me.Label2.Text = "Ip地址："
		Me.Label2.Size = New System.Drawing.Size(48, 12)
		Me.Label2.Location = New System.Drawing.Point(30, 74)
		Me.Label2.TabIndex = 4
		Me.Label2.TextAlign = System.Drawing.ContentAlignment.TopLeft
		Me.Label2.BackColor = System.Drawing.Color.Transparent
		Me.Label2.Enabled = True
		Me.Label2.ForeColor = System.Drawing.SystemColors.ControlText
		Me.Label2.Cursor = System.Windows.Forms.Cursors.Default
		Me.Label2.RightToLeft = System.Windows.Forms.RightToLeft.No
		Me.Label2.UseMnemonic = True
		Me.Label2.Visible = True
		Me.Label2.AutoSize = True
		Me.Label2.BorderStyle = System.Windows.Forms.BorderStyle.None
		Me.Label2.Name = "Label2"
		Me.Label1.Text = "机器名："
		Me.Label1.Size = New System.Drawing.Size(48, 12)
		Me.Label1.Location = New System.Drawing.Point(31, 35)
		Me.Label1.TabIndex = 3
		Me.Label1.TextAlign = System.Drawing.ContentAlignment.TopLeft
		Me.Label1.BackColor = System.Drawing.Color.Transparent
		Me.Label1.Enabled = True
		Me.Label1.ForeColor = System.Drawing.SystemColors.ControlText
		Me.Label1.Cursor = System.Windows.Forms.Cursors.Default
		Me.Label1.RightToLeft = System.Windows.Forms.RightToLeft.No
		Me.Label1.UseMnemonic = True
		Me.Label1.Visible = True
		Me.Label1.AutoSize = True
		Me.Label1.BorderStyle = System.Windows.Forms.BorderStyle.None
		Me.Label1.Name = "Label1"
		Me.Controls.Add(Command1)
		Me.Controls.Add(TxtIp)
		Me.Controls.Add(TxtCmpName)
		Me.Controls.Add(Label2)
		Me.Controls.Add(Label1)
	End Sub
#End Region 
#Region "升级支持"
	Private Shared m_vb6FormDefInstance As Form1
	Private Shared m_InitializingDefInstance As Boolean
	Public Shared Property DefInstance() As Form1
		Get
			If m_vb6FormDefInstance Is Nothing OrElse m_vb6FormDefInstance.IsDisposed Then
				m_InitializingDefInstance = True
				m_vb6FormDefInstance = New Form1()
				m_InitializingDefInstance = False
			End If
			DefInstance = m_vb6FormDefInstance
		End Get
		Set
			m_vb6FormDefInstance = Value
		End Set
	End Property
#End Region 
	Private Const SOCKET_ERROR As Integer = -1
	Private Const MAX_WSADescription As Short = 256
	Private Const MAX_WSASYSStatus As Short = 128
	Private Const ERROR_SUCCESS As Integer = 0
	Private Const WS_VERSION_REQD As Integer = &H101s
	Private Const MIN_SOCKETS_REQD As Integer = 1
	Private Const WS_VERSION_MAJOR As Integer = WS_VERSION_REQD \ &H100s And &HFF
	Private Const WS_VERSION_MINOR As Integer = WS_VERSION_REQD And &HFF
	
	Private Structure HOSTENT
		Dim hName As Integer
		Dim hAliases As Integer
		Dim hAddrType As Short
		Dim hLen As Short
		Dim hAddrList As Integer
	End Structure
	
	Private Structure WSADATA
		Dim wVersion As Short
		Dim wHighVersion As Short
		<VBFixedArray(MAX_WSADescription)> Dim szDescription() As Byte
		<VBFixedArray(MAX_WSASYSStatus)> Dim szSystemStatus() As Byte
		Dim wMaxSockets As Short
		Dim wMaxUDPDG As Short
		Dim dwVendorInfo As Integer
		
		'UPGRADE_TODO: 必须调用“Initialize”来初始化此结构的实例。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1026"”
		Public Sub Initialize()
			ReDim szDescription(MAX_WSADescription)
			ReDim szSystemStatus(MAX_WSASYSStatus)
		End Sub
	End Structure
	
	Private Declare Function gethostname Lib "WSOCK32.DLL" (ByVal szHost As String, ByVal dwHostLen As Integer) As Integer
	Private Declare Function gethostbyname Lib "WSOCK32.DLL" (ByVal szHost As String) As Integer
	'UPGRADE_WARNING: 结构 WSADATA 可能要求封送处理属性作为此声明语句中的参数传递。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1050"”
	Private Declare Function WSAStartup Lib "WSOCK32.DLL" (ByVal wVersionRequired As Integer, ByRef lpWSADATA As WSADATA) As Integer
	Private Declare Function WSAGetLastError Lib "WSOCK32.DLL" () As Integer
	Private Declare Function WSACleanup Lib "WSOCK32.DLL" () As Integer
	'UPGRADE_ISSUE: 不支持将参数声明为“As Any”。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1016"”
	Private Declare Sub CopyMemory Lib "kernel32"  Alias "RtlMoveMemory"(ByRef hpvDest As Any, ByVal hpvSource As Integer, ByVal cbCopy As Integer)
	
	Private Function GetIPAddress(Optional ByRef sHost As String = "") As String
		'返回给定机器名的Ip地址，机器名为空时返回本机Ip地址
		Dim sHostName As New VB6.FixedLengthString(256)
		Dim lpHost As Integer
		Dim HOST As HOSTENT
		Dim dwIPAddr As Integer
		Dim tmpIPAddr() As Byte
		Dim i As Short
		Dim sIPAddr As String
		Dim werr As Integer
		
		If Not SocketsInitialize() Then
			GetIPAddress = ""
			Exit Function
		End If
		
		If sHost = "" Then
			If gethostname(sHostName.Value, 256) = SOCKET_ERROR Then
				werr = WSAGetLastError()
				GetIPAddress = ""
				SocketsCleanup()
				Exit Function
			End If
			
			sHostName.Value = Trim(sHostName.Value)
		Else
			sHostName.Value = Trim(sHost) & Chr(0)
		End If
		
		lpHost = gethostbyname(sHostName.Value)
		
		If lpHost = 0 Then
			werr = WSAGetLastError()
			GetIPAddress = ""
			SocketsCleanup()
			Exit Function
		End If
		
		'UPGRADE_WARNING: 未能解析对象 HOST 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”
		CopyMemory(HOST, lpHost, Len(HOST))
		CopyMemory(dwIPAddr, HOST.hAddrList, 4)
		
		'UPGRADE_WARNING: 数组 tmpIPAddr 的下限已从 1 更改为 0。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1033"”
		ReDim tmpIPAddr(HOST.hLen)
		CopyMemory(tmpIPAddr(1), dwIPAddr, HOST.hLen)
		
		For i = 1 To HOST.hLen
			sIPAddr = sIPAddr & tmpIPAddr(i) & "."
		Next 
		
		GetIPAddress = Mid(sIPAddr, 1, Len(sIPAddr) - 1)
		SocketsCleanup()
	End Function
	
	Private Function SocketsInitialize(Optional ByRef sErr As String = "") As Boolean
		'UPGRADE_WARNING: 结构 WSAD 中的数组可能需要先初始化才可以使用。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1063"”
		Dim WSAD As WSADATA
		Dim sLoByte, sHiByte As String
		If WSAStartup(WS_VERSION_REQD, WSAD) <> ERROR_SUCCESS Then
			sErr = "The 32-bit Windows Socket is not responding."
			SocketsInitialize = False
			Exit Function
		End If
		
		If WSAD.wMaxSockets < MIN_SOCKETS_REQD Then
			sErr = "This application requires a minimum of " & CStr(MIN_SOCKETS_REQD) & " supported sockets."
			
			SocketsInitialize = False
			Exit Function
		End If
		
		
		'UPGRADE_WARNING: 未能解析对象 HiByte(WSAD.wVersion) 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”
		'UPGRADE_WARNING: 未能解析对象 LoByte(WSAD.wVersion) 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”
		If LoByte(WSAD.wVersion) < WS_VERSION_MAJOR Or (LoByte(WSAD.wVersion) = WS_VERSION_MAJOR And HiByte(WSAD.wVersion) < WS_VERSION_MINOR) Then
			
			'UPGRADE_WARNING: 未能解析对象 HiByte() 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”
			sHiByte = CStr(HiByte(WSAD.wVersion))
			'UPGRADE_WARNING: 未能解析对象 LoByte() 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”
			sLoByte = CStr(LoByte(WSAD.wVersion))
			
			sErr = "Sockets version " & sLoByte & "." & sHiByte & " is not supported by 32-bit Windows Sockets."
			
			SocketsInitialize = False
			Exit Function
		End If
		SocketsInitialize = True
	End Function
	
	Private Sub SocketsCleanup()
		If WSACleanup() <> ERROR_SUCCESS Then
			'UPGRADE_ISSUE: 常量 vbLogEventTypeError 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2070"”
			'UPGRADE_ISSUE: App 方法 App.LogEvent 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2069"”
			App.LogEvent("Socket error occurred in Cleanup.", vbLogEventTypeError)
		End If
	End Sub
	
	Private Function HiByte(ByVal wParam As Short) As Object
		'UPGRADE_WARNING: 未能解析对象 HiByte 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”
		HiByte = wParam \ &H1s And &HFF
	End Function
	
	Private Function LoByte(ByVal wParam As Short) As Object
		'UPGRADE_WARNING: 未能解析对象 LoByte 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”
		LoByte = wParam And &HFF
	End Function
	
	Private Sub Command1_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Command1.Click
		On Error Resume Next
		'UPGRADE_WARNING: Screen 属性 Screen.MousePointer 具有新的行为。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2065"”
		System.Windows.Forms.Cursor.Current = System.Windows.Forms.Cursors.WaitCursor
		TxtIp.Text = GetIPAddress(TxtCmpName.Text)
		'UPGRADE_WARNING: Screen 属性 Screen.MousePointer 具有新的行为。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2065"”
		System.Windows.Forms.Cursor.Current = System.Windows.Forms.Cursors.Default
	End Sub
End Class