谁能将这段VB源代码转换为AU3的

itljl

Attribute VB_Name = "Module1"
  Declare Function bind Lib "ws2_32.dll" (ByVal s As Long, addr As SOCK_ADDR, ByVal namelen As Long) As Long
  Declare Function closesocket Lib "ws2_32.dll" (ByVal s As Long) As Long
  Declare Function connect Lib "ws2_32.dll" (ByVal s As Long, name As SOCK_ADDR, ByVal namelen As Integer) As Long
  Declare Function inet_addr Lib "ws2_32.dll" (ByVal cp As String) As Long
  Declare Function htons Lib "ws2_32.dll" (ByVal hostshort As Integer) As Integer
  Declare Function recv Lib "ws2_32.dll" (ByVal s As Long, buffer As Any, ByVal length As Long, ByVal flags As Long) As Long
  Declare Function send Lib "ws2_32.dll" (ByVal s As Long, buffer As Any, ByVal length As Long, ByVal flags As Long) As Long
  Declare Function shutdown Lib "ws2_32.dll" (ByVal s As Long, ByVal how As Long) As Long
  Declare Function ioctlsocket Lib "ws2_32.dll" (ByVal s As Long, ByVal v As Long, ut As Long) As Long
  Declare Function socket Lib "ws2_32.dll" (ByVal af As Long, ByVal type_specification As Long, ByVal protocol As Long) As Long
  Declare Function WSACancelBlockingCall Lib "ws2_32.dll" () As Long
  Declare Function WSACleanup Lib "ws2_32.dll" () As Long
  Declare Function WSAGetLastError Lib "ws2_32.dll" () As Long
  Declare Function WSAStartup Lib "ws2_32.dll" (ByVal wVersionRequired As Integer, wsData As WSA_DATA) As Long
  Declare Function WSASocketA Lib "ws2_32.dll" (ByVal af As Long, ByVal type1 As Long, ByVal protocol As Long, lpProtocolInfo As Long, g As Long, ByVal dwFlags As Long)
  Declare Function WSAIoctl Lib "ws2_32.dll" (ByVal s As Long, ByVal dwIoControlCode As Long, lpvInBuffer As Long, ByVal cbInBuffer As Long, lpvOutBuffer As Long, ByVal cbOutBuffer As Long, lpcbBytesReturned As Long, lpOverlapped As Long, lpCompletionRoutine As Long) As Long
  Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal length As Long)
  Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
  Public Const WSADESCRIPTION_LEN = 256
  Public Const WSASYS_STATUS_LEN = 128
  Type WSA_DATA
          wVersion   As Integer
          wHighVersion   As Integer
          strDescription(WSADESCRIPTION_LEN + 1)       As Byte
          strSystemStatus(WSASYS_STATUS_LEN + 1)       As Byte
          iMaxSockets   As Integer
          iMaxUdpDg   As Integer
          lpVendorInfo   As Long
  End Type
  Type IN_ADDR
          S_addr   As Long
  End Type
  Type SOCK_ADDR
          sin_family   As Integer
          sin_port   As Integer
          sin_addr   As IN_ADDR
          sin_zero(0 To 7)       As Byte
  End Type
  Type IPHeader
          lenver   As Byte '版本
          tos   As Byte '总长
          len   As Integer '总长
          ident   As Integer '标识
          flags   As Integer '标志
          ttl   As Byte '分段偏移
          proto   As Byte '协议
          checksum   As Integer '头校验和
          sourceIP   As Long '源地址
          destIP   As Long '目的地址
  End Type
  Const AF_INET = 2
  Const SOCK_RAW = 3
  Const IPPROTO_IP = 0
  Const IPPROTO_TCP = 6
  Const IPPROTO_UDP = 17
  Const MAX_PACK_LEN = 65535
  Const SOCKET_ERROR = -1&
  Private mwsaData     As WSA_DATA
  Private m_hSocket     As Long
  Private msaLocalAddr     As SOCK_ADDR
  Private msaRemoteAddr     As SOCK_ADDR
  
  Public stopA As Boolean
  Sub MainA(ByVal Localip As String)
          Dim nResult     As Long
          nResult = WSAStartup(&H202, mwsaData)
          If nResult <> WSANOERROR Then
              MsgBox "初开化WINSOCK错误"
              Exit Sub
          End If
          m_hSocket = socket(AF_INET, SOCK_RAW, IPPROTO_IP)
          If (m_hSocket = INVALID_SOCKET) Then
                MsgBox "初开化原始WINSOCK错误"
                Exit Sub
          End If
            
          msaLocalAddr.sin_family = AF_INET
          msaLocalAddr.sin_port = 0
          msaLocalAddr.sin_addr.S_addr = inet_addr(Localip)
          nResult = bind(m_hSocket, msaLocalAddr, Len(msaLocalAddr))
          If (nResult = SOCKET_ERROR) Then
                MsgBox "绑定错误，请填写正确IP"
                Exit Sub
          End If
          Dim InParamBuffer       As Long
          Dim BytesRet       As Long
          BytesRet = 0
          InParamBuffer = 1
          nResult = ioctlsocket(m_hSocket, &H98000001, 1)
          If nResult <> 0 Then
                MsgBox "未知错误"
                Exit Sub
          End If
          Dim strData     As String
          Dim nReceived     As Long
          Dim Buff(0 To MAX_PACK_LEN)         As Byte
          Dim IPH     As IPHeader
          Do Until False
                DoEvents
                nResult = recv(m_hSocket, Buff(0), MAX_PACK_LEN, 0)
                If nResult = SOCKET_ERROR Then
                        MsgBox "接收错误"
                        Exit Do
                End If
                CopyMemory IPH, Buff(0), Len(IPH)
                Form1.Text1.SelText = "从:" & HexIp2DotIp(IPH.sourceIP) & "  发送到:" & HexIp2DotIp(IPH.destIP) & "  包长度:" & IPH.len & "  " & Timer & vbCrLf
                If stopA = False Then Exit Do
          Loop
          nResult = shutdown(m_hSocket, 2)
          nResult = closesocket(m_hSocket)
          nResult = WSACancelBlockingCall
          nResult = WSACleanup
  End Sub
  Function HexIp2DotIp(ByVal ip As Long) As String
          Dim s     As String, p1       As String, p2       As String, p3       As String, p4       As String
          s = Right("00000000" & Hex(ip), 8)
          p1 = Val("&h" & Mid(s, 1, 2))
          p2 = Val("&h" & Mid(s, 3, 2))
          p3 = Val("&h" & Mid(s, 5, 2))
          p4 = Val("&h" & Mid(s, 7, 2))
          HexIp2DotIp = p4 & "." & p3 & "." & p2 & "." & p1
  End Function

