Windows-Fenster friert zeitweise ein

Windowsspezifisches Forum , API ,..
Beiträge, die plattformübergreifend sind, gehören ins 'Allgemein'-Forum.
deichi1
Beiträge: 14
Registriert: 08.03.2012 17:43
Computerausstattung: _____________________________________________
i5 3200 | Windows 10 (64bit) | PrureBasic 5.62 (64bit)

Windows-Fenster friert zeitweise ein

Beitrag von deichi1 »

Hallo zusammen,

lange ist es her, dass ich hier eine Frage gestellt habe. Nun ist es wieder mal soweit. Ich weiss nicht mehr weiter und habe auch schon das Thema „Event-Handling“ hoch und runter recherchiert. Komme jedoch zu keinem Ergebnis.

Ich habe ein kleines Programm geschrieben, das mittels Tshark (...ist ein Tool in Wireshark) die Netzwerkkommunikation (IP-Datenstrom) aufzeichnet, sortiert, tabellarisch darstellt und in einem Aray speichert. Der netzwerktechnische Teil funktioniert hervorragend. Jedoch macht mir das Event-Handling (so glaube ich) Probleme. Dies äussert sich derart, dass das Hauptfenster kurz einfiert und die Meldung "Keine Rückmeldung" anzeigt. Sobald weitere Daten vom Netzwerk empfangen werden geht es weiter. Ich bekomme nicht raus was die Ursache des Programmhänger ist.

Zur Bedienung:
Wireshark muss als Voraussetzung, dass das Programm funktioniert, installiert sein. Auch muss das Programm im Administrator-Modus gestartet werden. Einmal gestartet muss man auf den Buton „Interface“ klicken und ein Interface im kleinen unteren Fenster auswählen/anklicken. Danach kann man den Buton „Start“ anklicken und das Programm zeichnet den Datenverkehr von diesem Interface auf. Es werden nur IP-Pakete aufgezeichnet, die dann im Listview angezeigt und nach Anzahl sortiert werden. Die Spalte „Anzahl“ stellt die Menge an Paketen eines IP-Paares dar.

Ich hoffe sehr, dass Jemand weiss, oder sieht, wo ich den Fehler gemacht habe.

PS:
Die PNGs (LED grün und LED rot) sind nicht im Post enthalten.

Und hier der Code:

Code: Alles auswählen

Enumeration FormWindow
  #ETH_List
EndEnumeration

Enumeration
  #StatusBar_0
EndEnumeration

Enumeration FormGadget
  #ETHList
  #Inf_List
  #ETH_TPbar
  #ETH_Pbar
  #Save_ETH
  #Close_ETH
  #Start_ETH
  #Stop_ETH
  #Interface_ETH
  #LED_B
  #LED_G
EndEnumeration

;Meine Konstanten

#Aus = 1
#Ein = 0
#MyTimer1 = 100
#MyTimer2 = 200

;Ende meine Konstanten

UsePNGImageDecoder()

Structure ETHComm
  SourceIP.s
  SrcMAC.s
  Src_Name.s
  DestIP.s
  DstMAC.s
  Dst_Name.s
  Anzahl.l
  Indizi.l
EndStructure

Structure If_Tab
IF_Index.s
IF_ID.s
IF_Name.s
If_Stat.i
EndStructure

Declare ResizeGadgetsETH_List()

Global Dim ETH.ETHComm(262136)
Global Dim Datei.s(256)
Global Dim CapInt.If_Tab(50)

Global SizeOfETH.l = 262136, SizeOfDatei.l = 256
Global CurrentFiles.l=0, MaxFiles=100, ProgNum.l, CapInt.s, Output.s, Ende.l, event.l

If InitNetwork() = 0
  MessageRequester("Error", "Kann das Netzwerk nicht initialiesieren !", 0)
  End
EndIf

IncludeFile "DNS_Query.pb"

If  LoadDnsApi(0) = 0
  MessageRequester("Error", "Kann DNS-Library nicht öffnen. Starte Program ohne DNS-Auflösung", 0)
EndIf

