Threadprobleme -.-

[Sauer-RAM]

Hi,
da bin ich mal wieder... Und leider mit einem Problemchen...
Ich kenne mich mit der Threadprogrammierung nicht wirklich aus und der Code ist ziemlich hingemurkst und bei weitem noch nicht fertig.
Das Programm soll das Internet "kartographieren" (Ja, ist eine äußerst dumme und undurchführbare Idee, aber wenn ich die Zielliste nicht mit zufälligen Nummern fülle sondern mit existierenden Bereichen könnte ich es irgendwann mal vielleicht brauchen).

Interessant sind, wie ich finde, zwei Bugs:
1. Warum wird in der Konsole gelegentlich eine Zeile der ausgabe von nslookup ausgegeben, obwohl dies nirgends im Code steht? Und warum gibt mein Programm nur extrem selten aus, dass es den Error der in der ausgegebenen Zeile von nslookup zurückgegeben wird korrekt behandelt hat? (aka. Warum schlägt der Filter in Zeile 156 nicht an?)

und 2. Warum schmiert das Programm irgendwann mit der Meldung ab, die Targets()-Liste hätte kein aktives Element, während die an den Thread übergebene Elementnummer zum Zeitpunkt des Fehlers IMMER 8090 ist, was zum einen mal in einer Schleife von 0<=n<=1999 nicht möglich ist und zudem noch mit dem HTTP_alt-Port, welcher auch in dem Programm überprüft wird, übereinstimmt (vllt hat es was damit zu tun)?
Habe ich da mit den Buffern Mist gebaut?

Ich würde mich freuen, wenn jemand mir einen Tipp geben könnte.

Hier wäre der Code:

Code: Alles auswählen

#MaxPingWaits = 200
#PingDelay = 80

#NSDelay = 200
#MaxNsWaits = 150

#MaxThreads = 50

Structure IP
  IP.s
  Name.s
  Ping.b
  Param.b
EndStructure

Global NewList Targets.IP()

OpenConsole("Crawler")

If InitNetwork()
  PrintN("Network initiated")
Else
  PrintN("Can not initiate Network")
EndIf

Global TargetMutex = CreateMutex()
Global CounterMutex = CreateMutex()
UnlockMutex(CounterMutex)

Global Counter = 0
Procedure FailSave(String.s)
  Global Stop = #True
  PrintN(String.s)
  Input()
  End
EndProcedure

Procedure CheckPort(IP.s,Port)
  Connection = OpenNetworkConnection(IP,Port)
  If Connection
    CloseNetworkConnection(Connection)
    ProcedureReturn #True
  Else
    ProcedureReturn #False
  EndIf
EndProcedure


