PureBasic Forums - English

Code: Select all

;- Just a few help-y function I use here at top....

;- I prefer these mutex functions to the native, b/c the native mutex
;  function don't watch for mutexes that are still locked if a thread
;  has exited and the mutex is abandoned...

Procedure myReleaseMutex( mMutex )
    ProcedureReturn ReleaseMutex_(mMutex)
EndProcedure

Procedure myLockMutex( mMutex, myWait = #INFINITE )
    dwWaitResult = WaitForSingleObject_(mMutex, myWait)
    Select dwWaitResult
        Case #WAIT_OBJECT_0
            retVal = 1
        Case #WAIT_ABANDONED
            retVal = 1
        Case #WAIT_FAILED
            retVal = 0
        Case #WAIT_TIMEOUT
            retVal = 0
    EndSelect
    ProcedureReturn retVal
EndProcedure

Procedure.l myCreateMutex()
    ProcedureReturn CreateMutex_(#Null, #False, #Null)
EndProcedure


Procedure.s input32(title.s, request.s, defText.s = "", dwStyle = 0)
  mWndRect.RECT
  mWndSize.SIZE
  myWindow = OpenWindow(#PB_Any, 0, 0, 0, 0, title.s, #PB_Window_ScreenCentered|#PB_Window_SystemMenu|#PB_Window_Invisible)
  hMyWnd = WindowID(myWindow)
  dwClassStyle = GetClassLongPtr_(hMyWnd, #GCL_STYLE) | #CS_SAVEBITS
  SetClassLongPtr_(hMyWnd, #GCL_STYLE, dwClassStyle)
  hWnd = WindowID(myWindow)
  hDc = GetDC_(hWnd)
  GetTextExtentPoint32_(hDc, @request, Len(request), @txtSize.SIZE)
  ReleaseDC_(hWnd, hDc)
  hDsk = GetDesktopWindow_()
  GetWindowRect_(hDsk, @dt.RECT)
  hTaskBar = FindWindow_("Shell_traywnd", "")
  GetWindowRect_(hTaskBar, @tb.RECT)
  tbHeight = tb\bottom-tb\top
  mWndSize\cx = txtSize\cx + 20
  mWndSize\cy = 160
  mWndRect\left = (((dt\right-dt\left) / 2) - (mWndSize\cx / 2))
  mWndRect\top  = (((dt\bottom-dt\top) - tbHeight) / 2) - 80
  SetWindowPos_(hWnd, #HWND_TOPMOST, mWndRect\left, mWndRect\top, mWndSize\cx, mWndSize\cy, #SWP_SHOWWINDOW)
  mText = TextGadget(#PB_Any, 0, 15, WindowWidth(myWindow)-5, 20, request, #PB_Text_Center)
  GetWindowRect_(GadgetID(mText), @text.RECT)
  padding = (GadgetWidth(mText) - txtSize\cx) 
  mInput = StringGadget(#PB_Any, padding, 40, GadgetWidth(mText) - (padding+5), 20, "", dwStyle)
  If defText <> ""
    SetGadgetText(mInput, defText)
    SendMessage_(GadgetID(mInput), #EM_SETSEL, 0, Len(defText))
  EndIf
  mOk = ButtonGadget(#PB_Any, (WindowWidth(myWindow)/2) - 50, 80, 100, 25, "OK")
  SetActiveGadget(mInput)
  BringWindowToTop_(hWnd)
  SetForegroundWindow_(hWnd)
  Repeat
    event = WaitWindowEvent()
    If event = #PB_Event_Gadget And EventGadget() = mOk And EventType() = #PB_EventType_LeftClick
      event = -1
    EndIf
    If event = #WM_KEYDOWN
      If EventwParam() = 13
        event = -1
      EndIf
    EndIf
  Until ((event = 16) Or (event = -1))
  If event <> 16
    retVal.s = GetGadgetText(mInput)
  EndIf
  CloseWindow(myWindow)
  ProcedureReturn retVal
EndProcedure

; - Begin code here
Structure ether_header
	ether_dhost.c[6] ;[ETHER_ADDR_LEN];
	ether_shost.c[6] ;[ETHER_ADDR_LEN];
	ether_type.w;
EndStructure


Structure ip
  ether_dhost.b[6];
	ether_shost.b[6];
	ether_type.w;
	ip_vhl.b;		/* header length, version */
	ip_tos.b;		/* type of service */
	ip_tle.w;		/* total length */
	ip_id.w;		/* identification */
	ip_off.w;		/* fragment offset field */
	ip_ttl.b;		/* time to live */
	ip_p.b;		  /* protocol */
	ip_sum.w;		/* checksum */
	ip_scr.c[4];
	ip_dst.c[4];
	udp_srcPort.w;
	udp_destPort.w;
	udp_length.w;
	udp_chksum.w;
EndStructure


Structure pcap_addr
  *next.pcap_addr
  *addr.SOCKADDR
  *netmask.SOCKADDR
  *broadaddr.SOCKADDR
  *dstaddr.SOCKADDR
EndStructure

Structure pcap_if_t
  *nextStruct
  *szDevName
  *szDescription
  *addressesptr
  flags.i
EndStructure

Structure pcap_pkthdr
  ts.TIMEVAL
  caplen.i
  len.i
EndStructure

Structure bpf_insn
  code.w
  jt.c
  jf.c
  k.i
EndStructure

Structure bpf_program
  bflen.i
  *bf_insns.bpf_insn
EndStructure

Structure myAdapters
  deviceName.s
  deviceDescription.s
  *addresses.pcap_addr
EndStructure

; _CDecl 
ImportC "C:\Users\Justin\Desktop\WpdPack_4_1_2\WpdPack\Lib\wpcap.lib"
  pcap_findalldevs.i(*lpPcap_if_t, *szerrbuf)
  pcap_open_live.l(*deviceName, snaplen.i, promisc.i, to_ms.i, *errorBuffer)
  pcap_compile.i(*pcap_t, *fp.bpf_program, *str, optimize.i, netmask.i)
  pcap_setfilter.i(*pcap_t, *fp.bpf_program)
  pcap_freecode(*fp.bpf_program)
  pcap_loop.i(*pcap_t, cnt.i, *lpFnCallBack, *lpUser)
  pcap_breakloop(*fp.bpf_program)
  pcap_close(*fp.bpf_program)
EndImport

Procedure getAllAdapters( List adpt.myAdapters() )
  errorBuffer.s = Space(256)
  *pcap_if_t_ptr.pcap_if_t
  If pcap_findalldevs(@*pcap_if_t_ptr, @errorBuffer) = -1
    MessageBox_(0, errorBuffer, "Error finding adapters...", #MB_OK|#MB_ICONERROR)
    ProcedureReturn 0
  EndIf
  ClearList(adpt())
  ResetList(adpt())
  Repeat 
    AddElement(adpt())
    adpt()\deviceName = PeekS(*pcap_if_t_ptr\szDevName)
    adpt()\deviceDescription = PeekS(*pcap_if_t_ptr\szDescription)
    adpt()\addresses = PeekL(*pcap_if_t_ptr\addressesptr)
    *pcap_if_t_ptr.pcap_if_t = *pcap_if_t_ptr\nextStruct
  Until *pcap_if_t_ptr = 0
  ProcedureReturn ListSize(adpt())
EndProcedure


; _CDecl
ProcedureC pktProcessProc( *useless, *pkthdr.pcap_pkthdr, *pktData )
  myTime = *pkthdr\ts\tv_sec
  *ipInfo.ip = *pktData
  totalLength = ntohs_(*ipInfo\ip_tle)
  ipVersion = (*ipInfo\ip_vhl >> 4)
  protocol = *ipInfo\ip_p
  ipFrom.s = StrU(*ipInfo\ip_dst[0]) + "."
  ipFrom.s + StrU(*ipInfo\ip_dst[1]) + "."
  ipFrom.s + StrU(*ipInfo\ip_dst[2]) + "."
  ipFrom.s + StrU(*ipInfo\ip_dst[3])
  ipTo.s = StrU(*ipInfo\ip_scr[0]) + "."
  ipTo.s + StrU(*ipInfo\ip_scr[1]) + "."
  ipTo.s + StrU(*ipInfo\ip_scr[2]) + "."
  ipTo.s + StrU(*ipInfo\ip_scr[3])
  myDataLength = ntohs_(*ipInfo\ip_tle)
  *peekAddr = *pktData + SizeOf(ether_header)
  If myDataLength > 1
    PrintN("Packet Received.")
    PrintN("----------------")
    Print("Protocol: ")
    Select protocol
      Case 1
        PrintN(" ICMP (Ping)")
      Case 6
        PrintN(" TCP")
      Case 12
        PrintN(" PUP")
      Case 17
        PrintN(" UDP")
      Default
        PrintN(" Other Protocol: " + Str(protocol))
    EndSelect
    PrintN("Source IP: " + ipFrom)
    PrintN("Destination IP: " + ipTo)
    PrintN("IPv" + Str(ipVersion))
    PrintN("----------------------------------------------")
    PrintN("")
  EndIf
EndProcedure

Structure startMonitorStructure
  adName.s
  stopMonSemaphore.l
  mainIpAddress.s
  *fp
EndStructure


Procedure monitorNetwork( *sms.startMonitorStructure )

 adapterName.s = *sms\adName
 myMonSemaphore = *sms\stopMonSemaphore
 mainIPAddress.s = *sms\mainIpAddress
 *fp = pcap_open_live(@adapterName, 65536, 1, 1000, @pcapOpenErrorBuffer.s)
 *sms\fp = *fp
 If (*fp)
  If Trim(mainIPAddress) <> ""
    myFilter.s = "ip host " + mainIPAddress
    filterProgram.bpf_program
    If pcap_compile(*fp, @filterProgram, @myFilter, 0, 0) <> -1
      If pcap_setfilter(*fp, @filterProgram) <> -1
        pcap_freecode(@filterProgram)
      Else
        MessageBox_(0, "pcap_setfilter() Failed.", "Error!", #MB_ICONERROR|#MB_OK)
      EndIf
    Else
      MessageBox_(0, "pcap_complie() Failed.", "Error!", #MB_ICONERROR|#MB_OK)
    EndIf
  EndIf
  iCode = pcap_loop(*fp, -1, @pktProcessProc(), #Null)
  Select iCode
    Case 0
      ;Debug "Successfully quit pcap_loop!"
    Case -1
      ;Debug "Error: " + pcapOpenErrorBuffer
    Case -2
      ;Debug "pcap_breakloop() called!"
    Default
      Debug "Not quite sure why we exited with a code of: " + Str(iCode)
   EndSelect
   SignalSemaphore(myMonSemaphore)
   pcap_close(*fp)
 Else
  SignalSemaphore(myMonSemaphore)
  MessageBox_(WindowID(myWindow), "AdapterName: " + adapterName.s, "pcap_open_live() Failed", #MB_ICONERROR|#MB_OK)
 EndIf
EndProcedure


Procedure main( mainIPAddress.s = "" )
  myWindow.l
  myDevSelect.l
  numAdapters = 0
  sms.startMonitorStructure
  OpenConsole()
  NewList NICAdapters.myAdapters()
  numAdapters = getAllAdapters(NICAdapters())
  If numAdapters > 0
    myWindow = OpenWindow(#PB_Any, 0, 0, 500, 500, "Packet Capture Window Selected IP: " + mainIPAddress, #PB_Window_ScreenCentered|#PB_Window_SystemMenu|#PB_Window_SizeGadget)
    TextGadget(#PB_Any, 10, 10, 150, 20, "Select Device to Monitor:")
    myBeginButton = ButtonGadget(#PB_Any, 10, 40, 100, 25, "Begin Monitoring")
    myDevSelect = ComboBoxGadget(#PB_Any, 160, 8, 300, 20)
    ResetList(NICAdapters())
    While NextElement(NICAdapters())
      AddGadgetItem(myDevSelect, -1, NICAdapters()\deviceDescription)
    Wend
    SetGadgetState(myDevSelect, 0)
    Repeat
      myWindowEvent = WaitWindowEvent(500)
      If sms\stopMonSemaphore <> 0
        If TrySemaphore(sms\stopMonSemaphore)
          FreeSemaphore(sms\stopMonSemaphore)
          sms\stopMonSemaphore = 0
          DisableGadget(myBeginButton, 0)
        EndIf
      EndIf
      Select myWindowEvent
        Case #PB_Event_Gadget
          Select EventGadget()
              Case myBeginButton
                If EventType() = #PB_EventType_LeftClick
                  Select GetGadgetText(myBeginButton)
                    Case "Begin Monitoring"
                      pcapOpenErrorBuffer.s = Space(256)
                      mySelectedAdapter = GetGadgetState(myDevSelect)
                      SelectElement(NICAdapters(), mySelectedAdapter)
                      sms\adName = NICAdapters()\deviceName
                      sms\stopMonSemaphore = CreateSemaphore()
                      sms\mainIpAddress = mainIPAddress
                      monitoringActive = CreateThread(@monitorNetwork(), @sms)
                      SetGadgetText(myBeginButton, "Stop Monitoring")
                    Case "Stop Monitoring"
                      DisableGadget(myBeginButton, 1)
                      pcap_breakloop(sms\fp)
                      SetGadgetText(myBeginButton, "Begin Monitoring")
                  EndSelect
                EndIf
          EndSelect
      EndSelect
      
    Until myWindowEvent = 16
    CloseConsole()
  Else
    MessageBox_(0, "No WIRED Network adapters found!", "Error Message", #MB_ICONERROR|#MB_OK)
  EndIf
  If cProcessPhoneSystemSemaphore > 0
    SignalSemaphore(cProcessPhoneSystemSemaphore)
  EndIf
  ProcedureReturn 0
EndProcedure

main(input32("Specify IPv4 Address?", "Please enter IP Address Filter (optional)", ""))