谁能帮我将下面的VB代码转换成VB.net下面的代码，不甚感激，最好是能支持.Net2003,谢谢。

zkw0302 2010-07-12 10:48:32



VERSION 5.00

Begin VB.UserControl IpBox1 

   ClientHeight    =   420

   ClientLeft      =   0

   ClientTop       =   0

   ClientWidth     =   2940

   ScaleHeight     =   420

   ScaleWidth      =   2940

End

Attribute VB_Name = "IpBox1"

Attribute VB_GlobalNameSpace = False

Attribute VB_Creatable = True

Attribute VB_PredeclaredId = False

Attribute VB_Exposed = False

Option Explicit

  Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal X As Long, ByVal y As Long, ByVal nWIDTH As Long, ByVal nHEIGHT As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long

  Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long

  Private Declare Function GetStockObject Lib "gdi32.dll" (ByVal nIndex As Long) As Long

  Private Declare Function INITCOMMONCONTROLSEX Lib "comctl32.dll" Alias "InitCommonControlsEx" (ByRef TLPINITCOMMONCONTROLSEX As INITCOMMONCONTROLSEX) As Long

  Private Type INITCOMMONCONTROLSEX

          dwSize   As Long     'size   of   this   structure

          dwICC   As Long     'flags   indicating   which   classes   to   be   initialized

  End Type

  Private Const ICC_INTERNET_CLASSES       As Long = &H800

    

  Private Const WS_CHILD       As Long = &H40000000

  Private Const WS_GROUP       As Long = &H20000

  Private Const WS_TABSTOP       As Long = &H10000

  Private Const WS_VISIBLE       As Long = &H10000000

  Private Const WS_BORDER       As Long = &H800000

    

  Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

  Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

  

  Private Const WM_SETFONT       As Long = &H30

  Private Const WM_GETFONT       As Long = &H31

    

  Private Const WM_USER       As Long = &H400

  Private Const IPM_CLEARADDRESS         As Long = (WM_USER + 100)

  Private Const IPM_SETADDRESS           As Long = (WM_USER + 101)

  Private Const IPM_GETADDRESS           As Long = (WM_USER + 102)

  Private Const IPM_SETRANGE             As Long = (WM_USER + 103)

  Private Const IPM_SETFOCUS             As Long = (WM_USER + 104)

  Private Const IPM_ISBLANK              As Long = (WM_USER + 105)

  Private Const DEFAULT_GUI_FONT As Long = 17

  Private IP1     As Long

    

    

    

  Private Sub UserControl_Initialize()

          Call CreateIPAddressBox

          SendMessage IP1, IPM_SETADDRESS, 0, ByVal MAKEIPADDRESS(127, 0, 0, 1)

  End Sub

    

  Private Function CreateIPAddressBox() As Boolean

          Dim CommCtrl     As INITCOMMONCONTROLSEX

          Dim hFont As Long

          

          CommCtrl.dwSize = Len(CommCtrl)

          

          CommCtrl.dwICC = ICC_INTERNET_CLASSES

            

          If INITCOMMONCONTROLSEX(CommCtrl) Then

                  IP1 = CreateWindowEx(0, "SysIPAddress32", "IPADDR1", _

                                  WS_CHILD Or WS_TABSTOP Or WS_GROUP Or WS_VISIBLE, _

                                  0, 0, UserControl.Width / 15, UserControl.Height / 15, _

                                  UserControl.hwnd, 0, App.hInstance, ByVal 0&)

                                    

                  If IP1 Then

                    hFont = GetStockObject(DEFAULT_GUI_FONT) ' 获取默认字体

                    SendMessage IP1, WM_SETFONT, hFont, 1 '设置默认字体

                          '½«IP¿Ø¼þµÄ×ÖÌåÉèÖÃµÄÓë´°ÌåÒ»Ñù   ÓÃËÎÌå

                     '     SendMessage IP1, WM_SETFONT, SendMessage(UserControl.hwnd, WM_GETFONT, 0, ByVal 0&), ByVal 0&

                  Else

                         ' MsgBox "²»ÄÜ´´½¨¿Ø¼þ", vbCritical, "´íÎó£¡"

                  End If

                    

          Else

                 ' MsgBox "²»ÄÜ´´½¨¿Ø¼þ", vbCritical, "´íÎó£¡"

          End If

  End Function

    

    

  Private Sub UserControl_Resize()

          DestroyWindow IP1

          Call CreateIPAddressBox

          SendMessage IP1, IPM_SETADDRESS, 0, ByVal MAKEIPADDRESS(0, 0, 0, 0)

  End Sub

    

  Private Sub UserControl_Terminate()

          DestroyWindow IP1

  End Sub

    

  Private Function FIRST_IPADDRESS(ByVal X As Long) As Byte

          FIRST_IPADDRESS = ((X And &H7F000000) \ &H1000000) Or (((X And &H80000000) <> 0) And &H80)

  End Function

    

  Private Function SECOND_IPADDRESS(ByVal X As Long) As Byte

          SECOND_IPADDRESS = (X And &HFF0000) \ &H10000

  End Function

    

  Private Function THIRD_IPADDRESS(ByVal X As Long) As Byte

          THIRD_IPADDRESS = (X And &HFF00&) \ &H100

  End Function

    

  Private Function FOURTH_IPADDRESS(ByVal X As Long) As Byte

          FOURTH_IPADDRESS = X And &HFF

  End Function

    

  Private Function MAKEIPRANGE(ByVal low As Byte, ByVal high As Byte) As Long

          MAKEIPRANGE = high * &H100& Or low

  End Function

    

  Private Function MAKEIPADDRESS(ByVal b1 As Byte, ByVal b2 As Byte, ByVal b3 As Byte, ByVal b4 As Byte) As Long

          MAKEIPADDRESS = ((b1 And &H7F) * &H1000000 Or (b1 And &H80) <> 0 And &H80000000) Or (b2 * &H10000) Or (b3 * &H100&) Or (b4)

  End Function

    

    

  '''µÃµ½   IP   µØÖ·

  Public Function GetIPAddress() As String

          Dim TempLng     As Long

          SendMessage IP1, IPM_GETADDRESS, 0, TempLng

            

          GetIPAddress = FIRST_IPADDRESS(TempLng) & "." & SECOND_IPADDRESS(TempLng) & "." & THIRD_IPADDRESS(TempLng) & "." & FOURTH_IPADDRESS(TempLng)

  End Function

    

  '''ÉèÖÃ   IP   µØÖ·

  Public Property Let SetIPAddress(ByVal NewIP As String)

  'Public Function SetIPAddress(ByVal v1 As Integer, v2 As Integer, v3 As Integer, v4 As Integer) As Boolean

        '  SendMessage IP1, IPM_SETADDRESS, 0, ByVal MAKEIPADDRESS(v1, v2, v3, v4)

         ' SendMessage IP1, IPM_SETADDRESS, 0, ByVal FIRST_IPADDRESS(v1) & "." & SECOND_IPADDRESS(v2) & "." & THIRD_IPADDRESS(v3) & "." & FOURTH_IPADDRESS(v4)

          Dim mByte(3) As Byte, vIp As Variant

    Dim IpPrt As Long



    If CountIF(NewIP, ".") < 3 Then

