PureBasic

Code : Tout sélectionner

;
; CheckIP
; Local IPs, external IP, and LAN servers and workstations scan giving names and local IPs.
; F.Weil 20050927
;
#NERR_SUCCESS = $0
#NERR_INVALIDCOMPUTER = 2351
#NERR_MOREDATA = $234

#SV_TYPE_WORKSTATION = $00000001 ; All LAN Manager workstations
#SV_TYPE_SERVER = $00000002 ; All LAN Manager servers
#SV_TYPE_SQLSERVER = $00000004 ; Any server running with Microsoft SQL Server
#SV_TYPE_DOMAIN_CTRL = $00000008 ; Primary domain controller
#SV_TYPE_DOMAIN_BAKCTRL = $00000010 ; Backup domain controller
#SV_TYPE_TIMESOURCE = $00000020 ; Server running the Timesource service
#SV_TYPE_AFP = $00000040 ; Apple File Protocol servers
#SV_TYPE_NOVELL = $00000080 ; Novell servers
#SV_TYPE_DOMAIN_MEMBER = $00000100 ; LAN Manager 2.x Domain Member
#SV_TYPE_PRINT = $00000200 ; Server sharing print queue
#SV_TYPE_DIALIN = $00000400 ; Server running dial-in service
#SV_TYPE_XENIX_SERVER = $00000800 ; Xenix server
#SV_TYPE_NT = $00001000 ; Windows NT (either Workstation or Server)
#SV_TYPE_WFW = $00002000 ; Server running Windows for Workgroups
#SV_TYPE_MFPN = $00004000 ; Microsoft file and print for Netware
#SV_TYPE_SERVER_NT = $00008000 ; Windows NT Non-DC server
#SV_TYPE_POTENTIAL_BROWSER = $00010000 ; Server that can run the Browser service
#SV_TYPE_BACKUP_BROWSER = $00020000 ; Server running a Browser service as backup
#SV_TYPE_MASTER_BROWSER = $00040000 ; Server running the master Browser service
#SV_TYPE_DOMAIN_MASTER = $00080000 ; Server running the domain master Browser
#SV_TYPE_WINDOWS = $00400000 ; Windows 95 or later
#SV_TYPE_LOCAL_LIST_ONLY = $40000000 ; Servers maintained by the browser. See the following Remarks section.
#SV_TYPE_DOMAIN_ENUM = $80000000 ; Primary Domain 
#SV_TYPE_ALL = $FFFFFFFF ; All servers

Structure SERVER_INFO_100
  sv100_platform_id.l
  sv100_name.l
EndStructure
  
NewList ServerList.s()

Procedure.s MyIP()
  URL.s = "http://www.whatismyip.com"
  FileName.s = "CheckIP.tmp"
  If URLDownloadToFile_(0, URL, FileName, 0, 0) = #S_OK
      If ReadFile(0, FileName)
          Repeat
            String.s = ReadString()
            If FindString(String, "<h1>", 1)
                iu = FindString(String, "<h1>", 1)
                String = Mid(String, iu + 4, Len(String) - iu - 4 + 1)
                iu = FindString(String, "</h1>", 1)
                String = Mid(String, 1, iu - 1)
                String1.s = ""
                For i = 1 To Len(String)
                  Cod.s = Mid(String, i, 1)
                  If (Cod => "0" And Cod <= "9") Or Cod = "."
                      String1 + Cod
                  EndIf
                Next
            EndIf
          Until Eof(0)
          CloseFile(0)
          DeleteFile(FileName)
      EndIf
      ProcedureReturn String1
    Else
      ProcedureReturn "Can't access to " + URL
  EndIf
EndProcedure

