home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / NexIRC_v2_2222363312012.psc / clsDNS.cls < prev    next >
Text File  |  2005-04-25  |  5KB  |  149 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "clsDNS"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Option Explicit
  15. Private Declare Function WSAStartup Lib "wsock32" (ByVal VersionReq As Long, WSADataReturn As gWSAInfo) As Long
  16. Private Declare Function WSACleanup Lib "wsock32" () As Long
  17. Private Declare Function WSAGetLastError Lib "wsock32" () As Long
  18. Private Declare Function GetHostByAddr Lib "wsock32" (addr As Long, addrLen As Long, addrType As Long) As Long
  19. Private Declare Function gethostbyname Lib "wsock32" Alias "GetHostByName" (ByVal hostname As String) As Long
  20. Private Declare Sub RtlMoveMemory Lib "kernel32" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)
  21. Private lStarted As Boolean
  22. Private Type gWSAInfo
  23.     wversion As Integer
  24.     wHighVersion As Integer
  25.     szDescription(0 To 256) As Byte
  26.     szSystemStatus(0 To 128) As Byte
  27.     iMaxSockets As Integer
  28.     iMaxUdpDg As Integer
  29.     lpszVendorInfo As Long
  30. End Type
  31. Private Type gHostInfo
  32.     hName As Long
  33.     hAliases As Long
  34.     hAddrType As Integer
  35.     hLength As Integer
  36.     hAddrList As Long
  37. End Type
  38.  
  39. Private Sub Class_Initialize()
  40. If lSettings.sHandleErrors = True Then On Local Error Resume Next
  41. Dim lWSA As gWSAInfo
  42. lStarted = (WSAStartup(257, lWSA) = 0)
  43. If Err.Number <> 0 Then ProcessRuntimeError Err.Description, Err.Number, "Private Sub Class_Initialize()"
  44. End Sub
  45.  
  46. Private Sub Class_Terminate()
  47. If lSettings.sHandleErrors = True Then On Local Error Resume Next
  48. If lStarted = True Then WSACleanup
  49. If Err.Number <> 0 Then ProcessRuntimeError Err.Description, Err.Number, "Private Sub Class_Terminate()"
  50. End Sub
  51.  
  52. Private Function ReturnIP(lIP As String) As Boolean
  53. If lSettings.sHandleErrors = True Then On Error GoTo ErrHandler
  54. Dim msg, l As Long, b As Byte
  55. msg = Split(lIP, ".")
  56. If UBound(msg) < 3 Then
  57.     Exit Function
  58. End If
  59. For l = LBound(msg) To UBound(msg)
  60.     b = msg(l)
  61. Next l
  62. ReturnIP = True
  63. ErrHandler:
  64. If Err.Number <> 0 Then ProcessRuntimeError Err.Description, Err.Number, "Private Function ReturnIP(lIP As String) As Boolean"
  65. End Function
  66.  
  67. Private Function CreateIP(lAddress As String) As Long
  68. If lSettings.sHandleErrors = True Then On Error GoTo ErrHandler
  69. Dim msg, l As Long, i As Long
  70. msg = Split(lAddress, ".")
  71. For i = 0 To (UBound(msg) - 1)
  72.     l = l + (msg(i) * (256 ^ i))
  73. Next i
  74. If msg(UBound(msg)) < 128 Then
  75.     l = l + (msg(UBound(msg)) * (256 ^ 3))
  76. Else
  77.     l = l + ((msg(UBound(msg)) - 256) * (256 ^ 3))
  78. End If
  79. CreateIP = l
  80. ErrHandler:
  81. If Err.Number <> 0 Then ProcessRuntimeError Err.Description, Err.Number, "Private Function CreateIP(lAddress As String) As Long"
  82. End Function
  83.  
  84. Public Function AddrToName(lAddress As String) As String
  85. If lSettings.sHandleErrors = True Then On Error GoTo ErrHandler
  86. Dim lHostInfo As gHostInfo, lHost As String * 255, msg As String, l As Long, i As Long
  87. If ReturnIP(lAddress) Then
  88.     i = CreateIP(lAddress)
  89.     l = GetHostByAddr(i, 4, 4&)
  90.     If l = 0 Then
  91.         Exit Function
  92.     End If
  93.     RtlMoveMemory lHostInfo, l, Len(lHostInfo)
  94.     RtlMoveMemory ByVal lHost, lHostInfo.hName, 255
  95.     msg = TrimNull(lHost)
  96.     AddrToName = msg
  97. End If
  98. ErrHandler:
  99. If Err.Number <> 0 Then ProcessRuntimeError Err.Description, Err.Number, "Public Function AddrToName(lAddress As String) As String"
  100. End Function
  101.  
  102. Public Function NameToAddr(ByVal lHost As String)
  103. If lSettings.sHandleErrors = True Then On Error GoTo ErrHandler
  104. Dim lIpArr() As Byte, lHostEntry As gHostInfo, msg As String, l As Long, i As Long, n As Integer
  105. l = gethostbyname(lHost)
  106. If l = 0 Then
  107.     Exit Function
  108. End If
  109. RtlMoveMemory lHostEntry, l, LenB(lHostEntry)
  110. RtlMoveMemory i, lHostEntry.hAddrList, 4
  111. ReDim lIpArr(1 To lHostEntry.hLength)
  112. RtlMoveMemory lIpArr(1), i, lHostEntry.hLength
  113. For n = 1 To lHostEntry.hLength
  114.     msg = msg & lIpArr(n) & "."
  115. Next n
  116. msg = Mid(msg, 1, Len(msg) - 1)
  117. NameToAddr = msg
  118. ErrHandler:
  119. If Err.Number <> 0 Then ProcessRuntimeError Err.Description, Err.Number, "Public Function NameToAddr(ByVal lHost As String)"
  120. End Function
  121.  
  122. Public Function AddressToName(strIP As String) As String
  123. If lSettings.sHandleErrors = True Then On Local Error Resume Next
  124. If lStarted = True Then
  125.     AddressToName = AddrToName(strIP)
  126. End If
  127. If Err.Number <> 0 Then ProcessRuntimeError Err.Description, Err.Number, "Public Function AddressToName(strIP As String) As String"
  128. End Function
  129.  
  130. Public Function NameToAddress(strName As String) As String
  131. If lSettings.sHandleErrors = True Then On Local Error Resume Next
  132. If lStarted = True Then
  133.     NameToAddress = NameToAddr(strName)
  134. End If
  135. If Err.Number <> 0 Then ProcessRuntimeError Err.Description, Err.Number, "Public Function NameToAddress(strName As String) As String"
  136. End Function
  137.  
  138. Private Function TrimNull(lTrim As String) As String
  139. If lSettings.sHandleErrors = True Then On Local Error Resume Next
  140. Dim l As Long
  141. l = InStr(1, lTrim, Chr(0))
  142. If l > 0 Then
  143.     TrimNull = Left(lTrim, l - 1)
  144. Else
  145.     TrimNull = lTrim
  146. End If
  147. If Err.Number <> 0 Then ProcessRuntimeError Err.Description, Err.Number, "Private Function TrimNull(lTrim As String) As String"
  148. End Function
  149.