PureBasic

Code : Tout sélectionner

; ______________________________________________________________________________
;
; Module permettant de scanner le réseau local à la recherche d'un hote ayant 
; un port donné ouvert (recherche de serveur).
; 
; Programme multi threadé, permettant d'accélérer la recherche.
; 
; Modifier la variable TIMEOUT pour accélérer la recherche.
; Modifier la variable MAX_RUNNING_THREAD pour augmenter le nombre de thread simultané
; Compatible réseau Microsoft uniquement.
; Utilise les APIs Windows.
; Sans interface graphique ;) Utiliser le debugguer pour voir les résultats
;
; Compilé sous version 4.40 b5
;
; ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯

;- Structures internes
; __________________________________________
Structure CONNECT_INFO
  host.s{100}
  port.l
  type.l ; TCP ou UDP  
EndStructure

Structure RUNNING_THREAD
  thread_id.l
  ms_debut.l
  host.s{100}
  port.l
EndStructure

Structure SERVER_INFO_101 
 dwPlatformId.l 
 lpszServerName.l 
 dwVersionMajor.l 
 dwVersionMinor.l 
 dwType.l 
 lpszComment.l 
EndStructure 

Structure LAN_RESULT 
 Name.s 
 IP_Name.s 
 Aktiv_Server.l
 Spiel_Name.s 
 Spieler_bisher.l 
EndStructure 
; ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯

;- Listes chainées
Global NewList TabThread.RUNNING_THREAD()

Global NewList LAN_Client.LAN_RESULT() 


;- Variables globales
Global current_running_thread
Global SEM_SCAN_CURRENT_THREAD
Global MAX_RUNNING_THREAD = 50
Global TIMEOUT = 50 ; en millisecondes
Global PORT = 1025 ; Port à rechercher


