Accueil > > > 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
Description
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.
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
Sources de la même categorie
Commentaires et avis
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 à mon problè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 ne suis pas developpeur. Je suis administrateur reseau W2K chez un grand compte ( 6 000 postes) . Active directory est en p
|
Derniers Blogs
UNE JOLIE-HORLOGE ET PAS QU'UN PEU !UNE JOLIE-HORLOGE ET PAS QU'UN PEU ! par neodante
Pour les possesseurs d'iPhone, ça y est Bijin Tokei - qui se traduit littéralement en Français par " Jolie Horloge " - est arrivé et GRATUITEMENT s'il vous plaît ! Après la version Tokyo, Hokkaido, night club, racing, Gal, "pour les mademoiselles'", . voi...
Cliquez pour lire la suite de l'article par neodante TECHDAYS PARIS 2010 : CONNECTEZ VOS DONNéES à SHAREPOINT 2010 AVEC LES BUSINESS CONNECTIVITY SERVICESTECHDAYS PARIS 2010 : CONNECTEZ VOS DONNéES à SHAREPOINT 2010 AVEC LES BUSINESS CONNECTIVITY SERVICES par ROMELARD Fabrice
Animé par: Gaetan Bouveret et Julien Chomarat Business Connectivity Services (BCS) est dans SharePoint 2010 la version 2 de Business Data Catalog (BDC dans SharePoint 2007). Il s'agit de la solution permettant de visualiser des données provenan...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice [DIVERS] SUIVRE VOS SéRIES PRéFéRéS SUR LA TOILE[DIVERS] SUIVRE VOS SéRIES PRéFéRéS SUR LA TOILE par orion
Comme de nombreux geek, je suis un grand amateur de série TV et je rate régulièrement des épisodes de mes séries préférés. Une solution s'offre à vous avec ce merveilleux site : Tv Gorge - www.tvgorge.com Moteur de recherche à l'appui, vous pouvez ...
Cliquez pour lire la suite de l'article par orion TECHDAYS PARIS 2010 : LA BI DANS SHAREPOINT 2010TECHDAYS PARIS 2010 : LA BI DANS SHAREPOINT 2010 par ROMELARD Fabrice
Animé par: Vincent Bellet et Baptiste Giraudier La BI dans SharePoint 2010, Les nouveaux services d'application dans SP2010 et SQL Server Reporting services 2008 R2. La BI dans SharePoint est généralisée pour tous afin de permettre à tous les coll...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice
Logiciels
DB-MAIN (9.1.0)DB-MAIN (9.1.0)DB-MAIN is a data-modeling and data-architecture tool. It is designed to help developers and anal... Cliquez pour télécharger DB-MAIN Xilisoft DPG Convertisseur (5.1.37.0120)XILISOFT DPG CONVERTISSEUR (5.1.37.0120)Xilisoft DPG Convertisseur offre aux fans de Nintendo DS une bonne solution leur permettant de dé... Cliquez pour télécharger Xilisoft DPG Convertisseur GraphicsGale (2.01.01)GRAPHICSGALE (2.01.01)GraphicsGale est un logiciel de PixelArt avec de nombreuse fonctionnalités permettant de réalisé ... Cliquez pour télécharger GraphicsGale Architecte 3D (Platinum 2010)ARCHITECTE 3D (PLATINUM 2010)Architecte 3D Platinium vous permet de concevoir facilement les plans votre future maison, de l'é... Cliquez pour télécharger Architecte 3D TeamViewer 5 (TeamViewer 5)TEAMVIEWER 5 (TEAMVIEWER 5)Dépanner un ami,expliquer une manipulation devient un jeu d'enfant.
Prise en main d'un autre ord... Cliquez pour télécharger TeamViewer 5
|