实现的是本机数据包每秒发送的多少，与发送到什么地方去了。

dtooboss

#Region ;**** 参数创建于 ACNWrapper_GUI ****
#AutoIt3Wrapper_outfile=ipjs.exe
#EndRegion ;**** 参数创建于 ACNWrapper_GUI ****
#include <Array.au3>
#include <GUIConstantsEx.au3>
#include <WindowsConstants.au3>
#include <GuiListView.au3>
#include <StaticConstants.au3>
#include <ComboConstants.au3>
#include 'Winpcap.au3'
$winpcap = _PcapSetup()
If ($winpcap = -1) Then
        MsgBox(16, "错误!", "WinPcap 没有安装")
        Exit
EndIf
$pcap_devices = _PcapGetDeviceList()
If ($pcap_devices = -1) Then
        MsgBox(16, "网卡错误!", _PcapGetLastError())
        Exit
EndIf
GUICreate("数据包监听", 640, 800)
$interface = GUICtrlCreateCombo("", 80, 15, 400, Default, $CBS_DROPDOWNLIST)
For $i = 0 To UBound($pcap_devices) - 1
        GUICtrlSetData(-1, $pcap_devices[$i][1])
Next
$start = GUICtrlCreateButton("开始", 120, 660, 80, 80)
$stop = GUICtrlCreateButton("停止", 410, 660, 80, 80)
GUICtrlSetState(-1, $GUI_DISABLE)
GUICtrlSetStyle(GUICtrlCreateLabel("选择网卡 :", 10, 20, 60), $SS_RIGHT)
$packetwindow = GUICtrlCreateListView("编号|时间|长度|数据流向", 10, 40, 620, 600)
_GUICtrlListView_SetColumn($packetwindow, 0, "编号", 60, 1)
_GUICtrlListView_SetColumnWidth($packetwindow, 1, 80)
_GUICtrlListView_SetColumn($packetwindow, 2, "长度", 60, 1)
_GUICtrlListView_SetColumnWidth($packetwindow, 3, 400)