Procedure.l Ansi2Uni(ansi.s)
  size.l=MultiByteToWideChar_(#CP_ACP,0,ansi,-1,0,0)
  Dim unicode.w(size)
  MultiByteToWideChar_(#CP_ACP, 0, ansi, Len(ansi), unicode(), size)
  ProcedureReturn @unicode() 
EndProcedure

Procedure.s Uni2Ansi(*Unicode.l)
  size.l = WideCharToMultiByte_(#CP_ACP, 0, *Unicode, -1, #Null, #Null, #Null, #Null)
  ansi.s=Space(size)
  WideCharToMultiByte_(#CP_ACP, 0, *Unicode, -1, @ansi, size, #Null, #Null)
  ProcedureReturn ansi 
EndProcedure

Procedure.s GetIPbyName(ServerName.s)
  ServerName = ReplaceString(ServerName, "\", "")
  TheIPAddress.s
  pHostinfo = gethostbyname_(ServerName)
  If pHostinfo = 0
      TheIPAddress = "Unable to resolve domain name"
    Else
      CopyMemory (pHostinfo, hostinfo.HOSTENT, SizeOf(HOSTENT))
      If hostinfo\h_addr <> #AF_INET
          TheIPAddress = "A non-IP address was returned."
        Else
          While PeekL(hostinfo\h_list + AdressNumber * 4)
            ipAddress = PeekL(hostinfo\h_list + AdressNumber * 4)
            TheIPAddress + StrU(PeekB(ipAddress), 0) + "." + StrU(PeekB(ipAddress + 1), 0) + "." + StrU(PeekB(ipAddress + 2), 0) + "." + StrU(PeekB(ipAddress + 3), 0) + Chr(10) + Chr(13)
            AdressNumber + 1
          Wend
      EndIf
  EndIf
  ProcedureReturn TheIPAddress
EndProcedure

  
  If InitNetwork()
      ;
      ; Pour voir les IP locales en utilisant les fonctions Purebasic
      ;
      Message.s = ""
      ExamineIPAddresses()
      Repeat
        Result = NextIPAddress()
        If Result <> 0
            Message + IPString(Result) + Chr(10)
          Else
            Break
        EndIf
      ForEver
      MessageRequester("Local IPs", Message, #PB_MessageRequester_Ok)
      ;
      ; Pour récupérer l'IP externe du réseau
      ;
      MessageRequester("External IP", "Your IP address is : " + MyIP(), #PB_MessageRequester_Ok)
      ;
      ; Pour lister les PC accessibles sur le réseau local
      ;
      LocalServerName.s = Space(255)
      gethostname_(@LocalServerName, 255)
      ServerName.SERVER_INFO_100
      ServerName\sv100_platform_id = 0
      ServerName\sv100_name = Ansi2Uni("\\" + LocalServerName)
      Message.s = ""
      Repeat
        Result = NetServerEnum_(Ansi2Uni(""), 100, @ServerName, prefmaxlen = 65536, @entriesread, @totalentries, servertype = #SV_TYPE_ALL, #Null, 0)
        Select Result
          Case #NERR_SUCCESS
            AddElement(ServerList())
            ServerList() = Uni2Ansi(ServerName\sv100_name)
          Case #ERROR_ACCESS_DENIED
            Message + "The user does not have access to the requested information." + Chr(10)
          Case #NERR_INVALIDCOMPUTER
            Message + "The computer name is invalid." + Chr(10)
          Case #ERROR_NO_BROWSER_SERVERS_FOUND
            Message + "No browser servers found." + Chr(10)
          Case #ERROR_MORE_DATA
            Message + "More entries are available with subsequent calls." + Chr(10)
          Default
            Message + "Unknown message" + Chr(10)
        EndSelect
      Until Result <> #NERR_SUCCESS Or entriesread = totalentries ; = #NERR_MOREDATA
      ForEach ServerList()
        Message + ServerList() + " " + GetIPbyName(ServerList()) + Chr(10)
      Next
      MessageRequester("PCs enum", Message, #PB_MessageRequester_Ok)
    Else
      MessageRequester("Error", "Can't open the network", #PB_MessageRequester_Ok)
  EndIf
End