Bon allez j'en mets une deuxième
dans le meme genre que DOSPing (
http://www.vbfrance.com/code.aspx?ID=17409)
je fais ici une commande ipconfig et j'analyse le résultat...
je trouve alors les différentes adresses IP de l'ordinateur local (WAN, LAN...) et je leur attribue leurs cartes respectives
j'explique pas mais allez voir la source de DOSPing, y'a quelques explications (peu, je l'admet) en plus.
Source / Exemple :
'Fonctions principales :
'fonction detectIP
Private Sub detectIP()
On Error Resume Next
Dim path As String
path = "c:\ipconfig.txt"
Shell "cmd /C ipconfig > " & path, 0
test:
Dim listIP As Liste
listIP = StrToList(searchParam(path, "Adresse IP", True, ": ", " "))
Dim listCards As Liste
listCards = StrToList(searchParam(path, "Carte", True, " ", ":"))
If listIP.str(1) = "" Then
listIP.str(1) = "Aucune adresse IP ou 127.0.0.1"
End If
'affiche les IPs
lblAdresses.Caption = "Adresses IP Locales :" & vbCrLf
Dim i As Integer
ipStr = "" 'cache pour clipboard
For i = 1 To listIP.nb
lblAdresses.Caption = lblAdresses.Caption & vbCrLf & listIP.str(i) & " (" & listCards.str(i) & ")"
If ipStr = "" Then
ipStr = listIP.str(i)
Else
ipStr = ipStr & listIP.str(i)
End If
Next i
'supprime le fichier
Kill path
End Sub
'/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\
'Fonction searchParam, qui analyse un fichier et renvoie les paramètres recherchés
'utilisable aussi pour plein d'autres utilisations (pff)
Public Function searchParam(filePath As String, paramTitle As String, Optional multi As Boolean, Optional sepStr As String, Optional lastCar1 As String, Optional lastCar2 As String) As String
'sepStr : la chaine présentant la valeur du parametre cherché. ex:
'Adresse IP . . . . . . . . : 127.0.0.1
'ici, sepStr = ": "
'lastCar1 : le caractère suivant la valeur du parametre. ex:
'Adresse IP . . . . . . . . : 127.0.0.1
'ici, lastStr1 = chr(10) et lastStr2 = chr(13) (===> vbcrlf)
'multi : défini si il faut chercher plusieurs parametres ou un seul
If lastCar1 = "" Then lastCar1 = Chr(10)
If lastCar2 = "" Then lastCar2 = Chr(13)
If paramTitle = "" Then GoTo fin
Dim noFile As Integer, intNoEssai As Integer, intNoessai2 As Integer
noFile = FreeFile()
testExists:
Wait 250
intNoEssai = intNoEssai + 1
If intNoEssai > 10 Then GoTo fin
If Dir$(filePath) = "" Then GoTo testExists
Open filePath For Input As noFile
If LOF(noFile) = 0 Then
'attend encore et refait le test d'existence
Close noFile
intNoessai2 = intNoessai2 + 1
Wait 250
If intNoessai2 > 10 Then GoTo fin
GoTo testExists
End If
Do Until EOF(noFile)
Dim Cache As String
Dim Octet As String
'cherche le titre du param
Do While Cache <> paramTitle
'recherche : "Adresse IP"
If EOF(noFile) Then GoTo endLoop
Octet = Input(1, noFile)
Cache = Cache & Octet
If Len(Cache) > Len(paramTitle) Then Cache = Right(Cache, Len(paramTitle))
Loop
Cache = ""
Octet = ""
'saute le sepStr
If sepStr <> "" Then
Do While Cache <> sepStr
If EOF(noFile) Then GoTo endLoop
Octet = Input(1, noFile)
Cache = Cache & Octet
If Len(Cache) > Len(sepStr) Then Cache = Right(Cache, Len(sepStr))
Loop
End If
Cache = ""
Octet = ""
'récupère la valeur
Do While Octet <> lastCar1 And Octet <> lastCar2
If EOF(noFile) Then GoTo endLoop
Octet = Input(1, noFile)
If Octet <> lastCar1 And Octet <> lastCar2 Then _
Cache = Cache & Octet
Loop
If searchParam = "" Then
searchParam = searchParam & Cache
Else
searchParam = searchParam & vbCrLf & Cache
End If
If Not multi Then GoTo fin
endLoop:
Loop
Close noFile
fin:
End Function
'/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\
'copy to clipboard
'un petit rappel tout simple
Private Sub mnuClipBoard_Click()
Clipboard.SetText ipStr
End Sub
'/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\
'et transformer un String en une liste de Strings, avec le nombre de membres
'type liste :
Private Type Liste
nb As Integer
str() As String
End Type
'et fonction de transformation :
Private Function StrToList(str As String) As Liste
'attention :
'un str de la liste est terminé par un vbcrlf !
Dim i As Long, cList As Liste
ReDim cList.str(1 To 1)
If Len(str) = 0 Then
cList.str(1) = ""
cList.nb = 1
GoTo fin
End If
Dim o As String, oo As String, cString As String
Do While i < Len(str)
oo = ""
o = ""
cString = ""
Do While oo <> vbCrLf And i < Len(str)
i = i + 1
o = Mid(str, i, 1)
oo = Mid(str, i, 2)
If oo = vbCrLf Or oo = "" Then GoTo finloop
cString = cString & o
finloop:
Loop
i = i + 1 'saute un char de trop
cList.nb = cList.nb + 1
ReDim Preserve cList.str(1 To cList.nb)
cList.str(cList.nb) = cString
Loop
fin:
StrToList = cList
End Function
'bon, je pense que c'est largement assez...
Conclusion :
Bon... pour l'instant je n'ai rien à ajouter là-dessus... mais envoyez moi vos commentaires, je me ferai un plaisir de répondre à vos attentes (enfin... ça dépend...)
Bonne prog à tous!
Helkanen
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.