begin process at 2012 02 16 22:50:38
  Trouver un code source :
 
dans
 
Accueil > 

Code

 > 

VBScript

 > INTERFACE WEB DYNAMIQUE PERMETTANT LA SELECTION DE DONNÉES D'UN FICHIER CSV [VBSCRIPT]

INTERFACE WEB DYNAMIQUE PERMETTANT LA SELECTION DE DONNÉES D'UN FICHIER CSV [VBSCRIPT]


 Information sur la source

Note :
Aucune note
Catégorie :VBScript Classé sous :selection, recherche, action, fichiercsv, vbscript Niveau :Initié Date de création :21/01/2009 Date de mise à jour :22/01/2009 11:56:53 Vu / téléchargé :3 887 / 443

Auteur : vsgn

Ecrire un message privé
Commentaire sur cette source (0)
Ajouter un commentaire et/ou une note

 Description

Cliquez pour voir la capture en taille normale
Cet utilitaire permet de:
  rechercher et selectionner des données dans un fichier csv ou txt
  appliquer des actions sur les objets selectionnés

Dans cet exemple, j'utilise cet utilitaire pour la gestion des pc du réseau:
  les démarrer, les arreter, les redemarrer
  détecter s'ils sont allumé et qui est connecté
  recupérer / mettre à jour l'adresse mac des postes