;-------------------  Semaphore Functions  ------------------------
Macro Sem_Create(Init, Max)
  CreateSemaphore_(#Null, Init, Max, #Null)
EndMacro
Macro Sem_Acquire(Sem)
  WaitForSingleObject_(Sem, #INFINITE)
EndMacro
Macro Sem_ReleaseSeveral(Sem, nb)
  ReleaseSemaphore_(Sem, nb, #Null)
EndMacro
Macro Sem_Release(Sem)
  ReleaseSemaphore_(Sem, 1, #Null)
EndMacro
;----------------  End of Semaphore Functions  ---------------------


;- Constantes
#MAX_PREFERRED_LENGTH = -1 
#NERR_SUCCESS         = 0 
#ERROR_MORE_DATA      = 234 
#MainWindow           = 100 
#MMTB                 = 200 


;- Procédures et fonctions
; __________________________________________
Procedure.s GetIPbyName (NameIP.s) 
  TheIPAdress.s 
  pHostinfo = gethostbyname_(NameIP) ; /!\ Fonction lente => A threader pour améliorer les performances
  
  If pHostinfo = 0 
    TheIPAdress = "Unable to resolve domain name" 
  Else 
  
    CopyMemory (pHostinfo, hostinfo.HOSTENT, SizeOf(HOSTENT)) 
    
    If hostinfo\h_addrtype <> #AF_INET 
      MessageRequester("Info","A non-IP address was returned",0) 
    Else 
      While PeekL(hostinfo\h_addr_list+AdressNumber*4) 
        ipAddress = PeekL(hostinfo\h_addr_list+AdressNumber*4) 
        TheIPAdress = StrU(PeekB(ipAddress),0)+"."+StrU(PeekB(ipAddress+1),0)+"."+StrU(PeekB(ipAddress+2),0)+"."+StrU(PeekB(ipAddress+3),0) 
        AdressNumber+1 
      Wend 
    EndIf 
  EndIf 
  
  ProcedureReturn TheIPAdress 
EndProcedure 

Procedure GetLANList(type.l) 
  IPResult.s 
  se101.SERVER_INFO_101 
  nStructSize = SizeOf(SERVER_INFO_101) 
  
  RetCode = NetServerEnum_(0, 101, @bufptr, #MAX_PREFERRED_LENGTH, @dwEntriesread, @dwTotalentries, type, 0, @dwResumehandle) 
  
  If RetCode = #NERR_SUCCESS And RetCode <> #ERROR_MORE_DATA 
    
    For i = 0 To dwEntriesread - 1 
      
      CopyMemory( bufptr + (nStructSize * i),@se101, nStructSize) 
      
      Buffer.s=Space(512) 
      result=WideCharToMultiByte_(#CP_ACP, 0, se101\lpszServerName, 255, @Buffer.s, 512, 0, 0) 
      ;IPResult = GetIPbyName (Buffer) ; /!\ Fonction lente => On la zappe car le nom d'hôte nous suffit ;)
      
      Debug Buffer + " => " + IPResult
      
      AddElement(LAN_Client()) 
        LAN_Client()\Name = Buffer 
        LAN_Client()\IP_Name = IPResult 
    Next 
    
  Else 
    MessageRequester("Info","Failed",0) 
  EndIf 
  
  NetApiBufferFree_(bufptr) 
EndProcedure  


Procedure connect_thread (connect_info_.l)
  
  *connect_info.CONNECT_INFO = connect_info_ 
  
  con = OpenNetworkConnection(*connect_info\host, *connect_info\port, *connect_info\type)

  If con
    
    Debug *connect_info\host + " -------------------------- > " + Str(*connect_info\port) + " is open !"    
    ;AddGadgetItem(ports, -1, Str(*connect_info\port) + Chr(10) + "Open")
    
    CloseNetworkConnection(con)
  
  Else
    
    Debug "Le port " + Str(*connect_info\port) + " ne répond pas sur " + *connect_info\host
    
  EndIf
  
  FreeMemory(*connect_info)
  
  Global current_running_thread
  Sem_Acquire(SemCurrentThreadRunning)
  current_running_thread - 1
  Sem_Release(SemCurrentThreadRunning)
  
  ProcedureReturn 
  
EndProcedure

Procedure.l ScanLanThread(port.l)
  
  ForEach LAN_Client()

    struct = AllocateMemory(SizeOf(CONNECT_INFO))
    *connect_info.CONNECT_INFO = struct
  
    *connect_info\host = Lan_Client()\Name
    *connect_info\port = port
    *connect_info\type = #PB_Network_TCP
    
    
    AddElement(TabThread())
    TabThread()\thread_id = CreateThread(@connect_thread(), *connect_info)
    TabThread()\ms_debut = ElapsedMilliseconds()
    TabThread()\host = Lan_Client()\Name
    TabThread()\port = port
    
    ; Ajout un thread
    Sem_Acquire(SemCurrentThreadRunning)
    current_running_thread + 1
    Sem_Release(SemCurrentThreadRunning)
    
    ; Synchro
    While current_running_thread >= MAX_RUNNING_THREAD
      
      ; Vérifie qu'un ou plusieurs thread n'a pas dépassé le time out. Si c'est le cas  => on le supprime
      ForEach TabThread()
        
        If ElapsedMilliseconds() - TabThread()\ms_debut > TIMEOUT
          
          If IsThread(TabThread()\thread_id)
            
            PauseThread(TabThread()\thread_id)
            KillThread(TabThread()\thread_id)
            

            Debug "Le port " + Str(TabThread()\port) + " ne répond pas sur " + TabThread()\host
            
            DeleteElement(TabThread())
            
            Sem_Acquire(SemCurrentThreadRunning)
            current_running_thread - 1
            Sem_Release(SemCurrentThreadRunning)
          
          Else
            
            DeleteElement(TabThread())
          
          EndIf
        EndIf
        
      Next
      
      Delay(1)
      
    Wend
    
    Delay(15)
    
  Next
  
  
  ; Attends jusqu'à ce que tous les thread se terminent
  While CountList(TabThread()) > 0
    
    ForEach TabThread()
        
        If ElapsedMilliseconds() - TabThread()\ms_debut > TIMEOUT
          
          If IsThread(TabThread()\thread_id)
            KillThread(TabThread()\thread_id)
            
            Debug "Le port " + Str(TabThread()\port) + " ne répond pas sur " + TabThread()\host
          
          EndIf
          
          ; Suppression de l'élement
          DeleteElement(TabThread())  
            
          
          Sem_Acquire(SemCurrentThreadRunning)
          current_running_thread - 1
          Sem_Release(SemCurrentThreadRunning)
          
        EndIf
        
      Next
    
    Delay(05)
  Wend

EndProcedure


; Initialise le réseau
InitNetwork()

; Scan le réseau
; Le paramètre correspond au type de matériel à scanner
; Les valeurs possibles sont :
; SV_TYPE_WORKSTATION => All workstations.
; SV_TYPE_SERVER => All computers that run the Server service.
; SV_TYPE_SQLSERVER => Any server that runs Microsoft SQL Server.
; SV_TYPE_DOMAIN_CTRL => A server that is primary domain controller.
; SV_TYPE_DOMAIN_BAKCTRL => Any server that is a backup domain controller.
; SV_TYPE_TIME_SOURCE => Any server that runs the Timesource service.
; SV_TYPE_AFP => Any server that runs the Apple Filing Protocol (AFP) file service.
; SV_TYPE_NOVELL => Any server that is a Novell server.
; SV_TYPE_DOMAIN_MEMBER => Any computer that is LAN Manager 2.x domain member.
; SV_TYPE_LOCAL_LIST_ONLY => Any computer maintained in a list by the browser. See the following Remarks section.
; SV_TYPE_PRINTQ_SERVER => Any computer that shares a print queue.
; SV_TYPE_DIALIN_SERVER => Any server that runs a dial-in service.
; SV_TYPE_XENIX_SERVER => Any server that is a Xenix server.
; SV_TYPE_SERVER_MFPN => Any server that runs the Microsoft File And Print For NetWare service.
; SV_TYPE_NT => A workstation Or server.
; SV_TYPE_WFW => Any computer that runs Windows For Workgroups.
; SV_TYPE_SERVER_NT => Any server that is Not a domain controller.
; SV_TYPE_POTENTIAL_BROWSER => Any computer that can run the browser service.
; SV_TYPE_BACKUP_BROWSER => A computer that runs a browser service As backup.
; SV_TYPE_MASTER_BROWSER => A computer that runs the master browser service.
; SV_TYPE_DOMAIN_MASTER => A computer that runs the domain master browser.
; SV_TYPE_DOMAIN_ENUM => The primary domain.
; SV_TYPE_WINDOWS => A computer that runs Windows.
; SV_TYPE_ALL => All servers.
; SV_TYPE_TERMINALSERVER => A server running the Terminal Server service.
; SV_TYPE_CLUSTER_NT => Server clusters available in the domain.
; SV_TYPE_CLUSTER_VS_NT => Cluster virtual servers available in the domain.
#SV_TYPE_ALL               = $FFFFFFFF
#SV_TYPE_UNKNOWN           = $1F000000

#SV_TYPE_DOMAIN_ENUM       = $80000000
#SV_TYPE_LOCAL_LIST_ONLY   = $40000000
#SV_TYPE_ALTERNATE_XPORT   = $20000000
#SV_TYPE_DFS_SERVER        = $00800000
#SV_TYPE_WIN95_PLUS        = $00400000
#SV_TYPE_SERVER_VMS        = $00200000
#SV_TYPE_SERVER_OSF        = $00100000
#SV_TYPE_DOMAIN_MASTER     = $00080000
#SV_TYPE_MASTER_BROWSER    = $00040000
#SV_TYPE_BACKUP_BROWSER    = $00020000
#SV_TYPE_POTENTIAL_BROWSER = $00010000
#SV_TYPE_SERVER_NT         = $00008000
#SV_TYPE_SERVER_MFPN       = $00004000
#SV_TYPE_WFW               = $00002000
#SV_TYPE_NT                = $00001000
#SV_TYPE_SERVER_UNIX       = $00000800
#SV_TYPE_DIALIN_SERVER     = $00000400
#SV_TYPE_PRINTQ_SERVER     = $00000200
#SV_TYPE_DOMAIN_MEMBER     = $00000100
#SV_TYPE_NOVELL            = $00000080
#SV_TYPE_AFP               = $00000040
#SV_TYPE_TIME_SOURCE       = $00000020
#SV_TYPE_DOMAIN_BAKCTRL    = $00000010
#SV_TYPE_DOMAIN_CTRL       = $00000008
#SV_TYPE_SQLSERVER         = $00000004
#SV_TYPE_SERVER            = $00000002
#SV_TYPE_WORKSTATION       = $00000001

GetLANList(#SV_TYPE_ALL) 

; La liste chainée LAN_Client est désormais à jour
; On lance un thread pour trouver si un serveur tourne sur ces clients

ScanLanThread(PORT)
 

Code : Tout sélectionner

Macro Sem_Create(Init, Max)
  CreateSemaphore_(#Null, Init, Max, #Null)
EndMacro
Macro Sem_Acquire(Sem)
  WaitForSingleObject_(Sem, #INFINITE)
EndMacro
Macro Sem_ReleaseSeveral(Sem, nb)
  ReleaseSemaphore_(Sem, nb, #Null)
EndMacro
Macro Sem_Release(Sem)
  ReleaseSemaphore_(Sem, 1, #Null)
EndMacro