当前位置:编程学习 > VB >>

求高手帮忙检测这段代码哪地方出问题了

--------------------编程问答-------------------- --------------------编程问答-------------------- 还是出错了,不晓得怎么搞了 --------------------编程问答-------------------- 所有的API都不对,API是要认大小写的。DLL也不对,我的XPSp3不是wsock32.dll,而是ws2_32.dll,有点奇怪,你的什么系统?
现在错误是没有了,但这段程序总是Ping不成功,连本机都Ping不成功,程序设计上有问题。但时间和地址是对的。

Option Explicit
Private Const ws_version_reqd As Long = &H101
Private Const inaddr_none As Long = &HFFFFFFFF
Private Const max_wsadescription As Long = 256
Private Const max_wsasysstatus As Long = 128
Private Const ping_timeout As Long = 500
Private Type icmp_options
    ttl        As Byte
    tos        As Byte
    plags      As Byte
    optionssize As Byte
    optionsdata As Long
End Type
Private Type icmp_echo_reply
    address As Long
    status As Long
    roundtriptime As Long
    datasize As Long
    datapointer As Long
    data As String * 250
End Type
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 IcmpCreateFile Lib "ICMP.dll" () As Long
Private Declare Function IcmpCloseHandle Lib "ICMP.dll" (ByVal IcmpHandle As Long) As Long
'Private Declare Function IcmpSendEcho Lib "ICMP.dll" (ByVal IcmpHandle As Long, ByRef DestinationAddress As IPAddr, ByRef RequestData As Any, ByVal RequestSize As Integer, ByRef RequestOptions As PIP_OPTION_INFORMATION, ByRef ReplyBuffer As Any, ByVal ReplySize As Long, ByVal Timeout As Long) As Long
Private Declare Function IcmpSendEcho Lib "ICMP.dll" (ByVal IcmpHandle As Long, ByRef DestinationAddress As String, ByRef RequestData As Any, ByVal RequestSize As Integer, ByRef RequestOptions As Long, ByRef ReplyBuffer As Any, ByVal ReplySize As Long, ByVal Timeout As Long) As Long
Private Declare Function WSAStartup Lib "ws2_32.dll" (ByVal wVersionRequired As Integer, ByRef lpWSAData As wsadata) As Long
Private Declare Function WSACleanup Lib "ws2_32.dll" () As Long
Private Declare Function gethostname Lib "ws2_32.dll" (ByVal name As String, ByVal namelen As Long) As Long
Private Declare Sub gethostbyname Lib "ws2_32.dll" (ByVal name As String)
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Private Declare Function inet_addr Lib "ws2_32.dll" (ByVal cp As String) As Long


'Private Declare Function icmpcreatefile Lib "icmp.dll" () As Long
'Private Declare Function icmpclosehandle Lib "icmp.dll" (ByVal icmphandle As Long) As Long
'Private Declare Function icmpsendecho Lib "icmp.dll" (ByVal icmphandle As Long, ByVal destinationaddress As Long, ByVal requestdata As String, ByVal requestsize As Long, ByVal requestoptions As Long, replybuffer As icmp_echo_reply, ByVal replysize As Long, ByVal timeout As Long) As Long
'Private Declare Function wsastartup Lib "ws2_32.dll" (ByVal wversionrequired As Long, lpwsadata As wsadata) As Long
'Private Declare Function wsacleanup Lib "ws2_32.dll" () As Long
'Private Declare Function gethostname Lib "wsock32.dll" (ByVal szhost As String, ByVal dwhostlen As Long) As Long
'Private Declare Function gethostbyname Lib "wsock32.dll" (ByVal szhost As String) As Long
'Private Declare Sub conpymenory Lib "kernel32" Alias "relmovememory" (xdest As Any, xsource As Any, ByVal nbytes As Long)
'Private Declare Function inet_addr Lib "wsock32.dll" (ByVal s As String) As Long

Private Sub command1_click() 'ping网络计算机
    Dim echo As icmp_echo_reply
    Dim pos As Long
    Dim wsad As wsadata
    Dim aa As Boolean
    Dim mystr As String
    
    aa = WSAStartup(ws_version_reqd, wsad) = 0
    If aa Then
        Dim hport As Long
        mystr = inet_addr(Text1.Text)
        If mystr <> inaddr_none Then
            hport = IcmpCreateFile()
            If hport Then
                Call IcmpSendEcho(hport, StrPtr(mystr), Text2.Text, Len(Text2.Text), 0, echo, Len(echo), ping_timeout)  '发送回响请求报文,返易做图响应答报文
                Call IcmpCloseHandle(hport)
            End If
            If echo.status = 0 Then Label4(0).Caption = "ping 成功" Else Label4(0).Caption = "ping 失败"
            Label4(1).Caption = echo.address
            Label4(2).Caption = echo.roundtriptime & "ms" '显示网络连接延迟时间
            Label4(3).Caption = echo.datasize & "bytes '显示数据包大小"
            Label4(4).Caption = echo.datapointer
        End If
    End If
End Sub
--------------------编程问答-------------------- 我的是server 2003
补充:VB ,  基础类
CopyRight © 2022 站长资源库 编程知识问答 zzzyk.com All Rights Reserved
部分文章来自网络,