Source

  • ''/*****************************************************************************/
  • '/*** utilitaire réseau permettant de:
  • '/*** rechercher et selectionner des ordinateurs du réseau,
  • '/*** les démarrer, les arreter, les redemarrer
  • '/*** détecter s'ils sont allumé et qui est connecté
  • '/*** recupérer / mettre à jour l'adresse mac des postes
  • '/***
  • '/*** NB: Il va sans dire que cet utilitaire doit êtres lancé par un compte administrateur du domaine
  • '/*** Pour le démarrage des postes j'utilise l'utilitaire WolCmd.exe téléchargeable sur www.depicus.com
  • '/*****************************************************************************/
  • 'variables à modifier suivant votre config
  • MacNameFile="" 'Chemin du fichier contenant tous les noms de machines du réseau. Si MacNameFile="" MacNameFile sera initialisé à [repwork]\mac-name.txt
  • CastIp="10.130.255.255" 'cast ip du réseau pour démarrage pc
  • ' Avant d'utiliser ce programme, il convient tout d'abord de créer manuellement
  • ' le fichier mac-name.txt de la manière suivante:
  • ' Chaque ligne comporte au minimum 2 champs: champ1;champ2;champ3;etc...
  • ' champ1 correspond à l'adresse mac
  • ' champ2 correspond au nom du pc
  • ' champ3;etc correspond à des champs que vous pouvez rajouter pour d'autre prog partageant le même fichier
  • ' NB: champ1 peut être vide car cet utilitaire permet de récupérer l'adresse mac d'un pc.
  • ' Par exemple vous pouvez marquer dans le fichier:
  • ' ;NomPoste1;
  • ' 00188B06C3A4;NomPoste2;
  • ' 00188B06C3A4;NomPoste3;192.168.1.10;255.255.255.0;192.168.1.1;
  • ' ...etc
  • ' Dans ActiveDirectory, il est possible d'exporter dans un fichier tous les noms des PC du domaine
  • ' Il serait aussi possible d'intégrer dans ce script une détection des postes du domaine mais je ne suis pas sûr que le jeu en vaille la chandelle
  • On error resume next
  • Const wbemFlagReturnImmediately = &h10
  • Const wbemFlagForwardOnly = &h20
  • Const Overwrite = True
  • Const ForReading = 1
  • Const ForWriting = 2
  • Const Green="#008000"
  • Const Red="#FF0000"
  • Const Black="#000000"
  • Const Gray="#CCCCCC"
  • Dim shell, IE
  • ' tableau pouvant contenir jusqu'à 500 lignes (à modifier suivant le nbre de pc)
  • Dim MacName(500, 4) '1:mac(1ier champ) 2:name(2ème champ) 3:MajMac(réservé maj mac) 4:tous les champs restants
  • Dim Inversion(500) 'contient le liste des index à inverser
  • dim PcSearch(500, 4) '1:indexMacName 2:selected 3:couleur affichage 4:username/mac
  • Set shell = WScript.CreateObject("WScript.Shell")
  • Set objFSO = CreateObject("Scripting.FileSystemObject")
  • strComputer = "."
  • SelectedClass=""
  • SelectedStudent=""
  • textsearch=""
  • RepWork = Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName, "\")-1)
  • if trim(MacNameFile)="" then MacNameFile=RepWork & "\mac-name.txt"
  • 'Charge tableau MacName
  • err.clear()
  • Set objfile = objFSO.OpenTextFile(MacNameFile, ForReading)
  • if err.number<>0 then
  • MsgBox "Erreur d'ouverture du fichier '" & MacNameFile & "'." & vbCrLf & "Veuillez vérifier que le fichier existe et qu'il soit accessible.", vbCritical + vbOkOnly + vbSystemModal + 0,"Erreur ouverture fichiers"
  • wscript.quit
  • end if
  • NbrePc=0
  • Do Until objfile.AtEndOfStream
  • line=trim(objfile.ReadLine)
  • MacName(NbrePc+1, 1)=trim(GetField(1, line, ";"))
  • MacName(NbrePc+1, 2)=trim(GetField(2, line, ";"))
  • MacName(NbrePc+1, 3)=""
  • if MacName(NbrePc+1, 2)<>"" then
  • index=GetIndexField(3, line, ";", 0)
  • if index>0 and index<=len(line) then MacName(NbrePc+1, 4)=mid(line, index)
  • NbrePc=NbrePc+1
  • end if
  • loop
  • objfile.close
  • NbrePcSearch=0
  • ' tri du tableau MacName + détection doublon
  • err=tritab()
  • if (err and 7)<>0 then
  • ListingErr="Avertissement: le fichier '" & MacNameFile & "' contient des doublons:" & vbCrLf
  • if (err and 1)<>0 then ListingErr=ListingErr & " /*** ligne(s) strictement identique(s) ***/" & vbCrLf
  • if (err and 2)<>0 then ListingErr=ListingErr & " /*** ligne(s) contenant la même adresse MAC et un nom de pc différent ***/" & vbCrLf
  • ListingErr=ListingErr & "Tous les doublons ont été supprimés. Voulez vous sauvegarder les modification?"
  • err=MsgBox(ListingErr, vbQuestion + vbYesNo + vbSystemModal + 0,"Enregistrer les modifications dans le fichier?")
  • if err=vbyes then 'sauvegarde le fichier
  • if SavMacName()=true then
  • MsgBox "Le fichier '" & MacNameFile & "' a été mis à jour. ", vbInformation + vbOkOnly + vbSystemModal + 0,"Sauvegarde fichier"
  • else
  • MsgBox "Erreur de mise à jour du fichier '" & MacNameFile & "'.", vbCritical + vbOkOnly + vbSystemModal + 0,"Sauvegarde fichier"
  • end if
  • end if
  • end if
  • 'Lancement ie + affichage postes
  • OpenIE()
  • shell.AppActivate "Gestionnaire d'ordinateurs"
  • AffichePageWeb "startpc.htm"
  • RazEtatPc=false
  • do
  • StartTime = Timer
  • do
  • WScript.Sleep 30
  • action=GetActionPageWeb()
  • if RazEtatPc=true then 'le username de chaque pc est affiché
  • difftime=Timer-StartTime
  • if difftime>60 then ' affichage du username pendant un labs de temps max de 60s (durée de validité de l'info)
  • for i=1 to NbrePcSearch
  • PcSearch(i, 3)=Black
  • PcSearch(i, 4)=""
  • next
  • RazEtatPc=false
  • AffichePageWeb "startpc.htm"
  • end if
  • end if
  • Loop While (action = "off")
  • if action="demarrer" or action="arreter" or action="redemarrer" or action="macadress" then
  • for i=1 to NbrePcSearch
  • execute "IsChecked=IE.Document.SelectionForm.cac_" & i & ".Checked"
  • if IsChecked then PcSearch(i, 2)=true else PcSearch(i, 2)=false
  • PcSearch(i, 3)=Gray
  • PcSearch(i, 4)=""
  • next
  • AffichePageWeb "startpc.htm"
  • StartTime = Timer
  • if action="demarrer" then
  • if objFSO.FileExists(RepWork & "\wolcmd.exe") then
  • for i=1 to NbrePcSearch
  • if PcSearch(i, 2) and MacName(PcSearch(i, 1), 1)<>"" then
  • commande=RepWork & "\wolcmd " & MacName(PcSearch(i, 1), 1) & " " & CastIp & " " & CastIp
  • Shell.Run commande, 0, 0
  • Wscript.Sleep 300
  • Shell.Run commande, 0, 0
  • Wscript.Sleep 300
  • Shell.Run commande, 0, 0
  • PcSearch(i, 3)=Black
  • difftime=Timer-StartTime
  • if difftime>2 then StartTime = Timer : AffichePageWeb "startpc.htm"
  • end if
  • next
  • else
  • MsgBox "Impossible de lancer le démarrage des postes. " & vbCrLf & "Le fichier 'WolCmd.exe' n'a pas été trouvé dans le dossier de l'application." & vbCrLf & "Vous pouvez le télécharger sur <www.depicus.com>.",vbCritical + vbOkOnly + vbSystemModal + 0,"Fichier introuvable"
  • end if
  • end if
  • if action="arreter" or action="redemarrer" then
  • for i=1 to NbrePcSearch
  • if PcSearch(i, 2) then
  • if action="arreter" then commande="shutdown -s -f -m \\" & MacName(PcSearch(i, 1), 2)
  • if action="redemarrer" then commande="shutdown -r -f -m \\" & MacName(PcSearch(i, 1), 2)
  • Shell.Run commande, 0, 0
  • PcSearch(i, 3)=Black
  • difftime=Timer-StartTime
  • if difftime>2 then StartTime = Timer : AffichePageWeb "startpc.htm"
  • end if
  • next
  • end if
  • if action="macadress" then
  • IE.Document.Script.SetVal("off")
  • NewMac=false
  • for i=1 to NbrePcSearch
  • if PcSearch(i, 2) then
  • if PcIsOn(MacName(PcSearch(i, 1), 2)) then
  • MacTemp=GetMacAdress(MacName(PcSearch(i, 1), 2))
  • if MacTemp="" then
  • PcSearch(i, 3)=red
  • PcSearch(i, 4)="[NotAccess]"
  • else
  • if MacTemp=MacName(PcSearch(i, 1), 1) then
  • PcSearch(i, 3)=green
  • PcSearch(i, 4)="[" & MacTemp & "]"
  • else
  • PcSearch(i, 3)=red
  • PcSearch(i, 4)="new[**" & MacTemp & "**]"
  • MacName(PcSearch(i, 1), 3)=MacTemp
  • NewMac=true
  • end if
  • end if
  • else
  • PcSearch(i, 3)=red
  • PcSearch(i, 4)="[OffLine]"
  • end if
  • end if
  • if GetActionPageWeb()<>"off" then
  • ret=MsgBox("Arrêter le traitement?", vbQuestion + vbYesNo + vbSystemModal + 0,"Arrêt traitement")
  • if ret=vbyes then exit for
  • end if
  • difftime=Timer-StartTime
  • if difftime>2 then StartTime = Timer : AffichePageWeb "startpc.htm"
  • next
  • end if
  • AffichePageWeb "startpc.htm"
  • if NewMac=true then
  • ret=MsgBox("De nouvelles adresses Mac ont été trouvées. Mettre à jour le fichier mac-name.txt?", vbQuestion + vbYesNo + vbSystemModal + 0,"Enregistrer les MacAdress?")
  • if ret=vbyes then
  • if SavMacName()=true then
  • for i=1 to NbrePc
  • if MacName(i, 3)<>"" then MacName(i, 1)=MacName(i, 3) : MacName(i, 3)=""
  • next
  • MsgBox "Le fichier '" & MacNameFile & "' a été mis à jour. ", vbInformation + vbOkOnly + vbSystemModal + 0,"Sauvegarde MacAdress"
  • else
  • MsgBox "Erreur de mise à jour du fichier '" & MacNameFile & "'.", vbCritical + vbOkOnly + vbSystemModal + 0,"Sauvegarde MacAdress"
  • end if
  • end if
  • end if
  • end if
  • if action="rechercher" then
  • NbrePcSearch=0
  • textsearch=trim(IE.Document.SelectionForm.textsearch.value)
  • if textsearch<>"" then
  • for i=1 to NbrePc
  • if IsFind(MacName(i, 2), textsearch) then
  • NbrePcSearch=NbrePcSearch+1
  • PcSearch(NbrePcSearch, 1)=i 'index MacName
  • PcSearch(NbrePcSearch, 2)=true 'case à cocher=ON
  • PcSearch(NbrePcSearch, 3)=Black 'pc ON(green), OFF(red), UNKNOW(black)
  • PcSearch(NbrePcSearch, 4)="" 'username
  • end if
  • next
  • end if
  • AffichePageWeb "startpc.htm"
  • end if
  • if action="rechercherinv" then
  • for i=1 to 500
  • Inversion(i)=true
  • next
  • for i=1 to NbrePcSearch
  • Inversion(PcSearch(i, 1))=false
  • next
  • NbrePcSearch=0
  • for i=1 to NbrePc
  • if Inversion(i)=true then
  • NbrePcSearch=NbrePcSearch+1
  • PcSearch(NbrePcSearch, 1)=i 'index MacName
  • PcSearch(NbrePcSearch, 2)=true 'case à cocher=ON
  • PcSearch(NbrePcSearch, 3)=Black 'pc ON ou OFF
  • PcSearch(NbrePcSearch, 4)="" 'username
  • end if
  • next
  • AffichePageWeb "startpc.htm"
  • end if
  • if action="supprimer" then
  • j=0
  • for i=1 to NbrePcSearch
  • execute "IsChecked=IE.Document.SelectionForm.cac_" & i & ".Checked"
  • if not IsChecked then
  • j=j+1
  • if j<>i then
  • PcSearch(j, 1)=PcSearch(i, 1) 'index MacName
  • PcSearch(j, 2)=PcSearch(i, 2) 'case à cocher=ON
  • PcSearch(j, 3)=PcSearch(i, 3) 'pc ON ou OFF
  • PcSearch(j, 4)=PcSearch(i, 4) 'username
  • end if
  • end if
  • next
  • NbrePcSearch=j
  • AffichePageWeb "startpc.htm"
  • end if
  • if action="inverser" then
  • for i=1 to NbrePcSearch
  • execute "IsChecked=IE.Document.SelectionForm.cac_" & i & ".Checked"
  • if IsChecked then PcSearch(i, 2)=false else PcSearch(i, 2)=true
  • next
  • AffichePageWeb "startpc.htm"
  • end if
  • if action="actualiser" then
  • for i=1 to NbrePcSearch
  • execute "IsChecked=IE.Document.SelectionForm.cac_" & i & ".Checked"
  • if IsChecked then PcSearch(i, 2)=true else PcSearch(i, 2)=false
  • PcSearch(i, 3)=Gray
  • PcSearch(i, 4)=""
  • next
  • AffichePageWeb "startpc.htm"
  • IE.Document.Script.SetVal("off")
  • StartTime = Timer
  • for i=1 to NbrePcSearch
  • if PcSearch(i, 2)=true then
  • if PcIsOn(MacName(PcSearch(i, 1), 2)) then
  • PcSearch(i, 3)=green
  • PcSearch(i, 4)="[" & getusername(MacName(PcSearch(i, 1), 2)) & "]"
  • if PcSearch(i, 4)="[]" then PcSearch(i, 4)="[NoUser]"
  • else
  • PcSearch(i, 3)=red
  • PcSearch(i, 4)="[OffLine]"
  • end if
  • if GetActionPageWeb()<>"off" then
  • ret=MsgBox("Arrêter le traitement?", vbQuestion + vbYesNo + vbSystemModal + 0,"Arrêt traitement")
  • if ret=vbyes then exit for
  • end if
  • difftime=Timer-StartTime
  • if difftime>2 then StartTime = Timer : AffichePageWeb "startpc.htm"
  • end if
  • next
  • AffichePageWeb "startpc.htm"
  • RazEtatPc=true
  • end if
  • err.clear()
  • IE.Document.Script.SetVal("off")
  • if err.number<>0 then exit do
  • Loop
  • exitprog()
  • '------------------------------------------------------------
  • ' Fonction de tri du tableau MacName(); renvois code erreur:
  • ' si 2 lignes du tableau sont strictement identiques -> TriTab|=1
  • ' si 2 lignes du tableau contiennent les mêmes adresses mac -> TriTab|=2
  • Function TriTab()
  • TriTab=0 : ii=1
  • while ii<NbrePc
  • jj=ii+1
  • while jj<=NbrePc
  • 'tri du tableau ordre croissant
  • if MacName(jj, 2)<MacName(ii, 2) then 'permute les lignes
  • MacName(NbrePc+1, 1)=MacName(ii, 1) : MacName(NbrePc+1, 2)=MacName(ii, 2) : MacName(NbrePc+1, 4)=MacName(ii, 4)
  • MacName(ii, 1)=MacName(jj, 1) : MacName(ii, 2)=MacName(jj, 2) : MacName(ii, 4)=MacName(jj, 4)
  • MacName(jj, 1)=MacName(NbrePc+1, 1) : MacName(jj, 2)=MacName(NbrePc+1, 2) : MacName(jj, 4)=MacName(NbrePc+1, 4)
  • end if
  • 'recherche et suppression des incohérences: mac en double
  • if MacName(jj, 1)=MacName(ii, 1) then
  • 'codage erreur
  • if MacName(jj, 2)=MacName(ii, 2) then TriTab=TriTab or 1 else TriTab=TriTab or 2
  • 'suppression ligne
  • for kk=jj+1 to NbrePc
  • MacName(kk-1, 1)=MacName(kk, 1)
  • MacName(kk-1, 2)=MacName(kk, 2)
  • MacName(kk-1, 4)=MacName(kk, 4)
  • next
  • NbrePc=NbrePc-1
  • else
  • jj=jj+1
  • end if
  • wend
  • ii=ii+1
  • wend
  • end function
  • '------------------------------------------------------------
  • ' Fonction d'affichage de la page web [pageweb)
  • Function AffichePageWeb(pageweb)
  • On error resume next
  • NbreColonnes=6
  • err.clear()
  • Set objPageWeb = objFSO.OpenTextFile(RepWork & "\" & pageweb, ForReading)
  • if err.number<>0 then
  • MsgBox "Erreur d'ouverture de fichier." & vbCrLf & "Veuillez vérifier que le fichier '" & RepWork & "\" & pageweb & "' est accessible.", vbCritical + vbOkOnly + vbSystemModal + 0,"Erreur ouverture fichiers"
  • exitprog()
  • end if
  • IE.document.Open
  • Do Until objPageWeb.AtEndOfStream
  • line=trim(objPageWeb.ReadLine)
  • if line<>"" then
  • IE.document.Writeln(line)
  • if line="<!--inserrer ici la liste des PC-->" then
  • 'insertion du code html pour affichage sélection pc
  • NbreLigne=int(NbrePcSearch/NbreColonnes)
  • if NbreLigne*NbreColonnes<NbrePcSearch then NbreLigne=NbreLigne+1
  • for ii=1 to NbreLigne
  • ligne="<tr>"
  • IE.document.Writeln(ligne)
  • for jj=1 to NbreColonnes
  • IndexTabSearch=(ii-1)*NbreColonnes+jj
  • if IndexTabSearch>NbrePcSearch then exit for
  • if PcSearch(IndexTabSearch, 2) then selected="checked" else selected=""
  • if PcSearch(IndexTabSearch, 4)<>"" then strusername="<br>" & PcSearch(IndexTabSearch, 4) else strusername=""
  • ligne="<td width='10%'><input type='checkbox' name='cac_" & IndexTabSearch & "' value='ONOFF' " & selected & "><font color='" & PcSearch(IndexTabSearch, 3) & "' size='2'>" & MacName(PcSearch(IndexTabSearch, 1), 2) & strusername & "</font></td>"
  • IE.document.Writeln(ligne)
  • next
  • ligne="</tr>"
  • IE.document.Writeln(ligne)
  • next
  • end if
  • end if
  • loop
  • IE.document.Close
  • objPageWeb.Close
  • IE.Document.SelectionForm.textsearch.value=textsearch
  • end function
  • '------------------------------------------------------------
  • ' Fonction d'arret du script
  • Function exitprog()
  • on error resume next
  • IE.Quit
  • Set IE = Nothing
  • wscript.quit
  • end function
  • '------------------------------------------------------------
  • ' Fonction ouverture IE
  • Function OpenIE()
  • Set IE = WScript.CreateObject("InternetExplorer.Application", "IE_")
  • With IE
  • .left=0
  • .top=0
  • .height=740
  • .width=1024
  • .menubar=0
  • .toolbar=0
  • .statusBar=0
  • .navigate "About:Blank"
  • .visible=1
  • End With
  • ' Attendre la fin du chargement de IE
  • Do while IE.busy
  • loop
  • end function
  • '------------------------------------------------------------
  • ' fonction retournant la valeur du n ième champ(NumField) d'une variable chaine de caractaires(ligne)
  • function GetField(NumField, ligne, separateur)
  • 'verification et init variables
  • GetField=""
  • if separateur="" then separateur=";"
  • if NumField<1 then exit function
  • if trim(ligne)="" then exit function
  • OutOfRange=len(ligne)+1
  • 'traitement
  • ii=0 : IndexLigneFin=0
  • do
  • 'init variables
  • ii=ii+1
  • IndexLigneDeb=IndexLigneFin
  • IndexLigneFin=OutOfRange
  • ' recherche IndexLigneFin
  • for sep=1 to len(separateur) 'traite multi séparateur ex: separateur=":;/" équivalent à separateur=":" OU separateur=";" OU separateur="/"
  • IndexLigneFinTemp = Instr(IndexLigneDeb+1, ligne, mid(separateur, sep, 1))
  • if IndexLigneFinTemp>0 and IndexLigneFinTemp<IndexLigneFin then IndexLigneFin=IndexLigneFinTemp
  • next
  • if IndexLigneFin=OutOfRange then exit do
  • loop until ii=NumField
  • if ii=NumField then
  • if IndexLigneDeb=0 then IndexLigneDeb=1 else IndexLigneDeb=IndexLigneDeb+1
  • IndexLigneFin=IndexLigneFin-1
  • if IndexLigneFin>=IndexLigneDeb then GetField=mid(ligne, IndexLigneDeb, IndexLigneFin-IndexLigneDeb+1)
  • end if
  • end function
  • '------------------------------------------------------------
  • ' fonction retournant l'index de départ ou de fin(DepFin) du N ième champ(NumField) d'une variable chaine de caractaires(ligne)
  • ' DepFin=0 -> recherche index départ sinon recherche index Fin
  • function GetIndexField(NumField, ligne, separateur, DepFin)
  • 'verification et init variables
  • GetIndexField=-1
  • if separateur="" then separateur=";"
  • if NumField<1 then exit function
  • if trim(ligne)="" then exit function
  • OutOfRange=len(ligne)+1
  • 'traitement
  • ii=0 : IndexLigneFin=0
  • do
  • 'init variables
  • ii=ii+1
  • IndexLigneDeb=IndexLigneFin
  • IndexLigneFin=OutOfRange
  • ' recherche IndexLigneFin
  • for sep=1 to len(separateur) 'traite multi séparateur ex: separateur=":;/" équivalent à separateur=":" OU separateur=";" OU separateur="/"
  • IndexLigneFinTemp = Instr(IndexLigneDeb+1, ligne, mid(separateur, sep, 1))
  • if IndexLigneFinTemp>0 and IndexLigneFinTemp<IndexLigneFin then IndexLigneFin=IndexLigneFinTemp
  • next
  • if IndexLigneFin=OutOfRange then exit do
  • loop until ii=NumField
  • if ii=NumField then
  • if IndexLigneDeb=0 then IndexLigneDeb=1 else IndexLigneDeb=IndexLigneDeb+1
  • IndexLigneFin=IndexLigneFin-1
  • if IndexLigneFin>=IndexLigneDeb then
  • if StartEnd=0 then GetIndexField=IndexLigneDeb else GetIndexField=IndexLigneFin
  • end if
  • end if
  • end function
  • '------------------------------------------------------------
  • ' retourne true si ping ok sinon retourne false
  • function PcIsOn(strpc)
  • Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}!\\").ExecQuery("select * from Win32_PingStatus where address = '" & strpc & "'")
  • PcIsOn=false
  • For Each objStatus in objPing
  • If objStatus.Statuscode = 0 Then PcIsOn=true : exit function
  • next
  • end function
  • '------------------------------------------------------------
  • ' retourne true si la recherche strsearch composé de "|"(OR) et de "&"(AND) est trouvé dans strbase sinon retourne false
  • ' ex: strsearch="pc1|pc2"; retourne true si la chaine "pc1" OU la chaine "pc2" est trouvé dans strbase
  • ' strsearch="pc1&pc2"; retourne true si la chaine "pc1" ET la chaine "pc2" sont trouvées dans strbase
  • ' strsearch="*"; retourne true
  • function IsFind(strbase, strsearch)
  • if strsearch="*" then IsFind=true : exit function
  • kk=1 : IsFind=false
  • do
  • str2search=trim(GetField(kk, strsearch, "|&")) 'récupération du kk ième champs
  • if str2search="" then exit do
  • operator=""
  • if kk>1 then operator=mid(strsearch, GetIndexField(kk, strsearch, "|&", 0)-1, 1) 'récupération du kk ième opérateur
  • if operator="" then 'donc dernier champs de strsearch
  • if Instr(1, strbase, str2search)>0 then IsFind=true else IsFind=false
  • end if
  • if operator="|" and Instr(1, strbase, str2search)>0 then IsFind=true
  • if operator="&" and Instr(1, strbase, str2search)=0 then IsFind=false
  • kk=kk+1
  • loop
  • end function
  • '------------------------------------------------------------
  • ' retourne le username du compte connecté sur le pc OnThisPc
  • function getusername(OnThisPc)
  • getusername=""
  • Set objWMIService = GetObject("winmgmts:\\" & OnThisPc & "\root\CIMV2")
  • Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_ComputerSystem", "WQL", wbemFlagReturnImmediately + wbemFlagForwardOnly)
  • For Each objItem In colItems
  • getusername=trim(objItem.UserName)
  • next
  • end function
  • '------------------------------------------------------------
  • ' retourne l'adresse mac du pc OnThisPc
  • function GetMacAdress(OnThisPc)
  • on error resume next
  • GetMacAdress=""
  • Err.clear()
  • set IPConfigSet = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & OnThisPc).ExecQuery("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled=TRUE")
  • If Err.Number<>0 Then exit function
  • for each IPConfig in IPConfigSet
  • mtemp=trim(IPConfig.MACAddress)
  • Next
  • for ii=1 to len(mtemp) 'retrait des ':'
  • char=mid(mtemp, ii, 1)
  • if char<>":" then GetMacAdress=GetMacAdress & char
  • next
  • End function
  • '------------------------------------------------------------
  • ' Sauvegarde du tableau MacName() dans le fichier [MacNameFile]
  • function SavMacName()
  • on error resume next
  • SavMacName=false
  • 'ouverture fichier temporaire [MacNameFile].tmp
  • err.clear()
  • if objFSO.fileExists(MacNameFile & ".tmp") then objFSO.deleteFile(MacNameFile & ".tmp")
  • Set objWriteFile = objFSO.OpenTextFile(MacNameFile & ".tmp", ForWriting, True)
  • if err.number<>0 then exit function
  • 'ecriture dans fichier [MacNameFile].tmp
  • for xx=1 to NbrePc
  • if MacName(xx, 3)<>"" then lignetemp=MacName(xx, 3) & ";" else lignetemp=MacName(xx, 1) & ";"
  • lignetemp=lignetemp & MacName(xx, 2) & ";"
  • if MacName(xx, 4)<>"" then lignetemp=lignetemp & MacName(xx, 4)
  • objWriteFile.WriteLine(lignetemp)
  • next
  • objWriteFile.close
  • 'cré 2 copies de sauvegarde: [MacNameFile].sav->[MacNameFile].sav.bak
  • ' et [MacNameFile]->[MacNameFile].sav
  • 'renome [MacNameFile].tmp->[MacNameFile]
  • if err.number=0 then
  • if objFSO.FileExists(MacNameFile & ".sav") then
  • if objFSO.FileExists(MacNameFile & ".sav.bak") then objFSO.DeleteFile(MacNameFile & ".sav.bak")
  • objFSO.MoveFile MacNameFile & ".sav" , MacNameFile & ".sav.bak"
  • end if
  • objFSO.MoveFile MacNameFile , MacNameFile & ".sav"
  • err.clear()
  • objFSO.MoveFile MacNameFile & ".tmp", MacNameFile
  • if err.number=0 then SavMacName=true
  • end if
  • end function
  • '------------------------------------------------------------
  • ' retourne l'action demandé par l'utilisateur
  • function GetActionPageWeb()
  • on error resume next
  • err.clear()
  • GetActionPageWeb=IE.Document.Script.CheckVal()
  • if err.number<>0 then 'teste si IE est fermé
  • WScript.Sleep 30
  • err.clear()
  • IE.document.Open : IE.document.close
  • if err.number<>0 then exitprog() else AffichePageWeb "startpc.htm"
  • end if
  • end function
