用VB6來取得電腦名稱及IP地址

n4chen

請先設定成這樣,不用text box 用lable就好了
然後

一般區：

1. Private Const WS_VERSION_REQD = &H101
   
2. Private Const WS_VERSION_MAJOR = WS_VERSION_REQD \ &H100 And &HFF&
   
3. Private Const WS_VERSION_MINOR = WS_VERSION_REQD And &HFF&
   
4. Private Const MIN_SOCKETS_REQD = 1
   
5. Private Const SOCKET_ERROR = -1
   
6. Private Const WSADescription_Len = 256
   
7. Private Const WSASYS_Status_Len = 128
   
8. 
   
9. Private Type HOSTENT
   
10. hName As Long
    
11. hAliases As Long
    
12. hAddrType As Integer
    
13. hLength As Integer
    
14. hAddrList As Long
    
15. End Type
    
16. 
    
17. Private Type WSADATA
    
18. wversion As Integer
    
19. wHighVersion As Integer
    
20. szDescription(0 To WSADescription_Len) As Byte
    
21. szSystemStatus(0 To WSASYS_Status_Len) As Byte
    
22. iMaxSockets As Integer
    
23. iMaxUdpDg As Integer
    
24. lpszVendorInfo As Long
    
25. End Type
    
26. 
    
27. Private Declare Function WSAGetLastError Lib "WSOCK32.DLL" () As Long
    
28. Private Declare Function WSAStartup Lib "WSOCK32.DLL" (ByVal wVersionRequired As Integer, lpWSAData As WSADATA) As Long
    
29. Private Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long
    
30. Private Declare Function gethostname Lib "WSOCK32.DLL" (ByVal hostname$, ByVal HostLen As Long) As Long
    
31. Private Declare Function gethostbyname Lib "WSOCK32.DLL" (ByVal hostname$) As Long
    
32. Private Declare Sub RtlMoveMemory Lib "KERNEL32" (hpvDest As Any, ByVal hpvSource&, ByVal cbCopy&)

複製代碼

程式區：

1. Function hibyte(ByVal wParam As Integer)
   
2. 
   
3. hibyte = wParam \ &H100 And &HFF&
   
4. 
   
5. End Function
   
6. 
   
7. Function lobyte(ByVal wParam As Integer)
   
8. 
   
9. lobyte = wParam And &HFF&
   
10. 
    
11. End Function
    
12. 
    
13. Sub SocketsInitialize()
    
14. Dim WSAD As WSADATA
    
15. Dim iReturn As Integer
    
16. Dim sLowByte As String, sHighByte As String, sMsg As String
    
17. 
    
18. iReturn = WSAStartup(WS_VERSION_REQD, WSAD)
    
19. 
    
20. If iReturn <> 0 Then
    
21. MsgBox "Winsock.dll is not responding."
    
22. End
    
23. End If
    
24. 
    
25. If lobyte(WSAD.wversion) < WS_VERSION_MAJOR Or (lobyte(WSAD.wversion) = _
    
26. WS_VERSION_MAJOR And hibyte(WSAD.wversion) < WS_VERSION_MINOR) Then
    
27. 
    
28. sHighByte = Trim$(Str$(hibyte(WSAD.wversion)))
    
29. sLowByte = Trim$(Str$(lobyte(WSAD.wversion)))
    
30. sMsg = "Windows Sockets version " & sLowByte & "." & sHighByte
    
31. sMsg = sMsg & " is not supported by winsock.dll "
    
32. MsgBox sMsg
    
33. End
    
34. End If
    
35. 
    
36. 'iMaxSockets is not used in winsock 2. So the following check is only
    
37. 'necessary for winsock 1. If winsock 2 is requested,
    
38. 'the following check can be skipped.
    
39. 
    
40. If WSAD.iMaxSockets < MIN_SOCKETS_REQD Then
    
41. sMsg = "This application requires a minimum of "
    
42. sMsg = sMsg & Trim$(Str$(MIN_SOCKETS_REQD)) & " supported sockets."
    
43. MsgBox sMsg
    
44. End
    
45. End If
    
46. 
    
47. End Sub
    
48. 
    
49. Sub SocketsCleanup()
    
50. Dim lReturn As Long
    
