Page web dans fichier Vbscript?

pepe2626 Messages postés 9 Date d'inscription mardi 1 août 2006 Statut Membre Dernière intervention 29 septembre 2006 - 25 sept. 2006 à 15:03
cs_JMO Messages postés 1854 Date d'inscription jeudi 23 mai 2002 Statut Membre Dernière intervention 24 juin 2018 - 29 sept. 2006 à 12:56
Bonjour,


je voudrais afficher une page web.il faudrait qu'elle soit incorporé dans un documents .vbs


Comment dois je faire ??

3 réponses

cs_JMO Messages postés 1854 Date d'inscription jeudi 23 mai 2002 Statut Membre Dernière intervention 24 juin 2018 27
26 sept. 2006 à 12:49
 Bonjour,

Je ne suis pas certain d'avoir compris la question !!!

Le script (complet, en vbs), ci-dessous, permet d'afficher un résultat
dans un fichier .html (donc possibilité de le publier).
J'utilise fréquemment cette méthode pour du reporting.
Pour essai, il suffit de créer un .txt contenant les lignes rouges.

jean-marc

'Description du fichier CONTROLE-BIB.txt
'
'V4.000   FDMC306                       INVENTAIRE DES BIBLIOTHEQUES DU    10 03 2006                  10/03/2006  14H25   PAGE:    1
'SITE: DIA7  USER: *            GF: *             RG: CROUZET
'------------------------------------------------------------------------------------------------------------------------------------
':                              :                  :            :   CONTENU       :    CAPACITE     :   INVENTAIRES  PRECEDENTS     :
': EFN                          : ORG     MEDIA  C :  M-O    %UT:                 :                 :                               :
':                              :                  :            :    MB    LIGNES :    MB    LIGNES : DATE       MB   LIGNES   EVOL :
'------------------------------------------------------------------------------------------------------------------------------------
':EXPLOIT.EDITCAE               :L SL     DA15   C :  198    62 :   232   542 220 :   374   874 548 :03 03 06   232   542220        :
':EXPLOIT.EDITCAE-ANN           :L SL     DA15   C :  351    70 :     6           :     9           :                               :
':EXPLOIT.EDITION               :L SL     DA15   C :  7,7    13 :     5           :    38           :03 03 06     5                 :
':IMS.JCL-MB-SAUV               :L SL     DA15   C :  8,8    91 : 1 828    47 146 : 2 009    51 809 :                         47146 :
':IMSA.EDIHEBDO                 :L SL     DA15   C :   35    56 :   180           :   321           :03 03 06   179                 :
':IMSA.EDIMENS                  :L SL     DA15   C :   57    76 :   155    33 757 :   204    44 417 :03 03 06   150    33757        :
':IMSA.EDITION                  :L SL     DA15   C :   18    15 :   133           :   887           :03 03 06   134                 :
':IMSA.EDITION-SAUV             :L SL     DA15   C :   32    48 : 3 646    81 573 : 7 596   169 944 :03 03 06  3560    79659   1914 :
':IMSB.EDIHEBDO                 :L SL     DA15   C :   35    62 :   233           :   376           :03 03 06   233                 :
':IMSB.EDIMENS                  :L SL     DA15   C :   46    72 :   143        33 :   199        46 :03 03 06   143       33        :
':IMSB.EDITION                  :L SL     DA15   C :   18    26 :   151           :   581           :03 03 06   152                 :
':IMSB.EDITION-SAUV             :L SL     DA15   C :   72    45 : 3 639   297 043 : 8 087   660 096 :03 03 06  3541   287253   9790 :
':IMSP.EDIHEBDO                 :L SL     DA15   C :   40    80 :   188           :   235           :03 03 06   187                 :
':IMSP.EDIMENS                  :L SL     DA15   C :  127    32 :   140       203 :   438       634 :03 03 06   135      203        :
':IMSP.EDITION                  :L SL     DA15   C :   31    16 :   134           :   838           :03 03 06   135                 :
':IMSP.EDITION-SAUV             :L SL     DA15   C :  6,5    75 :   524    47 526 :   699    63 368 :03 03 06   462    43689   3837 :
'------------------------------------------------------------------------------------------------------------------------------------