''/*****************************************************************************/
'/*** utilitaire réseau permettant de:
'/***           rechercher et selectionner des ordinateurs du réseau,
'/***           les démarrer, les arreter, les redemarrer
'/***           détecter s'ils sont allumé et qui est connecté
'/***           recupérer / mettre à jour l'adresse mac des postes
'/***
'/*** NB: Il va sans dire que cet utilitaire doit êtres lancé par un compte administrateur du domaine
'/***     Pour le démarrage des postes j'utilise l'utilitaire WolCmd.exe téléchargeable sur www.depicus.com
'/*****************************************************************************/
'variables à modifier suivant votre config
MacNameFile=""           'Chemin du fichier contenant tous les noms de machines du réseau. Si MacNameFile="" MacNameFile sera initialisé à [repwork]\mac-name.txt
CastIp="10.130.255.255"  'cast ip du réseau pour démarrage pc

' Avant d'utiliser ce programme, il convient tout d'abord de créer manuellement
' le fichier mac-name.txt de la manière suivante:
' Chaque ligne comporte au minimum 2 champs:   champ1;champ2;champ3;etc...
' champ1 correspond à l'adresse mac
' champ2 correspond au nom du pc
' champ3;etc correspond à des champs que vous pouvez rajouter pour d'autre prog partageant le même fichier
' NB: champ1 peut être vide car cet utilitaire permet de récupérer l'adresse mac d'un pc.
' Par exemple vous pouvez marquer dans le fichier:
'   ;NomPoste1;
'   00188B06C3A4;NomPoste2;
'   00188B06C3A4;NomPoste3;192.168.1.10;255.255.255.0;192.168.1.1;
'   ...etc
' Dans ActiveDirectory, il est possible d'exporter dans un fichier tous les noms des PC du domaine
' Il serait aussi possible d'intégrer dans ce script une détection des postes du domaine mais je ne suis pas sûr que le jeu en vaille la chandelle

