Lotusscript et ping

[diarno]

Je cherche un code lotusscript pour faire le ping de serveur... Actuellement j'envoie une commande dos et je recupere le resultat dans un fichier texte... pas top top.Donc si quelqu'un a un bout de code a me proposé, je suis preneur.

[diarno]

pourquoi personne il veut repondre à mes questions !!!!c'est trop injuste

[Stephane Maillard]

Bonjour,Voici un code que j'utilise :Sub Initialize Dim servername As Variant Dim view As NotesView Dim doc As NotesDocument Dim x As Integer Dim session As New NotesSession Dim dbase2 As NotesDatabase servername = session.GetEnvironmentString("MailServer",True) Dim dbase As New NotesDatabase(servername,"Names.nsf") Dim nlog As New NotesLog("Server Responsiveness List") Call nlog.OpenMailLog(session.UserName,"Resultat de la vérification du serveur") Set view = dbase.GetView("Servers") Set doc = view.GetFirstDocument On Error Resume Next While Not (doc Is Nothing) servername = doc.getItemValue("ServerName") Dim dbasecollection As New NotesDBDirectory(ServerName(0)) Set dbase2 = dbasecollection.GetFirstDatabase(Database) If Err <> 0 Then Call nlog.LogAction("Impossible d'accéder au serveur :" & _ servername(0)) Err = 0 Else Call nlog.LogAction("Serveur " & servername(0) & _ " OK") End If Set Doc = view.GetNextDocument(Doc) Wend nlog.Close Messagebox("Terminer")End Sub[%sig%]

[Droad]

