ip.frm

适合乡镇供电所使用电费处理系统v3 软件

VERSION 5.00
Begin VB.Form IP 
   AutoRedraw      =   -1  'True
   Caption         =   "Form2"
   ClientHeight    =   3195
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   7215
   LinkTopic       =   "Form2"
   ScaleHeight     =   3195
   ScaleWidth      =   7215
   StartUpPosition =   3  '窗口缺省
   Begin VB.PictureBox Picture1 
      AutoRedraw      =   -1  'True
      Height          =   525
      Left            =   150
      Picture         =   "IP.frx":0000
      ScaleHeight     =   465
      ScaleWidth      =   390
      TabIndex        =   4
      Top             =   120
      Width           =   450
   End
   Begin VB.CommandButton Command3 
      Caption         =   "Command3"
      Height          =   345
      Left            =   2535
      TabIndex        =   3
      Top             =   2565
      Width           =   1350
   End
   Begin VB.CommandButton Command2 
      Caption         =   "Command2"
      Height          =   375
      Left            =   510
      TabIndex        =   2
      Top             =   2520
      Width           =   1320
   End
   Begin VB.TextBox Text1 
      Height          =   495
      IMEMode         =   1  'ON
      Left            =   2025
      TabIndex        =   1
      Text            =   "Text1"
      Top             =   105
      Width           =   2280
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   495
      Left            =   1740
      TabIndex        =   0
      Top             =   1350
      Width           =   1215
   End
End
Attribute VB_Name = "IP"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
' #MndSoft#************************************************************
' * 程序名  : 获取本机IP
' * 主页    : www.MNDSOFT.363.NET
' * E-Mail           : [e-mail]
' * 日期              : 17/01/02
' * 时间              : 14:25
' * 模块名           : IP_Module
' * 模块文件名        : IP.bas
' **********************************************************************
' * 注释         :
' **********************************************************************

Private Const WS_VERSION_REQD = &H101
Private Const WS_VERSION_MAJOR = WS_VERSION_REQD \ &H100 And &HFF&
Private Const WS_VERSION_MINOR = WS_VERSION_REQD And &HFF&
Private Const MIN_SOCKETS_REQD = 1
Private Const SOCKET_ERROR = -1
Private Const WSADescription_Len = 256
Private Const WSASYS_Status_Len = 128

Private Type HOSTENT
   hName As Long
   hAliases As Long
   hAddrType As Integer
   hLength As Integer
   hAddrList As Long
End Type

Private Type WSADATA
   wversion As Integer
   wHighVersion As Integer
   szDescription(0 To WSADescription_Len) As Byte
   szSystemStatus(0 To WSASYS_Status_Len) As Byte
   iMaxSockets As Integer
   iMaxUdpDg As Integer
   lpszVendorInfo As Long
End Type

Private Declare Function WSAGetLastError Lib "WSOCK32.DLL" () As Long
Private Declare Function WSAStartup Lib "WSOCK32.DLL" (ByVal wVersionRequired&, lpWSAData As WSADATA) As Long
Private Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long
Private Declare Function gethostbyname Lib "WSOCK32.DLL" (ByVal hostname$) As Long
Private Declare Sub RtlMoveMemory Lib "kernel32" (hpvDest As Any, ByVal hpvSource&, ByVal cbCopy&)

Private hwnd5 As Long

Function hibyte(ByVal wParam As Integer)
   hibyte = wParam \ &H100 And &HFF&
End Function

Function lobyte(ByVal wParam As Integer)
   lobyte = wParam And &HFF&
End Function

Sub SocketsInitialize()
   Dim WSAD As WSADATA
   Dim iReturn As Integer
   Dim sLowByte As String, sHighByte As String, sMsg As String
   iReturn = WSAStartup(WS_VERSION_REQD, WSAD)
   If iReturn <> 0 Then
      MsgBox "Winsock.dll没有响应."
      End
   End If
   
   If lobyte(WSAD.wversion) < WS_VERSION_MAJOR Or (lobyte(WSAD.wversion) = WS_VERSION_MAJOR And hibyte(WSAD.wversion) < WS_VERSION_MINOR) Then
      sHighByte = Trim$(Str$(hibyte(WSAD.wversion)))
      sLowByte = Trim$(Str$(lobyte(WSAD.wversion)))
      sMsg = "Windows Sockets的版本" & sLowByte & "." & sHighByte
      sMsg = sMsg & " 是不支持的winsock.dll "
      MsgBox sMsg
      End
   End If
   
   If WSAD.iMaxSockets < MIN_SOCKETS_REQD Then
      sMsg = "该程序需要最小"
      sMsg = sMsg & Trim$(Str$(MIN_SOCKETS_REQD)) & "支持的值."
      MsgBox sMsg
      End
   End If
   
End Sub

Sub SocketsCleanup()
   Dim lReturn As Long
   
   lReturn = WSACleanup()
   
   If lReturn <> 0 Then
      MsgBox "Socket 出错 " & Trim$(Str$(lReturn)) & "产生！"
      End
   End If
   
End Sub

Sub Form_Load()
   SocketsInitialize
End Sub

Private Sub Form_Unload(Cancel As Integer)
   SocketsCleanup
End Sub

Private Sub Command1_Click()
   Dim hostent_addr As Long
   Dim host As HOSTENT
   Dim hostip_addr As Long
   Dim temp_ip_address() As Byte
   Dim i As Integer
   Dim ip_address As String
   
   hostent_addr = gethostbyname(Text1)
   
   If hostent_addr = 0 Then
      MsgBox "无法解析计算机名."
      Exit Sub
   End If
   
   RtlMoveMemory host, hostent_addr, LenB(host)
   RtlMoveMemory hostip_addr, host.hAddrList, 4
   
   ReDim temp_ip_address(1 To host.hLength)
   RtlMoveMemory temp_ip_address(1), hostip_addr, host.hLength
   
   For i = 1 To host.hLength
      ip_address = ip_address & temp_ip_address(i) & "."
   Next
   ip_address = Mid$(ip_address, 1, Len(ip_address) - 1)
   
   MsgBox ip_address
   
End Sub

Private Sub Form_Resize()
   Picture1.Move 100, 800, ScaleWidth - 200, ScaleHeight - 200
End Sub

Private Sub Form_Paint()
     Me.PaintPicture Me.Picture1, 0, 0, ScaleWidth, ScaleHeight
End Sub