-
Notifications
You must be signed in to change notification settings - Fork 3
/
modIPAddress.bas
152 lines (101 loc) · 4.2 KB
/
modIPAddress.bas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
Attribute VB_Name = "modIP"
Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2006 VBnet, Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
' applications, but you may not reproduce
' or publish this code on any web site,
' online service, or distribute as source
' on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Const IP_SUCCESS As Long = 0
Private Const MAX_WSADescription As Long = 256
Private Const MAX_WSASYSStatus As Long = 128
Private Const WS_VERSION_REQD As Long = &H101
Private Const WS_VERSION_MAJOR As Long = WS_VERSION_REQD \ &H100 And &HFF&
Private Const WS_VERSION_MINOR As Long = WS_VERSION_REQD And &HFF&
Private Const MIN_SOCKETS_REQD As Long = 1
Private Const SOCKET_ERROR As Long = -1
Private Const ERROR_SUCCESS As Long = 0
Private Type WSADATA
wVersion As Integer
wHighVersion As Integer
szDescription(0 To MAX_WSADescription) As Byte
szSystemStatus(0 To MAX_WSASYSStatus) As Byte
wMaxSockets As Long
wMaxUDPDG As Long
dwVendorInfo As Long
End Type
Private Declare Function gethostbyname Lib "wsock32.dll" _
(ByVal hostname As String) As Long
Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(xDest As Any, _
xSource As Any, _
ByVal nbytes As Long)
Private Declare Function lstrlenA Lib "kernel32" _
(lpString As Any) As Long
Private Declare Function WSAStartup Lib "wsock32.dll" _
(ByVal wVersionRequired As Long, _
lpWSADATA As WSADATA) As Long
Private Declare Function WSACleanup Lib "wsock32.dll" () As Long
Private Declare Function inet_ntoa Lib "wsock32.dll" _
(ByVal addr As Long) As Long
Private Declare Function lstrcpyA Lib "kernel32" _
(ByVal RetVal As String, _
ByVal Ptr As Long) As Long
Private Declare Function gethostname Lib "wsock32.dll" _
(ByVal szHost As String, _
ByVal dwHostLen As Long) As Long
Public Function SocketsInitialize() As Boolean
Dim WSAD As WSADATA
Dim success As Long
SocketsInitialize = WSAStartup(WS_VERSION_REQD, WSAD) = IP_SUCCESS
End Function
Public Sub SocketsCleanup()
If WSACleanup() <> 0 Then
MsgBox "Windows Sockets error occurred in Cleanup.", vbExclamation
End If
End Sub
Public Function GetMachineName() As String
Dim sHostName As String * 256
If gethostname(sHostName, 256) = ERROR_SUCCESS Then
GetMachineName = Trim$(sHostName)
End If
End Function
Public Function GetIPFromHostName(ByVal sHostName As String) As String
'converts a host name to an IP address
Dim nbytes As Long
Dim ptrHosent As Long 'address of HOSENT structure
Dim ptrName As Long 'address of name pointer
Dim ptrAddress As Long 'address of address pointer
Dim ptrIPAddress As Long
Dim ptrIPAddress2 As Long
ptrHosent = gethostbyname(sHostName & vbNullChar)
If ptrHosent <> 0 Then
'assign pointer addresses and offset
'Null-terminated list of addresses for the host.
'The Address is offset 12 bytes from the start of
'the HOSENT structure. Note: Here we are retrieving
'only the first address returned. To return more than
'one, define sAddress as a string array and loop through
'the 4-byte ptrIPAddress members returned. The last
'item is a terminating null. All addresses are returned
'in network byte order.
ptrAddress = ptrHosent + 12
'get the IP address
CopyMemory ptrAddress, ByVal ptrAddress, 4
CopyMemory ptrIPAddress, ByVal ptrAddress, 4
CopyMemory ptrIPAddress2, ByVal ptrIPAddress, 4
GetIPFromHostName = GetInetStrFromPtr(ptrIPAddress2)
End If
End Function
Public Function GetStrFromPtrA(ByVal lpszA As Long) As String
GetStrFromPtrA = String$(lstrlenA(ByVal lpszA), 0)
Call lstrcpyA(ByVal GetStrFromPtrA, ByVal lpszA)
End Function
Public Function GetInetStrFromPtr(Address As Long) As String
GetInetStrFromPtr = GetStrFromPtrA(inet_ntoa(Address))
End Function