Trouvé sur vbfrance.com. Pour Win32. Ne fonctionne qu'avec des IP (pas les noms dns).Option PublicOption Declare'La liste des erreurs pouvant etre retournées !%REM11001 Buffer Too Small 11002 Destination Net Unreachable 11003 Destination Host Unreachable 11004 Destination Protocol Unreachable 11005 Destination Port Unreachable 11006 No Resources 11007 Bad Option 11008 Hardware Error 11009 Packet Too Big 11010 Request Timed Out 11011 Bad Request 11012 Bad Route 11013 TimeToLive Expired Transit 11014 TimeToLive Expired Reassembly 11015 Parameter Problem 11016 Source Quench 11017 Option Too Big 11018 Bad Destination 11032 Negotiating IPSEC 11050 General Failure %END REMPrivate Const IP_STATUS_BASE = 11000Private Const IP_SUCCESS = 0Private Const IP_BUF_TOO_SMALL = (11000 + 1)Private Const IP_DEST_NET_UNREACHABLE = (11000 + 2)Private Const IP_DEST_HOST_UNREACHABLE = (11000 + 3)Private Const IP_DEST_PROT_UNREACHABLE = (11000 + 4)Private Const IP_DEST_PORT_UNREACHABLE = (11000 + 5)Private Const IP_NO_RESOURCES = (11000 + 6)Private Const IP_BAD_OPTION = (11000 + 7)Private Const IP_HW_ERROR = (11000 + Private Const IP_PACKET_TOO_BIG = (11000 + 9)Private Const IP_REQ_TIMED_OUT = (11000 + 10)Private Const IP_BAD_REQ = (11000 + 11)Private Const IP_BAD_ROUTE = (11000 + 12)Private Const IP_TTL_EXPIRED_TRANSIT = (11000 + 13)Private Const IP_TTL_EXPIRED_REASSEM = (11000 + 14)Private Const IP_PARAM_PROBLEM = (11000 + 15)Private Const IP_SOURCE_QUENCH = (11000 + 16)Private Const IP_OPTION_TOO_BIG = (11000 + 17)Private Const IP_BAD_DESTINATION = (11000 + 18)Private Const IP_ADDR_DELETED = (11000 + 19)Private Const IP_SPEC_MTU_CHANGE = (11000 + 20)Private Const IP_MTU_CHANGE = (11000 + 21)Private Const IP_UNLOAD = (11000 + 22)Private Const IP_ADDR_ADDED = (11000 + 23)Private Const IP_GENERAL_FAILURE = (11000 + 50)Private Const MAX_IP_STATUS = 11000 + 50Private Const IP_PENDING = (11000 + 255)Private Const PING_TIMEOUT = 200 ' nb seconde a attendrePrivate Const WSADESCRIPTION_LEN = 256Private Const WSASYSSTATUS_LEN = 256Private Const WSADESCRIPTION_LEN_1 = WSADESCRIPTION_LEN + 1Private Const WSASYSSTATUS_LEN_1 = WSASYSSTATUS_LEN + 1Private Const SOCKET_ERROR = -1'DeclarationPrivate Type ip_option_information Ttl_And_Tos As Integer Flags_And_OptionsSize As Integer 'Ttl As Integer 'Byte 'duree de vie 'Tos As Integer 'Byte 'Type de service 'Flags As Integer 'Byte 'nb flag 'OptionsSize As Integer 'Byte 'Taille en byte des datas OptionsData As Long 'Pointer vers options dataEnd TypePrivate Type icmp_echo_reply Address As Long 'Retourne l'@ Status As Long 'Retourne IP_STATUS RoundTripTime As Long 'RTT en ms DataSize As Integer 'Retourne la taille des données Reserved As Integer 'Reservé à une utilisation systèem DataPointer As Long 'Pointeur vers la donné retourné Options As ip_option_information 'option de retour Data As String * 250End TypePrivate Type tagWSAData wVersion As Integer wHighVersion As Integer szDescription As String * WSADESCRIPTION_LEN_1 szSystemStatus As String * WSASYSSTATUS_LEN_1 iMaxSockets As Integer iMaxUdpDg As Integer lpVendorInfo As String * 200End TypeDeclare Function IcmpCreateFile Lib "icmp.dll" () As LongDeclare Function IcmpCloseHandle Lib "icmp.dll" (Byval IcmpHandle As Long) As LongDeclare Function WSAStartup Lib "wsock32" (Byval wVersionRequested As Integer, lpWSAData As tagWSAData) As IntegerDeclare Function IcmpSendEcho Lib "icmp.dll" (Byval IcmpHandle As Long, _Byval DestinationAddress As Long, _Byval RequestData As String, _Byval RequestSize As Integer, _RequestOptions As ip_option_information, _ReplyBuffer As icmp_echo_reply, _Byval ReplySize As Long, _Byval Timeout As Long) As LongDeclare Function WSACleanup Lib "wsock32" () As IntegerFunction ConvertIPAddressToLong(strAddress As String) As Long Dim strTemp As String Dim lAddress As Long Dim iValCount As Integer Dim lDotValues(1 To 4) As String strTemp = strAddress iValCount = 0 'Tant qu'il y a des points While Instr(strTemp, ".") > 0 iValCount = iValCount + 1 'ben compte lDotValues(iValCount) = Mid(strTemp, 1, Instr(strTemp, ".") - 1) ' vire le point et convertit strTemp = Mid(strTemp, Instr(strTemp, ".") + 1) Wend iValCount = iValCount + 1 lDotValues(iValCount) = strTemp 'Si il n'y a pas quatre element ben le ping marchera po alors il s'arrete If iValCount <> 4 Then ConvertIPAddressToLong = 0 Exit Function End If 'Hex les 4 valeurs lAddress = Val("&H" & Right("00" & Hex(lDotValues(4)), 2) & _ Right("00" & Hex(lDotValues(3)), 2) & _ Right("00" & Hex(lDotValues(2)), 2) & _ Right("00" & Hex(lDotValues(1)), 2)) ' valeur de retour ConvertIPAddressToLong = lAddressEnd FunctionFunction Ping(IpAddress As String, TTL As Integer) As Integer Dim hFile As Long Dim lRet As Long Dim lIPAddress As Long Dim strMessage As String Dim pOptions As ip_option_information Dim pReturn As icmp_echo_reply Dim iVal As Integer Dim lPingRet As Long Dim pWsaData As tagWSAData strMessage = "Echo cette chaine de donnée" iVal = WSAStartup(&H101, pWsaData) 'Convertit l'adresse ip en long lIPAddress = ConvertIPAddressToLong(IPAddress) 'Ouvre un fichier pour le ping hFile = IcmpCreateFile() 'Met la duréee de vie du ping pOptions.Ttl_And_Tos = TTL 'Fonction qui ping lRet = IcmpSendEcho(hFile, _ lIPAddress, _ strMessage, _ Len(strMessage), _ pOptions, _ pReturn, _ Len(pReturn), _ PING_TIMEOUT) If lRet = 0 Then Error pReturn.Status, "Erreur Ping" If pReturn.Status <> 0 Then Error pReturn.Status, "Erreur Ping (Non terminé)" Ping = pReturn.RoundTripTime lRet = IcmpCloseHandle(hFile) iVal = WSACleanup()End Function[%sig%]

[diarno]

Merci beaucoup

[diarno]

Merci

[diarno]

Le code proposé ne convient pas vraiment à ma problématique.En fait j'ai créé une base Notes qui permet de vérifier l'état des serveurs que j'administre.Actuellement j'envoie une commande serveur, et j'attends une réponse.Votre code fonctionne sur le même principe si pas de retour pas de serveur…Mon but de réduire le temps de réponse dans le cas d’un serveur HS.Je segmente mes tests pour nous permettre d'agir en fonction des retours.si pas de « ping » : hors tension ou hors réseau ou HSsi « ping » mais pas accessible Notes : Serveur Notes HS ou Non lancé / bloqué / RIPetc..De plus si un serveur Notes ne répond pas, le retour comme quoi il est inaccessible n’est pas très rapide.Donc en gros mon souhait est de « pinger » mes serveurs. Si j’ai un retour je lance d’autres tests ( mail en attente, rebus , espace disque … ) Sinon j’envoie un mail + popup à celui qui a lancé le test… et je continue le test pour les autres serveurs pendant que les lutins chassent les marmottes du serveur HS.Cordialement,Arnaud CLAVEAU