'        Err.Raise 102, , "Ip 地址格式错误" & vbCrLf _

        & "正确的格式应该为: 255.255.255.255"

        Exit Property

    Else

        vIp = Split(NewIP, ".") ' IP地址分隔符

        mByte(0) = vIp(3)

        mByte(1) = vIp(2)

        mByte(2) = vIp(1)

        mByte(3) = vIp(0)

        '删除临时

        Erase vIp

        CopyMemory IpPrt, mByte(0), 4

        SendMessage IP1, IPM_SETADDRESS, 0, ByVal IpPrt

    End If

  End Property



Private Function CountIF(lzExpr As String, nChar As String)

    Dim X As Integer, iCount As Integer

    Dim sByte() As Byte

    sByte = lzExpr

    For X = LBound(sByte) To UBound(sByte)

        If sByte(X) = Asc(nChar) Then iCount = iCount + 1

    Next

    X = 0: Erase sByte

    CountIF = iCount

    iCount = 0

End Function

...全文

273 16 打赏收藏转发到动态举报

写回复

用AI写文章

16 条回复

切换为时间正序

请发表友善的回复…

发表回复

lsh2216024 2010-07-14

打赏
举报

可以转换的，
只是个别的定义需要手动改一下，如某索引从0开始，或是从1开始的

