parser.bas

Windows网络编程技术源码 (是Windows网络编程技术配套的一本源码教程）

End Sub

'//
'// Function: DecodeUDPHeader
'//
'// Description:
'//    This function takes a buffer which points to a UDP
'//    header and prints it out in a readable form.
'//
Sub DecodeUDPHeader(ptr() As Byte, ByVal iphdrlen As Long)

    Dim shortval As Long, udp_src_port As Long, udp_dest_port As Long, udp_len As Long, udp_chksum As Long
    Dim addr As sockaddr
    Dim hdr As Byte
    Dim pos As Long
    Dim strUDPHeader As String
    
    pos = iphdrlen
    hdr = ptr(pos)
    
    CopyMemory shortval, ptr(pos), 2
    udp_src_port = ntohs(shortval) And &HFFFF&
    pos = pos + 2

    CopyMemory shortval, ptr(pos), 2
    udp_dest_port = ntohs(shortval) And &HFFFF&
    pos = pos + 2

    CopyMemory shortval, ptr(pos), 2
    udp_len = ntohs(shortval) And &HFFFF&
    pos = pos + 2
    
    CopyMemory shortval, ptr(pos), 2
    udp_chksum = ntohs(shortval) And &HFFFF&
    
    frmrcvall.List2.AddItem "   UDP HEADER"
    frmrcvall.List2.AddItem "   Source Port: " & udp_src_port & "       | Dest Port: " & udp_dest_port
    frmrcvall.List2.AddItem "       UDP Len: " & udp_len & "       |    ChkSum: " & udp_chksum
End Sub


'//
'// Function: DecodeTCPHeader
'//
'// Description:
'//    This function takes a buffer pointing to a TCP header
'//    and prints it out in a readable form.
'//
Sub DecodeTCPHeader(ptr() As Byte, ByVal iphdrlen As Long)
    Dim shortval As Long, longval As Long
    Dim hdr As Byte
    Dim pos As Long
    Dim strTCPHeader As String
    
    pos = iphdrlen
    hdr = ptr(pos)
    
    frmrcvall.List2.AddItem "   TCP HEADER"
    
    CopyMemory shortval, ptr(pos), 2
    shortval = ntohs(shortval) And &HFFFF&
    frmrcvall.List2.AddItem "   Src Port   : " & shortval
    pos = pos + 2
    
    CopyMemory shortval, ptr(pos), 2
    shortval = ntohs(shortval) And &HFFFF&
    frmrcvall.List2.AddItem "   Dest Port  : " & shortval
    pos = pos + 2

    CopyMemory longval, ptr(pos), 4
    longval = ntohl(longval)
    frmrcvall.List2.AddItem "   Seq Num    : " & longval
    pos = pos + 4
    
    CopyMemory longval, ptr(pos), 4
    longval = ntohl(longval)
    frmrcvall.List2.AddItem "   ACK Num    : " & longval
    pos = pos + 4

    frmrcvall.List2.AddItem "   Header Len : " & HI_WORD(ptr(pos)) & " (bytes " & HI_WORD(ptr(pos)) * 4 & ")"

    CopyMemory shortval, ptr(pos), 2
    shortval = ntohs(shortval) And &H3F&
    strTCPHeader = "   Flags      : "
    If shortval And &H20& Then strTCPHeader = strTCPHeader & "URG "
    If shortval And &H10& Then strTCPHeader = strTCPHeader & "ACK "
    If shortval And &H8& Then strTCPHeader = strTCPHeader & "PSH "
    If shortval And &H4& Then strTCPHeader = strTCPHeader & "RST "
    If shortval And &H2& Then strTCPHeader = strTCPHeader & "SYN "
    If shortval And &H1& Then strTCPHeader = strTCPHeader & "FIN "
    frmrcvall.List2.AddItem strTCPHeader
    pos = pos + 2
    
    CopyMemory shortval, ptr(pos), 2
    shortval = ntohs(shortval) And &HFFFF&
    frmrcvall.List2.AddItem "   Window size: " & shortval
    pos = pos + 2
    
    CopyMemory shortval, ptr(pos), 2
    shortval = ntohs(shortval) And &HFFFF&
    frmrcvall.List2.AddItem "   TCP Chksum : 0x" & Hex(shortval)
    pos = pos + 2

    CopyMemory shortval, ptr(pos), 2
    shortval = ntohs(shortval) And &HFFFF&
    frmrcvall.List2.AddItem "   Urgent ptr : " & shortval

End Sub

'//
'// Function: DecodeIPHeader
'//
'// Description:
'//    This function takes a pointer to an IP header and prints
'//    it out in a readable form.
'//
Sub DecodeIPHeader(buf() As Byte, srcip As Long, ByVal srcport As Long, _
          destip As Long, ByVal destport As Long)
    
    Dim shortval As Long
    Dim hdr As Byte
    Dim nexthdr As Long
    Dim pos As Long
    Dim srcaddr As sockaddr, destaddr As sockaddr
    Dim ip_version As Long, ip_hdr_len As Long, ip_tos As Long, ip_total_len As Long
    Dim ip_id As Long, ip_flags As Long, ip_ttl As Long, ip_frag_offset As Long
    Dim ip_proto As Long, ip_hdr_chksum As Long, ip_src_port As Long, ip_dest_port As Long
    
    Dim ip_src As Long, ip_dest As Long
    Dim bPrint As Boolean
    bPrint = True
    
    pos = 0
    hdr = buf(pos)
    
    ip_version = HI_WORD(hdr)
    ip_hdr_len = LO_WORD(hdr) * 4
    
    nexthdr = pos + ip_hdr_len
    pos = pos + 1
    
    ip_tos = buf(pos)
    pos = pos + 1
    
    CopyMemory shortval, buf(pos), 2
    ip_total_len = ntohs(shortval) And &HFFFF&
    pos = pos + 2
    
    CopyMemory shortval, buf(pos), 2
    ip_id = ntohs(shortval) And &HFFFF&
    pos = pos + 2
   
    hdr = buf(pos)
    ip_flags = hdr \ 32
    
    CopyMemory shortval, buf(pos), 2
    ip_frag_offset = ntohs(shortval) And &H1FFF&
    pos = pos + 2
    
    ip_ttl = buf(pos)
    pos = pos + 1

    ip_proto = buf(pos)
    pos = pos + 1
    
    CopyMemory shortval, buf(pos), 2
    ip_hdr_chksum = ntohs(shortval) And &HFFFF&
    pos = pos + 2
    
    CopyMemory srcaddr.sin_addr, buf(pos), 4
    ip_src = srcaddr.sin_addr
    pos = pos + 4
    
    CopyMemory destaddr.sin_addr, buf(pos), 4
    ip_dest = destaddr.sin_addr
    pos = pos + 4
    
    '//
    '// If packet is UDP, TCP, or IGMP read ahead and
    '//  get the port values.
    '//
    If ((ip_proto = 2) Or (ip_proto = 6) Or (ip_proto = 17)) And (bFilter = True) Then
        
        CopyMemory ip_src_port, buf(nexthdr), 2
        ip_src_port = ntohs(ip_src_port) And &HFFFF&
        nexthdr = nexthdr + 2
        CopyMemory ip_dest_port, buf(nexthdr), 2
        ip_dest_port = ntohs(ip_dest_port) And &HFFFF&

        If (srcip = ip_src) Or (srcport = ip_src_port) Or (destip = ip_dest) Or (destport = ip_dest_port) Then
            bPrint = True
        Else
            bPrint = False
        End If
        
    ElseIf bFilter = True Then
        bPrint = False
    End If
    
    '// Print IP Hdr
    '//
    If bPrint Then
        frmrcvall.List2.AddItem "IP HEADER"
        frmrcvall.List2.AddItem "   IP Version: " & ip_version & "  |  IP Header Len: " & ip_hdr_len & " bytes   |   IP TOS: 0x" & Hex(HI_WORD(CByte(ip_tos))) & Hex(LO_WORD(CByte(ip_tos)))
        frmrcvall.List2.AddItem "   IP Total Len: " & ip_total_len & " bytes | Identification: 0x" & Hex(ip_id) & " | IP Flags: 0x" & Hex(ip_flags)
        
        frmrcvall.List2.AddItem "   Frag Offset: 0x" & Hex(ip_frag_offset) & "  |            TTL: " & ip_ttl & "  | Protocol: " & szProto(ip_proto)
        frmrcvall.List2.AddItem "   Hdr Checksum: 0x" & Hex(ip_hdr_chksum)
        Dim strIP As String
        strIP = String(256, 0)
        lstrcpy1 strIP, inet_ntoa(srcaddr.sin_addr)
        strIP = Trim(strIP)
        frmrcvall.List2.AddItem "   Src Addr:  " & strIP
        strIP = String(256, 0)
        lstrcpy1 strIP, inet_ntoa(destaddr.sin_addr)
        strIP = Trim(strIP)
        frmrcvall.List2.AddItem "   Dest Addr: " & strIP
    Else
        Exit Sub
    End If
    
    
    Select Case ip_proto
        Case 2:        '// IGMP
            DecodeIGMPHeader buf, ip_hdr_len
        Case 6:        '// TCP
            DecodeTCPHeader buf, ip_hdr_len
        Case 17:       '// UDP
            DecodeUDPHeader buf, ip_hdr_len
        Case Else:
            frmrcvall.List2.AddItem "   No decoder installed for protocol"
    End Select
    
    frmrcvall.List2.AddItem ""
End Sub