On error resume next
Const wbemFlagReturnImmediately = &h10
Const wbemFlagForwardOnly = &h20
Const Overwrite = True
Const ForReading = 1
Const ForWriting = 2
Const Green="#008000"
Const Red="#FF0000"
Const Black="#000000"
Const Gray="#CCCCCC"
Dim shell, IE
' tableau pouvant contenir jusqu'à 500 lignes (à modifier suivant le nbre de pc)
Dim MacName(500, 4) '1:mac(1ier champ) 2:name(2ème champ) 3:MajMac(réservé maj mac) 4:tous les champs restants
Dim Inversion(500)  'contient le liste des index à inverser
dim PcSearch(500, 4) '1:indexMacName 2:selected 3:couleur affichage 4:username/mac
Set shell = WScript.CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
strComputer = "."
SelectedClass=""
SelectedStudent=""
textsearch=""
RepWork = Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName, "\")-1)
if trim(MacNameFile)="" then MacNameFile=RepWork & "\mac-name.txt"
'Charge tableau MacName
err.clear()
Set objfile = objFSO.OpenTextFile(MacNameFile, ForReading)
if err.number<>0 then
        MsgBox "Erreur d'ouverture du fichier '" & MacNameFile & "'." & vbCrLf & "Veuillez vérifier que le fichier existe et qu'il soit accessible.", vbCritical + vbOkOnly + vbSystemModal + 0,"Erreur ouverture fichiers"
        wscript.quit