ElfSundae 2010-07-13

打赏
举报

http://xxc168.download.csdn.net/ 第一个资源

能编译通过，只是转换不正确，那个CopyMemory弄了半天都不行..你要真想转的话可以参考下。
我是VS2008编译的，VS2003可以修改下VBPROJ文件的ProductVersion或者新建个项目复制代码。

zkw0302 2010-07-13

打赏
举报

Who can help me?

ElfSundae 2010-07-13

打赏
举报

[Quote=引用 6 楼 gxingmin 的回复:]

你是要ip地址控件吗？
你下载这个，c#源代码
http://www.codeproject.com/KB/miscctrl/IpAddrCtrlLib.aspx
[/Quote]

正解。

如果需要VB.NET源码的，可以将其转换成VB.NET，C#转VB.NET几乎没有任何问题，可VB6转换要改动的可能会比较多。

rqx110 2010-07-13

打赏
举报

哈哈 IP控件啊找一个.net下的IP控件就行了，如果有需要我发个给你。

鸭梨山大帝 2010-07-13

打赏
举报

vb6升級VB.NET还是老老实实重写吧.

两个不是一个概念的东西.

bcrun 2010-07-13

打赏
举报

[Quote=引用 8 楼 zkw0302 的回复:]
Who can help me?
[/Quote]

试过6楼所说的控件吗,我觉得可以啊:)

gxingmin 2010-07-12

打赏
举报

Option Strict Off

Option Explicit On

Friend Class IpBox1

	Inherits System.Windows.Forms.UserControl

#Region "Windows 窗体设计器生成的代码"

	Public Sub New()

		MyBase.New()

		'此调用是 Windows 窗体设计器所必需的。

		InitializeComponent()

		UserControl_Initialize()

	End Sub

	'窗体重写处置，以清理组件列表。

	Protected Overloads Overrides Sub Dispose(ByVal Disposing As Boolean)

		If Disposing Then

			UserControl_Terminate()

			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

	'注意: 以下过程是 Windows 窗体设计器所必需的

	'可以使用 Windows 窗体设计器来修改它。

	'不要使用代码编辑器修改它。

	<System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()

		Dim resources As System.Resources.ResourceManager = New System.Resources.ResourceManager(GetType(IpBox1))

		Me.components = New System.ComponentModel.Container()

		Me.ToolTip1 = New System.Windows.Forms.ToolTip(components)

		Me.ToolTip1.Active = True

		Me.ClientSize = New System.Drawing.Size(196, 28)

		MyBase.Location = New System.Drawing.Point(0, 0)

		MyBase.Name = "IpBox1"

	End Sub