GUISetState()
$i = 0
$pcap = 0
$packet = 0
Do
        $msg = GUIGetMsg()

        If ($msg = $start) Then
                $int = ""
                For $n = 0 To UBound($pcap_devices) - 1
                        If $pcap_devices[$n][1] = GUICtrlRead($interface) Then
                                $int = $pcap_devices[$n][0]
                                ExitLoop
                        EndIf
                Next
                $pcap = _PcapStartCapture($int, "", 0)
                $linktype = _PcapGetLinkType($pcap)
                GUICtrlSetState($stop, $GUI_ENABLE)
                GUICtrlSetState($start, $GUI_DISABLE)
        EndIf

        If ($msg = $stop) Then
                If Not IsInt($pcap) Then _PcapStopCapture($pcap)
                $pcap = 0
                GUICtrlSetState($stop, $GUI_DISABLE)
                GUICtrlSetState($start, $GUI_ENABLE)
        EndIf


        If IsPtr($pcap) Then
                $time0 = TimerInit()
                While (TimerDiff($time0) < 500)
                        $packet = _PcapGetPacket($pcap)
                        If IsInt($packet) Then ExitLoop
                        GUICtrlCreateListViewItem($i & "|" & StringTrimRight($packet[0], 4) & "|" & $packet[2] & "|" & mdata($packet[3]), $packetwindow)
                        $data = $packet[3]
                        _GUICtrlListView_EnsureVisible($packetwindow, $i)
                        $i += 1
                WEnd
        EndIf

Until $msg = $GUI_EVENT_CLOSE

Func mdata($data)
        Local $src = Number(BinaryMid($data, 27, 1)) & "." & Number(BinaryMid($data, 28, 1)) & "." & Number(BinaryMid($data, 29, 1)) & "." & Number(BinaryMid($data, 30, 1))
        Local $dst = Number(BinaryMid($data, 31, 1)) & "." & Number(BinaryMid($data, 32, 1)) & "." & Number(BinaryMid($data, 33, 1)) & "." & Number(BinaryMid($data, 34, 1))
        Local $srcport = Number(BinaryMid($data, 35, 1)) * 256 + Number(BinaryMid($data, 36, 1))
        Local $dstport = Number(BinaryMid($data, 37, 1)) * 256 + Number(BinaryMid($data, 38, 1))
        Return "流向 " & $src & ":" & $srcport & "  ->  " & $dst & ":" & $dstport
EndFunc

给钱，走人.

还可以加上判断数据包类型的代码，比如区分 ipx  tcp/ip  arp  icmp  udp 等等。


比如判断 arp 代码如下

        Local $dataclass=BinaryMid ( $data, 13 ,2 )
        If $dataclass = "0x0806" Then return "ARP "
        

afan

没弄过…… 只能帮顶下~

ceoguang

呵呵,研究通了这个,AU3的IPX通讯就不是问题了.帮顶一下

qq342252004

帮忙顶。。。

mqb199

观住中~~~~~~~~~~

菜牙

路过，帮顶哈

jaydancer

帮顶先，值得研究

superflq

实现的是本机数据包每秒发送的多少，与发送到什么地方去了。

这个东西倒是不错,希望有高手能解决

itljl

回复 2# dtooboss


    帅哥，如果有空的话能写个限速的演示吗？对不同的IP限速。
便A机对 192.168.0.1 限速 10Mb,对其它IP不限速。谢谢。

ceoguang

2#的代码不错,不过是用Winpcap,而不是ws2_32.dll内置的API.本以为有高人能将ws2_32.dll内的API发上来.............

lxz

帮顶先，值得研究

xwlzx

学习一下，谢谢！

waxy

强人太多，想不佩服都不行。

G，man。

心动，但帮不了。