end if
NbrePc=0
Do Until objfile.AtEndOfStream
        line=trim(objfile.ReadLine)
        MacName(NbrePc+1, 1)=trim(GetField(1, line, ";"))
        MacName(NbrePc+1, 2)=trim(GetField(2, line, ";"))
        MacName(NbrePc+1, 3)=""
        if MacName(NbrePc+1, 2)<>"" then
                index=GetIndexField(3, line, ";", 0)
                if index>0 and index<=len(line) then MacName(NbrePc+1, 4)=mid(line, index)
                NbrePc=NbrePc+1
        end if
loop
objfile.close
NbrePcSearch=0

' tri du tableau MacName + détection doublon
err=tritab()
if (err and 7)<>0 then
        ListingErr="Avertissement: le fichier '" & MacNameFile & "' contient des doublons:" & vbCrLf
        if (err and 1)<>0 then ListingErr=ListingErr & "       /*** ligne(s) strictement identique(s) ***/" & vbCrLf
        if (err and 2)<>0 then ListingErr=ListingErr & "       /*** ligne(s) contenant la même adresse MAC et un nom de pc différent ***/" & vbCrLf
        ListingErr=ListingErr & "Tous les doublons ont été supprimés. Voulez vous sauvegarder les modification?"
        err=MsgBox(ListingErr, vbQuestion + vbYesNo + vbSystemModal + 0,"Enregistrer les modifications dans le fichier?")
        if err=vbyes then 'sauvegarde le fichier
                if SavMacName()=true then
                        MsgBox "Le fichier '" & MacNameFile & "' a été mis à jour. ", vbInformation + vbOkOnly + vbSystemModal + 0,"Sauvegarde fichier"
                else
                        MsgBox "Erreur de mise à jour du fichier '" & MacNameFile & "'.", vbCritical + vbOkOnly + vbSystemModal + 0,"Sauvegarde fichier"
                end if
        end if
end if

'Lancement ie + affichage postes
OpenIE()
shell.AppActivate "Gestionnaire d'ordinateurs"
AffichePageWeb "startpc.htm"