#End Region 

	'UPGRADE_ISSUE: 不支持将参数声明为“As Any”。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1016"”

    Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Integer, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Integer, ByVal X As Integer, ByVal y As Integer, ByVal nWIDTH As Integer, ByVal nHEIGHT As Integer, ByVal hWndParent As Integer, ByVal hMenu As Integer, ByVal hInstance As Integer, ByRef lpParam As Object) As Integer

	Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Integer) As Integer

	Private Declare Function GetStockObject Lib "gdi32.dll" (ByVal nIndex As Integer) As Integer

	'UPGRADE_WARNING: 结构 INITCOMMONCONTROLSEX 可能要求封送处理属性作为此声明语句中的参数传递。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1050"”

	Private Declare Function INITCOMMONCONTROLSEX_Renamed Lib "comctl32.dll"  Alias "InitCommonControlsEx"(ByRef TLPINITCOMMONCONTROLSEX As INITCOMMONCONTROLSEX) As Integer

	Private Structure INITCOMMONCONTROLSEX

		Dim dwSize As Integer 'size   of   this   structure

		Dim dwICC As Integer 'flags   indicating   which   classes   to   be   initialized

	End Structure

	Private Const ICC_INTERNET_CLASSES As Integer = &H800s

	

	Private Const WS_CHILD As Integer = &H40000000

	Private Const WS_GROUP As Integer = &H20000

	Private Const WS_TABSTOP As Integer = &H10000

	Private Const WS_VISIBLE As Integer = &H10000000

	Private Const WS_BORDER As Integer = &H800000

	

	'UPGRADE_ISSUE: 不支持将参数声明为“As Any”。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1016"”

    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByRef lParam As Object) As Integer

	'UPGRADE_ISSUE: 不支持将参数声明为“As Any”。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1016"”

	'UPGRADE_ISSUE: 不支持将参数声明为“As Any”。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1016"”

    Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Object, ByRef Source As Object, ByVal Length As Integer)

	

	Private Const WM_SETFONT As Integer = &H30s

	Private Const WM_GETFONT As Integer = &H31s

	

	Private Const WM_USER As Integer = &H400s

	Private Const IPM_CLEARADDRESS As Integer = (WM_USER + 100)

	Private Const IPM_SETADDRESS As Integer = (WM_USER + 101)

	Private Const IPM_GETADDRESS As Integer = (WM_USER + 102)

	Private Const IPM_SETRANGE As Integer = (WM_USER + 103)

	Private Const IPM_SETFOCUS As Integer = (WM_USER + 104)

	Private Const IPM_ISBLANK As Integer = (WM_USER + 105)

	Private Const DEFAULT_GUI_FONT As Integer = 17

	Private IP1 As Integer

	

	

	

	Private Sub UserControl_Initialize()

		Call CreateIPAddressBox()

		SendMessage(IP1, IPM_SETADDRESS, 0, MAKEIPADDRESS(127, 0, 0, 1))

	End Sub

	

	Private Function CreateIPAddressBox() As Boolean

		Dim CommCtrl As INITCOMMONCONTROLSEX

		Dim hFont As Integer

		

		CommCtrl.dwSize = Len(CommCtrl)

		

		CommCtrl.dwICC = ICC_INTERNET_CLASSES

		

		If INITCOMMONCONTROLSEX_Renamed(CommCtrl) Then

			IP1 = CreateWindowEx(0, "SysIPAddress32", "IPADDR1", WS_CHILD Or WS_TABSTOP Or WS_GROUP Or WS_VISIBLE, 0, 0, VB6.PixelsToTwipsX(MyBase.Width) / 15, VB6.PixelsToTwipsY(MyBase.Height) / 15, MyBase.Handle.ToInt32, 0, VB6.GetHInstance.ToInt32, 0)

			

			If IP1 Then

				hFont = GetStockObject(DEFAULT_GUI_FONT) ' 获取默认字体

				SendMessage(IP1, WM_SETFONT, hFont, 1) '设置默认字体

				'½«IP¿Ø¼þµÄ×ÖÌåÉèÖÃµÄÓë´°ÌåÒ»Ñù   ÓÃËÎÌå

				'     SendMessage IP1, WM_SETFONT, SendMessage(UserControl.hwnd, WM_GETFONT, 0, ByVal 0&), ByVal 0&

			Else

				' MsgBox "²»ÄÜ´´½¨¿Ø¼þ", vbCritical, "´íÎó£¡"

			End If

			

		Else

			' MsgBox "²»ÄÜ´´½¨¿Ø¼þ", vbCritical, "´íÎó£¡"

		End If

	End Function

	

	

	Private Sub IpBox1_Resize(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Resize

		DestroyWindow(IP1)

		Call CreateIPAddressBox()

		SendMessage(IP1, IPM_SETADDRESS, 0, MAKEIPADDRESS(0, 0, 0, 0))

	End Sub

	

	Private Sub UserControl_Terminate()

		DestroyWindow(IP1)

	End Sub

	

	Private Function FIRST_IPADDRESS(ByVal X As Integer) As Byte

		FIRST_IPADDRESS = ((X And &H7F000000) \ &H1000000) Or (((X And &H80000000) <> 0) And &H80s)

	End Function

	

	Private Function SECOND_IPADDRESS(ByVal X As Integer) As Byte

		SECOND_IPADDRESS = (X And &HFF0000) \ &H10000

	End Function

	

	Private Function THIRD_IPADDRESS(ByVal X As Integer) As Byte

		THIRD_IPADDRESS = (X And &HFF00) \ &H100s

	End Function

	

	Private Function FOURTH_IPADDRESS(ByVal X As Integer) As Byte

		FOURTH_IPADDRESS = X And &HFFs

	End Function

	

	Private Function MAKEIPRANGE(ByVal low As Byte, ByVal high As Byte) As Integer

		MAKEIPRANGE = high * &H100 Or low

	End Function

	

	Private Function MAKEIPADDRESS(ByVal b1 As Byte, ByVal b2 As Byte, ByVal b3 As Byte, ByVal b4 As Byte) As Integer

		MAKEIPADDRESS = (CShort(b1 And &H7Fs) * &H1000000 Or (b1 And &H80s) <> 0 And &H80000000) Or (b2 * &H10000) Or (b3 * &H100) Or (b4)

	End Function

	

	

	'''µÃµ½   IP   µØÖ·

	Public Function GetIPAddress() As String

		Dim TempLng As Integer

		SendMessage(IP1, IPM_GETADDRESS, 0, TempLng)

		

		GetIPAddress = FIRST_IPADDRESS(TempLng) & "." & SECOND_IPADDRESS(TempLng) & "." & THIRD_IPADDRESS(TempLng) & "." & FOURTH_IPADDRESS(TempLng)

	End Function

	

	'''ÉèÖÃ   IP   µØÖ·

	Public WriteOnly Property SetIPAddress() As String

		Set(ByVal Value As String)

			'Public Function SetIPAddress(ByVal v1 As Integer, v2 As Integer, v3 As Integer, v4 As Integer) As Boolean

			'  SendMessage IP1, IPM_SETADDRESS, 0, ByVal MAKEIPADDRESS(v1, v2, v3, v4)

			' SendMessage IP1, IPM_SETADDRESS, 0, ByVal FIRST_IPADDRESS(v1) & "." & SECOND_IPADDRESS(v2) & "." & THIRD_IPADDRESS(v3) & "." & FOURTH_IPADDRESS(v4)

			Dim mByte(3) As Byte

			Dim vIp As Object

			Dim IpPrt As Integer

			

			'UPGRADE_WARNING: 未能解析对象 CountIF(NewIP, .) 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”

			If CountIF(Value, ".") < 3 Then

				'        Err.Raise 102, , "Ip 地址格式错误" & vbCrLf _

				'& "正确的格式应该为: 255.255.255.255"

				Exit Property

			Else

				'UPGRADE_WARNING: 未能解析对象 vIp 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”

				vIp = Split(Value, ".") ' IP地址分隔符

				'UPGRADE_WARNING: 未能解析对象 vIp() 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”

				mByte(0) = vIp(3)

				'UPGRADE_WARNING: 未能解析对象 vIp() 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”

				mByte(1) = vIp(2)

				'UPGRADE_WARNING: 未能解析对象 vIp() 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”

				mByte(2) = vIp(1)

				'UPGRADE_WARNING: 未能解析对象 vIp() 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”

				mByte(3) = vIp(0)

				'删除临时

				Erase vIp

				CopyMemory(IpPrt, mByte(0), 4)

				SendMessage(IP1, IPM_SETADDRESS, 0, IpPrt)

			End If

		End Set

	End Property

	

	Private Function CountIF(ByRef lzExpr As String, ByRef nChar As String) As Object

		Dim X, iCount As Short

		Dim sByte() As Byte

		'UPGRADE_TODO: 代码已升级为使用可能具有不同行为的 System.Text.UnicodeEncoding.Unicode.GetBytes()。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1059"”

		sByte = System.Text.UnicodeEncoding.Unicode.GetBytes(lzExpr)

		For X = LBound(sByte) To UBound(sByte)

			If sByte(X) = Asc(nChar) Then iCount = iCount + 1

		Next 

		X = 0 : Erase sByte

		'UPGRADE_WARNING: 未能解析对象 CountIF 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”

		CountIF = iCount

		iCount = 0

	End Function

End Class