51. 
    
52. lReturn = WSACleanup()
    
53. 
    
54. If lReturn <> 0 Then
    
55. MsgBox "Socket error " & Trim$(Str$(lReturn)) & " occurred in Cleanup "
    
56. End
    
57. End If
    
58. 
    
59. End Sub
    
60. 
    
61. Sub Form_Load()
    
62. 
    
63. SocketsInitialize
    
64. 
    
65. End Sub
    
66. 
    
67. Private Sub Form_Unload(Cancel As Integer)
    
68. 
    
69. SocketsCleanup
    
70. 
    
71. End Sub

複製代碼

表單-按鈕

1. Private Sub Command1_click()
   
2. Dim hostname As String * 256
   
3. Dim hostent_addr As Long
   
4. Dim host As HOSTENT
   
5. Dim hostip_addr As Long
   
6. Dim temp_ip_address() As Byte
   
7. Dim i As Integer
   
8. Dim ip_address As String
   
9. 
   
10. If gethostname(hostname, 256) = SOCKET_ERROR Then
    
11. MsgBox "Windows Sockets error " & Str(WSAGetLastError())
    
12. Exit Sub
    
13. Else
    
14. hostname = Trim$(hostname)
    
15. End If
    
16. 
    
17. hostent_addr = gethostbyname(hostname)
    
18. 
    
19. If hostent_addr = 0 Then
    
20. MsgBox "Winsock.dll is not responding."
    
21. Exit Sub
    
22. End If
    
23. 
    
24. RtlMoveMemory host, hostent_addr, LenB(host)
    
25. RtlMoveMemory hostip_addr, host.hAddrList, 4
    
26. 
    
27. Label2.Caption = hostname
    
28. 
    
29. 'get all of the IP address if machine is multi-homed
    
30. Label3.Caption = ""
    
31. 
    
32. Do
    
33. ReDim temp_ip_address(1 To host.hLength)
    
34. RtlMoveMemory temp_ip_address(1), hostip_addr, host.hLength
    
35. 
    
36. For i = 1 To host.hLength
    
37. ip_address = ip_address & temp_ip_address(i) & "."
    
38. Next
    
39. ip_address = Mid$(ip_address, 1, Len(ip_address) - 1)
    
40. 
    
41. Label3 = Label3 & ip_address & vbCrLf
    
42. 
    
43. 
    
44. ip_address = ""
    
45. host.hAddrList = host.hAddrList + LenB(host.hAddrList)
    
46. RtlMoveMemory hostip_addr, host.hAddrList, 4
    
47. Loop While (hostip_addr <> 0)
    
48. 
    
49. End Sub

複製代碼

作者不是我
我原本要貼他的部落格的 結果貼不成
只能跟那個作者說抱歉了...

瀏覽完整內容，請先 註冊 或 登入會員

可以參考這個範例寫我的VB程式,真的是提供很好的參考方向!!!

新手上路

感謝分享

tonybenny1234

謝謝大大提供的範例~
幫助很大~謝囉!!~
還有也謝謝原作者~

alver

感謝分享
很好的參考方向

philip129

謝謝大大清楚貼上程式碼
太久的記憶
VB都全忘光了

[b]回復 [url=http://www.eyny.com/redirect.php?goto=findpost&pid=138414902&ptid=5531973]1#[/url] [i]n4chen[/i] [/b]


    謝謝大大

太讚了，真是實用
謝謝大大無私的分享
馬上來試run看看。

sluo

程式好像太長了,先下載附件看看,可能裡面有其他東西

gemini670521

謝謝大大分享source code，目前公司有需要這樣的方式可以減低人員在電腦點來點去的
時間

ahway9988

我也想知道伊莉是否有限制哪些網址不能貼上來
知道有摩部落格的不行
原因不曉得(我也想知道)

至於作者的部落格,版大您可以加進記事本放進您的壓縮檔裡,檔名再註名
這樣您就對得起作者了

darkjack

給樓上的，
就我所知的
很多 縮短的網址 例如   p t t . c c
就是不能
然後有關於 部落格的也幾乎不行
好像連 無名的也不行

alan198606

哇!~大大分享程式碼耶!!~好棒喔!!

給你一個讚!!