RazEtatPc=false
do
        StartTime = Timer
        do
                WScript.Sleep 30
                action=GetActionPageWeb()
                if RazEtatPc=true then 'le username de chaque pc est affiché
                        difftime=Timer-StartTime
                        if difftime>60 then ' affichage du username pendant un labs de temps max de 60s (durée de validité de l'info)
                                for i=1 to NbrePcSearch
                                        PcSearch(i, 3)=Black
                                        PcSearch(i, 4)=""
                                next
                                RazEtatPc=false
                                AffichePageWeb "startpc.htm"
                        end if
                end if
        Loop While (action = "off")

        if action="demarrer" or action="arreter" or action="redemarrer" or action="macadress" then
                for i=1 to NbrePcSearch
                        execute "IsChecked=IE.Document.SelectionForm.cac_" & i & ".Checked"
                        if IsChecked then PcSearch(i, 2)=true else PcSearch(i, 2)=false
                        PcSearch(i, 3)=Gray
                        PcSearch(i, 4)=""
                next
                AffichePageWeb "startpc.htm"
                StartTime = Timer
                if action="demarrer" then
                        if objFSO.FileExists(RepWork & "\wolcmd.exe") then
                                for i=1 to NbrePcSearch
                                        if PcSearch(i, 2) and MacName(PcSearch(i, 1), 1)<>"" then
                                                commande=RepWork & "\wolcmd " & MacName(PcSearch(i, 1), 1) & " " & CastIp & " " & CastIp
                                                Shell.Run commande, 0, 0
                                                Wscript.Sleep 300
                                                Shell.Run commande, 0, 0
                                                Wscript.Sleep 300
                                                Shell.Run commande, 0, 0
                                                PcSearch(i, 3)=Black
                                                difftime=Timer-StartTime
                                                if difftime>2 then StartTime = Timer : AffichePageWeb "startpc.htm"
                                        end if
                                next
                        else
                                MsgBox "Impossible de lancer le démarrage des postes. " & vbCrLf & "Le fichier 'WolCmd.exe' n'a pas été trouvé dans le dossier de l'application." & vbCrLf & "Vous pouvez le télécharger sur <www.depicus.com>.",vbCritical + vbOkOnly + vbSystemModal + 0,"Fichier introuvable"
                        end if
                end if
                if action="arreter" or action="redemarrer" then
                        for i=1 to NbrePcSearch
                                if PcSearch(i, 2) then
                                        if action="arreter" then commande="shutdown -s -f -m \\" & MacName(PcSearch(i, 1), 2)
                                        if action="redemarrer" then commande="shutdown -r -f -m \\" & MacName(PcSearch(i, 1), 2)
                                        Shell.Run commande, 0, 0
                                        PcSearch(i, 3)=Black
                                        difftime=Timer-StartTime
                                        if difftime>2 then StartTime = Timer : AffichePageWeb "startpc.htm"
                                end if
                        next
                end if
                if action="macadress" then
                        IE.Document.Script.SetVal("off")
                        NewMac=false
                        for i=1 to NbrePcSearch
                                if PcSearch(i, 2) then
                                        if PcIsOn(MacName(PcSearch(i, 1), 2)) then
                                                MacTemp=GetMacAdress(MacName(PcSearch(i, 1), 2))
                                                if MacTemp="" then
                                                        PcSearch(i, 3)=red
                                                        PcSearch(i, 4)="[NotAccess]"
                                                else
                                                        if MacTemp=MacName(PcSearch(i, 1), 1) then
                                                                PcSearch(i, 3)=green
                                                                PcSearch(i, 4)="[" & MacTemp & "]"
                                                        else
                                                                PcSearch(i, 3)=red
                                                                PcSearch(i, 4)="new[**" & MacTemp & "**]"
                                                                MacName(PcSearch(i, 1), 3)=MacTemp
                                                                NewMac=true
                                                        end if
                                                end if
                                        else
                                                PcSearch(i, 3)=red
                                                PcSearch(i, 4)="[OffLine]"
                                        end if
                                end if
                                if GetActionPageWeb()<>"off" then
                                        ret=MsgBox("Arrêter le traitement?", vbQuestion + vbYesNo + vbSystemModal + 0,"Arrêt traitement")
                                        if ret=vbyes then exit for
                                end if
                                difftime=Timer-StartTime
                                if difftime>2 then StartTime = Timer : AffichePageWeb "startpc.htm"
                        next
                end if
                AffichePageWeb "startpc.htm"
                if NewMac=true then
                        ret=MsgBox("De nouvelles adresses Mac ont été trouvées. Mettre à jour le fichier mac-name.txt?", vbQuestion + vbYesNo + vbSystemModal + 0,"Enregistrer les MacAdress?")
                        if ret=vbyes then
                                if SavMacName()=true then
                                        for i=1 to NbrePc
                                                if MacName(i, 3)<>"" then MacName(i, 1)=MacName(i, 3) : MacName(i, 3)=""
                                        next
                                        MsgBox "Le fichier '" & MacNameFile & "' a été mis à jour. ", vbInformation + vbOkOnly + vbSystemModal + 0,"Sauvegarde MacAdress"
                                else
                                        MsgBox "Erreur de mise à jour du fichier '" & MacNameFile & "'.", vbCritical + vbOkOnly + vbSystemModal + 0,"Sauvegarde MacAdress"
                                end if
                        end if
                end if
        end if

        if action="rechercher" then
                NbrePcSearch=0
                textsearch=trim(IE.Document.SelectionForm.textsearch.value)
                if textsearch<>"" then
                        for i=1 to NbrePc
                                if IsFind(MacName(i, 2), textsearch) then
                                        NbrePcSearch=NbrePcSearch+1
                                        PcSearch(NbrePcSearch, 1)=i      'index MacName
                                        PcSearch(NbrePcSearch, 2)=true   'case à cocher=ON
                                        PcSearch(NbrePcSearch, 3)=Black  'pc ON(green), OFF(red), UNKNOW(black)
                                        PcSearch(NbrePcSearch, 4)=""     'username
                                end if
                        next
                end if
                AffichePageWeb "startpc.htm"
        end if

        if action="rechercherinv" then
                for i=1 to 500
                        Inversion(i)=true
                next
                for i=1 to NbrePcSearch
                        Inversion(PcSearch(i, 1))=false
                next
                NbrePcSearch=0
                for i=1 to NbrePc
                        if Inversion(i)=true then
                                NbrePcSearch=NbrePcSearch+1
                                PcSearch(NbrePcSearch, 1)=i 'index MacName
                                PcSearch(NbrePcSearch, 2)=true   'case à cocher=ON
                                PcSearch(NbrePcSearch, 3)=Black  'pc ON ou OFF
                                PcSearch(NbrePcSearch, 4)="" 'username
                        end if
                next
                AffichePageWeb "startpc.htm"
        end if

        if action="supprimer" then
                j=0
                for i=1 to NbrePcSearch
                        execute "IsChecked=IE.Document.SelectionForm.cac_" & i & ".Checked"
                        if not IsChecked then
                                j=j+1
                                if j<>i then
                                        PcSearch(j, 1)=PcSearch(i, 1) 'index MacName
                                        PcSearch(j, 2)=PcSearch(i, 2) 'case à cocher=ON
                                        PcSearch(j, 3)=PcSearch(i, 3) 'pc ON ou OFF
                                        PcSearch(j, 4)=PcSearch(i, 4) 'username
                                end if
                        end if
                next
                NbrePcSearch=j
                AffichePageWeb "startpc.htm"
        end if

        if action="inverser" then
                for i=1 to NbrePcSearch
                        execute "IsChecked=IE.Document.SelectionForm.cac_" & i & ".Checked"
                        if IsChecked then PcSearch(i, 2)=false else PcSearch(i, 2)=true
                next
                AffichePageWeb "startpc.htm"
        end if

        if action="actualiser" then
                for i=1 to NbrePcSearch
                        execute "IsChecked=IE.Document.SelectionForm.cac_" & i & ".Checked"
                        if IsChecked then PcSearch(i, 2)=true else PcSearch(i, 2)=false
                        PcSearch(i, 3)=Gray
                        PcSearch(i, 4)=""
                next
                AffichePageWeb "startpc.htm"
                IE.Document.Script.SetVal("off")
                StartTime = Timer
                for i=1 to NbrePcSearch
                        if PcSearch(i, 2)=true then
                                if PcIsOn(MacName(PcSearch(i, 1), 2)) then
                                        PcSearch(i, 3)=green
                                        PcSearch(i, 4)="[" & getusername(MacName(PcSearch(i, 1), 2)) & "]"
                                        if PcSearch(i, 4)="[]" then PcSearch(i, 4)="[NoUser]"
                                 else
                                        PcSearch(i, 3)=red
                                        PcSearch(i, 4)="[OffLine]"
                                 end if
                                 if GetActionPageWeb()<>"off" then
                                        ret=MsgBox("Arrêter le traitement?", vbQuestion + vbYesNo + vbSystemModal + 0,"Arrêt traitement")
                                        if ret=vbyes then exit for
                                 end if
                                 difftime=Timer-StartTime
                                 if difftime>2 then StartTime = Timer : AffichePageWeb "startpc.htm"
                        end if
                next
                AffichePageWeb "startpc.htm"
                RazEtatPc=true
        end if

        err.clear()
        IE.Document.Script.SetVal("off")
        if err.number<>0 then exit do
Loop

exitprog()


'------------------------------------------------------------
' Fonction de tri du tableau MacName(); renvois code erreur:
'       si 2 lignes du tableau sont strictement identiques -> TriTab|=1
'       si 2 lignes du tableau contiennent les mêmes adresses mac -> TriTab|=2

Function TriTab()
 TriTab=0 : ii=1
 while ii<NbrePc
        jj=ii+1
        while jj<=NbrePc
                'tri du tableau ordre croissant
                if MacName(jj, 2)<MacName(ii, 2) then 'permute les lignes
                        MacName(NbrePc+1, 1)=MacName(ii, 1) : MacName(NbrePc+1, 2)=MacName(ii, 2) : MacName(NbrePc+1, 4)=MacName(ii, 4)
                        MacName(ii, 1)=MacName(jj, 1) : MacName(ii, 2)=MacName(jj, 2) : MacName(ii, 4)=MacName(jj, 4)
                        MacName(jj, 1)=MacName(NbrePc+1, 1) : MacName(jj, 2)=MacName(NbrePc+1, 2) : MacName(jj, 4)=MacName(NbrePc+1, 4)
                end if

                'recherche et suppression des incohérences: mac en double
                if MacName(jj, 1)=MacName(ii, 1) then
                        'codage erreur
                        if MacName(jj, 2)=MacName(ii, 2) then TriTab=TriTab or 1 else TriTab=TriTab or 2
                        'suppression ligne
                        for kk=jj+1 to NbrePc
                                MacName(kk-1, 1)=MacName(kk, 1)
                                MacName(kk-1, 2)=MacName(kk, 2)
                                MacName(kk-1, 4)=MacName(kk, 4)
                        next
                        NbrePc=NbrePc-1
                else
                        jj=jj+1
                end if
        wend
        ii=ii+1
 wend
end function

