预览模式: 普通 | 列表

VB将域名转换成IP地址

作者:青锋幽灵 日期:2007-04-08 15:20

ASP/Visual Basic代码
  1. Option Explicit   
  2.   
  3. Private Type HOSTENT   
  4.     hName As Long  
  5.     hAliases As Long  
  6.     hAddrType As Integer  
  7.     hLength As Integer  
  8.     hAddrList As Long  
  9. End Type   
  10.   
  11. Private Type WSADATA   
  12.     wversion As Integer  
  13.     wHighVersion As Integer  
  14.     szDescription(0 To 256) As Byte  
  15.     szSystemStatus(0 To 128) As Byte  
  16.     iMaxSockets As Integer  
  17.     iMaxUdpDg As Integer  
  18.     lpszVendorInfo As Long  
  19. End Type   
  20.   
  21. Private Declare Function WSAGetLastError Lib "WSOCK32.DLL" () As Long  
  22. Private Declare Function WSAStartup Lib "WSOCK32.DLL" (ByVal wVersionRequired As Integer, lpWSAData As WSADATA) As Long  
  23. Private Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long  
  24. Private Declare Function gethostname Lib "WSOCK32.DLL" (ByVal szHostname As String, ByVal HostLen As Long) As Long  
  25. Private Declare Function gethostbyname Lib "WSOCK32.DLL" (ByVal szHostname As String) As Long  
  26. Private Declare Sub RtlMoveMemory Lib "KERNEL32" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)   
  27.   
  28. Private Const WS_VERSION_REQD = &H101   
  29.   
  30. Private Function Test(URL As String) As String  
  31.     InitializeWinSock   
  32.     Test = GetAddressByName(URL)   
  33.     TerminateWinSock   
  34. End Function  
  35.   
  36. Private Function GetAddressByName(strHostname As String)   
  37.     Dim lngAddr As Long  
  38.     Dim udtHost As HOSTENT   
  39.     Dim lngIP As Long  
  40.     Dim bteTmp() As Byte  
  41.     Dim i As Integer  
  42.     Dim strIP As String  
  43.   
  44.     lngAddr = gethostbyname(strHostname)   
  45.   
  46.     If lngAddr = 0 Then  
  47.         MsgBox "Kein Host gefunden."  
  48.         GetAddressByName = Null   
  49.         Exit Function  
  50.     End If  
  51.   
  52.     RtlMoveMemory udtHost, lngAddr, LenB(udtHost)   
  53.     RtlMoveMemory lngIP, udtHost.hAddrList, 4   
  54.   
  55.     ReDim bteTmp(1 To udtHost.hLength)   
  56.     RtlMoveMemory bteTmp(1), lngIP, udtHost.hLength   
  57.     For i = 1 To udtHost.hLength   
  58.         strIP = strIP & bteTmp(i) & "."  
  59.     Next  
  60.     strIP = Mid$(strIP, 1, Len(strIP) - 1)   
  61.   
  62.     GetAddressByName = strIP   
  63. End Function  
  64.   
  65. Private Sub InitializeWinSock()   
  66.     Dim udtWSAD As WSADATA   
  67.     Dim lngRet As Long  
  68.     lngRet = WSAStartup(WS_VERSION_REQD, udtWSAD)   
  69.     If lngRet <> 0 Then  
  70.         MsgBox "Winsock.dll konnte nicht initialisiert werden."  
  71.         End  
  72.     End If  
  73. End Sub  
  74.   
  75. Private Sub TerminateWinSock()   
  76.     Dim lngRet As Long  
  77.     lngRet = WSACleanup()   
  78.     If lngRet <> 0 Then  
  79.         MsgBox "Fehler " & lngRet & " beim Beenden von Winsock.dll"  
  80.         End  
  81.     End If  
  82. End Sub  
  83.   
  84. Private Sub Command1_Click()   
  85.     Dim MyURL As String  
  86.     MyURL = "domain"  
  87.     MsgBox MyURL & "的IP地址是：" & Test(MyURL)   
  88. End Sub  
类别: VB | 引用: 0 | 评论: 0 | 阅读: 1362 | 打印 | 打包

VB获取系统运行时间

作者:青锋幽灵 日期:2007-04-05 13:58

ASP/Visual Basic代码
  1. Private Declare Function GetTickCount& Lib "kernel32" ()   
  2.   
  3. Dim a As Long  
  4. Dim b As Long  
  5. Dim c As Long  
  6. Dim d As Long  
  7. Dim e As Long  
  8.   
  9. Private Sub Form_Load()   
  10.      '   
  11. End Sub  
  12.   
  13. Private Sub Timer1_Timer()   
  14.      a = GetTickCount \ 1000   
  15.      b = GetTickCount \ 1000 \ 60   
  16.      c = GetTickCount \ 1000 \ 60 \ 60   
  17.      d = (a - c * 3600) \ 60   
  18.      e = a - b * 60   
  19.      lblsecond.Caption = e   
  20.      lblminute.Caption = d   
  21.      lblhour.Caption = c   
  22. End Sub  
类别: VB | 引用: 0 | 评论: 0 | 阅读: 1934 | 打印 | 打包
  • 1