Dim fso, Path, FicLog, Fichier, RepOut, objTextStream, strListe
Path    = "D:\Oxauser1"
Fichier = "CONTROLE-BIB.txt"
RepOut  = Path & "Controle Bibliothèques.html"
Set fso = CreateObject("Scripting.FileSystemObject")
Set objTextStream = fso.OpenTextFile(Path & Fichier, 1)



'Init tableau
c_bib     = "<td style=""font-weight: normal; width: 200px; height: 30px; "">" & "&nbsp;&nbsp;"
c_taille  = "<td style=""text-align: center; width: 100px;  height: 30px;  "">"
c_occup   = "<td style=""text-align: center; width: 100px; height: 30px;  "">"
c_font    = "</td>"
'Couleur ligne du tableau
jaune = " background-color: rgb(255, 255, 153);"     
rouge = " background-color: rgb(255, 0,     0); font-weight: bold;"
bleu  = " background-color: rgb(153, 255, 255);"
vert  = " background-color: rgb(153, 255, 153);"
orange = "background-color: rgb(255, 204, 102);"
rose   = "background-color: rgb(255, 0,   255);"
blanc  = "background-color: rgb(255, 255, 255);"



'MsgBox ShowFolderList(Path),vbmessage,"Vérification du % d'occupation des Bibliothèques"
Call ShowFolderList(Path)



Function ShowFolderList(strPath)
Dim strtmp, i , pourc(2), t
t = 0
pourc(1) = 7 & "!bib7 " & "|taille7"
pourc(2) = 7 & "!bib7 " & "|taille7"





Do while not objTextStream.AtEndOfStream
strtmp = split(objtextstream.readline,":")
For i = 0 to Ubound(strTmp)
'MsgBox "rrrrrrrrrrr   " & pourc(t)If Left(strtmp(i),3) "EXP" Or Left(strtmp(i),3) "IMS" Then




 



strListe = strListe & "Bib: " & Left(strtmp(i), 20) & "  Taille: " & Left(strtmp(i+2), 5) &_
 " Mo    Taux d'occupation: " & Right(strtmp(i+2), 3) & " %" &vbCrLf
