This code was found on a Visual Basic web site and converted to LotusScript. It is a LotusScript class that allows you to convert a host name to its IP address. To use, create a new HostName object. Then check the IPAddress property of the new object to get the IP address. The property is a string.
This code is best stored in a script library. Create a new script library, then go to the (Declarations) section. The first part of that section is some constants:
Public Const IP_SUCCESS = 0
Private Const WSADescription_Len = 255 ' 256, 0-based
Private Const WSASYS_Status_Len = 127 ' 128, 0-based
Public Const WS_VERSION_REQD = &H101
Public Const MIN_SOCKETS_REQD = 1
Public Const SOCKET_ERROR = -1
After that, a custom Type is needed, still in the (Declarations) section.
Public Type WSADATA
wVersion As Integer
wHighVersion As Integer
szDescription(0 To WSADescription_Len) As Integer
szSystemStatus(0 To WSASYS_Status_Len) As Integer
wMaxSockets As Long
wMaxUDPDG As Long
dwVendorInfo As Long
End Type
Note: If you are using R6, then you can define szDescription and szSystemStatus as Byte arrays instead of Integer arrays.
Next comes the Windows API calls we will need to convert the host name to the IP address:
Declare Function gethostbyname Lib "wsock32" (Byval hostname As String) As Long
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (xDest As Any, xSource As Any, Byval nbytes As Long)
Declare Function lstrlenA Lib "kernel32" (lpString As Any) As Long
Declare Function WSAStartup Lib "wsock32" (Byval wVersionRequired As Long, lpWSADATA As WSADATA) As Long
Declare Function WSACleanup Lib "wsock32" () As Long
Declare Function inet_ntoa Lib "wsock32.dll" (Byval addr As Long) As Long
Declare Function lstrcpyA Lib "kernel32" (Byval RetVal As String, Byval Ptr As Long) As Long
Finally, the actual class definition comes. This class definition is pretty simplified (there aren't a lot of properties/methods).
Class HostName
Private HostNameStr As String
Public IPAddress As String
Public ErrMsg As String
Public Error As Integer
Sub New(host As String)
If SocketsInitialize() Then
Me.IPAddress = GetIPFromHostName(host)
Me.Error = 0
Me.ErrMsg = ""
If Not SocketsCleanup Then
Me.Error = 200
Me.ErrMsg = "Windows Sockets error occurred in Cleanup."
End If
Else
Me.Error = 100
Me.ErrMsg = "Windows Sockets for 32 bit Windows is not successfully responding."
Me.IPAddress = ""
End If
End Sub
End Class
Some additional functions are needed. Those are defined below. They are still part of the script library.
Private Function SocketsInitialize() As Integer
Dim WSAD As WSADATA
Dim success As Long
SocketsInitialize = (WSAStartup(WS_VERSION_REQD, WSAD) = IP_SUCCESS)
End Function
Private Function SocketsCleanup() As Integer
If WSACleanup() <> 0 Then
SocketsCleanup = False
Else
SocketsCleanup = True
End If
End Function
Private Function GetIPFromHostName(Byval sHostName As String) As String
Dim ptrHosent As Long
Dim ptrName As Long
Dim ptrAddress As Long
Dim ptrIPAddress As Long
Dim dwAddress As Long
ptrHosent = gethostbyname(sHostName & Chr(0))
If ptrHosent <> 0 Then
ptrName = ptrHosent
ptrAddress = ptrHosent + 12
CopyMemory ptrAddress, Byval ptrAddress, 4
CopyMemory ptrIPAddress, Byval ptrAddress, 4
CopyMemory dwAddress, Byval ptrIPAddress, 4
GetIPFromHostName = GetIPFromAddress(dwAddress)
End If
End Function
Public Function GetIPFromAddress(Address As Long) As String
Dim ptrString As Long
ptrString = inet_ntoa(Address)
GetIPFromAddress = GetStrFromPtrA(ptrString)
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
(author is here http://www.sbacode.com/pageTips.aspx?id=207&)
No comments :
Post a Comment