Procedure CheckIP(*Nr)
  Nr = *Nr
  Debug Nr
  LockMutex(TargetMutex)
  SelectElement(Targets(),Nr)
  PrintN("Starting at " + Targets()\IP)
  IP.s = Targets()\IP
  UnlockMutex(TargetMutex)
  Ping.b = 0
  Name.s = ""
  SMTP.b = #False
  POP.b = #False
  IMAP.b = #False
  HTTP.b = #False
  TELNET.b = #False
  OpenSMTP.b = #False
  HTTPS.b = #False
  FTP.b = #False
  
  *ResponseBuffer = AllocateMemory(50)
  Program = RunProgram("ping.exe",IP + " -n 3","C:\\",#PB_Program_Open|#PB_Program_Hide|#PB_Program_Read)

  If Not Program
    FreeMemory(*ResponseBuffer)
    FailSave("ERROR!!! Can not Start Ping")
  EndIf
  
  MaxCounter = 0
  WaitingPing:
  
  Repeat
    Delay(#PingDelay)
    Length = AvailableProgramOutput(Program)
    MaxCounter + 1
  Until Length >> 0 Or MaxCounter = #MaxPingWaits
  
  If MaxCounter = #MaxPingWaits
    FreeMemory(*ResponseBuffer)
    FailSave("ERROR!!! MaxPingWaits reached")
  EndIf
  
  *ResponseBuffer = ReAllocateMemory(*ResponseBuffer, Length)

  If Not Length = ReadProgramData(Program,*ResponseBuffer,Length)
    FreeMemory(*ResponseBuffer)
    FailSave("ERROR!!! ResponseBuffer for Ping too small, i can not handle it...")
  EndIf
  
  ResponseString.s = ResponseString + PeekS(*ResponseBuffer,Length,#PB_UTF8)
  Debug ResponseString
  EndPosition = FindString(ResponseString,"% V")
  If Not EndPosition
    If FindString(ResponseString," Sie den Namen, und versuchen Sie es erneut.") Or FindString(ResponseString,"Allgemeiner Fehler") Or FindString(ResponseString,"?bertragung ?berschritten")
      PrintN("Name falsch")
      Goto EndofTest
    EndIf
    Goto WaitingPing
  EndIf
  
  StartPosition =  FindString(ResponseString,"(",StartPosition - 5)
  If Not StartPosition
    Goto WaitingPing
  EndIf
  
  Verlust = Val(Mid(ResponseString,StartPosition + 1, EndPosition - 1))
  Ping = 100 - Verlust
  If Ping = 0
    Goto EndofTest
  EndIf
  
  ResponseString = ""
  Length = 0

  PrintN("Lookup")
  *ResponseBuffer = ReAllocateMemory(*ResponseBuffer,50)
  Program = RunProgram("nslookup.exe",IP,"C:\\",#PB_Program_Open|#PB_Program_Hide|#PB_Program_Read)
  
  If Not Program
    FreeMemory(*ResponseBuffer)
    FailSave("ERROR!!! Can not Start nslookup")
  EndIf
  
  MaxCounter = 0
  WaitingNs:
  
  Repeat
    Delay(#NsDelay)
    Length = AvailableProgramOutput(Program)
    MaxCounter + 1
  Until Length >> 0 Or MaxCounter = #MaxNsWaits

  If MaxCounter = #MaxNsWaits
    PrintN(Str(MaxCounter))
    PrintN(ResponseString)
    FreeMemory(*ResponseBuffer)
    FailSave("ERROR!!! MaxNsWaits reached")
  EndIf
  
  *ResponseBuffer = ReAllocateMemory(*ResponseBuffer, Length)

  If Not Length = ReadProgramData(Program,*ResponseBuffer,Length)
    FreeMemory(*ResponseBuffer)
    FailSave("ERROR!!! ResponseBuffer for nslookup too small, i can not handle it...")
  EndIf
  
  ResponseString.s = ResponseString + PeekS(*ResponseBuffer,Length,#PB_UTF8)
  
  If FindString(ResponseString,"Non-existent domain") Or FindString(ResponseString,"Server failed") Or FindString(ResponseString,"timed out")
    PrintN("------------------------- Handeled -------------------")
    Goto EndofTest
  EndIf
  
  StartPosition = FindString(ResponseString,"Name:")

  If Not StartPosition
    Goto WaitingNs
  EndIf
  
  EndPosition = FindString(ResponseString,"Address:",StartPosition)
  
  If Not EndPosition
    Goto WaitingNs
  EndIf
  
  ResponseString = Mid(ResponseString,StartPosition + 5,EndPosition - 1 - StartPosition - 6)
  Name.s = LTrim(ResponseString,Chr(32))
  
  
  
  If CheckPort(IP,25) Or CheckPort(IP,587)
    SMTP = #True
    Mail = CreateMail(#PB_Any,"testmail@test.com","Testing")
    If Mail
      SetMailBody(Mail,"Testtext")
      AddMailRecipient(Mail,"myname@trash-mail.com",#PB_Mail_To)
      If SendMail(Mail,IP)
        OpenSMTP = #True
      EndIf
    Else
      FreeMemory(*ResponseBuffer)
      FailSave("ERROR!!! Konnte Mail nicht erstellen")
    EndIf
  EndIf
  
  IMAP = CheckPort(IP,143)
  POP = CheckPort(IP,110)
  
  If CheckPort(IP,80) Or CheckPort(IP,8008) Or CheckPort(IP,8080) Or CheckIP(8090)
    HTTP = #True
  EndIf
  
  HTTPS = CheckPort(IP,443)
  
  TELNET = CheckPort(IP,23)
  
  EndOfTest:
  
  FreeMemory(*ResponseBuffer)
  If SMTP
    Param = Param | %10000000
  EndIf
  
  If OpenSMTP
    Param = Param | %01000000
  EndIf
  
  If POP
    Param = Param | %00100000
  EndIf
  
  If IMAP
    Param = Param | %00010000
  EndIf
  
  If HTTP
    Param = Param | %00001000
  EndIf
  
  If TELNET
    Param = Param | %00000100
  EndIf
  
  If HTTPS
    Param = Param | %00000010
  EndIf
  
  If FTP
    Param = Param | %00000001
  EndIf
  
  
  LockMutex(TargetMutex)
  SelectElement(Targets(),Nr)
  Targets()\IP = IP
  Targets()\Name = Name.s
  Targets()\Ping = Ping
  Targets()\Param = Param
  UnlockMutex(TargetMutex)
  LockMutex(CounterMutex)
  Counter - 1
  UnlockMutex(CounterMutex)
  PrintN("Finishing at " + IP + " (" + Name + ")")
EndProcedure
For n = 0 To 2000
  AddElement(Targets())
  Targets()\IP = Str(Random(255)) + "." + Str(Random(255)) + "." + Str(Random(255)) + "." + Str(Random(255))
Next
AddElement(Targets())
Targets()\IP = "173.194.32.255"

Debug ListIndex(Targets())
For i = 0 To ListSize(Targets()) - 2
  Repeat
    Delay(200)
    LockMutex(CounterMutex)
    If Counter < #MaxThreads
      Counter + 1
      UnlockMutex(CounterMutex)
      Goto StartThread
    EndIf
    UnlockMutex(CounterMutex) 
  ForEver
  
  StartThread:
  ;LockMutex(TargetMutex)
  ;SelectElement(Targets(),i)
  ;PrintN("Starting at " + Targets()\IP)
  ;UnlockMutex(TargetMutex)
  CreateThread(@CheckIP(),i)
Next
Input()

Vielen Dank schonmal im Vorraus.

(PS Der Code ist leider alles andere als schön und z.B. die FailSave Funktion macht noch überhaupt keinen Sinn... Ich wollte nur möglichst schnell ein so grob in etwa laufendes Programm...)

Gruß Felix

[NicTheQuick]

Zwei Fragen:
1. Hast du Threadsafe in den Compileroptionen aktiviert? Das ist wichtig, wenn du Strings in Threads nutzt.
2. Wieso übergibst du dem Thread die Position des Elementes und nutzt das urlangsame 'SelectElement()'? Einfacher wäre es, wenn du dem Thread direkt den Pointer zum Element übergibst. Dann brauchst du auch kein Mutex für das einzelne Element.

Ausprobieren kann ich den Code so eh nicht. Ich hab grad kein Windows da.

[Sauer-RAM]

Danke erstmal für die schnelle Antwort.
1. Ja habe ich an
und 2. Mh... Ich kenne mich mit der Verwendung von Pointern noch nicht so gut aus und wusste nicht, dass SelectElement() so langsam ist... Wie bekomme ich denn den Pointer zu einem Element der Liste, ohne es mit SelectElement auszuwählen?
Gruß
Felix

[NicTheQuick]

Ich würde einmalig so viele Threads erstellen wie du brauchst und dann jeden Thread von einer Queue lesen lassen. Also in etwa so:

Code: Alles auswählen

EnableExplicit

#MaxPingWaits = 200
#PingDelay = 80

#NSDelay = 200
#MaxNsWaits = 150

#MaxThreads = 25

OpenConsole("Crawler")

If InitNetwork()
	PrintN("Network initiated")
Else
	PrintN("Can not initiate Network")
EndIf

Global Counter = 0
Procedure FailSave(String.s)
	Global Stop = #True
	PrintN(String.s)
	Input()
	End
EndProcedure

Procedure CheckPort(IP.s, Port.i)
	Protected Connection.i
	Connection = OpenNetworkConnection(IP,Port)
	If Connection
		CloseNetworkConnection(Connection)
		ProcedureReturn #True
	Else
		ProcedureReturn #False
	EndIf
EndProcedure

Structure IP
	IP.s
	Name.s
	Ping.i
	Param.i
	hThread.i
EndStructure


Procedure CheckIP(*target.IP)
	PrintN(*target\IP)
EndProcedure

Structure Queue
	List *queue.IP()
	lock.i
EndStructure

Procedure Thread(*q.Queue)
	Protected *target.IP
	
	Repeat
		LockMutex(*q\lock)
		If FirstElement(*q\queue())
			*target = *q\queue()
			DeleteElement(*q\queue())
			UnlockMutex(*q\lock)
			CheckIP(*target)
		Else
			UnlockMutex(*q\lock)
			ProcedureReturn
		EndIf
	ForEver
EndProcedure

Procedure StartThreads(List targets.IP())
	Protected Dim runningThreads.i(#MaxThreads - 1)
	Protected q.Queue
	q\lock = CreateMutex()
	
	;Fülle Warteschlange
	ForEach targets()
		If AddElement(q\queue())
			q\queue() = @targets()
		EndIf
	Next
	
	Protected i.i
	;Starte Threads
	For i = 0 To #MaxThreads - 1
		runningThreads(i) = CreateThread(@Thread(), @q)
	Next
	;Warte auf Ende der Threads
	For i = 0 To #MaxThreads - 1
		WaitThread(runningThreads(i))
	Next
	
	FreeMutex(q\lock)
	
EndProcedure

NewList Targets.IP()

Define n.i
For n = 0 To 2000
	If AddElement(Targets())
		Targets()\IP = Str(Random(255)) + "." + Str(Random(255)) + "." + Str(Random(255)) + "." + Str(Random(255))
	EndIf
Next

If AddElement(Targets())
	Targets()\IP = "173.194.32.255"
EndIf

StartThreads(Targets())

PrintN("Fertig!")
Input() 

Bei insgesamt 50 Threads kommt bei mir allerdings immer ein Fehler bei 'WaitThread()'. Das scheint aber eher ein Bug in PB zu sein, oder eine Limitierung meines Betriebssystems, was ich aber weniger glaube.

[Sauer-RAM]

Vielen Dank für den Code ^^ leider habe im Moment ziemlich wenig Zeit (habe bald mein Abi, und alle Lehrer meinen sie müssten jetzt noch eine Arbeit schreiben -.-).

Ich werde mir den Code leider vermutlich erst am Wochenende oder sogar erst in den Ferien genauer anschauen.

Aber vielen Danke dafür schonmal.

Gruß

Felix