lBIB = "<tr>" & c_font & c_bib   & Left(strtmp(i), 20) & c_font &_
 c_taille  & CInt(Left(strtmp(i+2), 5)) & c_font &_
 c_occup  & Right(strtmp(i+2), 3) & c_font & "<tr>"If Right(strtmp(i+2), 3) >90                                 Then lBIB Replace(lBIB, """><", rouge & """><")                If Right(strtmp(i+2), 3) >80 And Right(strtmp(i+2), 3)< 89 Then lBIB = Replace(lBIB, """><", orange & """><")               
wBIB = wBIB & lBIB
End If



Next
Loop
ShowFolderList = strListe





'Création fichier html
If Fso.FileExists(RepOut) Then Result = Fso.DeleteFile(RepOut)
Set Result = Fso.CreateTextFile(RepOut, True)
Result.WriteLine "<html><head><meta content=""text/html; charset=ISO-8859-1"" http-equiv=""content-type"">"
Result.WriteLine "<title>""" & "Taux de remplissage des Bibliothèques" & """</title></head>"
Result.WriteLine ""
Result.WriteLine ""
Result.WriteLine "Contr&ocirc;le effectu&eacute; le&nbsp;"
Result.WriteLine "" & Date & "&nbsp;"
Result.WriteLine "&nbsp;&agrave;&nbsp;"
Result.WriteLine "" & Replace(Mid(Now, 12, 5),":","h") & "
"



Result.WriteLine "
Result.WriteLine " style=""font-family: MS Sans Serif;"">"
Result.WriteLine "\"
Result.WriteLine \"----
\"
Result.WriteLine \""
Result.WriteLine ""

Result.WriteLine "Pourcentage d'occupation des Bibliothèques"

Result.WriteLine "
"
Result.WriteLine "\"
 
        
ligne1 = \"----
\" & c_bib & \"&nbsp;Bibliothèque\" & c_font & c_taille  & \"&nbsp;&nbsp;Taille (Mo)\" &_
 c_font & c_occup    & \"&nbsp;&nbsp;%\" & c_font 
ligne1 = Replace(ligne1, \"\"\"><\", bleu & \"\"\"><\")
Result.WriteLine ligne1 & "" & wBIB & "
"



Result.WriteLine " </html>"
Result.Close



'MsgBox RepOut
'Affichage du fichier html
Set WshShell = WScript.CreateObject("WScript.Shell")
WshShell.Run "c:\WINDOWS\EXPLORER.EXE /n,/e," & RepOut   ' pour XP
'WshShell.Run "c:\WINNT\EXPLORER.EXE /n,/e," & RepOut    ' pour W2000
Set fso = Nothing
Set WshShell = Nothing
End Function
0
pepe2626 Messages postés 9 Date d'inscription mardi 1 août 2006 Statut Membre Dernière intervention 29 septembre 2006
29 sept. 2006 à 11:50
je te remercie pour ton aide déja.


Voila ton aide m'a permis d'avancer mais quelques petit problème subsiste.


Pourrais tu regarder mon code et voir ce qui fonctionne mal.



Dim fso, Path, FicLog, Fichier, RepOut, objTextStream, strListe
Path    = "D:\Oxauser1"
Fichier = "CONTROLE-BIB.txt"
RepOut  = Path & "Controle Bibliothèques.html"
Set fso = CreateObject("Scripting.FileSystemObject")
Set objTextStream = fso.OpenTextFile(Path & Fichier, 1)



'Init tableau
c_bib     = "<td style=""font-weight: normal; width: 200px; height: 30px; "">" & "&nbsp;&nbsp;"
c_taille  = "<td style=""text-align: center; width: 100px;  height: 30px;  "">"
c_occup   = "<td style=""text-align: center; width: 100px; height: 30px;  "">"
c_font    = "</td>"
'Couleur ligne du tableau
jaune = " background-color: rgb(255, 255, 153);"     
rouge = " background-color: rgb(255, 0,     0); font-weight: bold;"
bleu  = " background-color: rgb(153, 255, 255);"
vert  = " background-color: rgb(153, 255, 153);"
orange = "background-color: rgb(255, 204, 102);"
rose   = "background-color: rgb(255, 0,   255);"
blanc  = "background-color: rgb(255, 255, 255);"



'MsgBox ShowFolderList(Path),vbmessage,"Vérification du % d'occupation des Bibliothèques"
Call ShowFolderList(Path)



Function ShowFolderList(strPath)
Dim strtmp, i , pourc(2), t
t = 0
pourc(1) = 7 & "!bib7 " & "|taille7"
pourc(2) = 7 & "!bib7 " & "|taille7"





Do while not objTextStream.AtEndOfStream
strtmp = split(objtextstream.readline,":")
For i = 0 to Ubound(strTmp)
'MsgBox "rrrrrrrrrrr   " & pourc(t)If Left(strtmp(i),3) "EXP" Or Left(strtmp(i),3) "IMS" Then




 



strListe = strListe & "Bib: " & Left(strtmp(i), 20) & "  Taille: " & Left(strtmp(i+2), 5) &_
 " Mo    Taux d'occupation: " & Right(strtmp(i+2), 3) & " %" &vbCrLf
lBIB = "<tr>" & c_font & c_bib   & Left(strtmp(i), 20) & c_font &_
 c_taille  & CInt(Left(strtmp(i+2), 5)) & c_font &_
 c_occup  & Right(strtmp(i+2), 3) & c_font & "<tr>"If Right(strtmp(i+2), 3) >90                                 Then lBIB Replace(lBIB, """><", rouge & """><")                If Right(strtmp(i+2), 3) >80 And Right(strtmp(i+2), 3)< 89 Then lBIB = Replace(lBIB, """><", orange & """><")               
wBIB = wBIB & lBIB
End If



Next
Loop
ShowFolderList = strListe





'Création fichier html
If Fso.FileExists(RepOut) Then Result = Fso.DeleteFile(RepOut)
Set Result = Fso.CreateTextFile(RepOut, True)
Result.WriteLine "<html><head><meta content=""text/html; charset=ISO-8859-1"" http-equiv=""content-type"">"
Result.WriteLine "<title>""" & "Taux de remplissage des Bibliothèques" & """</title></head>"
Result.WriteLine ""
Result.WriteLine ""
Result.WriteLine "Contr&ocirc;le effectu&eacute; le&nbsp;"
Result.WriteLine "" & Date & "&nbsp;"
Result.WriteLine "&nbsp;&agrave;&nbsp;"
Result.WriteLine "" & Replace(Mid(Now, 12, 5),":","h") & "
"



Result.WriteLine "
Result.WriteLine " style=""font-family: MS Sans Serif;"">"
Result.WriteLine "\"
Result.WriteLine \"----
\"
Result.WriteLine \""
Result.WriteLine ""

Result.WriteLine "Pourcentage d'occupation des Bibliothèques"

Result.WriteLine "
"
Result.WriteLine "\"
 
        
ligne1 = \"----
\" & c_bib & \"&nbsp;Bibliothèque\" & c_font & c_taille  & \"&nbsp;&nbsp;Taille (Mo)\" &_
 c_font & c_occup    & \"&nbsp;&nbsp;%\" & c_font 
ligne1 = Replace(ligne1, \"\"\"><\", bleu & \"\"\"><\")
Result.WriteLine ligne1 & "" & wBIB & "
"



Result.WriteLine " </html>"
Result.Close



'MsgBox RepOut
'Affichage du fichier html
Set WshShell = WScript.CreateObject("WScript.Shell")
WshShell.Run "c:\WINDOWS\EXPLORER.EXE /n,/e," & RepOut   ' pour XP
'WshShell.Run "c:\WINNT\EXPLORER.EXE /n,/e," & RepOut    ' pour W2000
Set fso = Nothing
Set WshShell = Nothing
End Function



Note: ce script .vbs créé un formulaire html qui sert de saisie d'environnement, il offre le choix entre 4 boutons radio et récupère des infos telle que le nom de l'utilisateur, le nom de la machine..
Au moment ou l'utilisateur cliquera sur le bouton de validation de formulaire, le .vbs executera la suite du code (mapper lecteur, variable nevironnement...) .
Mon problème a l'heure actuelle est que après avoir affiché ma fenetre html, celui ci n'execute plus la suite du code.

Je te remercierais de jetter un coup d'oeil..


Merci et a bientot, master(lol)
0
cs_JMO Messages postés 1854 Date d'inscription jeudi 23 mai 2002 Statut Membre Dernière intervention 24 juin 2018 27
29 sept. 2006 à 12:56
 Bonjour,

Il est où "ton" code , je ne vois pas de checkbox.

Ci-dessous, un script vbs (qui n'est pas de moi) qui utilise des checkboxs.
J'en suis au même point que toi. J'affiche une page html, mais à que nenni
pour click sur checkbox ou autres.

jean-marc

' Script d'affichage détaillé des processus en cours
' sur une machine locale ou distante
' Fait appel à Internet Explorer pour la saisie
' des paramètres et l'affichage des résultats
'
' Jean-Claude BELLAMY © 2002
' --------------------------------------------------------------------
Dim args, network, computer, fso, ts, tparam, tPrint, oIE, fExec, user,domain, system,process
Set network  = Wscript.CreateObject("WScript.Network")
Set Shell = WScript.CreateObject("WScript.Shell")
' Création du fichier HTML qui va servir de formulaire
fichtml=GetPath() & "processlist.html"
ficparam=GetPath() & "processlist.cfg"
ficprint=GetPath() & "processlist.txt"


local=lcase(network.ComputerName)
Set args=Wscript.Arguments
If args.count>0 Then
 computer=lcase(args(0))
Else
 computer=local 
 End If
If computer=local Then typeordi="local" else typeordi="distant"
RootTitle="Liste des processus sur " & computer & " (" & typeordi & ")"
Set fso = WScript.CreateObject("Scripting.FileSystemObject")
Set ts  = fso.CreateTextFile(fichtml, True)
isparam=false
If fso.FileExists(ficparam)  Then
 Set tparam=fso.OpenTextFile(ficparam)
 isparam=true
 End If'Choix des paramètres
WriteHTMLHeader
header="Paramètres à afficher dans "
header=header & "IE"
' test d'existence de Excel
On Error Resume Next
ReadKey=shell.RegRead("HKEY_CLASSES_ROOT\.xls")
If Err.Number=0 Then header=header & "Excel"
On error goto 0
header=header & "Bloc-notes"
ts.writeline " " & header & "   : "
ts.writeline "\"
objet =\"Win32_Process\"
Set System = GetObject(\"winmgmts:\" & objet)
n=0
ncol=3
dim prop()
for each Property in System.Properties_
 AddProp Property.Name
 next
' Ajout des méthodes GetOwner et GetOwnerSid\"
AddProp \"GetOwner\"
AddProp \"GetOwnerSid\"
r=ncol-(n mod ncol)
If r<>ncol Then
 For i = 1 To r
  ts.writeline \", \"
  Next
 ts.writeline \"\"
 end if
ts.writeline "
"
WriteHTMLBottom "Afficher","Fermer"


If isParam Then tParam.Close
RunIE 600,600,true


DisplayIE=false
DisplayExcel=false
DisplayNotepad=false
if oIE.Document.processlistForm.IE.Checked then DisplayIE=true
if oIE.Document.processlistForm.Excel.Checked then DisplayExcel=true
if oIE.Document.processlistForm.Notepad.Checked then DisplayNotepad=true


Set tParam = fso.CreateTextFile(ficparam, True)
' Utilisation de la fonction execute afin de créer dynamiquement
' des commandes faisant intervenir des noms de champs variables
dim f(), res()
redim f(n), res(n)
lmax=0
for i = 0 to n-1
 f(i) = "function testparam() " & vbcrlf
 f(i) = f(i) & "testparam=0" & vbcrlf
 f(i) = f(i) & "if oIE.Document.processlistForm.param" & i &".Checked then testparam=1" & vbcrlf
 f(i) = f(i) & "end function" & vbcrlf
 execute f(i)
 res(i)=testparam()
 state=""
 If res(i)=1 Then
  state="Checked"
  l=len(prop(i))
  If lmax<l then lmax=l
  end if
 tParam.writeline state
 next
oIE.Quit
tParam.close


'Affichage des résultats
Set ts  = fso.CreateTextFile(fichtml, True)
If DisplayExcel Then
 Dim objXL
 Set objXL = WScript.CreateObject("Excel.Application")
 objXL.Workbooks.Add
 objXL.Cells(1,1).Value = Titre
 objXL.Visible = True
 End If


If DisplayNotepad Then
 Set tPrint = fso.CreateTextFile(ficprint, True)
 tprint.writeline Titre
 tprint.WriteBlankLines(1)
 end if
WriteHTMLHeader
ts.writeline "Liste des processus (" & date & " " & time & ")
"
ts.writeline "\"
ts.writeline \"----
\"
first=true
nl=2
nc=0
ts.writeline \"Terminer, \"
For i= 0 To n-1
 If res(i)=1 Then
  If DisplayNotepad then
   If not first Then tprint.write chr(9) else first=false
   tprint.write prop(i)
   end if
  nc=nc+1
  If DisplayExcel Then objXL.Cells(nl,nc).Value = prop(i)
  comment=\"\"
  If lcase(prop(i))=\"executablepath\" Then
   comment=\"
Cliquer sur un lien pour afficher
le fichier dans l'explorateur\"
   end if
  ts.writeline \"" & prop(i) & comment & ", \"
  End If
 Next
ts.writeline \"\"
If DisplayNotepad Then tprint.WriteBlankLines(2)

Set System=GetObject (\"winmgmts:{impersonationLevel=impersonate}!//\" & Computer).InstancesOf(objet)
nl=2
nc=0
nproc=0
dim ProcState(),ProcNum()
for each Process in System
 nl=nl+1
 first=true
 SetKill Process.Handle
 ts.writeline \"----
\"
 ts.writeline \", \"
 nc=0
 For i= 0 To n-3
  If res(i)=1 Then
   var =\"Process.\" & prop(i)
   valeur=eval(var)
   If IsNull(valeur) Then valeur=\"\"
   link=\"\"
   If prop(i)=\"ExecutablePath\" and valeur<>\"\" Then
    filename=valeur
    If computer<>local Then filename=\"\\\" & computer & \"\\" & Replace(filename, \":\", \"$\")
    link=\"\"
    End If
   addProcess 0,valeur,link
   End If
  Next
 If res(n-2)=1 Then
  result=Process.GetOwner(user,domain)
  addProcess result, user & \"/\" & domain,\"\"
  end if
 If res(n-1)=1 Then
  result=Process.GetOwnerSid(SID)
  addProcess result, SID,\"\"
  end if
 ts.writeline \"\"
 If DisplayNotepad Then tprint.writeline \"\"
 next

If DisplayExcel Then
 objXL.Rows(\"2:2\").Select
 objXL.Selection.Font.Bold = True
 d1=int((nc-1)/26)
 d2=((nc-1) mod 26)
 If d1=0 Then l1max=\"\" else l1max=chr(Asc(\"A\")+d1-1)
 l2max=chr(Asc(\"A\")+d2)
 objXL.Columns(\"A:\" & l1max & l2max).Select
 objXL.Selection.Columns.AutoFit
 objXL.Rows(\"1:1\").Select
 objXL.Selection.Font.Bold = True
 objXL.Selection.Font.Size = 12
 end if

ts.writeline "
"


If DisplayNotepad Then
 tprint.close
 commande=shell.ExpandEnvironmentStrings("%windir%\notepad.exe " & chr(34) & ficprint & chr(34))
 shell.Run commande, 1
 end if


If DisplayIE Then
 WriteHTMLBottom "","Fermer"
 RunIE 600,400,false
 End If
 
Wscript.quit


'------------------------------------------------------------
Function FormatStr(ch,lmax)
l=len(ch)
If l<lmax Then
 For k = l+1 To lmax
  ch=ch & " "
  Next
 End If
FormatStr=ch
End Function
'------------------------------------------------------------
' Fonction de récupération du répertoire courant
Function GetPath()
Dim path
path = WScript.ScriptFullName
GetPath = Left(path, InStrRev(path, ""))
End Function
'------------------------------------------------------------
Sub WriteHTMLHeader
ts.writeline "<html>"
ts.writeline "<head>"
ts.writeline "<title>" & Titre & "</title>"
ts.writeline "<STYLE TYPE=""text/css"">"
ts.writeline " body {"
ts.writeline " font-family: Verdana;"
ts.writeline " font-size: 8 pt }"
ts.writeline " h1, h2, h3, h4, h5, h6 { font-family: Verdana }"
ts.writeline "table {"
ts.writeline " table-border-color-light: rgb(102,204,204);"
ts.writeline " table-border-color-dark:  rgb(0,102,102);"
ts.writeline " font-size: 8 pt;"
ts.writeline " font-family: Verdana }"
ts.writeline "</STYLE>"
ts.writeline "</head>"
ts.writeline ""
ts.writeline "<script language=""VBScript""> "
ts.writeline "<!--"
ts.writeline "Dim ready,flagfile,file,flagkill,ID"
ts.writeline "Sub B0_OnClick"
ts.writeline "ready=-1"
ts.writeline "End Sub"
ts.writeline "Sub B1_OnClick"
ts.writeline "ready=1"
ts.writeline "End Sub"


ts.writeline "Sub Window_OnLoad()"
ts.writeline "ready=0"
ts.writeline "flagfile=0"
ts.writeline "flagkill=0"
ts.writeline "file="""""
ts.writeline "ID=0"
ts.writeline "End Sub"


ts.writeline "Public Function CheckVal()"
ts.writeline "CheckVal=ready"
ts.writeline "End function"


ts.writeline "Public Function CheckFile()"
ts.writeline "CheckFile=flagfile"
ts.writeline "End function"


ts.writeline "Public Function CheckID()"
ts.writeline "CheckID=flagkill"
ts.writeline "End function"


ts.writeline "Public Sub ResetFile()"
ts.writeline "flagFile=0"
ts.writeline "End sub"


ts.writeline "Public Sub ResetID()"
ts.writeline "flagkill=0"
ts.writeline "End sub"


ts.writeline "Public Function GetFile()"
ts.writeline "GetFile=file"
ts.writeline "End function"


ts.writeline "Public Function GetID()"
ts.writeline "GetID=ID"
ts.writeline "End function"


ts.writeline "function Explore(filename)"
ts.writeline "flagfile=1"
ts.writeline "file=filename"
ts.writeline "End function"


ts.writeline "function Kill(handle)"
ts.writeline "flagkill=1"
ts.writeline "ID=handle"
ts.writeline "End function"


ts.writeline "'-->"
ts.writeline "</script>"
ts.writeline "<form name=""processlistForm"">"
ts.writeline "<center>Ordinateur " & typeordi & " " & Computer & "</center>
<hr>"
End Sub
' -------------------------------------
Sub WriteHTMLBottom(B1,B0)
ts.writeline "
"
If B1<>"" Then ts.writeline ""
If B0<>"" Then ts.writeline ""
ts.writeline "</form>"
ts.writeline ""
ts.writeline "</html>"
ts.Close
End Sub
' -------------------------------------
Sub RunIE(W,H,testclose)
' Ouverture d'Internet Explorer
Set oIE = WScript.CreateObject("InternetExplorer.Application", "IE_")
oIE.Left = 50       
oIE.Top = 100
oIE.Height = H
oIE.Width = W
oIE.MenuBar = 0        
oIE.ToolBar = 0
oIE.StatusBar = 1
oIE.navigate fichtml 
oIE.Visible = 2     
Do While (oIE.Busy)   
 WScript.Sleep 200 
 Loop
shell.AppActivate Titre


' Attente d'action sur le bouton ou fermeture de la fenêtre
On Error Resume Next
Do                  
 WScript.Sleep 100
 If oIE.Document.Script.CheckFile()<>0 Then
  path=oIE.Document.Script.GetFile()
  oIE.Document.Script.ResetFile
  If path<>"" Then Shell.run "explorer /select," & path,1
  End If
 If oIE.Document.Script.CheckID()<>0 Then
  ID=oIE.Document.Script.GetID()
  oIE.Document.Script.ResetID
  If ID<>0 Then
   If GetStateKill(ID)=0 Then
    MsgBox "Le processus " & ID & " n'existe plus", vbExclamation,"Terminaison de processus"
   Else
    rep=MsgBox("Etes-vous sûr de terminer le processus " & ID & "?", vbYesNo + vbQuestion,"Terminaison de processus")
    If rep=vbYes Then
     result=killprocess(ID)
     If result=0 Then CancelKill(ID)
     end if
    End If
   end if
  End If
 Loop While (oIE.Document.Script.CheckVal() = 0)
' Si on ferme directement IE sans passer par un bouton,
' cela provoque une erreur qui est détectée et alors
' on quitte le script
If Err <> 0 Then
 If testclose Then
  Wscript.quit
 else
  On Error goto 0
  exit sub
  end if
 end if
test=oIE.Document.Script.CheckVal()
If test=-1 Then
 oIE.Quit
 If testclose Then Wscript.quit
 end if
On Error goto 0
End Sub
' -------------------------------------
Sub AddProp(ch)
n=n+1
redim preserve prop(n)
prop(n-1)=ch
state=""
If isParam then If not tParam.AtEndOfStream Then state=tParam.ReadLine
If ((n-1) mod ncol)=0 Then ts.writeline "<tr>"
ts.writeline "<td>" & prop(n-1) & "</td>"
If (n mod ncol)=0 Then ts.writeline "</tr>"
End Sub
' -------------------------------------
Sub AddProcess(result,ch, chlink)
tag=""
If IsNumeric(ch) Then tag=" align=""right"""
ts.writeline "<td" & tag & ">"
If result=0 Then
 If chlink<>"" Then ts.writeline chlink
 ts.writeline ch
 If chlink<>"" Then ts.writeline ""
 end if
ts.writeline "</td>"
If DisplayNotepad Then
 If not first Then tprint.write chr(9) else first=false
 If result=0 Then tprint.write ch 
 end if
nc=nc+1 
If DisplayExcel and result=0 Then objXL.Cells(nl,nc).Value = ch
End Sub
' -------------------------------------
Function Titre
Titre=rootTitle & " " & Date & " " & Time
End Function
' -------------------------------------
Function KillProcess(ID)
Set System=GetObject("winmgmts:{impersonationLevel=impersonate}!//" & Computer).ExecQuery("select * from " _
& objet & " where Handle=" & ID)
result=-1
for each Process in System
 result=Process.terminate(0)
 If result<>0 Then
  MsgBox "Erreur code " & result, vbExclamation,"Terminaison processus " & ID
 Else
  MsgBox "Processus correctement terminé", vbInformation,"Terminaison processus " & ID
  End If
 next
KillProcess=result
End Function
' -------------------------------------
Sub SetKill(Handle)
nproc=nproc+1
redim preserve ProcNum(nproc),ProcState(nproc)
ProcNum(nproc-1)=handle
ProcState(nproc)=1
End Sub
' -------------------------------------
Function GetStateKill(ID)
GetStateKill=0
For i = 0 To nproc-1
 If ProcNum(i)=ID Then
  GetStateKill=ProcState(i)
  exit function
  End If
 Next
End Function
' -------------------------------------
Sub CancelKill(ID)
For i = 0 To nproc-1
 If ProcNum(i)=ID Then
  ProcState(i)=0
  exit sub
  End If
 Next
End Sub
' -------------------------------------
0
Rejoignez-nous