'------------------------------------------------------------
' Fonction d'affichage de la page web [pageweb)
Function AffichePageWeb(pageweb)
On error resume next
 NbreColonnes=6

 err.clear()
 Set objPageWeb = objFSO.OpenTextFile(RepWork & "\" & pageweb, ForReading)
 if err.number<>0 then
        MsgBox "Erreur d'ouverture de fichier." & vbCrLf & "Veuillez vérifier que le fichier '" & RepWork & "\" & pageweb & "' est accessible.", vbCritical + vbOkOnly + vbSystemModal + 0,"Erreur ouverture fichiers"
        exitprog()
 end if

 IE.document.Open
 Do Until objPageWeb.AtEndOfStream
        line=trim(objPageWeb.ReadLine)
        if line<>"" then
                IE.document.Writeln(line)
                if line="<!--inserrer ici la liste des PC-->" then
                        'insertion du code html pour affichage sélection pc
                        NbreLigne=int(NbrePcSearch/NbreColonnes)
                        if NbreLigne*NbreColonnes<NbrePcSearch then NbreLigne=NbreLigne+1
                        for ii=1 to NbreLigne
                                ligne="<tr>"
                                IE.document.Writeln(ligne)
                                for jj=1 to NbreColonnes
                                        IndexTabSearch=(ii-1)*NbreColonnes+jj
                                        if IndexTabSearch>NbrePcSearch then exit for
                                        if PcSearch(IndexTabSearch, 2) then selected="checked" else selected=""
                                        if PcSearch(IndexTabSearch, 4)<>"" then strusername="<br>" & PcSearch(IndexTabSearch, 4) else strusername=""
                                        ligne="<td width='10%'><input type='checkbox' name='cac_" & IndexTabSearch & "' value='ONOFF' " & selected & "><font color='" & PcSearch(IndexTabSearch, 3) & "' size='2'>" & MacName(PcSearch(IndexTabSearch, 1), 2) & strusername & "</font></td>"
                                        IE.document.Writeln(ligne)
                                next
                                ligne="</tr>"
                                IE.document.Writeln(ligne)
                        next
                end if
         end if
 loop
 IE.document.Close
 objPageWeb.Close
 IE.Document.SelectionForm.textsearch.value=textsearch
end function

'------------------------------------------------------------
' Fonction d'arret du script
Function exitprog()
on error resume next
 IE.Quit
 Set IE = Nothing
 wscript.quit
end function

'------------------------------------------------------------
' Fonction ouverture IE
Function OpenIE()
        Set IE = WScript.CreateObject("InternetExplorer.Application", "IE_")
        With IE
         .left=0
         .top=0
         .height=740
         .width=1024
         .menubar=0
         .toolbar=0
         .statusBar=0
         .navigate "About:Blank"
         .visible=1
        End With
' Attendre la fin du chargement de IE
        Do while IE.busy
        loop
end function

'------------------------------------------------------------
' fonction retournant la valeur du n ième champ(NumField) d'une variable chaine de caractaires(ligne)
function GetField(NumField, ligne, separateur)
 'verification et init variables
 GetField=""
 if separateur="" then separateur=";"
 if NumField<1 then exit function
 if trim(ligne)="" then exit function
 OutOfRange=len(ligne)+1

 'traitement
 ii=0 : IndexLigneFin=0
 do
        'init variables
        ii=ii+1
        IndexLigneDeb=IndexLigneFin
        IndexLigneFin=OutOfRange
        ' recherche IndexLigneFin
        for sep=1 to len(separateur) 'traite multi séparateur ex: separateur=":;/" équivalent à  separateur=":" OU separateur=";" OU separateur="/"
                IndexLigneFinTemp = Instr(IndexLigneDeb+1, ligne, mid(separateur, sep, 1))
                if IndexLigneFinTemp>0 and IndexLigneFinTemp<IndexLigneFin then IndexLigneFin=IndexLigneFinTemp
        next
        if IndexLigneFin=OutOfRange then exit do
 loop until ii=NumField
 if ii=NumField then
        if IndexLigneDeb=0 then IndexLigneDeb=1 else IndexLigneDeb=IndexLigneDeb+1
        IndexLigneFin=IndexLigneFin-1
        if IndexLigneFin>=IndexLigneDeb then GetField=mid(ligne, IndexLigneDeb, IndexLigneFin-IndexLigneDeb+1)
 end if
end function

'------------------------------------------------------------
' fonction retournant l'index de départ ou de fin(DepFin) du N ième champ(NumField) d'une variable chaine de caractaires(ligne)
' DepFin=0 -> recherche index départ sinon recherche index Fin
function GetIndexField(NumField, ligne, separateur, DepFin)
 'verification et init variables
 GetIndexField=-1
 if separateur="" then separateur=";"
 if NumField<1 then exit function
 if trim(ligne)="" then exit function
 OutOfRange=len(ligne)+1

 'traitement
 ii=0 : IndexLigneFin=0
 do
        'init variables
        ii=ii+1
        IndexLigneDeb=IndexLigneFin
        IndexLigneFin=OutOfRange

        ' recherche IndexLigneFin
        for sep=1 to len(separateur) 'traite multi séparateur ex: separateur=":;/" équivalent à  separateur=":" OU separateur=";" OU separateur="/"
                IndexLigneFinTemp = Instr(IndexLigneDeb+1, ligne, mid(separateur, sep, 1))
                if IndexLigneFinTemp>0 and IndexLigneFinTemp<IndexLigneFin then IndexLigneFin=IndexLigneFinTemp
        next
        if IndexLigneFin=OutOfRange then exit do
 loop until ii=NumField
 if ii=NumField then
        if IndexLigneDeb=0 then IndexLigneDeb=1 else IndexLigneDeb=IndexLigneDeb+1
        IndexLigneFin=IndexLigneFin-1
        if IndexLigneFin>=IndexLigneDeb then
                if StartEnd=0 then GetIndexField=IndexLigneDeb else GetIndexField=IndexLigneFin
        end if
 end if
end function
'------------------------------------------------------------
' retourne true si ping ok sinon retourne false
function PcIsOn(strpc)
 Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}!\\").ExecQuery("select * from Win32_PingStatus where address = '" & strpc & "'")
 PcIsOn=false
 For Each objStatus in objPing
        If objStatus.Statuscode = 0 Then PcIsOn=true : exit function
 next
end function

'------------------------------------------------------------
' retourne true si la recherche strsearch composé de "|"(OR) et de "&"(AND) est trouvé dans strbase sinon retourne false
' ex: strsearch="pc1|pc2"; retourne true si la chaine "pc1" OU la chaine "pc2" est trouvé dans strbase
'     strsearch="pc1&pc2"; retourne true si la chaine "pc1" ET la chaine "pc2" sont trouvées dans strbase
'     strsearch="*"; retourne true
function IsFind(strbase, strsearch)
 if strsearch="*" then IsFind=true : exit function
 kk=1 : IsFind=false
 do
        str2search=trim(GetField(kk, strsearch, "|&")) 'récupération du kk ième champs
        if str2search="" then exit do
        operator=""
        if kk>1 then operator=mid(strsearch, GetIndexField(kk, strsearch, "|&", 0)-1, 1) 'récupération du kk ième opérateur
        if operator="" then 'donc dernier champs de strsearch
                if Instr(1, strbase, str2search)>0 then IsFind=true else IsFind=false
        end if
        if operator="|" and Instr(1, strbase, str2search)>0 then IsFind=true
        if operator="&" and Instr(1, strbase, str2search)=0 then IsFind=false
        kk=kk+1
 loop
end function

'------------------------------------------------------------
' retourne le username du compte connecté sur le pc OnThisPc
function getusername(OnThisPc)
 getusername=""
 Set objWMIService = GetObject("winmgmts:\\" & OnThisPc & "\root\CIMV2")
 Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_ComputerSystem", "WQL", wbemFlagReturnImmediately + wbemFlagForwardOnly)
 For Each objItem In colItems
        getusername=trim(objItem.UserName)
 next
end function