Procedure OpenETH_List(x = 0, y = 0, width = 865, height = 530)
  OpenWindow(#ETH_List, x, y, width, height, "IP-Datenbank", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget | #PB_Window_TitleBar)
  SetWindowColor(#ETH_List, RGB(89,89,89))
  CreateStatusBar(0, WindowID(#ETH_List))
  AddStatusBarField(540)
  StatusBarText(0, 0, "Label", #PB_StatusBar_Center)
  AddStatusBarField(200)
  StatusBarText(0, 1, "Label")
  AddStatusBarField(115)
  StatusBarText(0, 2, "Label")
  ListIconGadget(#ETHList, 0, 0, 865, 400, "Source IP", 100, #PB_ListIcon_GridLines)
  AddGadgetColumn(#ETHList, 1, "Source MAC", 100)
  AddGadgetColumn(#ETHList, 2, "Source Name", 200)
  AddGadgetColumn(#ETHList, 3, "Destination IP", 100)
  AddGadgetColumn(#ETHList, 4, "Destination MAC", 100)
  AddGadgetColumn(#ETHList, 5, "Destination_Name", 200)
  AddGadgetColumn(#ETHList, 6, "Anzahl", 60)
  SetGadgetColor(#ETHList, #PB_Gadget_FrontColor,RGB(0,0,0))
  SetGadgetColor(#ETHList, #PB_Gadget_BackColor,RGB(255,204,153))
  ListViewGadget(#Inf_List, 0, 410, 670, 45, #PB_ListView_ClickSelect)
  TextGadget(#ETH_TPbar, 700, 410, 160, 15, "IP Einträge (max. 262136)", #PB_Text_Center)
  ProgressBarGadget(#ETH_Pbar, 700, 440, 160, 15, 0, 262136)
  ButtonGadget(#Save_ETH, 710, 470, 70, 15, "Speichern")
  ButtonGadget(#Close_ETH, 790, 470, 70, 15, "Schliessen")
  ButtonGadget(#Start_ETH, 550, 470, 70, 15, "Start")
  ButtonGadget(#Stop_ETH, 630, 470, 70, 15, "Stop")
  ButtonGadget(#Interface_ETH, 470, 470, 70, 15, "Interface")
  ImageGadget(#LED_B, 420, 465, 24, 24, ImageID(LoadImage(#PB_Any,"D:\Netcomm_HS\ledrot.png")))
  HideGadget(#LED_B, #Aus)
  ImageGadget(#LED_G, 420, 465, 24, 24, ImageID(LoadImage(#PB_Any,"D:\Netcomm_HS\ledgrün.png")))
  HideGadget(#LED_G, #Aus)
EndProcedure

;****************************************************************

Procedure ResizeGadgetsETH_List()
  Protected FormWindowWidth, FormWindowHeight
  FormWindowWidth = WindowWidth(#ETH_List)
  FormWindowHeight = WindowHeight(#ETH_List)
  ResizeGadget(#ETHList, 0, 0, FormWindowWidth - 0, FormWindowHeight - StatusBarHeight(0) - 107)
  ResizeGadget(#Inf_List, 0, FormWindowHeight - 120, FormWindowWidth - 195, 45)
  ResizeGadget(#ETH_TPbar, FormWindowWidth - 165, FormWindowHeight - 120, #PB_Ignore, #PB_Ignore)
  ResizeGadget(#ETH_Pbar, FormWindowWidth - 165, FormWindowHeight - 90, #PB_Ignore, #PB_Ignore)
  ResizeGadget(#Save_ETH, FormWindowWidth - 155, FormWindowHeight - 60, 70, 15)
  ResizeGadget(#Close_ETH, FormWindowWidth - 75, FormWindowHeight - 60, 70, 15)
  ResizeGadget(#Start_ETH, FormWindowWidth - 315, FormWindowHeight - 60, 70, 15)
  ResizeGadget(#Stop_ETH, FormWindowWidth - 235, FormWindowHeight - 60, 70, 15)
  ResizeGadget(#Interface_ETH, FormWindowWidth - 395, FormWindowHeight - 60, 70, 15)
  ResizeGadget(#LED_B, FormWindowWidth - 445, FormWindowHeight - 65, 24, 24)
  ResizeGadget(#LED_G, FormWindowWidth - 445, FormWindowHeight - 65, 24, 24)
EndProcedure

;****************************************************************

Procedure GetCapInt()
  
Prognum.l = RunProgram("c:/Programme/Wireshark/Tshark.exe", "-D 1", "", #PB_Program_Open | #PB_Program_Read | #PB_Program_Hide)
  Output$ = ""
  If Prognum.l
    While ProgramRunning(Prognum.l)
      If AvailableProgramOutput(Prognum.l)
        Output.s = ReadProgramString(Prognum.l)
        CapInt(i)\IF_Index.s = StringField(Output.s, 1, ".") 
        CapInt(i)\IF_ID.s = StringField(Output.s, 2, " ")  
        CapInt(i)\IF_Name.s = Mid(Output.s, FindString(Output.s, "(", 1) + 1 , FindString(Output.s, ")", 1) - 1 - FindString(Output.s, "(", 1))
        i + 1
      EndIf
    Wend
    CloseProgram(Prognum.l)
    ProgNum.l = 0               ; Schließt die Verbindung zum Programm
  EndIf
  
  ProcedureReturn i-1
EndProcedure

;****************************************************************

Procedure StartCapData (CapInt.s)
  
  Parameter.s = "-i " + CapInt.s + " -f ip -e ip.src -e eth.src -e ip.dst -e eth.dst -T fields -E separator=,"
  Prog.s = "c:\Programme\Wireshark\tshark.exe"
  ProgNum.l = RunProgram(Prog.s, Parameter.s, "", #PB_Program_Open | #PB_Program_Read | #PB_Program_Hide)
  If ProgramRunning(ProgNum.l)
    ProcedureReturn ProgNum.l
  Else
    MessageRequester("Fehler", "Das Programm tshark.exe wurde nicht gestartet")
  EndIf
  
EndProcedure

;****************************************************************

Procedure StopCapData (ProgNum.l)
  
  If ProgramRunning(ProgNum.l)
    CloseProgram(ProgNum.l)
    ProgNum.l = 0
    ProcedureReturn #True  
  EndIf
  
EndProcedure 

;****************************************************************

Procedure.s ReadCapData ()
  
  If ProgramRunning(ProgNum.l)
    If AvailableProgramOutput(ProgNum.l)
      Output.s = ""
      Output.s = ReadProgramString(ProgNum.l)
      Debug Output.s
      ProcedureReturn Output.s
    EndIf
  EndIf
    
EndProcedure

;****************************************************************

Procedure List_UpDate(Ende.l)

  For Anf.l = 0 To Ende.l

    SetGadgetItemText(#ETHList, Anf.l, ETH(Anf.l)\SourceIP.s, 0)
    SetGadgetItemText(#ETHList, Anf.l, ETH(Anf.l)\SrcMAC.s, 1)
    SetGadgetItemText(#ETHList, Anf.l, ETH(Anf.l)\Src_Name.s, 2)
    SetGadgetItemText(#ETHList, Anf.l, ETH(Anf.l)\DestIP.s, 3)
    SetGadgetItemText(#ETHList, Anf.l, ETH(Anf.l)\DstMAC.s, 4)
    SetGadgetItemText(#ETHList, Anf.l, ETH(Anf.l)\Dst_Name.s, 5)
    SetGadgetItemText(#ETHList, Anf.l, Str(ETH(Anf.l)\Anzahl.l), 6)
        
  Next
  
EndProcedure
    
;****************************************************************     
    
Procedure IP_Indizi(IP.s)
  
  Static Pos1.i, Pos2.i, Pos3.i
  
  Pos1.i = FindString(IP.s, "." , 1)
  Pos2.i = FindString(IP.s, "." , Pos1 + 1)
  Pos3.i = FindString(IP.s, "." , Pos2 + 1)
  Feld1.i = Val(StringField(IP.s, 1, "."))
  Feld2.i = Val(StringField(IP.s, 2, "."))
  Feld3.i = Val(StringField(IP.s, 3, "."))
  Feld4.i = Val(Right(IP.s, Len(IP.s) - Pos3.i))
  IP_Indizi.l = Feld1.i * 4 + Feld2.i * 3 + Feld3.i * 2 + Feld4.i
  ProcedureReturn IP_Indizi.l
  
EndProcedure

;**************************************************************** 

Procedure.s Get_Name(IP.s)
  
  Static Pos1.i, Pos2.i, Pos3.i
  
  Pos1.i = FindString(IP.s, "." , 1)
  Pos2.i = FindString(IP.s, "." , Pos1 + 1)
  Pos3.i = FindString(IP.s, "." , Pos2 + 1)
  Feld0.i = Val(StringField(IP.s, 1, "."))
  Feld1.i = Val(StringField(IP.s, 2, "."))
  Feld2.i = Val(StringField(IP.s, 3, "."))
  Feld3.i = Val(Right(IP.s, Len(IP.s) - Pos3.i))
  IP_Addr.l = MakeIPAddress(Feld0, Feld1, Feld2, Feld3 )
  SName.s = ReverseDnsQuery(IP_Addr.l)
  ProcedureReturn SName.s
  
EndProcedure

;**************************************************************** 

Procedure HEX_Indizi(MAC.s)
  
  Feld1.i = Val("$" + StringField(MAC.s, 1, ":"))
  Feld2.i = Val("$" + StringField(MAC.s, 2, ":"))
  Feld3.i = Val("$" + StringField(MAC.s, 3, ":"))
  Feld4.i = Val("$" + StringField(MAC.s, 4, ":"))
  Feld5.i = Val("$" + StringField(MAC.s, 5, ":"))
  Feld6.i = Val("$" + Right(MAC.s, 2))
  
  MAC_Indizi.l = Feld1 * 6 + Feld2 * 5 + Feld3 * 4 + Feld4 * 3 + Feld5 * 2 + Feld6
  ProcedureReturn MAC_Indizi.l
EndProcedure

;****************************************************************     

Procedure Store_ETH(Output.s)
  
  Static EIndex.l, Paket.l, New_Indizi.l, K.l
  
  
  SIP.s = StringField(Output.s, 1, ",")
  SMAC.s = StringField(Output.s, 2, ",")
  DIP.s = StringField(Output.s, 3, ",")
  DMAC.s = Right(Output.s, 17)

  New_Indizi.l = IP_Indizi(SIP.s) + IP_Indizi(DIP.s) + HEX_Indizi(SMAC.s) + HEX_Indizi(DMAC.s)
  I = 0
  
  Repeat
    If ETH(I)\Indizi.l = New_Indizi.l
       ETH(I)\Anzahl + 1
       Paket.l + 1
       Break
    EndIf
    I + 1
  Until I > EIndex.l
  
  If I > EIndex.l
    ETH(EIndex.l)\SourceIP = SIP.s
    ETH(EIndex.l)\SrcMAC = SMAC.s
    ETH(EIndex.l)\Src_Name = Get_Name(SIP.s)
    ETH(EIndex.l)\DestIP = DIP.s
    ETH(EIndex.l)\DstMAC = DMAC.s
    ETH(EIndex.l)\Dst_Name = Get_Name(DIP.s)
    ETH(EIndex.l)\Indizi = New_Indizi.l
    ETH(EIndex.l)\Anzahl = 1
    AddGadgetItem(#ETHList, -1, ETH(EIndex.l)\SourceIP.s + Chr(10) + ETH(EIndex.l)\SrcMAC.s + Chr(10) + ETH(EIndex.l)\Src_Name.s + Chr(10) + ETH(EIndex)\DestIP.s + Chr(10) + ETH(EIndex)\DstMAC.s + Chr(10) + ETH(EIndex.l)\Dst_Name + Chr(10) +Str(ETH(EIndex)\Anzahl) + Chr(10))
    EIndex.l + 1
    Paket.l + 1    
  EndIf 
  
  
  SetGadgetText(#ETH_TPbar, Str(Paket.l - 1))
  ProcedureReturn EIndex.l - 1
   
EndProcedure

;****************************************************************

Procedure MyTimer(Ende.l)
  
  Anf.l = 0
  SortStructuredArray(ETH(), #PB_Sort_Descending, OffsetOf(ETHComm\Anzahl.l), #PB_Long, Anf.l, Ende.l)
  List_UpDate(Ende.l)
  SetGadgetState   (#ETH_Pbar, Ende.l)
  
EndProcedure

;****************************************************************

Procedure MyDateTimer(Ende.l)
  
  StatusBarText(0, 2, FormatDate("%dd.%mm.%yyyy %hh:%ii", Date()))
  StatusBarText(0, 1, "Aufgezeichnete IP-Sessions: " + Str(Ende.l))
  
EndProcedure

;****************************************************************

;****************************************************************

Procedure ETH_List_Events(event)
  Select event
      
    Case #PB_Event_Timer
      Select EventTimer()
        Case #MyTimer1
          MyTimer(Ende.l)
          event = 0
          
        Case #MyTimer2
          MyDateTimer(Ende.l)
          event = 0
      EndSelect
      
    Case #PB_Event_SizeWindow
      ResizeGadgetsETH_List()
      event = 0
    Case #PB_Event_CloseWindow
      ProcedureReturn #False
      
    Case #PB_Event_Repaint
      event = 0
      
    Case #PB_Event_Menu
      Select EventMenu()
      EndSelect
      
    Case #PB_Event_Gadget
      Select EventGadget()
        Case #ETHList
          Select EventType()
            Case #PB_EventType_LeftClick
              event = 0
              Debug "Linksklick in die Liste"
            Case #PB_EventType_RightClick
              event = 0
              Debug "Rechtsklick in die Liste"
            Case #PB_EventType_LeftDoubleClick
              event = 0
              Debug "Linksdoppelklick in die Liste"
            Case #PB_EventType_RightDoubleClick
              event = 0
              Debug "Rechtsdoppelklick in die Liste"
            Case #PB_EventType_Focus
              event = 0
              Debug "Die Liste hat den Fokus erhalten"
            Case #PB_EventType_LostFocus
              event = 0
              Debug "Die Liste hat den Fokus verlohren"
            Case #PB_EventType_Change
              Debug "Der Inhalt der Liste hat sich geändert"
;               Anf.l = 0
;               SortStructuredArray(ETH(), #PB_Sort_Descending, OffsetOf(ETHComm\Anzahl.l), #PB_Long, Anf.l, Ende.l)
;               List_UpDate(Ende.l)
;               SetGadgetState   (#ETH_Pbar, Ende.l)
                event = 0
              Case #PB_EventType_DragStart 
                event = 0
                Debug "DragStart in Liste"
          EndSelect          
        Case #Interface_ETH
          Select EventType()
            Case #PB_EventType_LeftClick          
              i = GetCapInt()
              ii = 0
              While ii <= i        
                AddGadgetItem(#Inf_List, -1, CapInt(ii)\IF_Index.s + " " + CapInt(ii)\IF_Name.s  )
                ii + 1
              Wend
              event = 0
              
            Case #PB_EventType_RightClick
              event = 0
              
            Case #PB_EventType_LeftDoubleClick
              event = 0
              
            Case #PB_EventType_RightDoubleClick
              event = 0
              
            Case #PB_EventType_Focus
              event = 0
              
            Case #PB_EventType_LostFocus
              event = 0
              
            Case #PB_EventType_Change
              event = 0
              
            Case #PB_EventType_DragStart 
              event = 0
              
          EndSelect          
        Case #Inf_List
          Select EventType()
            Case #PB_EventType_LeftClick
              CapInt.s = StringField(GetGadgetText(#Inf_List), 1, " ")
              StatusBarText(0, 0, "Capture Interface: : " + GetGadgetText(#Inf_List))
              DisableGadget(#Interface_ETH, #Aus)
              ;DisableGadget(#Save_ETH, #Aus)
              DisableGadget(#Stop_ETH, #Aus)
              DisableGadget(#Start_ETH, #Ein)
              HideGadget(#LED_B, #Ein)
              event = 0
              
            Case #PB_EventType_RightClick
              event = 0
              
            Case #PB_EventType_LeftDoubleClick
              event = 0
              
            Case #PB_EventType_RightDoubleClick
              event = 0
              
            Case #PB_EventType_Focus
              event = 0
              
            Case #PB_EventType_LostFocus
              event = 0
              
            Case #PB_EventType_Change
              event = 0
              
            Case #PB_EventType_DragStart
              event = 0
              
          EndSelect
       
        Case #Start_ETH
          
          Select EventType()
            Case #PB_EventType_LeftClick          
              ProgNum.l = StartCapData (CapInt.s)
              DisableGadget(#Start_ETH, #Aus)
              DisableGadget(#Stop_ETH, #Ein)
              AddWindowTimer(#ETH_List, #MyTimer1, 1000)
              HideGadget(#LED_G, #Ein)
              HideGadget(#LED_B, #Aus)
              event = 0
              
         EndSelect
          
       Case #Stop_ETH
         Select EventType()
            Case #PB_EventType_LeftClick
              If StopCapData (ProgNum.l)
                ;DisableGadget(#Save_ETH, #Ein)
                DisableGadget(#Interface_ETH, #Ein)
                DisableGadget(#Stop_ETH, #Aus)
                RemoveWindowTimer(#ETH_List, #MyTimer1)                      
                HideGadget(#LED_G, #Aus)
                HideGadget(#LED_B, #Ein) 
                ProgNum.l = 0
              EndIf
              event = 0
              
          EndSelect
          
        Case #Save_ETH
          Select EventType()
            Case #PB_EventType_LeftClick          
              ;If Speichere_Tabelle(Ende.l) : Else : MessageRequester("Fehler", "Speichern fehlgeschlagen!", #PB_MessageRequester_Ok ) : EndIf
              event = 0
              
          EndSelect
          
        Case #Close_ETH
          Select EventType()
            Case #PB_EventType_LeftClick
              RemoveWindowTimer(#ETH_List, #MyTimer2)
              ProcedureReturn #False
          EndSelect                 
      EndSelect
  EndSelect
  ProcedureReturn #True
EndProcedure

;****************************************************************

OpenETH_List()
DisableGadget(#Stop_ETH, #Aus)
DisableGadget(#Start_ETH, #Aus)
DisableGadget(#Save_ETH, #Aus)
StatusBarText(0, 2, FormatDate("%dd.%mm.%yyyy %hh:%ii", Date()))
AddWindowTimer(#ETH_List, #MyTimer2, 500)


Repeat
  
  Repeat
    event = WindowEvent()
    ergebnis = ETH_List_Events(event)
    Select ergebnis
      Case #False
        quit = 1
    EndSelect
  Until event = 0
  If ProgNum
    If AvailableProgramOutput(ProgNum)
      Output.s = ReadCapData ()
      Ende.l = Store_ETH(Output.s)
    EndIf
  EndIf
  Delay(10)
Until  quit = 1

End
__________________________________________________
Code-Tags hinzugefügt
21.11.2018
RSBasic
Benutzeravatar
RSBasic
Admin
Beiträge: 8022
Registriert: 05.10.2006 18:55
Wohnort: Gernsbach
Kontaktdaten:

Re: Windows-Fenster friert zeitweise ein

Beitrag von RSBasic »

Du kannst deinen Vorganz zum Empfangen in einen Thread auslagern, dann läuft dein Code asynchron und du hast dann keine Probleme, dass dein Fenster kurz einfriert.
Aus privaten Gründen habe ich leider nicht mehr so viel Zeit wie früher. Bitte habt Verständnis dafür.
Bild
Bild
deichi1
Beiträge: 14
Registriert: 08.03.2012 17:43
Computerausstattung: _____________________________________________
i5 3200 | Windows 10 (64bit) | PrureBasic 5.62 (64bit)

Re: Windows-Fenster friert zeitweise ein

Beitrag von deichi1 »

RSBasic hat geschrieben:Du kannst deinen Vorganz zum Empfangen in einen Thread auslagern, dann läuft dein Code asynchron und du hast dann keine Probleme, dass dein Fenster kurz einfriert.
Hallo RSBasic,

vielen Dank für Deine super schnelle Antwort.
Das mit dem Thread hatte ich auch schon überlegt. Jedoch weiss ich nicht wie ich die Ausgabe von Tshark dann an mein Hauptprogramm übergeben soll. Denn in der Hilfe steht doch, dass ein Thread keine Werte übergeben kann. Und wenn es möglich ist einen Wert von Tread an das Hauptprogramm zu senden, stellt sich mir die Frage wie ich das Vorhandensein von Daten signalisiere/synchronisiere?

Hast Du eventuell eine Beispiel für mich?

Gruss Deichi1
Benutzeravatar
Kiffi
Beiträge: 10621
Registriert: 08.09.2004 08:21
Wohnort: Amphibios 9

Re: Windows-Fenster friert zeitweise ein

Beitrag von Kiffi »

deichi1 hat geschrieben:Jedoch weiss ich nicht wie ich die Ausgabe von Tshark dann an mein Hauptprogramm übergeben soll.
schau Dir hierzu mal PostEvent() an,

Grüße ... Peter
Hygge
Benutzeravatar
mk-soft
Beiträge: 3695
Registriert: 24.11.2004 13:12
Wohnort: Germany

Re: Windows-Fenster friert zeitweise ein

Beitrag von mk-soft »

Oder ein fertiges Modul nehmen was dieses über PostEvent erledigt...

ThreadToGUI: viewtopic.php?f=8&t=29728
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
deichi1
Beiträge: 14
Registriert: 08.03.2012 17:43
Computerausstattung: _____________________________________________
i5 3200 | Windows 10 (64bit) | PrureBasic 5.62 (64bit)

Re: Windows-Fenster friert zeitweise ein

Beitrag von deichi1 »

Kiffi hat geschrieben:
deichi1 hat geschrieben:Jedoch weiss ich nicht wie ich die Ausgabe von Tshark dann an mein Hauptprogramm übergeben soll.
schau Dir hierzu mal PostEvent() an,

Grüße ... Peter
Hallo Kiffi,

vielen Dank für die Idee. Habe es damit zum Laufen gebracht und die Hänger sind weg. Leider habe ich nun das Problem, dass ich Daten verliere. Denke ich muss hier nochmal ins Eingemachte gehen und das Programm optimieren. Melde mich wieder wenn ich ein Ergebnis habe. Noch mal vielen Dank.

Gruß Deichi1

Udate:

Code: Alles auswählen

Enumeration FormWindow
  #ETH_List
EndEnumeration
Enumeration
  #StatusBar_0
EndEnumeration

Enumeration FormGadget
  #ETHList
  #Inf_List
  #ETH_TPbar
  #ETH_Pbar
  #Save_ETH
  #Close_ETH
  #Start_ETH
  #Stop_ETH
  #Interface_ETH
  #LED_B
  #LED_G
EndEnumeration

;Meine Konstanten

#Aus = 1
#Ein = 0
#MyTimer1 = 100
#MyTimer2 = 200

;Ende meine Konstanten

; Alle unsere beutzerdefinierten Ereignisse
Enumeration #PB_Event_FirstCustomValue
  #EventCaptureData
EndEnumeration
  
UsePNGImageDecoder()

Structure ETHComm
  SourceIP.s
  SrcMAC.s
  Src_Name.s
  DestIP.s
  DstMAC.s
  Dst_Name.s
  Anzahl.l
  Indizi.l
EndStructure

Structure If_Tab
IF_Index.s
IF_ID.s
IF_Name.s
If_Stat.i
EndStructure

Declare ResizeGadgetsETH_List()

Global Dim ETH.ETHComm(262136)
Global Dim Datei.s(256)
Global Dim CapInt.If_Tab(50)

Global SizeOfETH.l = 262136, SizeOfDatei.l = 256
Global CurrentFiles.l=0, MaxFiles=100, ProgNum.l, CapInt.s, Output.s, Ende.l, event.l, thread

If InitNetwork() = 0
  MessageRequester("Error", "Kann das Netzwerk nicht initialiesieren !", 0)
  End
EndIf

IncludeFile "DNS_Query.pb"

If  LoadDnsApi(0) = 0
  MessageRequester("Error", "Kann DNS-Library nicht öffnen. Starte Program ohne DNS-Auflösung", 0)
EndIf

Procedure OpenETH_List(x = 0, y = 0, width = 865, height = 530)
  OpenWindow(#ETH_List, x, y, width, height, "IP-Datenbank", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget | #PB_Window_TitleBar)
  SetWindowColor(#ETH_List, RGB(89,89,89))
  CreateStatusBar(0, WindowID(#ETH_List))
  AddStatusBarField(540)
  StatusBarText(0, 0, "Label", #PB_StatusBar_Center)
  AddStatusBarField(200)
  StatusBarText(0, 1, "Label")
  AddStatusBarField(115)
  StatusBarText(0, 2, "Label")
  ListIconGadget(#ETHList, 0, 0, 865, 400, "Source IP", 100, #PB_ListIcon_GridLines)
  AddGadgetColumn(#ETHList, 1, "Source MAC", 100)
  AddGadgetColumn(#ETHList, 2, "Source Name", 200)
  AddGadgetColumn(#ETHList, 3, "Destination IP", 100)
  AddGadgetColumn(#ETHList, 4, "Destination MAC", 100)
  AddGadgetColumn(#ETHList, 5, "Destination_Name", 200)
  AddGadgetColumn(#ETHList, 6, "Anzahl", 60)
  SetGadgetColor(#ETHList, #PB_Gadget_FrontColor,RGB(0,0,0))
  SetGadgetColor(#ETHList, #PB_Gadget_BackColor,RGB(255,204,153))
  ListViewGadget(#Inf_List, 0, 410, 670, 45, #PB_ListView_ClickSelect)
  TextGadget(#ETH_TPbar, 700, 410, 160, 15, "IP Einträge (max. 262136)", #PB_Text_Center)
  ProgressBarGadget(#ETH_Pbar, 700, 440, 160, 15, 0, 262136)
  ButtonGadget(#Save_ETH, 710, 470, 70, 15, "Speichern")
  ButtonGadget(#Close_ETH, 790, 470, 70, 15, "Schliessen")
  ButtonGadget(#Start_ETH, 550, 470, 70, 15, "Start")
  ButtonGadget(#Stop_ETH, 630, 470, 70, 15, "Stop")
  ButtonGadget(#Interface_ETH, 470, 470, 70, 15, "Interface")
  ImageGadget(#LED_B, 420, 465, 24, 24, ImageID(LoadImage(#PB_Any,"D:\Netcomm_HS\ledrot.png")))
  HideGadget(#LED_B, #Aus)
  ImageGadget(#LED_G, 420, 465, 24, 24, ImageID(LoadImage(#PB_Any,"D:\Netcomm_HS\ledgrün.png")))
  HideGadget(#LED_G, #Aus)
EndProcedure

;****************************************************************

Procedure ResizeGadgetsETH_List()
  Protected FormWindowWidth, FormWindowHeight
  FormWindowWidth = WindowWidth(#ETH_List)
  FormWindowHeight = WindowHeight(#ETH_List)
  ResizeGadget(#ETHList, 0, 0, FormWindowWidth - 0, FormWindowHeight - StatusBarHeight(0) - 107)
  ResizeGadget(#Inf_List, 0, FormWindowHeight - 120, FormWindowWidth - 195, 45)
  ResizeGadget(#ETH_TPbar, FormWindowWidth - 165, FormWindowHeight - 120, #PB_Ignore, #PB_Ignore)
  ResizeGadget(#ETH_Pbar, FormWindowWidth - 165, FormWindowHeight - 90, #PB_Ignore, #PB_Ignore)
  ResizeGadget(#Save_ETH, FormWindowWidth - 155, FormWindowHeight - 60, 70, 15)
  ResizeGadget(#Close_ETH, FormWindowWidth - 75, FormWindowHeight - 60, 70, 15)
  ResizeGadget(#Start_ETH, FormWindowWidth - 315, FormWindowHeight - 60, 70, 15)
  ResizeGadget(#Stop_ETH, FormWindowWidth - 235, FormWindowHeight - 60, 70, 15)
  ResizeGadget(#Interface_ETH, FormWindowWidth - 395, FormWindowHeight - 60, 70, 15)
  ResizeGadget(#LED_B, FormWindowWidth - 445, FormWindowHeight - 65, 24, 24)
  ResizeGadget(#LED_G, FormWindowWidth - 445, FormWindowHeight - 65, 24, 24)
EndProcedure

;****************************************************************

Procedure GetCapInt()
  
Prognum.l = RunProgram("c:/Programme/Wireshark/Tshark.exe", "-D 1", "", #PB_Program_Open | #PB_Program_Read | #PB_Program_Hide)
  Output$ = ""
  If Prognum.l
    While ProgramRunning(Prognum.l)
      If AvailableProgramOutput(Prognum.l)
        Output.s = ReadProgramString(Prognum.l)
        CapInt(i)\IF_Index.s = StringField(Output.s, 1, ".") 
        CapInt(i)\IF_ID.s = StringField(Output.s, 2, " ")  
        CapInt(i)\IF_Name.s = Mid(Output.s, FindString(Output.s, "(", 1) + 1 , FindString(Output.s, ")", 1) - 1 - FindString(Output.s, "(", 1))
        i + 1
      EndIf
    Wend
    CloseProgram(Prognum.l)
    ProgNum.l = 0               ; Schließt die Verbindung zum Programm
  EndIf
  
  ProcedureReturn i-1
EndProcedure

;****************************************************************

Procedure StartCapData (CapInt.s)
  
  Parameter.s = "-i " + CapInt.s + " -f ip -e ip.src -e eth.src -e ip.dst -e eth.dst -T fields -E separator=,"
  Prog.s = "c:\Programme\Wireshark\tshark.exe"
  ProgNum.l = RunProgram(Prog.s, Parameter.s, "", #PB_Program_Open | #PB_Program_Read | #PB_Program_Hide)
  If ProgramRunning(ProgNum.l)
    ProcedureReturn ProgNum.l
  Else
    MessageRequester("Fehler", "Das Programm tshark.exe wurde nicht gestartet")
  EndIf
  
EndProcedure

;****************************************************************

Procedure StopCapData (ProgNum.l)
  
  If ProgramRunning(ProgNum.l)
    CloseProgram(ProgNum.l)
    ProgNum.l = 0
    ProcedureReturn #True  
  EndIf
  
EndProcedure 

;****************************************************************

Procedure ReadCapData (*Wert)
  
  While ProgramRunning(ProgNum.l)
    If AvailableProgramOutput(ProgNum.l)
      Output.s = ""
      Output.s = ReadProgramString(ProgNum.l)
      Debug Output.s
      PostEvent(#EventCaptureData)
    EndIf
  Wend
    
EndProcedure

;****************************************************************

Procedure List_UpDate(Ende.l)

  For Anf.l = 0 To Ende.l

    SetGadgetItemText(#ETHList, Anf.l, ETH(Anf.l)\SourceIP.s, 0)
    SetGadgetItemText(#ETHList, Anf.l, ETH(Anf.l)\SrcMAC.s, 1)
    SetGadgetItemText(#ETHList, Anf.l, ETH(Anf.l)\Src_Name.s, 2)
    SetGadgetItemText(#ETHList, Anf.l, ETH(Anf.l)\DestIP.s, 3)
    SetGadgetItemText(#ETHList, Anf.l, ETH(Anf.l)\DstMAC.s, 4)
    SetGadgetItemText(#ETHList, Anf.l, ETH(Anf.l)\Dst_Name.s, 5)
    SetGadgetItemText(#ETHList, Anf.l, Str(ETH(Anf.l)\Anzahl.l), 6)
        
  Next
  
EndProcedure
    
;****************************************************************     
    
Procedure IP_Indizi(IP.s)
  
  Static Pos1.i, Pos2.i, Pos3.i
  
  Pos1.i = FindString(IP.s, "." , 1)
  Pos2.i = FindString(IP.s, "." , Pos1 + 1)
  Pos3.i = FindString(IP.s, "." , Pos2 + 1)
  Feld1.i = Val(StringField(IP.s, 1, "."))
  Feld2.i = Val(StringField(IP.s, 2, "."))
  Feld3.i = Val(StringField(IP.s, 3, "."))
  Feld4.i = Val(Right(IP.s, Len(IP.s) - Pos3.i))
  IP_Indizi.l = Feld1.i * 4 + Feld2.i * 3 + Feld3.i * 2 + Feld4.i
  ProcedureReturn IP_Indizi.l
  
EndProcedure

;**************************************************************** 

Procedure.s Get_Name(IP.s)
  
  Static Pos1.i, Pos2.i, Pos3.i
  
  Pos1.i = FindString(IP.s, "." , 1)
  Pos2.i = FindString(IP.s, "." , Pos1 + 1)
  Pos3.i = FindString(IP.s, "." , Pos2 + 1)
  Feld0.i = Val(StringField(IP.s, 1, "."))
  Feld1.i = Val(StringField(IP.s, 2, "."))
  Feld2.i = Val(StringField(IP.s, 3, "."))
  Feld3.i = Val(Right(IP.s, Len(IP.s) - Pos3.i))
  IP_Addr.l = MakeIPAddress(Feld0, Feld1, Feld2, Feld3 )
  SName.s = ReverseDnsQuery(IP_Addr.l)
  ProcedureReturn SName.s
  
EndProcedure

;**************************************************************** 

Procedure HEX_Indizi(MAC.s)
  
  Feld1.i = Val("$" + StringField(MAC.s, 1, ":"))
  Feld2.i = Val("$" + StringField(MAC.s, 2, ":"))
  Feld3.i = Val("$" + StringField(MAC.s, 3, ":"))
  Feld4.i = Val("$" + StringField(MAC.s, 4, ":"))
  Feld5.i = Val("$" + StringField(MAC.s, 5, ":"))
  Feld6.i = Val("$" + Right(MAC.s, 2))
  
  MAC_Indizi.l = Feld1 * 6 + Feld2 * 5 + Feld3 * 4 + Feld4 * 3 + Feld5 * 2 + Feld6
  ProcedureReturn MAC_Indizi.l
EndProcedure

;****************************************************************     

Procedure Store_ETH(Output.s)
  
  Static EIndex.l, Paket.l, New_Indizi.l, K.l
  
  
  SIP.s = StringField(Output.s, 1, ",")
  SMAC.s = StringField(Output.s, 2, ",")
  DIP.s = StringField(Output.s, 3, ",")
  DMAC.s = Right(Output.s, 17)

  New_Indizi.l = IP_Indizi(SIP.s) + IP_Indizi(DIP.s) + HEX_Indizi(SMAC.s) + HEX_Indizi(DMAC.s)
  I = 0
  
  Repeat
    If ETH(I)\Indizi.l = New_Indizi.l
       ETH(I)\Anzahl + 1
       Paket.l + 1
       Break
    EndIf
    I + 1
  Until I > EIndex.l
  
  If I > EIndex.l
    ETH(EIndex.l)\SourceIP = SIP.s
    ETH(EIndex.l)\SrcMAC = SMAC.s
    ETH(EIndex.l)\Src_Name = Get_Name(SIP.s)
    ETH(EIndex.l)\DestIP = DIP.s
    ETH(EIndex.l)\DstMAC = DMAC.s
    ETH(EIndex.l)\Dst_Name = Get_Name(DIP.s)
    ETH(EIndex.l)\Indizi = New_Indizi.l
    ETH(EIndex.l)\Anzahl = 1
    AddGadgetItem(#ETHList, -1, ETH(EIndex.l)\SourceIP.s + Chr(10) + ETH(EIndex.l)\SrcMAC.s + Chr(10) + ETH(EIndex.l)\Src_Name.s + Chr(10) + ETH(EIndex)\DestIP.s + Chr(10) + ETH(EIndex)\DstMAC.s + Chr(10) + ETH(EIndex.l)\Dst_Name + Chr(10) +Str(ETH(EIndex)\Anzahl) + Chr(10))
    EIndex.l + 1
    Paket.l + 1    
  EndIf 
  
  
  SetGadgetText(#ETH_TPbar, Str(Paket.l - 1))
  ProcedureReturn EIndex.l - 1
   
EndProcedure

;****************************************************************

Procedure MyTimer(Ende.l)
  
  Anf.l = 0
  SortStructuredArray(ETH(), #PB_Sort_Descending, OffsetOf(ETHComm\Anzahl.l), #PB_Long, Anf.l, Ende.l)
  List_UpDate(Ende.l)
  SetGadgetState   (#ETH_Pbar, Ende.l)
  
EndProcedure

;****************************************************************

Procedure MyDateTimer(Ende.l)
  
  StatusBarText(0, 2, FormatDate("%dd.%mm.%yyyy %hh:%ii", Date()))
  StatusBarText(0, 1, "Aufgezeichnete IP-Sessions: " + Str(Ende.l))
  
EndProcedure

;****************************************************************

;****************************************************************

Procedure ETH_List_Events(event)
  Select event
      
    Case #EventCaptureData
      Ende.l = Store_ETH(Output.s)
      
    Case #PB_Event_Timer
      Select EventTimer()
        Case #MyTimer1
          MyTimer(Ende.l)
          
        Case #MyTimer2
          MyDateTimer(Ende.l)

      EndSelect
      
    Case #PB_Event_SizeWindow
      ResizeGadgetsETH_List()
      
    Case #PB_Event_CloseWindow
      ProcedureReturn #False
      
    Case #PB_Event_Menu
      Select EventMenu()
      EndSelect
      
    Case #PB_Event_Gadget
      Select EventGadget()
        Case #ETHList
          
        Case #Interface_ETH
          Select EventType()
            Case #PB_EventType_LeftClick          
              i = GetCapInt()
              ii = 0
              While ii <= i        
                AddGadgetItem(#Inf_List, -1, CapInt(ii)\IF_Index.s + " " + CapInt(ii)\IF_Name.s  )
                ii + 1
              Wend              
          EndSelect
          
        Case #Inf_List
          Select EventType()
            Case #PB_EventType_LeftClick
              CapInt.s = StringField(GetGadgetText(#Inf_List), 1, " ")
              StatusBarText(0, 0, "Capture Interface: : " + GetGadgetText(#Inf_List))
              DisableGadget(#Interface_ETH, #Aus)
              ;DisableGadget(#Save_ETH, #Aus)
              DisableGadget(#Stop_ETH, #Aus)
              DisableGadget(#Start_ETH, #Ein)
              HideGadget(#LED_B, #Ein)          
          EndSelect
       
        Case #Start_ETH
          
          Select EventType()
            Case #PB_EventType_LeftClick          
              ProgNum.l = StartCapData (CapInt.s)
              If ProgNum.l > 0 : thread = CreateThread(@ReadCapData(), 0) : Debug Thread : EndIf
              DisableGadget(#Start_ETH, #Aus)
              DisableGadget(#Stop_ETH, #Ein)
              AddWindowTimer(#ETH_List, #MyTimer1, 1000)
              HideGadget(#LED_G, #Ein)
              HideGadget(#LED_B, #Aus)
              
         EndSelect
          
       Case #Stop_ETH
         Select EventType()
           Case #PB_EventType_LeftClick
             Debug thread
             Debug "Thread beendet"
             KillThread(thread)
             If StopCapData (ProgNum.l)
               ;DisableGadget(#Save_ETH, #Ein)
               DisableGadget(#Interface_ETH, #Ein)
               DisableGadget(#Stop_ETH, #Aus)
               RemoveWindowTimer(#ETH_List, #MyTimer1)
               HideGadget(#LED_G, #Aus)
               HideGadget(#LED_B, #Ein) 
               ProgNum.l = 0
             EndIf
              
          EndSelect
          
        Case #Save_ETH
          Select EventType()
            Case #PB_EventType_LeftClick          
              ;If Speichere_Tabelle(Ende.l) : Else : MessageRequester("Fehler", "Speichern fehlgeschlagen!", #PB_MessageRequester_Ok ) : EndIf             
          EndSelect
          
        Case #Close_ETH
          Select EventType()
            Case #PB_EventType_LeftClick
              RemoveWindowTimer(#ETH_List, #MyTimer2)
              ProcedureReturn #False
          EndSelect
          
      EndSelect
  EndSelect
  ProcedureReturn #True
EndProcedure

;****************************************************************

OpenETH_List()
DisableGadget(#Stop_ETH, #Aus)
DisableGadget(#Start_ETH, #Aus)
DisableGadget(#Save_ETH, #Aus)
StatusBarText(0, 2, FormatDate("%dd.%mm.%yyyy %hh:%ii", Date()))
AddWindowTimer(#ETH_List, #MyTimer2, 500)


Repeat
  
    event = WaitWindowEvent()
    ergebnis = ETH_List_Events(event)
    event = 0
    Select ergebnis
      Case #False
        quit = 1
    EndSelect

Until  quit = 1

End
__________________________________________________
Code-Tags hinzugefügt
21.11.2018
RSBasic
Benutzeravatar
ts-soft
Beiträge: 22292
Registriert: 08.09.2004 00:57
Computerausstattung: Mainboard: MSI 970A-G43
CPU: AMD FX-6300 Six-Core Processor
GraKa: GeForce GTX 750 Ti, 2 GB
Memory: 16 GB DDR3-1600 - Dual Channel
Wohnort: Berlin

Re: Windows-Fenster friert zeitweise ein

Beitrag von ts-soft »

Bitte Code Tags setzen:
[ code ]Hier der Code[ /code ]
ohne die Leerzeichen in den Eckigen Klammern.
PureBasic 5.73 LTS | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Nutella hat nur sehr wenig Vitamine. Deswegen muss man davon relativ viel essen.
Bild
Antworten