'------------------------------------------------------------
' retourne l'adresse mac du pc OnThisPc
function GetMacAdress(OnThisPc)
on error resume next
 GetMacAdress=""
 Err.clear()
 set IPConfigSet = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & OnThisPc).ExecQuery("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled=TRUE")
 If Err.Number<>0 Then exit function
 for each IPConfig in IPConfigSet
        mtemp=trim(IPConfig.MACAddress)
 Next
 for ii=1 to len(mtemp) 'retrait des ':'
        char=mid(mtemp, ii, 1)
        if char<>":" then GetMacAdress=GetMacAdress & char
 next
End function

'------------------------------------------------------------
' Sauvegarde du tableau MacName() dans le fichier [MacNameFile]
function SavMacName()
on error resume next

 SavMacName=false
 'ouverture fichier temporaire [MacNameFile].tmp
 err.clear()
 if objFSO.fileExists(MacNameFile & ".tmp") then objFSO.deleteFile(MacNameFile & ".tmp")
 Set objWriteFile = objFSO.OpenTextFile(MacNameFile & ".tmp", ForWriting, True)
 if err.number<>0 then exit function

 'ecriture dans fichier [MacNameFile].tmp
 for xx=1 to NbrePc
        if MacName(xx, 3)<>"" then lignetemp=MacName(xx, 3) & ";" else lignetemp=MacName(xx, 1) & ";"
        lignetemp=lignetemp & MacName(xx, 2) & ";"
        if MacName(xx, 4)<>"" then lignetemp=lignetemp & MacName(xx, 4)
        objWriteFile.WriteLine(lignetemp)
 next
 objWriteFile.close

 'cré 2 copies de sauvegarde: [MacNameFile].sav->[MacNameFile].sav.bak
 '                         et [MacNameFile]->[MacNameFile].sav
 'renome [MacNameFile].tmp->[MacNameFile]
 if err.number=0 then
        if objFSO.FileExists(MacNameFile & ".sav") then
                if objFSO.FileExists(MacNameFile & ".sav.bak") then objFSO.DeleteFile(MacNameFile & ".sav.bak")
                objFSO.MoveFile MacNameFile & ".sav" , MacNameFile & ".sav.bak"
        end if
        objFSO.MoveFile MacNameFile , MacNameFile & ".sav"

        err.clear()
        objFSO.MoveFile MacNameFile & ".tmp", MacNameFile
        if err.number=0 then SavMacName=true
 end if
end function

'------------------------------------------------------------
' retourne l'action demandé par l'utilisateur
function GetActionPageWeb()
on error resume next
 err.clear()
 GetActionPageWeb=IE.Document.Script.CheckVal()
 if err.number<>0 then 'teste si IE est fermé
        WScript.Sleep 30
        err.clear()
        IE.document.Open : IE.document.close
        if err.number<>0 then exitprog() else AffichePageWeb "startpc.htm"
 end if
end function

 Conclusion

A modifier selon vos besoins.

 Fichier Zip

Les Membres Club peuvent télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !

Télécharger le zip


 Historique

22 janvier 2009 11:56:54 :
Modification minime: Correction du bug sur DemarragePc (WolCmd.exe n'existe pas). Ajout d'une variable CastIp pour DemarragePc (à modifier suivant votre IpRéseau).

 Sources du même auteur

Source avec Zip INSTALLER UN PROGRAMME(MSI) EN TANT QU'ADMINISTRATEUR
Source avec Zip SAUVEGARDE DES DONNÉES D'UN RÉSEAU EN VBSCRIPT

 Sources de la même categorie

Source avec Zip Source avec une capture RECHERCHE & SAUVEGARDE DES FICHIERS PAR LEURS EXTENSIONS par hackoo
Source avec Zip Source avec une capture [VBS] SPLASH SCREEN EN VBSCRIPT par hackoo
Source avec Zip Source avec une capture [VBS] GOOGLE EASTER EGGS par hackoo
Source avec Zip Source avec une capture FILE2COMPARE: COMPARAISON DE DEUX FICHIERS LIGNE PAR LIGNE par hackoo
Source avec Zip Source avec une capture [VBS] COMMENT CRÉER UN DOSSIER ET LE PROTÉGER PAR MOT DE PAS... par hackoo

 Sources en rapport avec celle ci

Source avec Zip Source avec une capture RECHERCHE & SAUVEGARDE DES FICHIERS PAR LEURS EXTENSIONS par hackoo
Source avec Zip Source avec une capture [VBS] SPLASH SCREEN EN VBSCRIPT par hackoo
Source avec Zip RECHERCHE D'UN ENREGISTREMENT DANS UNE DATATABLE ET POSITION... par erdna
Source avec Zip Source avec une capture Source .NET (Dotnet) SELECTION DANS UNE BASE ACCESS PAR CHOIX (VB 2005) par sadok_sa
Source avec Zip PETIT MOTEUR DE RECHERCHE SQL / VB SUR BASE DE DONNEES par m2rtech

Commentaires et avis

Aucun commentaire pour le moment.

 Ajouter un commentaire


Discussions en rapport avec ce code source dans le forum

selection dans un MSFlexGrid [ par flohand ] Salut voila mon problème j'ai fais un peit logiciel où le contenu de ma base de donnée s'affiche dans un MSFlexGrid , je voudrai pouvoir a la suite d' selection dans un MSFlexGrid [ par flohand ] Salut voila mon problème j'ai fais un peit logiciel où le contenu de ma base de donnée s'affiche dans un MSFlexGrid , je voudrai pouvoir a la suite d' selection dans un MSFlexGrid [ par flohand ] Salut voila mon problème j'ai fais un peit logiciel où le contenu de ma base de donnée s'affiche dans un MSFlexGrid , je voudrai pouvoir a la suite d' Récupérer un selection dans un textarea en VBScript [ par Dje ] Je cherche à savoir comment récupérer une sélection d'une partie d'un texte dans une balise TEXTAREA.En VBScript ou ASP ou autre ...Merci de l'aide. EDI VBScript [ par crenaud76 ] Je recherche un bon environnement de développement VBScript : Coloration syntaxique, auto-completion du code par liste des méthodes et propriétés d'un selection disque dut dans une recherche [ par DraaFil ] Bonjour à tous, Je développe un module de recherche de fichier comme celui de windows. Ma question est : comment obtenir un combobox ou une variable Recherche d'un dossier [ par culie3 ] Bonjour, j'aurai voulu avoir un petit morceau de code qui me permettré de lancer une recherche sur l'ordinateur (juste en cliquant sur un boutton ou a Recherche qhelqu'un qui connait VBScript !!! [ par JMO ] Bonsoir, (ou bonjour)Recherche quelqu'un qui connait VBScript .Actuellement, VicoLaChip2 et Almandric essaient de me dépanner. Je les remercie de nouv VbScript : Recherche de tout les Input Text dans une page [ par Cramfr ] Bonjour,Je cherche une solution &#224; mon probl&#232;me. Je commence simplement une petite application intraNet me permetant sans serveur web, par si Recherche un ouvrage sur le language VBScript. [ par cartman78 ] Bonjour, Je&nbsp;ne suis pas developpeur. Je&nbsp;suis administrateur reseau W2K chez un grand compte&nbsp;( 6 000 postes) . Active directory est en p


Nos sponsors


Sondage...

CalendriCode

Février 2012
LMMJVSD
  12345
6789101112
13141516171819
20212223242526
272829    

Consulter la suite du CalendriCode

Photothèque

 
Développement réalisé par Nicolas SOREL (Nix) avec l'aide de : Cyril DURAND et Emmanuel (EBArtSoft), Merci à Vincent pour ses précieux conseils.
CodeS-SourceS.com© Toute reproduction même partielle est interdite sauf accord écrit du Webmaster
CodeS-SourceS.com© est une marque déposée tous droits réservés

Google Coop CodeS-SourceS Google Coop CodeS-SourceS
Temps d'éxécution de la page : 0,546 sec (4)

Nous contacter | Annoncer sur CodeS-SourceS | Mentions légales