So if you put this script in a copy of dvd from windows server 2016, it will generate folders for wim editing and command according to the actual folder the script is executed in
Simply put: copy this script in dvd root folder copy and run it, folder names should be fine
wim editing windows 10 and server 2016
This script will:
Create folder in C:\ to mount .wim file, split it etc.
List all commands necessary to split this image for a usb key (with same folders)
=============================wimediting.vbs ===============
'=== Ultimate dynamic web interface 2.0
'=== this script:
'=== generate dynamically a web interface to manage virtually anything
'=== control (left frame), input (middle frame), and output (bottom frame) from vbs/wsh (windows host scripts)
'=== the first version was a simple interface made by a programmer
'=== the second version have more explanations
'=== more dynamism than ever
'=== more functions to clean up main loop code
'=== easier array display coding to add stuff more easily
'=== MDB (access type database) management (creation, edition, search/edit)
'=== futur: mdb import, mdb export, sql sync, excel export
'=== by: SergeFournier(at)hotmail.com
'=== tested on windows vista 64, internet explorer 7
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objshe = CreateObject("WScript.Shell")
Set objNet = CreateObject("WScript.Network")
set objsheapp = wscript.CreateObject("Shell.Application") '=== application (permission for execution)
Const hkcr = &H80000000 'HKEY_CLASSES_ROOT
Const HKCU = &H80000001 'HKEY_CURRENT_USER
Const hklm = &H80000002 'HKEY_LOCAL_MACHINE
Const hku = &H80000003 'HKEY_USERS
Const hkcc = &H80000005 'HKEY_CURRENT_CONFIG
dim allara(10,10)
dim alltab(10)
DIM ordcol(10,10)
'=== actual drive, actual directory, and "\"
thepath=WScript.ScriptFullName
p = instrRev(thepath,"\")
basedir = left(thepath,p)
filnam = right(thepath,len(thepath)-p)
arr01 = split(basedir, "\")
basedir2 = arr01(0) & "\" & arr01(1) '=== will work for home and work folder
arr01 = split(filnam, ".")
scriptname01 = arr01(0)
'=== windows dir
WinDir = objfso.GetSpecialFolder(0)
'=== restart the script in 32 bits if we are on a 64 bits system
'=== (databases drivers issues)
a64 = windir & "\syswow64\wscript.exe"
Elevatedpriv01 = 0
if objFSO.fileEXISTS(a64) and instr(lcase(wscript.fullname),"syswow64")=0 then
'=== 64 bits system
a = """" & a64 & """ """ & basedir & filnam & """"
if Elevatedpriv01 = 1 then
'msgbox(a)
'objSheapp.ShellExecute "wscript.exe ", Chr(34) & ser & "\users\_03_vista.VBS" & Chr(34), "", "runas", 1
'objSheapp.ShellExecute a, "", "runas", 1
'wscript.quit
else
objshe.Run a,0, false
wscript.quit
end if
end if
'=== log everything in a file
logall = 1
'=== edit mode 0=off 1=on
'=== if edtmod = 1 every results will be in editable html boxes
edtmod = 0
totrec = 0
offset = 0
'=== no second search in the lower frame (fbot)
'=== this mean the search button is removed when table is generated
secseatag=0
dim tabnam,aratit,ara01,edtmod,offset,maxoff,myarray,component, strsearch, tab,sel,whe,objcon,tabnam2,ooper,wwild
priara = array(_
"<input type=""button"" onClick=""javascript:print()"" value=""Print""/><br><br>")
lefara = array(_
"<body background=""" & basedir & "images_interface\fond_gauche.jpg"">")
midara = array(_
"<body background=""" & basedir & "images_interface\fond_gris.jpg"">")
botara = array(_
"<body background=""" & basedir & "images_interface\fond_gris.jpg"">")
if logall=1 then
'=== debug log
file02 = basedir & left(filnam, instr(filnam, ".")-1) & "_log.txt"
on error resume next
Set Fil02 = objFSo.OpenTextFile(file02, 2, true)
on error goto 0
end if
'============================================== main loop =============================================
'=== name of the user logged in window (network or not)
usenam=lcase(objnet.username)
'=== maximum row in the grid when more than the max
'=== we display only this number and a button "precedent" and "next" to swtich page
maxoff=15 '=== since 0 is included, 24 = 25 record
'=== menu items on left side (control side, frame: flef)
'= arabutnam: name of button, purely programmation name, used later to execute functions in main loop
'= arabutdes: description of button, text inside it actually
'= aradepnam: departement name, each departement (Section) is separated by a space
'= aradepcol: color of departement, blue = computer, brown = accounting, etc will follow a standard on internet (vague)
'=== button at the start for control frame (flef object)
'=== you can add as many buttons as you want, it's all dynamic (extendable)
if logall=1 then
fil02.WriteLine date & " " & time & " START"
end if
x=0
ReDim Preserve arabutnam(x): ReDim Preserve arabutdes(x): ReDim Preserve aradepnam(x): ReDim Preserve aradepcol(x)
arabutnam(x)="getwiminfo_win10"
arabutdes(x)="Get WIM info from windows 10 file"
aradepnam(x)="WIN10"
aradepcol(x)="cccccc"
x=x+1
ReDim Preserve arabutnam(x): ReDim Preserve arabutdes(x): ReDim Preserve aradepnam(x): ReDim Preserve aradepcol(x)
arabutnam(x)="delindex_win10"
arabutdes(x)="Delete an index (windows version) from wim win10"
aradepnam(x)="WIN10"
aradepcol(x)="cccccc"
x=x+1
ReDim Preserve arabutnam(x): ReDim Preserve arabutdes(x): ReDim Preserve aradepnam(x): ReDim Preserve aradepcol(x)
arabutnam(x)="extractwim_win10"
arabutdes(x)="Extract source\install.wim to folder (mount)"
aradepnam(x)="WIN10"
aradepcol(x)="cccccc"
x=x+1
ReDim Preserve arabutnam(x): ReDim Preserve arabutdes(x): ReDim Preserve aradepnam(x): ReDim Preserve aradepcol(x)
arabutnam(x)="addpackage_win10"
arabutdes(x)="Add PACKAGE (msu) to extracted wim image"
aradepnam(x)="WIN10"
aradepcol(x)="cccccc"
x=x+1
ReDim Preserve arabutnam(x): ReDim Preserve arabutdes(x): ReDim Preserve aradepnam(x): ReDim Preserve aradepcol(x)
arabutnam(x)="adddriver_win10"
arabutdes(x)="Add driver to extracted wim image"
aradepnam(x)="WIN10"
aradepcol(x)="cccccc"
x=x+1
ReDim Preserve arabutnam(x): ReDim Preserve arabutdes(x): ReDim Preserve aradepnam(x): ReDim Preserve aradepcol(x)
arabutnam(x)="commitwim_win10"
arabutdes(x)="unmount /commit wim image"
aradepnam(x)="WIN10"
aradepcol(x)="cccccc"
x=x+1
ReDim Preserve arabutnam(x): ReDim Preserve arabutdes(x): ReDim Preserve aradepnam(x): ReDim Preserve aradepcol(x)
arabutnam(x)="splitwim_win10"
arabutdes(x)="SPLIT wim image (2gig) or merge"
aradepnam(x)="WIN10"
aradepcol(x)="cccccc"
'====================== winpe
x=x+1
ReDim Preserve arabutnam(x): ReDim Preserve arabutdes(x): ReDim Preserve aradepnam(x): ReDim Preserve aradepcol(x)
arabutnam(x)="getwiminfo_winpe"
arabutdes(x)="Get WIM info from winPE file"
aradepnam(x)="WINPE"
aradepcol(x)="cccccc"
x=x+1
ReDim Preserve arabutnam(x): ReDim Preserve arabutdes(x): ReDim Preserve aradepnam(x): ReDim Preserve aradepcol(x)
arabutnam(x)="extractwim_winpe"
arabutdes(x)="Extract WIM file to directory (mount-wim)"
aradepnam(x)="WINPE"
aradepcol(x)="cccccc"
x=x+1
ReDim Preserve arabutnam(x): ReDim Preserve arabutdes(x): ReDim Preserve aradepnam(x): ReDim Preserve aradepcol(x)
arabutnam(x)="adddriverwim_winpe"
arabutdes(x)="Add driver to WIM directory (add-driver)"
aradepnam(x)="WINPE"
aradepcol(x)="cccccc"
x=x+1
ReDim Preserve arabutnam(x): ReDim Preserve arabutdes(x): ReDim Preserve aradepnam(x): ReDim Preserve aradepcol(x)
arabutnam(x)="unmountcommitwim_winpe"
arabutdes(x)="Compress WIM directory to file (unmount-wim)"
aradepnam(x)="WINPE"
aradepcol(x)="cccccc"
x=x+1
ReDim Preserve arabutnam(x): ReDim Preserve arabutdes(x): ReDim Preserve aradepnam(x): ReDim Preserve aradepcol(x)
arabutnam(x)="clrframes"
arabutdes(x)="Clear Frames"
aradepnam(x)="OTHER"
aradepcol(x)="cccccc"
x=x+1
ReDim Preserve arabutnam(x): ReDim Preserve arabutdes(x): ReDim Preserve aradepnam(x): ReDim Preserve aradepcol(x)
arabutnam(x)="info"
arabutdes(x)="Information/Help"
aradepnam(x)="OTHER"
aradepcol(x)="cccccc"
x=x+1
ReDim Preserve arabutnam(x): ReDim Preserve arabutdes(x): ReDim Preserve aradepnam(x): ReDim Preserve aradepcol(x)
arabutnam(x)="quit01"
arabutdes(x)="Quitter"
aradepnam(x)="All"
aradepcol(x)="cccccc"
'=== last departement for button sections spacing
lasdep=""
'=== web interface, internet explorer
'=== set the objects before calling functions, so they are global objects/variables, accessibles in all the program
set oIE = wscript.CreateObject("InternetExplorer.Application", "IE_")
dim flef, fmid, fbot
'=== title of internet explorer window
doctit = "titre de la page"
'=== title to display inside the left frame (control frame, flef object)
maitit = "Troubleshooting interface<br><br>STAS 45834"'=== title inside the left frame
maitit="<br><br><br><br>"
'=== create the main web interface with 3 frames, objects: flef, fmid, fbot
a = crewebmai(oie, doctit, maitit, arabutnam, arabutdes, aradepnam, aradepcol)
if instr(lcase(wscript.fullname),"syswow64") = 0 then
d = wrifra(flef, "Platform: 64 bits" & "<br>", 1)
else
d = wrifra(flef, "Platform: 32 bits" & "<br>", 1)
end if
'=== defaut menu option for certain name logged
'=== example: a certain user will use always the same function
'=== so the interface will start, by executing this function at first, not an empty frame
'=== simply enter the name of the button that should be pressed for this user when interface start
if usenam="wildboy" or usenam="fournier.serge" then
'=== defaut choice when program start
'resbutlefstr = "stristas"
end if
'=== sub to call for each button
'=== here we define a sub to be called when a button in the web page is pressed
Do While (oIE.Busy)
wscript.sleep 50
loop
do while oie.readystate<>4
wscript.sleep 50
loop
'=== set up a return value on click of each button on the left frame
'=== the returned value is the name (programmable name) of each button (arabutnam)
'=== later any action will be taken according to this value
'=== i use this method because i dont want to call a sub when a button is pressed
'=== to remain in a loop for the main program, that is standard procedure in programming (to have a main loop)
for i=0 to ubound(arabutnam)
flef.forms(0).elements(arabutnam(i)).onclick = getref("buttonlef")
next
'=== we also chek the key presse in each frame
'=== we do this cause we want "enter" key to be used instead of pressing "ok" button with the mouse
set flef.onkeypress = GetRef("Checklef")
set fmid.onkeypress = GetRef("Checkmid")
set fbot.onkeypress = GetRef("Checkbot")
'=== if bready = true, it mean they closed internet explorer, see the sub on internet explorer closing later in this code
'=== we have to chek this value often to stop the wscript.exe from interpreting this code, when internet explorer is closed
bReady=false
resbutlefstr = ""
resbutmidstr = ""
resbutbotstr = ""
reskeylef = 0
reskeymid = 0
reskeybot = 0
resblulefstr =""
resblumidstr =""
resblubotstr =""
resblulefid = ""
resblumidid = ""
resblubotid = ""
resblulefval =""
resblumidval =""
resblubotval =""
WScript.sleep(50) ' .1 seconds
'=== main loop, infinite
'=== unless someone press QUIT button
'=== or close internet explorer (bready = true)
h = "" '=== html content, global variable must be in main loop
level01 = 0
desmountfolder01 = "_mounted"
desmountfolder02 = "_mounted"
desmountfolder03 = "_wim_splitted"
desmountfolder04 = "_wim_notsplitted"
PACKAGEPATH01 = "C:\win10una1703frapro_work_todo"
imagename01 = "Microsoft Windows PE (x64)"
do
''''''''''''''''''''''''''''''''''''''''''''''''''
' get wim info
''''''''''''''''''''''''''''''''''''''''''''''''''
if resbutlefstr="getwiminfo_win10" then
a = clefra(array("fmid","fbot"))
resbutlefstr=""
x = 0
redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
distmp(x)="Win file found (win10)" '===== description displayed in front of the field
namtmp(x)="text01" '===== name of variable for programming purpose
deftmp(x)=basedir2 & "\sources\install.wim" '===== default value
typtmp(x)="textbox" '===== type of data: textbox password (futur: more to come)
errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords
buttmp=array("ok","cancel") '===== at the end, there will be an "ok" button and a "cancel" button
a = dynforgen2 (distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)
'=== if internet explorer was not closed (bready), a button was not pressed on left frame, and no excape or cancel in middle frame
if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
'=== get values from input boxes
filename01 = fmid.form01.text01.Value
d = wrifra(fbot, "<br>Index 1 is second image: windows 10 professionnal<br>", 1)
cmd01 = "Dism.exe /Get-WIMinfo /WimFile:" & filename01 & " /Index:1"
d = wrifra(fbot, "<br>" & cmd01, 1)
set objPing = objShe.Exec(cmd01)
'=== extract text from dos command execution
strPingOut = objPing.StdOut.ReadAll
strpingout = replace(strpingout, chr(13)+chr(10), "<br>")
fbot.WriteLn("<br>" & strPingOut)
fbot.WriteLn("<br>")
for i = 1 to len(strpingout)
c = mid(strpingout,i,1)
if asc(c) = 13 then
fbot.WriteLn("<br>found 13")
end if
if asc(c) = 10 then
fbot.WriteLn("<br>found 10")
end if
next
if instr(LCase(strPingOut), "reply") or instr(LCase(strPingOut), "ponse de") then
flag = TRUE
else
flag = FALSE
end if
'fPingTest = flag
if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
fbot.WriteLn("<br>FIN")
end if
end if
reskeymid=0
resbutmidstr=""
reskeylef=0
end if
''''''''''''''''''''''''''''''''''''''''''''''''''
' delete index in image
''''''''''''''''''''''''''''''''''''''''''''''''''
if resbutlefstr="delindex_win10" then
tit = "Delete index 2 in wim image"
a = clefra(array("fmid","fbot"))
resbutlefstr=""
x = 0
redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
distmp(x)="Win file found (win10)" '===== description displayed in front of the field
namtmp(x)="text01" '===== name of variable for programming purpose
'=== get first folder of basedir
deftmp(x)=basedir2 & "\sources\install.wim" '===== default value
typtmp(x)="textbox" '===== type of data: textbox password (futur: more to come)
errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords
buttmp=array("ok","cancel") '===== at the end, there will be an "ok" button and a "cancel" button
a = dynforgen2 (distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)
'=== if internet explorer was not closed (bready), a button was not pressed on left frame, and no excape or cancel in middle frame
if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
'=== get values from input boxes
filename01 = fmid.form01.text01.Value
cmd01 = "dism /Delete-Image /ImageFile:" & filename01 & " /Index:2"
d = wrifra(fbot, "<br>" & cmd01, 1)
set objPing = objShe.Exec(cmd01)
'=== extract text from dos command execution
strPingOut = objPing.StdOut.ReadAll
strpingout = replace(strpingout, chr(13)+chr(10), "<br>")
fbot.WriteLn("<br>" & strPingOut)
fbot.WriteLn("<br>")
for i = 1 to len(strpingout)
c = mid(strpingout,i,1)
if asc(c) = 13 then
fbot.WriteLn("<br>found 13")
end if
if asc(c) = 10 then
fbot.WriteLn("<br>found 10")
end if
next
if instr(LCase(strPingOut), "reply") or instr(LCase(strPingOut), "ponse de") then
flag = TRUE
else
flag = FALSE
end if
'fPingTest = flag
if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
fbot.WriteLn("<br>FIN")
end if
end if
reskeymid=0
resbutmidstr=""
reskeylef=0
end if
''''''''''''''''''''''''''''''''''''''''''''''''''
' extract image
''''''''''''''''''''''''''''''''''''''''''''''''''
if resbutlefstr="extractwim_win10" then
a = clefra(array("fmid","fbot"))
resbutlefstr=""
x = 0
redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
distmp(x)="Win file found (win10)" '===== description displayed in front of the field
namtmp(x)="text01" '===== name of variable for programming purpose
'=== get first folder of basedir
deftmp(x)=basedir2 & "\sources\install.wim" '===== default value
typtmp(x)="textbox" '===== type of data: textbox password (futur: more to come)
errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords
x = x + 1
redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
distmp(x)="Win temp dir (win10)" '===== description displayed in front of the field
namtmp(x)="text02" '===== name of variable for programming purpose
deftmp(x)=basedir2 & desmountfolder01 '===== default value
typtmp(x)="textbox" '===== type of data: textbox password (futur: more to come)
errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords
buttmp=array("ok","cancel") '===== at the end, there will be an "ok" button and a "cancel" button
a = dynforgen2 (distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)
'=== if internet explorer was not closed (bready), a button was not pressed on left frame, and no excape or cancel in middle frame
if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
'=== get values from input boxes
filename01 = fmid.form01.text01.Value
desmountfolder01 = fmid.form01.text02.Value
'caca
'=== see des01 variable for temp folder containing win10 image
if not objFSO.folderEXISTS(desmountfolder01) then
d = wrifra(fbot, "<br>CREATING folder: " & desmountfolder01, 1)
objFSO.CreateFolder (desmountfolder01)
else
'=== already exist
end if
cmd01 = "Dism /Mount-WIM /WimFile:" & basedir2 & desmountfolder04 & "\install.wim /Name:""Windows 10 pro"" /MountDir:" & desmountfolder01
d = wrifra(fbot, "<br><br>" & cmd01, 1)
cmd01 = "Dism /Mount-WIM /WimFile:" & filename01 & " /Name:""Windows 10 pro"" /MountDir:" & desmountfolder01
d = wrifra(fbot, "<br><br>" & cmd01, 1)
set objPing = objShe.Exec(cmd01)
'=== extract text from dos command execution
strPingOut = objPing.StdOut.ReadAll
strpingout = replace(strpingout, chr(13)+chr(10), "<br>")
fbot.WriteLn("<br>" & strPingOut)
fbot.WriteLn("<br>")
for i = 1 to len(strpingout)
c = mid(strpingout,i,1)
if asc(c) = 13 then
fbot.WriteLn("<br>found 13")
end if
if asc(c) = 10 then
fbot.WriteLn("<br>found 10")
end if
next
if instr(LCase(strPingOut), "reply") or instr(LCase(strPingOut), "ponse de") then
flag = TRUE
else
flag = FALSE
end if
'fPingTest = flag
if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
fbot.WriteLn("<br>FIN")
end if
end if
reskeymid=0
resbutmidstr=""
reskeylef=0
end if
''''''''''''''''''''''''''''''''''''''''''''''''''
' add patch windows 10
''''''''''''''''''''''''''''''''''''''''''''''''''
if resbutlefstr="addpackage_win10" then
tit = "add PACKAGE to windows 10 image"
a = clefra(array("fmid","fbot"))
resbutlefstr=""
x = 0
redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
distmp(x)="mounted image folder (win10)" '===== description displayed in front of the field
namtmp(x)="text01" '===== name of variable for programming purpose
deftmp(x)=basedir2 & desmountfolder01 '===== default value
typtmp(x)="textbox" '===== type of data: textbox password (futur: more to come)
errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords
x = x + 1
redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
distmp(x)="drivers path win10" '===== description displayed in front of the field
namtmp(x)="text02" '===== name of variable for programming purpose
deftmp(x)=PACKAGEPATH01 '===== default value
typtmp(x)="textbox" '===== type of data: textbox password (futur: more to come)
errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords
buttmp=array("ok","cancel") '===== at the end, there will be an "ok" button and a "cancel" button
a = dynforgen2 (distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)
'=== value
'=== chek if the file already exist
Set objFol01=objFSO.GetFolder(PACKAGEPATH01)'=== dir
Set objfol02=objFol01.files '=== files
x=0
redim arr02(0)
dimnum=1
For Each objFil in objFol02
filnam=objfil.name
filnam=lcase(filnam)
if right(filnam,4)=".msu" then
redim preserve arr02(x)
arr02(x)=filnam
d = wrifra(fbot, "<br>" & filnam, 1)
x=x+1
end if
next
d = wrifra(fbot, "<br>", 1)
'=== if internet explorer was not closed (bready), a button was not pressed on left frame, and no excape or cancel in middle frame
if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
'=== get values from input boxes
filename01 = fmid.form01.text01.Value
filename02 = fmid.form01.text02.Value
'Dism /Add-Package /Image:C:\mount\Windows /PackagePath:C:\MSU\Windows10-KBxxxxxxx-x64.msu /LogPath:AddPackage.log
for i = 0 to ubound(arr02)
cmd01 = "Dism /Add-Package /Image:" & desmountfolder01 & " /PackagePath:" & packagepath01 & "\" & arr02(i) & " /logpath:%temp%addpackage_" & arr02(i) & ".log"
d = wrifra(fbot, "<br>" & cmd01, 1)
next
set objPing = objShe.Exec(cmd01)
'=== extract text from dos command execution
strPingOut = objPing.StdOut.ReadAll
strpingout = replace(strpingout, chr(13)+chr(10), "<br>")
fbot.WriteLn("<br>" & strPingOut)
fbot.WriteLn("<br>")
for i = 1 to len(strpingout)
c = mid(strpingout,i,1)
if asc(c) = 13 then
fbot.WriteLn("<br>found 13")
end if
if asc(c) = 10 then
fbot.WriteLn("<br>found 10")
end if
next
if instr(LCase(strPingOut), "reply") or instr(LCase(strPingOut), "ponse de") then
flag = TRUE
else
flag = FALSE
end if
'fPingTest = flag
if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
fbot.WriteLn("<br>FIN")
end if
end if
reskeymid=0
resbutmidstr=""
reskeylef=0
end if
''''''''''''''''''''''''''''''''''''''''''''''''''
' add driver to wim
''''''''''''''''''''''''''''''''''''''''''''''''''
if resbutlefstr="adddriver_win10" then
a = clefra(array("fmid","fbot"))
resbutlefstr=""
x = 0
redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
distmp(x)="mounted image folder (win10)" '===== description displayed in front of the field
namtmp(x)="text01" '===== name of variable for programming purpose
deftmp(x)=desmountfolder01 '===== default value
typtmp(x)="textbox" '===== type of data: textbox password (futur: more to come)
errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords
x = x + 1
redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
distmp(x)="drivers path win10" '===== description displayed in front of the field
namtmp(x)="text02" '===== name of variable for programming purpose
deftmp(x)=driverspath01 '===== default value
typtmp(x)="textbox" '===== type of data: textbox password (futur: more to come)
errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords
buttmp=array("ok","cancel") '===== at the end, there will be an "ok" button and a "cancel" button
a = dynforgen2 (distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)
'=== if internet explorer was not closed (bready), a button was not pressed on left frame, and no excape or cancel in middle frame
if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
'=== get values from input boxes
filename01 = fmid.form01.text01.Value
filename02 = fmid.form01.text02.Value
cmd01 = "Dism /Image:" & desmountfolder01 & " /Add-Driver /Driver:" & driverspath01 & " /Recurse"
d = wrifra(fbot, "<br>" & cmd01, 1)
set objPing = objShe.Exec(cmd01)
'=== extract text from dos command execution
strPingOut = objPing.StdOut.ReadAll
strpingout = replace(strpingout, chr(13)+chr(10), "<br>")
fbot.WriteLn("<br>" & strPingOut)
fbot.WriteLn("<br>")
for i = 1 to len(strpingout)
c = mid(strpingout,i,1)
if asc(c) = 13 then
fbot.WriteLn("<br>found 13")
end if
if asc(c) = 10 then
fbot.WriteLn("<br>found 10")
end if
next
if instr(LCase(strPingOut), "reply") or instr(LCase(strPingOut), "ponse de") then
flag = TRUE
else
flag = FALSE
end if
'fPingTest = flag
if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
fbot.WriteLn("<br>FIN")
end if
end if
reskeymid=0
resbutmidstr=""
reskeylef=0
end if
'''''''''''''''''''''''''''''''''''''''''''''''''''
' win10 unmount commit wim image
'''''''''''''''''''''''''''''''''''''''''''''''''''
if resbutlefstr="commitwim_win10" then
a = clefra(array("fmid","fbot"))
resbutlefstr=""
tit = "Commit wim image"
x = 0
redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
distmp(x)="Win file found (win10)" '===== description displayed in front of the field
namtmp(x)="text01" '===== name of variable for programming purpose
'=== get first folder of basedir
deftmp(x)=basedir2 & "\sources\install.wim" '===== default value
typtmp(x)="textbox" '===== type of data: textbox password (futur: more to come)
errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords
x = x + 1
redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
distmp(x)="Win temp dir (win10)" '===== description displayed in front of the field
namtmp(x)="text02" '===== name of variable for programming purpose
deftmp(x)=basedir2 & desmountfolder01 '===== default value
typtmp(x)="textbox" '===== type of data: textbox password (futur: more to come)
errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords
buttmp=array("ok","cancel") '===== at the end, there will be an "ok" button and a "cancel" button
a = dynforgen2 (distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)
'=== if internet explorer was not closed (bready), a button was not pressed on left frame, and no excape or cancel in middle frame
if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
'=== get values from input boxes
filename01 = fmid.form01.text01.Value
desmountfolder01 = fmid.form01.text02.Value
cmd01 = "Dism /Unmount-WIM /MountDir:" & desmountfolder01 & " /Commit"
d = wrifra(fbot, "<br>" & cmd01, 1)
cmd01 = "Dism /Unmount-WIM /MountDir:" & desmountfolder01 & " /Commit"
d = wrifra(fbot, "<br>" & cmd01, 1)
set objPing = objShe.Exec(cmd01)
'=== extract text from dos command execution
strPingOut = objPing.StdOut.ReadAll
strpingout = replace(strpingout, chr(13)+chr(10), "<br>")
fbot.WriteLn("<br>" & strPingOut)
fbot.WriteLn("<br>")
for i = 1 to len(strpingout)
c = mid(strpingout,i,1)
if asc(c) = 13 then
fbot.WriteLn("<br>found 13")
end if
if asc(c) = 10 then
fbot.WriteLn("<br>found 10")
end if
next
if instr(LCase(strPingOut), "reply") or instr(LCase(strPingOut), "ponse de") then
flag = TRUE
else
flag = FALSE
end if
'fPingTest = flag
if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
fbot.WriteLn("<br>FIN")
end if
end if
reskeymid=0
resbutmidstr=""
reskeylef=0
end if
'''''''''''''''''''''''''''''''''''''''''''''
' win10 split image
'''''''''''''''''''''''''''''''''''''''''''''
if resbutlefstr="splitwim_win10" then
tit = "SPLIT wim image"
a = clefra(array("fmid","fbot"))
resbutlefstr=""
x = 0
redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
distmp(x)="Win file found (win10)" '===== description displayed in front of the field
namtmp(x)="text01" '===== name of variable for programming purpose
'=== get first folder of basedir
deftmp(x)=basedir2 & "\sources\install.wim" '===== default value
typtmp(x)="textbox" '===== type of data: textbox password (futur: more to come)
errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords
x = x + 1
redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
distmp(x)="Win temp dir (win10)" '===== description displayed in front of the field
namtmp(x)="text02" '===== name of variable for programming purpose
deftmp(x)=basedir2 & desmountfolder03 '===== default value
typtmp(x)="textbox" '===== type of data: textbox password (futur: more to come)
errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords
x = x + 1
redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
distmp(x)="Win file found (win10)" '===== description displayed in front of the field
namtmp(x)="text03" '===== name of variable for programming purpose
'=== get first folder of basedir
deftmp(x)=basedir2 & "\sources\install*.swm" '===== default value
typtmp(x)="textbox" '===== type of data: textbox password (futur: more to come)
errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords
x = x + 1
redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
distmp(x)="Win temp dir (win10)" '===== description displayed in front of the field
namtmp(x)="text04" '===== name of variable for programming purpose
deftmp(x)=basedir2 & desmountfolder04 '===== default value
typtmp(x)="textbox" '===== type of data: textbox password (futur: more to come)
errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords
buttmp=array("ok","cancel") '===== at the end, there will be an "ok" button and a "cancel" button
a = dynforgen2 (distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)
'=== if internet explorer was not closed (bready), a button was not pressed on left frame, and no excape or cancel in middle frame
if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
'=== get values from input boxes
filename01 = fmid.form01.text01.Value
desmountfolder03 = fmid.form01.text02.Value
filenameswm01 = fmid.form01.text03.Value
desmountfolder04 = fmid.form01.text04.Value
'=== create working folders
if not objFSO.folderEXISTS(desmountfolder03) then
d = wrifra(fbot, "<br>CREATING folder: " & desmountfolder03, 1)
objFSO.CreateFolder (desmountfolder03)
else
'=== already exist
end if
if not objFSO.folderEXISTS(desmountfolder04) then
d = wrifra(fbot, "<br>CREATING folder: " & desmountfolder04, 1)
objFSO.CreateFolder (desmountfolder04)
else
'=== already exist
end if
'=== unsplit
cmd01 = "DISM /Export-Image /sourceimagefile:" & replace(filenameswm01, "*", "") & " /SWMFile:" & filenameswm01 & " /Sourceindex:1 /DestinationImageFile:" & desmountfolder04 & "\install.wim"
d = wrifra(fbot, "<br><br>MERGE swm<br>" & cmd01, 1)
cmd01 = "dism /Split-Image /ImageFile:" & desmountfolder04 & "\install.wim /SWMFile:" & desmountfolder03 & "\install.swm /FileSize:1900"
d = wrifra(fbot, "<br><br>SPLIT wim<br>" & cmd01, 1)
d = wrifra(fbot, "<br><br>ORIGINAL DVD SPLIT wim", 1)
cmd01 = "dism /Split-Image /ImageFile:" & filename01 & " /SWMFile:" & desmountfolder03 & "\install.swm /FileSize:1900"
d = wrifra(fbot, "<br><br>SPLIT wim<br>" & cmd01, 1)
'DISM /Export-Image /sourceimagefile:install.swm /SWMFile:install*.swm /Sourceindex:1 DestinationImageFile:installwim.wim
test= 1
if test=0 then
set objPing = objShe.Exec(cmd0122)
strPingOut = objPing.StdOut.ReadAll
strpingout = replace(strpingout, chr(13)+chr(10), "<br>")
fbot.WriteLn("<br>" & strPingOut)
fbot.WriteLn("<br>")
for i = 1 to len(strpingout)
c = mid(strpingout,i,1)
if asc(c) = 13 then
fbot.WriteLn("<br>found 13")
end if
if asc(c) = 10 then
fbot.WriteLn("<br>found 10")
end if
next
if instr(LCase(strPingOut), "reply") or instr(LCase(strPingOut), "ponse de") then
flag = TRUE
else
flag = FALSE
end if
'fPingTest = flag
end if
if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
d = wrifra(fbot, "<br><br>FIN", 1)
end if
end if
reskeymid=0
resbutmidstr=""
reskeylef=0
end if
'''''''''''''''''''''''''''''''''''''''''''''
' wim win PE get info
'''''''''''''''''''''''''''''''''''''''''''''
if resbutlefstr="getwiminfo_winpe" then
a = clefra(array("fmid","fbot"))
resbutlefstr=""
x = 0
redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
distmp(x)="Wim file found (winPE)" '===== description displayed in front of the field
namtmp(x)="text01" '===== name of variable for programming purpose
deftmp(x)=basedir2 & "\sources\boot.wim" '===== default value
typtmp(x)="textbox" '===== type of data: textbox password (futur: more to come)
errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords
x = x + 1
redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
distmp(x)="wim temp dir (winPE)" '===== description displayed in front of the field
namtmp(x)="text02" '===== name of variable for programming purpose
deftmp(x)=desmountfolder02 '===== default value
typtmp(x)="textbox" '===== type of data: textbox password (futur: more to come)
errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords
buttmp=array("ok","cancel") '===== at the end, there will be an "ok" button and a "cancel" button
a = dynforgen2 (distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)
'=== if internet explorer was not closed (bready), a button was not pressed on left frame, and no excape or cancel in middle frame
if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
'=== get values from input boxes
filename01 = fmid.form01.text01.Value
filename02 = fmid.form01.text02.Value
cmd01 = "Dism.exe /Get-WIMinfo /WimFile:" & filename01 & " /Index:1"
'cmd01 = "Dism.exe /Mount-WIM /WimFile:" & filename01 & " /Name:"Windows 7 PROFESSIONAL" "
d = wrifra(fbot, "<br>" & cmd01, 1)
set objPing = objShe.Exec(cmd01)
strPingOut = objPing.StdOut.ReadAll
strpingout = replace(strpingout, chr(13)+chr(10), "<br>")
fbot.WriteLn("<br>" & strPingOut)
fbot.WriteLn("<br>")
for i = 1 to len(strpingout)
c = mid(strpingout,i,1)
if asc(c) = 13 then
fbot.WriteLn("<br>found 13")
end if
if asc(c) = 10 then
fbot.WriteLn("<br>found 10")
end if
next
if instr(LCase(strPingOut), "reply") or instr(LCase(strPingOut), "ponse de") then
flag = TRUE
else
flag = FALSE
end if
'fPingTest = flag
if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
d = wrifra(fbot, "<br>FIN", 1)
end if
end if
reskeymid=0
resbutmidstr=""
reskeylef=0
end if
'''''''''''''''''''''''''''''''''''''''''''''
' wim win PE extract wim
'''''''''''''''''''''''''''''''''''''''''''''
if resbutlefstr="extractwim_winpe" then
tit = "Extract winPE image"
a = clefra(array("fmid","fbot"))
resbutlefstr=""
x = 0
redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
distmp(x)="Win file found (winpe)" '===== description displayed in front of the field
namtmp(x)="text01" '===== name of variable for programming purpose
deftmp(x)=basedir2 & "\sources\boot.wim" '===== default value
typtmp(x)="textbox" '===== type of data: textbox password (futur: more to come)
errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords
x = x + 1
redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
distmp(x)="name of the index (image name)" '===== description displayed in front of the field
namtmp(x)="text02" '===== name of variable for programming purpose
deftmp(x)=imagename01 '===== default value
typtmp(x)="textbox" '===== type of data: textbox password (futur: more to come)
errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords
x = x + 1
redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
distmp(x)="Local destination folder" '===== description displayed in front of the field
namtmp(x)="text03" '===== name of variable for programming purpose
deftmp(x)=basedir2 & desmountfolder02 '===== default value
typtmp(x)="textbox" '===== type of data: textbox password (futur: more to come)
errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords
buttmp=array("ok","cancel") '===== at the end, there will be an "ok" button and a "cancel" button
a = dynforgen2 (distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)
'=== if internet explorer was not closed (bready), a button was not pressed on left frame, and no excape or cancel in middle frame
if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
'=== get values from input boxes
filename01 = fmid.form01.text01.Value
imagename01 = fmid.form01.text02.Value
desmountfolder02 = fmid.form01.text03.Value
if not objFSO.folderEXISTS(desmountfolder02) then
d = wrifra(fbot, "<br>CREATING folder: " & desmountfolder02, 1)
objFSO.CreateFolder (desmountfolder02)
else
'=== already exist
end if
cmd01 = "Dism /Mount-WIM /WimFile:""" & filename01 & """ /Name:""" & imagename01 & """ /MountDir:""" & desmountfolder02 & """"
d = wrifra(fbot, "<br>" & cmd01, 1)
set objPing = objShe.Exec(cmd01)
strPingOut = objPing.StdOut.ReadAll
strpingout = replace(strpingout, chr(13)+chr(10), "<br>")
fbot.WriteLn("<br>" & strPingOut)
fbot.WriteLn("<br>")
for i = 1 to len(strpingout)
c = mid(strpingout,i,1)
if asc(c) = 13 then
fbot.WriteLn("<br>found 13")
end if
if asc(c) = 10 then
fbot.WriteLn("<br>found 10")
end if
next
if instr(LCase(strPingOut), "reply") or instr(LCase(strPingOut), "ponse de") then
flag = TRUE
else
flag = FALSE
end if
'fPingTest = flag
if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
d = wrifra(fbot, "<br>FIN", 1)
end if
end if
reskeymid=0
resbutmidstr=""
reskeylef=0
end if
'''''''''''''''''''''''''''''''''''''''''''''
' wim win PE driver add
'''''''''''''''''''''''''''''''''''''''''''''
if resbutlefstr="adddriverwim_winpe" then
driverspath01 = basedir2 & "\sources\$oem$\$1\_drivers\vmware\pvscsi\"
tit = "Add driver winPE image for boot (Special controller, usually on floppy)"
a = clefra(array("fmid","fbot"))
resbutlefstr=""
x = 0
redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
distmp(x)="Win file found (winpe)" '===== description displayed in front of the field
namtmp(x)="text01" '===== name of variable for programming purpose
deftmp(x)=basedir2 & desmountfolder02 '===== default value
typtmp(x)="textbox" '===== type of data: textbox password (futur: more to come)
errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords
x = x + 1
redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
distmp(x)="name of the index (image name)" '===== description displayed in front of the field
namtmp(x)="text02" '===== name of variable for programming purpose
deftmp(x)=imagename01 '===== default value
typtmp(x)="textbox" '===== type of data: textbox password (futur: more to come)
errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords
x = x + 1
redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
distmp(x)="driver path to add to winpe" '===== description displayed in front of the field
namtmp(x)="text03" '===== name of variable for programming purpose
deftmp(x)=driverspath01 '===== default value
typtmp(x)="textbox" '===== type of data: textbox password (futur: more to come)
errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords
buttmp=array("ok","cancel") '===== at the end, there will be an "ok" button and a "cancel" button
a = dynforgen2 (distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)
'=== if internet explorer was not closed (bready), a button was not pressed on left frame, and no excape or cancel in middle frame
if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
'=== get values from input boxes
desmountfolder02 = fmid.form01.text01.Value
imagename01 = fmid.form01.text02.Value
driverspath01 = fmid.form01.text03.Value
'cmd01 = "Dism /Mount-WIM /WimFile:""" & filename01 & """ /Name:""" & imagename01 & """ /MountDir:""" & desmountfolder02 & """"
'if not objFSO.folderEXISTS(desmountfolder02) then
' d = wrifra(fbot, "<br>CREATING folder: " & desmountfolder02, 1)
' objFSO.CreateFolder (desmountfolder02)
'else
' '=== already exist
'end if
cmd01 = "dism /image:" & desmountfolder02 & " /add-driver:" & driverspath01 & " /recurse"
d = wrifra(fbot, "<br>" & cmd01, 1)
set objPing = objShe.Exec(cmd01)
strPingOut = objPing.StdOut.ReadAll
strpingout = replace(strpingout, chr(13)+chr(10), "<br>")
fbot.WriteLn("<br>" & strPingOut)
fbot.WriteLn("<br>")
for i = 1 to len(strpingout)
c = mid(strpingout,i,1)
if asc(c) = 13 then
fbot.WriteLn("<br>found 13")
end if
if asc(c) = 10 then
fbot.WriteLn("<br>found 10")
end if
next
if instr(LCase(strPingOut), "reply") or instr(LCase(strPingOut), "ponse de") then
flag = TRUE
else
flag = FALSE
end if
'fPingTest = flag
if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
d = wrifra(fbot, "<br>FIN", 1)
end if
end if
reskeymid=0
resbutmidstr=""
reskeylef=0
end if
'''''''''''''''''''''''''''''''''''''''''''''
' wim win PE unmount commit add
'''''''''''''''''''''''''''''''''''''''''''''
if resbutlefstr="unmountcommitwim_winpe" then
tit = "Umount Commit winPE image for boot"
a = clefra(array("fmid","fbot"))
resbutlefstr=""
x = 0
redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
distmp(x)="Win file found (winpe)" '===== description displayed in front of the field
namtmp(x)="text01" '===== name of variable for programming purpose
deftmp(x)=basedir2 & desmountfolder02 '===== default value
typtmp(x)="textbox" '===== type of data: textbox password (futur: more to come)
errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords
x = x + 1
redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
distmp(x)="name of the index (image name)" '===== description displayed in front of the field
namtmp(x)="text02" '===== name of variable for programming purpose
deftmp(x)=imagename01 '===== default value
typtmp(x)="textbox" '===== type of data: textbox password (futur: more to come)
errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords
buttmp=array("ok","cancel") '===== at the end, there will be an "ok" button and a "cancel" button
a = dynforgen2 (distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)
'=== if internet explorer was not closed (bready), a button was not pressed on left frame, and no excape or cancel in middle frame
if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
'=== get values from input boxes
desmountfolder02 = fmid.form01.text01.Value
imagename01 = fmid.form01.text02.Value
cmd01 = "Dism /Unmount-WIM /MountDir:" & desmountfolder02 & " /Commit"
d = wrifra(fbot, "<br>" & cmd01, 1)
set objPing = objShe.Exec(cmd01)
strPingOut = objPing.StdOut.ReadAll
strpingout = replace(strpingout, chr(13)+chr(10), "<br>")
fbot.WriteLn("<br>" & strPingOut)
fbot.WriteLn("<br>")
for i = 1 to len(strpingout)
c = mid(strpingout,i,1)
if asc(c) = 13 then
fbot.WriteLn("<br>found 13")
end if
if asc(c) = 10 then
fbot.WriteLn("<br>found 10")
end if
next
if instr(LCase(strPingOut), "reply") or instr(LCase(strPingOut), "ponse de") then
flag = TRUE
else
flag = FALSE
end if
'fPingTest = flag
if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
d = wrifra(fbot, "<br>FIN", 1)
end if
end if
reskeymid=0
resbutmidstr=""
reskeylef=0
end if
'''''''''''''''''''''''''''''''''''''''''''
' edit xml
'''''''''''''''''''''''''''''''''''''''''''
if resbutlefstr="editxmlfilerecur" then
resbutlefstr = ""
a = clefra(array("fmid","fbot"))
'=== value
'=== chek if the file already exist
Set objFol01=objFSO.GetFolder(basedir)'=== dir
Set objfol02=objFol01.files '=== files
x=0
redim ara01(0)
dimnum=1
For Each objFil in objFol02
filnam=objfil.name
filnam=lcase(filnam)
if right(filnam,4)=".xml" then
redim preserve ara01(x)
ara01(x)=filnam
x=x+1
end if
next
'=== title of the columns
aratit = array("Name of the database")
'=== array to put in table, choice button, header, middle line, bottom line, reload
a = dynbotcho(fmid, "choose the database to edit", aratit, ara01, 1 ,1, 1, 1, 1, 0, "mid")
do
wscript.sleep 100
'=== while we wait for input value (or button press), user can press "escape" key, "cancel" button or close internet explorer
if resbutmidstr="cancel" or reskeymid=27 or bready=true or resbutlefstr<>"" then
'=== if user pressed escape or cancel, we clear the frames
if resbutmidstr="cancel" or reskeymid=27 then
a = clefra(array("fmid","fbot"))
resbutmidstr="cancel"
end if
exit do
end if
loop while resbutmidstr=""
if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
'=== convert the choice made with the button to a number (remove "but" from left side)
a=right(resbutmidstr,len(resbutmidstr)-3)
resbutmidstr=""
'=== get the array that contain the choice in dbnam (database name)
filename01 = ara01(a-1)
end if
'fbot.WriteLn("<br>choice: " & xmlfile01)
'=== open xml file
Set xmlDoc = CreateObject("Microsoft.XMLDOM")
xmlDoc.Async = "False"
xmlDoc.Load(filename01)
'Set objRoot = xmlDoc.documentElement
'=== root node level 0
'Set Node00 = objroot.SelectSingleNode("/*")
node = 1
'=== references
'https://msdn.microsoft.com/en-us/library/system.xml.xmlelement(v=vs.100).aspx
Set colNodes01 = xmlDoc.selectNodes("/*")
dummy = edit_xml_node_recur(colNodes01, basedir & filename01)
'xmlDoc.Save basedir & "\facturation" & numero01 & ".xml"
if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
fmid.WriteLn("<br>FIN")
end if
reskeymid=0
resbutmidstr=""
reskeylef=0
end if
''''''''''''''''''''''''''''''''''''
' xml edit
''''''''''''''''''''''''''''''''''''
if resbutlefstr="editxmlfile" then
a = clefra(array("fmid","fbot"))
resbutlefstr=""
x=0
redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
distmp(x)="xml file name" '===== description displayed in front of the field
namtmp(x)="text01" '===== name of variable for programming purpose
deftmp(x)=basedir & "facturation10.xml" '===== default value
typtmp(x)="textbox" '===== type of data: textbox password (futur: more to come)
errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords
buttmp=array("ok","cancel") '===== at the end, there will be an "ok" button and a "cancel" button
a = dynforgen2 (distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)
'=== if internet explorer was not closed (bready), a button was not pressed on left frame, and no excape or cancel in middle frame
if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
'=== get values from input boxes
filename01 = fmid.form01.text01.Value
'=== open xml file
Set xmlDoc = CreateObject("Microsoft.XMLDOM")
xmlDoc.Async = "False"
xmlDoc.Load(filename01)
'Set objRoot = xmlDoc.documentElement
'=== root node level 0
'Set Node00 = objroot.SelectSingleNode("/*")
node = 1
'=== references
'https://msdn.microsoft.com/en-us/library/system.xml.xmlelement(v=vs.100).aspx
Set colNodes01 = xmlDoc.selectNodes("/*")
dummy = edit_xml_node(colNodes01, basedir & "\facturation" & numero01 & ".xml")
'xmlDoc.Save basedir & "\facturation" & numero01 & ".xml"
if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
fbot.WriteLn("<br>FIN")
end if
end if
reskeymid=0
resbutmidstr=""
reskeylef=0
end if
''''''''''''''''''''''''''''''''''''
' xml display
''''''''''''''''''''''''''''''''''''
if resbutlefstr="displayxmlfile" then
a = clefra(array("fmid","fbot"))
resbutlefstr=""
x=0
redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
distmp(x)="xml file name" '===== description displayed in front of the field
namtmp(x)="text01" '===== name of variable for programming purpose
deftmp(x)=basedir & "facturation9.xml" '===== default value
typtmp(x)="textbox" '===== type of data: textbox password (futur: more to come)
errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords
buttmp=array("ok","cancel") '===== at the end, there will be an "ok" button and a "cancel" button
a = dynforgen2 (distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)
'=== if internet explorer was not closed (bready), a button was not pressed on left frame, and no excape or cancel in middle frame
if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
'=== get values from input boxes
filename01 = fmid.form01.text01.Value
'=== display your answers
'fmid.WriteLn("<br>Answer01: " & text01)
'fmid.WriteLn("<br>Answer02: " & text02)
'=== open xml file
Set xmlDoc = CreateObject("Microsoft.XMLDOM")
xmlDoc.Async = "False"
xmlDoc.Load(filename01)
Set objRoot = xmlDoc.documentElement
'=== root node level 0
'Set Node00 = objroot.SelectSingleNode("/*")
node = 1
'=== references
'https://msdn.microsoft.com/en-us/library/system.xml.xmlelement(v=vs.100).aspx
Set colNodes01 = xmlDoc.selectNodes("/*")
'=== make a big table that will contain other tables inside
h = "<!DOCTYPE html>"
h = h & "<html>"
h = h & "<head>"
h = h & "<style>"
h = h & "table#items01 tr:nth-child(even) {"
h = h & "background-color: #eee;"
h = h & "}"
h = h & "</style>"
h = h & "</head>"
h = h & "<body>"
h = h & "<table width=""100%"" BORDERCOLOR=""black"" class=MsoTableGrid border=1 CELLSPACING=0 cellpadding=2 style='border-collapse:collapse;border: 1px solid black'>"
'=== list all root nodes
For Each objNode01 in colNodes01
h = h & "<tr>" '=== line 1
h = h & "<td>" & objnode01.nodeName & "</td>"
'=== any node under root
for each objnode02 in objnode01.childnodes
h = h & "<tr>" '=== line 1
h = h & "<td></td><td>" & objnode02.nodename & "</td>"
For Each objChild02 In objnode02.childNodes
h = h & "<tr>"
if objchild02.text <>"" then
displaynamefra = objchild02.getattribute("displaynamefra")
h = h & "<td></td><td></td><td>" & objchild02.nodename & "</td><td>" & displaynamefra & "</td><td>" & objchild02.text & "</td>"
'fbot.WriteLn("<td>" & displaynamefra & " " & objchild02.text)
end if
h = h & "</tr>" '=== line 1
next
h = h & "</tr>" '=== line 1
next
node = node+1
h = h & "</tr>" '=== line 1
next
xmlDoc.Save basedir & "\facturation" & numero01 & ".xml"
fbot.WriteLn(h)
fbot.WriteLn("<br>FIN")
end if
reskeymid=0
resbutmidstr=""
reskeylef=0
end if
if resbutlefstr="facturationnew" then
'=== this was a test with multiple button value (one for each line)
a = clefra(array("fmid","fbot"))
resbutlefstr=""
x=0
redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
distmp(x)="Invoice number" '===== description displayed in front of the field
namtmp(x)="text01" '===== name of variable for programming purpose
deftmp(x)="10" '===== default value inside the form (the form will be 20 char long if no value here, but you can enter more)
typtmp(x)="textbox" '===== type of data: textbox password (futur: more to come)
errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords
x=x+1
redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
distmp(x)="Quantitée (heures)" '===== description displayed in front of the field
namtmp(x)="text02" '===== name of variable for programming purpose
deftmp(x)="" '===== default value inside the form (the form will be 20 char long if no value here, but you can enter more)
typtmp(x)="textbox" '===== type of data: textbox password (futur: more to come)
errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords
x=x+1
redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
distmp(x)="Tarif (rate)" '===== description displayed in front of the field
namtmp(x)="text03" '===== name of variable for programming purpose
deftmp(x)="" '===== default value inside the form (the form will be 20 char long if no value here, but you can enter more)
typtmp(x)="textbox" '===== type of data: textbox password (futur: more to come)
errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords
x=x+1
redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
distmp(x)="Référence employeur (bon de commande)" '===== description displayed in front of the field
namtmp(x)="text04" '===== name of variable for programming purpose
deftmp(x)="" '===== default value inside the form (the form will be 20 char long if no value here, but you can enter more)
typtmp(x)="textbox" '===== type of data: textbox password (futur: more to come)
errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords
x=x+1
redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
distmp(x)="Time line" '===== description displayed in front of the field
namtmp(x)="text05" '===== name of variable for programming purpose
deftmp(x)="semaine du 2015" '===== default value inside the form (the form will be 20 char long if no value here, but you can enter more)
typtmp(x)="textbox" '===== type of data: textbox password (futur: more to come)
errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords
buttmp=array("ok","cancel") '===== at the end, there will be an "ok" button and a "cancel" button
a = dynforgen2 (distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)
'=== if internet explorer was not closed (bready), a button was not pressed on left frame, and no excape or cancel in middle frame
if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
'=== get values from input boxes
numero01 = fmid.form01.text01.Value
quantity01 = fmid.form01.text02.Value
rate01 = fmid.form01.text03.Value
billto_reference01 = fmid.form01.text04.Value
timeline01 = fmid.form01.text05.Value
'=== display your answers
'fmid.WriteLn("<br>Answer01: " & text01)
'fmid.WriteLn("<br>Answer02: " & text02)
'reference
'http://www.w3schools.com/xml/dom_element.asp
'fbot.WriteLn("<br>TESTING XML STUFF")
'fbot.WriteLn("<br>directory where xml file is saved: " & basedir)
'=== goal: have an xml list of items to generate an invoice
'=== do not create
'=== create xml
Set xmlDoc = CreateObject("Microsoft.XMLDOM")
Set objRoot = xmlDoc.createElement("facturation")
xmlDoc.appendChild objRoot
'Set objRecord = xmlDoc.createElement("source")
'objRoot.appendChild objRecord
'Set objName = xmlDoc.createElement("nom")
'objName.Text = "Serge Fournier"
'objRecord.appendChild objName
'Set objDate = xmlDoc.createElement("datecreation")
'objDate.Text = Date
'objRecord.appendChild objDate
Set objIntro = xmlDoc.createProcessingInstruction("xml","version='1.0'")
xmlDoc.insertBefore objIntro,xmlDoc.childNodes(0)
xmlDoc.Save basedir & "\facturation" & numero01 & ".xml"
'=== add a record
Set xmlDoc = CreateObject("Microsoft.XMLDOM")
xmlDoc.Async = "False"
xmlDoc.Load(basedir & "\facturation" & numero01 & ".xml")
Set objRoot = xmlDoc.documentElement
Set objRecord = xmlDoc.createElement("bill")
objRoot.appendChild objRecord
Set objFieldValue = xmlDoc.createElement("id")
objfieldvalue.SetAttribute "displaynamefra", "Numéro"
objFieldValue.Text = numero01
objRecord.appendChild objFieldValue
Set objFieldValue = xmlDoc.createElement("date")
objfieldvalue.SetAttribute "displaynamefra", "Date émise"
objFieldValue.Text = date
objRecord.appendChild objFieldValue
Set objFieldValue = xmlDoc.createElement("datedue")
objfieldvalue.SetAttribute "displaynamefra", "Date due"
objFieldValue.Text = date
objRecord.appendChild objFieldValue
Set objFieldValue = xmlDoc.createElement("billto_reference")
objfieldvalue.SetAttribute "displaynamefra", "Référence de l'employeur"
objFieldValue.Text = billto_reference01
objRecord.appendChild objFieldValue
Set objRecord = xmlDoc.createElement("billfrom")
objRoot.appendChild objRecord
objRecord.SetAttribute "displaynamefra", "Contracteur"
Set objFieldValue = xmlDoc.createElement("compagny")
objfieldvalue.SetAttribute "displaynamefra", "Compagnie"
objFieldValue.Text = ""
objRecord.appendChild objFieldValue
Set objFieldValue = xmlDoc.createElement("name")
objfieldvalue.SetAttribute "displaynamefra", "Nom"
objFieldValue.Text = "Serge Fournier"
objRecord.appendChild objFieldValue
Set objFieldValue = xmlDoc.createElement("addressnumber")
objfieldvalue.SetAttribute "displaynamefra", "Adresse"
objFieldValue.Text = ""
objRecord.appendChild objFieldValue
Set objFieldValue = xmlDoc.createElement("addressstreet")
objfieldvalue.SetAttribute "displaynamefra", "Rue"
objFieldValue.Text = ""
objRecord.appendChild objFieldValue
Set objFieldValue = xmlDoc.createElement("addresscity")
objfieldvalue.SetAttribute "displaynamefra", "Ville"
objFieldValue.Text = "Chicoutimi"
objRecord.appendChild objFieldValue
Set objFieldValue = xmlDoc.createElement("addresszip")
objfieldvalue.SetAttribute "displaynamefra", "Code postal"
objFieldValue.Text = ""
objRecord.appendChild objFieldValue
Set objFieldValue = xmlDoc.createElement("addressstate")
objfieldvalue.SetAttribute "displaynamefra", "Province"
objFieldValue.Text = "Québec"
objRecord.appendChild objFieldValue
Set objFieldValue = xmlDoc.createElement("addresscountry")
objfieldvalue.SetAttribute "displaynamefra", "Pays"
objFieldValue.Text = "Canada"
objRecord.appendChild objFieldValue
Set objFieldValue = xmlDoc.createElement("phonehome")
objfieldvalue.SetAttribute "displaynamefra", "Téléphone (residence)"
objFieldValue.Text = ""
objRecord.appendChild objFieldValue
Set objFieldValue = xmlDoc.createElement("phonework")
objfieldvalue.SetAttribute "displaynamefra", "Téléphone (travail)"
objFieldValue.Text = "418-612-7015"
objRecord.appendChild objFieldValue
Set objFieldValue = xmlDoc.createElement("email")
objfieldvalue.SetAttribute "displaynamefra", "Courriel"
objFieldValue.Text = "sergefournier@hotmail.com"
objRecord.appendChild objFieldValue
Set objFieldValue = xmlDoc.createElement("phonecell")
objfieldvalue.SetAttribute "displaynamefra", "Téléphone (cellulaire)"
objFieldValue.Text = ""
objRecord.appendChild objFieldValue
Set objRecord = xmlDoc.createElement("billto")
objRoot.appendChild objRecord
'31, Racine O., First floor, Saguenay ,QC ,Canada ,G7J 1E4
Set objFieldValue = xmlDoc.createElement("compagny")
objfieldvalue.SetAttribute "displaynamefra", "Compagnie"
objFieldValue.Text = "Bloobuzz Studio"
objRecord.appendChild objFieldValue
Set objFieldValue = xmlDoc.createElement("name")
objfieldvalue.SetAttribute "displaynamefra", "Nom"
objFieldValue.Text = "Payables@bloobuzz.com"
objRecord.appendChild objFieldValue
Set objFieldValue = xmlDoc.createElement("addressnumber")
objfieldvalue.SetAttribute "displaynamefra", "Adresse"
objFieldValue.Text = "31"
objRecord.appendChild objFieldValue
Set objFieldValue = xmlDoc.createElement("addressstreet")
objfieldvalue.SetAttribute "displaynamefra", "Rue"
objFieldValue.Text = "Racine Ouest"
objRecord.appendChild objFieldValue
Set objFieldValue = xmlDoc.createElement("addresscity")
objfieldvalue.SetAttribute "displaynamefra", "Ville"
objFieldValue.Text = "Chicoutimi"
objRecord.appendChild objFieldValue
Set objFieldValue = xmlDoc.createElement("addresszip")
objfieldvalue.SetAttribute "displaynamefra", "Code postal"
objFieldValue.Text = "G7J 1E4"
objRecord.appendChild objFieldValue
Set objFieldValue = xmlDoc.createElement("addressstate")
objfieldvalue.SetAttribute "displaynamefra", "Province"
objFieldValue.Text = "Québec"
objRecord.appendChild objFieldValue
Set objFieldValue = xmlDoc.createElement("addresscountry")
objfieldvalue.SetAttribute "displaynamefra", "Pays"
objFieldValue.Text = "Canada"
objRecord.appendChild objFieldValue
Set objFieldValue = xmlDoc.createElement("phonework")
objfieldvalue.SetAttribute "displaynamefra", "Téléphone"
objFieldValue.Text = "418-612-7015"
objRecord.appendChild objFieldValue
Set objRecord = xmlDoc.createElement("billitems")
objRoot.appendChild objRecord
Set objFieldValue = xmlDoc.createElement("id")
objfieldvalue.SetAttribute "displaynamefra", "Item #"
objFieldValue.Text = "1"
objRecord.appendChild objFieldValue
Set objFieldValue = xmlDoc.createElement("id_bill")
objfieldvalue.SetAttribute "displaynamefra", "Référence facture"
objFieldValue.Text = numero01
objRecord.appendChild objFieldValue
Set objFieldValue = xmlDoc.createElement("description")
objfieldvalue.SetAttribute "displaynamefra", "Description"
objFieldValue.Text = "Administration réseau et technique informatique"
objRecord.appendChild objFieldValue
Set objFieldValue = xmlDoc.createElement("timeline")
objfieldvalue.SetAttribute "displaynamefra", "Période"
objFieldValue.Text = timeline01
objRecord.appendChild objFieldValue
Set objFieldValue = xmlDoc.createElement("unity")
objfieldvalue.SetAttribute "displaynamefra", "Unitée"
objFieldValue.Text = "Heures"
objRecord.appendChild objFieldValue
Set objFieldValue = xmlDoc.createElement("quantity")
objfieldvalue.SetAttribute "displaynamefra", "Quantité"
objFieldValue.Text = quantity01
objRecord.appendChild objFieldValue
Set objFieldValue = xmlDoc.createElement("rate")
objfieldvalue.SetAttribute "displaynamefra", "Tarif"
objFieldValue.Text = rate01
objRecord.appendChild objFieldValue
xmlDoc.Save basedir & "\facturation" & numero01 & ".xml"
fmid.WriteLn("<br>New invoice created")
reskeymid=0
resbutmidstr=""
reskeylef=0
end if
end if
'''''''''''''''''''''''''''''''''''''
' facturation invoice (display)
'''''''''''''''''''''''''''''''''''''
if resbutlefstr="facturation" then
'=== this was a test with multiple button value (one for each line)
a = clefra(array("fmid","fbot"))
x=0
redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
distmp(x)="Invoice number" '===== description displayed in front of the field
namtmp(x)="text01" '===== name of variable for programming purpose
deftmp(x)="10" '===== default value inside the form (the form will be 20 char long if no value here, but you can enter more)
typtmp(x)="textbox" '===== type of data: textbox password (futur: more to come)
errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords
buttmp=array("ok","cancel") '===== at the end, there will be an "ok" button and a "cancel" button
a = dynforgen2 (distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)
'=== if internet explorer was not closed (bready), a button was not pressed on left frame, and no excape or cancel in middle frame
if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
'=== get values from input boxes
numero01 = fmid.form01.text01.Value
'quantity01 = fmid.form01.text02.Value
'rate01 = fmid.form01.text03.Value
'billto_reference01 = fmid.form01.text04.Value
'timeline01 = fmid.form01.text05.Value
'=== display your answers
fmid.WriteLn("<br>Answer01: " & text01)
fmid.WriteLn("<br>Answer02: " & text02)
'reference
'http://www.w3schools.com/xml/dom_element.asp
'fbot.WriteLn("<br>TESTING XML STUFF")
'fbot.WriteLn("<br>directory where xml file is saved: " & basedir)
'=== goal: have an xml list of items to generate an invoice
'=== affiche la facture dans le frame du bas
Set xmlDoc = CreateObject("Microsoft.XMLDOM")
xmlDoc.Async = "False"
xmlDoc.Load(basedir & "\facturation" & numero01 & ".xml")
'=== id facture
id_bill = numero01
'=== ROOT:
'=== facturation
'=== RECORDS:
'=== bill, billfrom, billto, billitems
'Set colNodes=xmlDoc.selectNodes("/facturation/ComputerAudit [ComputerName = 'atl-ws-100']")
'=== make a big table that will contain other tables inside
h = "<!DOCTYPE html>"
h = h & "<html>"
h = h & "<head>"
h = h & "<style>"
h = h & "table#items01 tr:nth-child(even) {"
h = h & "background-color: #eee;"
h = h & "}"
h = h & "</style>"
h = h & "</head>"
h = h & "<body>"
h = h & "<table width=""100%"" BORDERCOLOR=""black"" class=MsoTableGrid border=1 CELLSPACING=0 cellpadding=2 style='border-collapse:collapse;border: 3px solid black'>"
h = h & "<tr>" '=== line 1
''''''''''''''''''''''''''''''''
' billfrom
''''''''''''''''''''''''''''''''
h = h & "<td>" '=== column
'h = h & "<h1>Facture de:</h1>"
h = h & "<table width=""100%"" BORDERCOLOR=""black"" class=MsoTableGrid border=1 CELLSPACING=0 cellpadding=2 style='border-collapse:collapse;border:none'>"
Set colNodes=xmlDoc.selectNodes("/facturation/billfrom")
node = 1
For Each objNode in colNodes
'=== there is supposed to be only one node, one bill or invoice
For Each objChild In objnode.childNodes
if objchild.text <>"" then
h = h & "<tr>"
displaynamefra = objchild.getattribute("displaynamefra")
h = h & "<td>" & displaynamefra & "</td><td>" & objchild.text & "</td>"
h = h & "</tr>"
end if
next
node = node + 1
next
h = h & "</table>"
h = h & "</td>"
''''''''''''''''''''''''''''''''
' invoice
''''''''''''''''''''''''''''''''
h = h & "<td>"
h = h & "<table width=""100%"" BORDERCOLOR=""black"" class=MsoTableGrid border=1 CELLSPACING=0 cellpadding=2 style='border-collapse:collapse;border:none'>"
h = h & "<tr><td><center><h1>FACTURE</h1></center></td></tr>"
h = h & "</table>"
h = h & "</td>"
h = h & "</tr>" '=== line 1 end
h = h & "<tr>" '=== line 2
''''''''''''''''''''''''''''''''
' billto
''''''''''''''''''''''''''''''''
Set colNodes=xmlDoc.selectNodes("/facturation/billto")
h = h & "<td>"
h = h & "<h1>Facturé à :</h1>"
h = h & "<table width=""100%"" BORDERCOLOR=""black"" class=MsoTableGrid border=1 CELLSPACING=0 cellpadding=2 style='border-collapse:collapse;border:none'>"
Set colNodes=xmlDoc.selectNodes("/facturation/billto")
node = 1
For Each objNode in colNodes
'=== there is supposed to be only one node, one bill or invoice
For Each objChild In objnode.childNodes
h = h & "<tr>"
'fbot.WriteLn("<br>child node")
if objchild.text <>"" then
displaynamefra = objchild.getattribute("displaynamefra")
h = h & "<td>" & displaynamefra & "</td><td>" & objchild.text & "</td>"
end if
h = h & "</tr>"
next
'if objnode.text <>"" then
' displaynamefra = objnode.getattribute("displaynamefra")
' fbot.WriteLn("<br>node: " & node & " --- " & displaynamefra & " --- " & objnode.text)
'end if
node = node + 1
next
h = h & "</table>"
h = h & "</td>"
''''''''''''''''''''''''''''''''
' bill id and stuff
''''''''''''''''''''''''''''''''
h = h & "<td>"
h = h & "<table width=""100%"" BORDERCOLOR=""black"" class=MsoTableGrid border=1 CELLSPACING=0 cellpadding=2 style='border-collapse:collapse;border:none'>"
Set colNodes=xmlDoc.selectNodes("/facturation/bill [id = '" & id_bill & "']")
node = 1
For Each objNode in colNodes
'=== there is supposed to be only one node, one bill or invoice
For Each objChild In objnode.childNodes
h = h & "<tr>"
'fbot.WriteLn("<br>child node")
if objchild.text <>"" then
displaynamefra = objchild.getattribute("displaynamefra")
h = h & "<td>" & displaynamefra & "</td><td>" & objchild.text & "</td>"
end if
h = h & "</tr>"
next
'if objnode.text <>"" then
' displaynamefra = objnode.getattribute("displaynamefra")
' fbot.WriteLn("<br>node: " & node & " --- " & displaynamefra & " --- " & objnode.text)
'end if
node = node + 1
next
h = h & "</table>"
h = h & "</td>"
h = h & "</tr>" '=== line 2 end
h = h & "</tr>" '=== end 4 first squares
'''''''''''''''''''''''''''
' items
'''''''''''''''''''''''''''
h = h & "<td colspan=""2"">"
h = h & "<table id=""items01"" width=""100%"" BORDERCOLOR=""black"" class=MsoTableGrid border=1 CELLSPACING=0 cellpadding=2 style='border-collapse:collapse;border:none'>"
Set colNodes=xmlDoc.selectNodes("/facturation/billitems [id_bill = '" & id_bill & "']")
'fbot.WriteLn("<br>Numéro de la facture: " & id_bill)
Set colNodes=xmlDoc.selectNodes("/facturation/billitems")
'=== column titles
node = 1
h = h & "<tr>"
For Each objNode in colNodes
'=== there is supposed to be only one node, one bill or invoice
For Each objChild In objnode.childNodes
'fbot.WriteLn("<br>child node")
displaynamefra = objchild.getattribute("displaynamefra")
h = h & "<td>" & displaynamefra & "</td>"
next
h = h & "<td>Montant</td>"
'if objnode.text <>"" then
' displaynamefra = objnode.getattribute("displaynamefra")
' fbot.WriteLn("<br>node: " & node & " --- " & displaynamefra & " --- " & objnode.text)
'end if
node = node + 1
next
h = h & "</tr>"
'=== data in columns, line by line
total01 = 0
node = 1
For Each objNode in colNodes
h = h & "<tr>"
'=== there is supposed to be only one node, one bill or invoice
quantity01 = ""
rate01 = ""
nodecol = 0
For Each objChild In objnode.childNodes
'fbot.WriteLn("<br>child node")
displaynamefra = objchild.getattribute("displaynamefra")
if objchild.nodename = "rate" then prefix01 = "$ " else prefix01 = ""
h = h & "<td>" & prefix01 & objchild.text & "</td>"
if objchild.nodename = "quantity" then quantity01 = objchild.text
if objchild.nodename = "rate" then rate01 = objchild.text
nodecol = nodecol + 1
next
subtot01 = quantity01 * rate01
h = h & "<td>$ " & subtot01 & "</td>"
'if objnode.text <>"" then
' displaynamefra = objnode.getattribute("displaynamefra")
' fbot.WriteLn("<br>node: " & node & " --- " & displaynamefra & " --- " & objnode.text)
'end if
node = node + 1
h = h & "</tr>"
total01 = total01 + subtot01
next
'=== final line - total01
h = h & "<tr>"
'=== merge this to get total on right side, last 2 columns
h = h & "<td colspan=""" & nodecol-1 & """></td>"
h = h & "<td>Total (can)</td>"
h = h & "<td>$ " & total01 & "</td>"
h = h & "</tr>"
h = h & "</table>"
h = h & "</td>"
h = h & "</tr>" '=== line 2
h = h & "</body>"
h = h & "</html>"
'h = h & "<br>Total bills found: " & node-1 & " with " & id_bill & " as ID"
fbot.WriteLn(h)
'=== XML modification
Set xmlDoc = CreateObject("Microsoft.XMLDOM")
xmlDoc.Async = "False"
xmlDoc.Load(basedir & "\facturation" & numero01 & ".xml")
Set colNodes=xmlDoc.selectNodes("/facturation/source [nom = 'Serge Fournier']/datecreation")
For Each objNode in colNodes
objNode.Text = "dodo"
fbot.WriteLn(text & "<br>node")
Next
xmlDoc.Save basedir & "\facturation" & numero01 & ".xml"
'=== remove an element
Set xmlDoc = CreateObject("Microsoft.XMLDOM")
xmlDoc.Async = "False"
xmlDoc.Load(basedir & "\facturation" & numero01 & ".xml")
Set colNodes=xmlDoc.selectNodes ("/ITChecklist/ComputerAudit [ComputerName = 'atl-ws-100']")
For Each objNode in colNodes
'=== this node name does not exist, so it will bot really be removed in this program right now
'xmlDoc.documentElement.removeChild(objNode)
Next
xmlDoc.Save basedir & "\facturation" & numero01 & ".xml"
fmid.WriteLn("<br><br>Done")
'=== open xml and make a html table ready to print
end if
reskeymid=0
resbutmidstr=""
reskeylef=0
resbutlefstr=""
end if
'=== if the button named this is pressed we do this
'=== resbutlefstr: result from pressing a button in the left frame (control frame, flef object)
'=== its a string that contain the programmable name of the button that was pressed in the left frame (arabutnam)
if resbutlefstr="clrframes" then
a = clefra(array("fmid","fbot"))
'fbot.WriteLn("tried to clear middle frame")
end if
if resbutlefstr="info" then
fil02.WriteLine date & " " & time & " Info was pressed"
a = clefra(array("fmid","fbot"))
'=== print button
call oieready
for each a in priara
fbot.WriteLn(a)
next
for each a in botara
fbot.WriteLn(a)
next
fbot.WriteLn("<H2>Dynamic Web Interface</H2><br>")
texara=array(_
"",_
"1. REQUIREMENTS:",_
"1.1 Microsoft windows xp, vista (32 or 64), seven (32 or 64) (without UAC, users access control, off)",_
"1.2 Internet explorer",_
"1.3 .NET framework 1.1 (included with windows)", _
"",_
"Run this script in a windows installation directory (where you can find source directory, the root)",_
"It will create folder with same name for each function that you need to edit WIM files", _
"[this script folder]_wim_notsplitted (Extraction of one index if there is many installs in the same dvd)",_
"[this script folder]_wim_splitted (to be able to copy the dvd on a usb key that support only file smaller than 4gb)",_
"[this script folder]_mounted (win extracted as folders)",_
"[this script folder]_an other one i dont remember",_
"",_
"Contact: Serge Fournier, Prog./Analyst", _
"Email: sergefournier(a)hotmail.com")
for each a in texara
call oieready
fbot.WriteLn(a & "<br>")
next
call oieready
fbot.location.reload(true)
reskeymid=0
resbutmidstr=""
end if
'==========================================
'=== .1 seconds
wscript.sleep 50
'=== we loop until internet explorer was closed or the quit button was pressed
loop until bReady or resbutlefstr="quit01"
'======================
'====================== end of main loop
'======================
'=== someone pressed "quit" on left frame (control frame, flef object)
'=== at the end, if internet explorer was not closed, we close it
if bready=false then
oie.quit
set oie=nothing
end if
if logall=1 then
fil02.WriteLine date & " " & time & " END"
end if
if logall = 1 then
fil02.close
end if
'=== we end wscript.exe, exiting all running code interpretation
wscript.quit
'==================================================================================================
'=== many subs
'=== if internet explorer is closed (event) we change bready value to TRUE
sub IE_onQuit()
bReady=true
end sub
'============================================== subs and functions ====================================
'=== frames clear content by navigating to a blank
'=== input is an array containing name of frames as "flef" = frame left
'=== this sub generate a code and execute it in a string (cc)
'=== fully dynamic programming at it's best ;)
function clefra(aara)
For Each afra In aara
intfra = Int(InStr("fleffmidfbot", afra) / 4)
'•uninitialized - Has not started loading yet
'•loading - Is loading
'•interactive - Has loaded enough and the user can interact with it
'•complete - Fully loaded
fraara = array("left","middle","bottom")
set tmpfra = crefra(fraara(intfra))
'tmpfra.writeln(
htmtab = "<input type=""hidden""/> "
'Call wrifra(tmpfra, htmtab)
tmpfra.writeln(htmtab)
Call fready(tmpfra)
Call relfra(tmpfra)
tmpfra.location.reload(True)
Call fready(tmpfra)
htmtab = ""
'=== backgrounds
'fraara(0) = ("<body background=""" & BASEDIR & "images_interface\fond_gauche.jpg"">")
'fraara(1) = ("<body background=""" & BASEDIR & "images_interface\fond_gris.jpg"">")
'fraara(2) = ("<body background=""" & BASEDIR & "images_interface\fond_gris.jpg"">")
'For Each astr In fraara(intfra)
' htmtab = htmtab & astr
'Next
tmpfra.writeln(htmtab)
Call fready(tmpfra)
Next
resbutlefstr = ""
resbutmidstr = ""
resbutbotstr = ""
reskeylef = 0
reskeymid = 0
reskeybot = 0
end function
Function crefra(ffranam)
'Dim ffra As Object
err01 = 0
try01 = 0
ffra = ""
maxerr = 60 '=== 3 sec before fatal error
try01 = 1
fileversion = objFSO.GetFileVersion("C:\program files\internet explorer\iexplore.exe")
finddot = instr(fileversion,".")
fileversion2 = left(fileversion,finddot-1)
If logall = 1 Then fil02.WriteLine(DateValue(Now) & " " & TimeValue(Now) & " " & ffranam)
if fileversion2 = "10" or fileversion2 = "11" then
'=== ie10 frame access
'set crefra = oIE.parent.Document.frames.item(ffranam).document
set crefra = oie.parent.document.getElementByid(ffranam).contentdocument
else
set crefra = oie.document.frames(ffranam).document
end if
'If logall = 1 Then fil02.WriteLine(DateValue(Now) & " " & TimeValue(Now) & " crash creating frame again ")
End Function
Sub relfra(ffra)
ffra.location.reload(false)
'If logall = 1 Then fil02.WriteLine(DateValue(Now) & " " & TimeValue(Now) & " error reloading frame dynbotcho")
End Sub
Sub fready(tmpfra)
'=== old sub as ref in case something still calling it
End Sub
'=== form dynamically generated =========================================================================
'=== form dynamically generated =========================================================================
function dynforgen2 (distmp, namtmp, deftmp, typtmp, errtmp, buttmp, title)
err01 = 1
resbutmidstr=""
reskeymid=0
'=== save message before error one
redim errtmp2(ubound(errtmp))
for i = 0 to ubound(errtmp)
errtmp2(i) = errtmp(i)
next
do
if err01 = 1 then
'd = wrifra(fmid, title)
'=== generate a form for input in the input frame (fmid object)
'=== focus on the first field with no default value
'=== display suffix message in red if "error" (or "erreur" - french) keyword is in it
htmtab=""
for each a in midara
htmtab = htmtab & a
next
htmtab = htmtab & "<h3><span class=SpellE>" & title & "</span></h3>"
'=== default focus on empty field (with no default value)
deffoc=0
for ii=0 to ubound(namtmp)
if deftmp(ii)="" then
if instr(lcase(errtmp(ii)),"facultatif")=0 then
htmtab = htmtab & "<BODY onLoad=""document.form01." & namtmp(ii) & ".focus()"">"
deffoc=1
end if
end if
'=== no default value empty, we focus on first field
next
if deffoc=0 then
htmtab = htmtab & "<BODY onLoad=""document.form01." & namtmp(0) & ".focus()"">"
end if
htmtab = htmtab & "<div class=MsoNormal align=center style='text-align:center'>"
htmtab = htmtab & "</div>"
htmtab = htmtab & "<form name=form01>"
'=== button and error message
for ii=0 to ubound(namtmp)
htmtab = htmtab & distmp(ii) & ": "
'=== we disable "enter" to submit form because we manage this event as a onkeypress in the parent frame of the form later
'=== we had to do this, because the web page form is not run on a server, and the web page dont have control, the VBS script outside the page have control
htmtab = htmtab & "<input type=""" & typtmp(ii) & """ id=" & namtmp(ii) & " NAME=""" & namtmp(ii) & """ size=""" & max(20,len(deftmp(ii))+10) & """ value=""" & deftmp(ii) & """ onKeypress=""return event.keyCode!=13"""
'fmid.WriteLn("")
if instr(lcase(errtmp(ii)),"error")<>0 or instr(lcase(errtmp(ii)),"erreur")<>0 then
col="red"
else
col="blue"
end if
htmtab = htmtab & " <b><span style='color:" & col & "'> " & errtmp(ii) & "</span></b><br style='mso-special-character:line-break'>"
next
htmtab = htmtab & "<![if !supportLineBreakNewLine]><br style='mso-special-character:line-break'>"
htmtab = htmtab & "<![endif]></p>"
for ii=0 to ubound(buttmp)
typ01 = "button"
htmtab = htmtab & "<input type=""" & typ01 & """ name=""" & buttmp(ii) & """ value="" " & buttmp(ii) & " "">"
htmtab = htmtab & "          "
next
htmtab = htmtab & "</div>"
htmtab = htmtab & "</form>"
htmtab = htmtab & "</body>"
htmtab = htmtab & "</html>"
fmid.writeln htmtab
fmid.location.reload(true)
else
'=== there wa sno error or this is first run
end if
'=== wait for internet explorer to be ready after we refresh the page with the new form
for ii=0 to ubound(buttmp)
call oieready
'=== value to return for each button in the form
fmid.forms(0).elements(buttmp(ii)).onclick = getref("buttonmid")
next
'=== regenerate the event that call a sub if a button is pressed
set fmid.onkeypress = GetRef("Checkmid")
'=== clear button pressed and key pressed for this frame
'=== flag to tell if the input is not valid
err01=0
'=== flag to say input is done, since there might be a defaut value, we must validate if user was finished
inpdon=0
'=== "ok" button or "enter" key are the same
'=== and nothing was pressed on left frame (control frame)
if resbutlefstr="" and (resbutmidstr="ok" or reskeymid=13) then
'=== User has clicked the OK button, retrieve the values
i=0
'err01 = 0
for each name01 in namtmp
text01 = ""
code01 = "text01 = fmid.form01." & name01 & ".Value"
execute code01
deftmp(i) = text01
if len(text01) = 0 then
err01 = 1
errtmp(i) = "error - must be 1 char long at least"
reskeymid=0
resbutmidstr=""
else
errtmp(i) = errtmp2(i)
'fbot.writeln "<br>restore old text suffix"
end if
i=i+1
next
if err01 = 0 then inpdon=1
'fbot.writeln "<br>Error01: " & err01
else
'=== someone pressed left frame button
end if
'=== while we wait for input value, user can press "escape" key, "cancel" button or close internet explorer
if resbutmidstr="cancel" or reskeymid=27 or bready=true or resbutlefstr<>"" then
'=== if user pressed escape or cancel, we clear the frames
if resbutmidstr="cancel" or reskeymid=27 then
a = clefra(array("fmid","fbot"))
resbutmidstr="cancel"
end if
'=== cancel or excape was pressed
exit do
end if
resbutmidstr=""
reskeymid=0
wscript.sleep 50
'=== if there was an input error and no one used left control frame to exit, we keep asking for input
loop while inpdon=0
end function
'=== use dynforgen2 (dynamic validation of inputs)
function dynforgenold (distmp, namtmp,deftmp,typtmp,errtmp,buttmp,title)
'=== generate a form for input in the input frame (fmid object)
'=== focus on the first field with no default value
'=== display suffix message in red if "error" (or "erreur" - french) keyword is in it
htmtab=""
for each a in midara
htmtab = htmtab & a
next
htmtab = htmtab & "<h3><span class=SpellE>" & title & "</span></h3>"
'=== default focus on empty field (with no default value)
deffoc=0
for ii=0 to ubound(namtmp)
if deftmp(ii)="" then
if instr(lcase(errtmp(ii)),"facultatif")=0 then
htmtab = htmtab & "<BODY onLoad=""document.form01." & namtmp(ii) & ".focus()"">"
deffoc=1
end if
end if
'=== no default value empty, we focus on first field
next
if deffoc=0 then
htmtab = htmtab & "<BODY onLoad=""document.form01." & namtmp(0) & ".focus()"">"
end if
htmtab = htmtab & "<div class=MsoNormal align=center style='text-align:center'>"
htmtab = htmtab & "</div>"
htmtab = htmtab & "<form name=form01>"
'=== button and error message
for ii=0 to ubound(namtmp)
htmtab = htmtab & distmp(ii) & ": "
'=== we disable "enter" to submit form because we manage this event as a onkeypress in the parent frame of the form later
'=== we had to do this, because the web page form is not run on a server, and the web page dont have control, the VBS script outside the page have control
htmtab = htmtab & "<input type=""" & typtmp(ii) & """ id=" & namtmp(ii) & " NAME=""" & namtmp(ii) & """ size=""" & max(20,len(deftmp(ii))) & """ value=""" & deftmp(ii) & """ onKeypress=""return event.keyCode!=13"""
'fmid.WriteLn("")
if instr(lcase(errtmp(ii)),"error")<>0 or instr(lcase(errtmp(ii)),"erreur")<>0 then
col="red"
else
col="blue"
end if
htmtab = htmtab & " <b><span style='color:" & col & "'> " & errtmp(ii) & "</span></b><br style='mso-special-character:line-break'>"
next
htmtab = htmtab & "<![if !supportLineBreakNewLine]><br style='mso-special-character:line-break'>"
htmtab = htmtab & "<![endif]></p>"
for ii=0 to ubound(buttmp)
typ01 = "button"
htmtab = htmtab & "<input type=""" & typ01 & """ name=""" & buttmp(ii) & """ value="" " & buttmp(ii) & " "">"
htmtab = htmtab & "          "
next
htmtab = htmtab & "</div>"
htmtab = htmtab & "</form>"
htmtab = htmtab & "</body>"
htmtab = htmtab & "</html>"
fmid.writeln htmtab
fmid.location.reload(true)
'=== wait for internet explorer to be ready after we refresh the page with the new form
for ii=0 to ubound(buttmp)
Do While (oIE.Busy)
wscript.sleep 100
loop
do while oie.readystate<>4
wscript.sleep 100
Loop
'=== value to return for each button in the form
fmid.forms(0).elements(buttmp(ii)).onclick = getref("buttonmid")
next
'=== regenerate the event that call a sub if a button is pressed
set fmid.onkeypress = GetRef("Checkmid")
'=== clear button pressed and key pressed for this frame
resbutmidstr=""
reskeymid=0
end function
'=== max
Function max(a, b)
If a > b Then max = a Else max = b
End Function
function crewebmai(oie, doctit, maitit, arabutnam, arabutdes, aradepnam, aradepcol)
'=== create an internet explorer object (oie) that will be in 3 frames (flef, fmid, fbot), acting at the main interface for all this program
oie.FullScreen = False
'.ToolBar = False
'.StatusBar = False
'.Navigate("About:Blank")
'.visible = true
oIE.left=0 ' window position
oIE.top = 0 ' and other properties
'.ParentWindow
' .resizeto 640,300
' .moveto (.screen.width
oIE.height = 500
oIE.width = 500
oIE.menubar = 1 '=== no menu
oIE.toolbar = 1
oIE.statusbar = 1
oIE.RegisterAsDropTarget = True
oie.Navigate("about:blank")
'oie.Navigate("about:tabs")
oie.document.title = doctit
oiewid = oie.document.parentwindow.screen.width
oiehei = oie.document.parentwindow.screen.height
sizwidpercent = 100
sizheipercent = 95
loswid = 100-sizwidpercent
loshei = 100-sizheipercent
newwid = oiewid*sizwidpercent*.01
newhei = oiehei*sizheipercent*.01
oie.document.parentwindow.resizeto newwid,newhei
newx = oiewid * loswid * .01 /2
newy = oiehei * (loshei/2) * .01 /2
oie.document.parentwindow.moveto newx, newy
oIE.visible = 1 '=== visible on
oie.addressbar=false
'=== we will always have 3 frames, control, input and output (flef, fmid, fbot)
'=== used an array to have a good view of the line of html and possibility to add something else easily
aratmp=array(_
"<HTML>",_
"<HEAD><TITLE>" & doctit & "</TITLE>",_
"<meta content=""text/html; charset=utf-8"" http-equiv=""Content-Type"">",_
"<meta http-equiv=""X-UA-Compatible"" content=""IE=8"">",_
"</HEAD>",_
"<FRAMESET id='main' COLS=""13%, *"">",_
"<FRAME SRC=""About:Blank"" NAME=""left"" id=""left"">",_
"<frameset id='main2' rows=""30%,70%"">",_
"<FRAME SRC=""About:Blank"" NAME=""middle"" id=""middle"">",_
"<FRAME SRC=""About:Blank"" NAME=""bottom"" id=""bottom"">",_
"</FRAMESET>", _
"</frameset>", _
"</HTML>")
'oie.Navigate("About:Blank")
'=== send the array content in internet explorer to create 3 frames
for i = 0 to UBound(aratmp, 1)
oie.document.WriteLn(aratmp(i))
next
oie.refresh
Do While (oIE.Busy)
wscript.sleep 50
Loop
'=== wait till document loaded
do while oie.readystate<>4
wscript.sleep 50
Loop
'=== vista activate
'=== make internet explorer the main active window
a = objShe.AppActivate("http:/// - " & doctit & " - M")
a = objShe.AppActivate(doctit & " - M")
'=== theses objects are used to send data to the 3 different frames
'=== if you dont define them as object, the access to them is very slow when we use the names instead of the objects
'=== object used to write in a frame with writeln
fileversion = objFSO.GetFileVersion("C:\program files\internet explorer\iexplore.exe")
finddot = instr(fileversion,".")
fileversion2 = left(fileversion,finddot-1)
if fileversion2 = "10" or fileversion2 = "11" then
'=== ie10 frame access
set flef = oie.parent.document.getElementByid("left").contentdocument
set fmid = oie.parent.document.getElementByid("middle").contentdocument
set fbot = oie.parent.document.getElementByid("bottom").contentdocument
else
set flef = oie.document.frames("left").document
set fmid = oie.document.frames("middle").document
set fbot = oie.document.frames("bottom").document
end if
'=== object used to navigate an empty page in a frame
'set flefl = oie.document.frames("left").location
'set fmidl = oie.document.frames("middle").location
'set fbotl = oie.document.frames("bottom").location
'=== string result for a button press in a frame (lef = left frame, mid = middle frame (up))
resbutlefstr=""
resbutmidstr=""
resbutbotstr=""
reskeylef=0
reskeymid=0
reskeybot=0
'=== all the chek to be made in first page (1 at the moment, since ready have many values)
nbrbut=UBound(arabutnam, 1)
redim buttag(nbrbut)
form = "flef"
flef.WriteLn("<html><body>")
flef.WriteLn("<body background=""" & basedir & "images_interface\fond_gauche.jpg"">")
flef.WriteLn("<h3><span class=SpellE>" & maitit & "</span></h3>")
flef.WriteLn("<form name='form1'>")
'(1) Where you want the image to appear: <span id="image"></span>
'(2) Get a reference to it: var e = document.getElementById('image');
'(3) Insert the img HTML code into the span: e.innerHTML = '<img src="./images/your_picture.jpg" />';
htmtab = ""
'htmtab = htmtab & "<img src=" & aa & " alt=" & aa & " />"
fmid.location.reload(true)
for i=0 to ubound(arabutnam)
'=== convert xls to mdb button appear for stas only
if ((usenam="wildboy" or usenam="fournier.serge" or usenam="fortin.jp" or usenam="lavoie.daniel" or usenam="doucet.gm") and arabutnam(i)="excel2mdb") or arabutnam(i)<>"excel2mdb" then
'style="background-color: #cc0000; color: #ffffff;" /
b = "<input type=""button"" style=""height:50px;font-size:14px;width:100%;white-space: normal;"" name=""" & arabutnam(i) & """ value=""" & arabutdes(i) & """"
i2=i
if i>ubound(aradepnam) then
i2=ubound(aradepnam)
else
a=aradepnam(i2)
end if
if a<>lasdep then
'=== new departement name
flef.WriteLn( "<br>" & a & "<br>")
lasdep=a
end if
b = b & " style=""background-color: #" & aradepcol(i2) & "; color: #000000;""><br>"
flef.WriteLn(b)
end if
next
flef.WriteLn("</form>")
flef.WriteLn("</body>")
flef.WriteLn("</html>")
'=== we dont refresh this frame, its the first one
end function
'=== sub to call when something is pressed
'=== called for many buttons, return the button name or a keyboard code (Ascii)
sub buttonlef
set src = flef.parentWindow.event.srcElement
resbutlefstr = src.name
end sub
sub buttonmid
set src = fmid.parentWindow.event.srcElement
resbutmidstr = src.name
end sub
sub buttonbot
set src = fbot.parentWindow.event.srcElement
resbutbotstr = src.name
end sub
sub Checklef
reskeylef = flef.parentWindow.event.keycode
end sub
sub Checkmid
reskeymid = fmid.parentWindow.event.keycode
end sub
sub Checkbot
reskeybot = fbot.parentWindow.event.keycode
end sub
'=== unblur (event when cursor leave a textbox)
sub onblurlef
set src = flef.parentWindow.event.srcElement
resblulefstr = src.name
resblulefval = src.value
resblulefid = src.id
end sub
sub onblurmid
set src = fmid.parentWindow.event.srcElement
resblumidstr = src.name
resblumidval = src.value
resblumidid = src.id
end sub
sub onblurbot
set src = fbot.parentWindow.event.srcElement
resblubotstr = src.name
resblubotval = src.value
resblubotid = src.id
end sub
'=== chek in the actual folder if a file exist
function filsea(filname)
'=== chek also actual folder for a "Rappel_LOG" file (instr)
Set objFolder2 = objFSO.GetFolder(basedir)'=== dir
Set objFiles2 = objFolder2.files '=== fichiers
found=0 '=== fichier de rapport pas trouve
For Each objFile3 in objFiles2
nomfile =objfile3.name
nomfile= lcase(nomfile)
next
end function
'=== delete a table in a database
function tabdel()
for each tab in objcat.Tables
If tab.Type = "TABLE" Then
b=lcase(tab.name)
'=== object.delete not supported, so we delete with name
objcat.tables.delete b
fbot.WriteLn("delete: " & b & "<br>")
END IF
next
end function
'=== for reference
function dynbotcho00
i3=0
For each dia01 in choiceara
sql = makque(dia01,tab,sel,whe,"","=","")
a = exesql(objcon,tag,sql)
'=== make same array for a multiples queries
if tag.eof=0 then
'a = dynbotcho("DIAGNOSTIC",tag,0,sql,1,1,1,1) '=== 1 2 3
if ubound(choiceara)=0 and i3=0 then
a = dynbotcho("DIAGNOSTIC",tag,0,sql,1,1,1,1) '=== 1 2 3
elseif i3=0 then
'=== header
a = dynbotcho("DIAGNOSTIC",tag,0,sql,1,1,0,0) '=== 1 2 3
elseif i3<>ubound(choiceara) and i3<>0 then
'=== footer
a = dynbotcho("DIAGNOSTIC",tag,0,sql,0,1,0,0) '=== 1 2 3
elseif i3=ubound(choiceara) then
a = dynbotcho("DIAGNOSTIC",tag,0,sql,0,1,1,1) '=== 1 2 3
end if
i3 = i3 + 1
else
'=== 0 results
a = nores(sql)
end if
next
end function
function dynbotcho(ffra, ttext, aaratit, aara, cc01 ,hh, mm, ff, rr, ttxtbox,ffranam)
'=== ffra frame to use for display (object)
'=== ttext to display
'=== aara = array with what to display
'=== cc01 = choice button (no choice button when we display disgnostics, cause of multiple tables in one)
'=== sql = sql query for debugging
'=== hh = 1 = header
'=== mm = 1 = middle
'=== bb = 1 = footer
'=== rr = 1 = reload at end
'=== ttxtbox = all data are in a textbox so we can edit them (1) no date in text box (0)
'=== ffranam = frame name
htmtab = ""
if ffranam = "lef" then
for each a in lefara
htmtab = htmtab & a
next
end if
if ffranam = "mid" then
for each a in midara
htmtab = htmtab & a
next
end if
if ffranam = "bot" then
for each a in botara
htmtab = htmtab & a
next
end if
if logall = 1 then fil02.writeline "--- the sub dynbotcho has been called"
call oieready
'=== print button
'priara = array("<input type=""button"" onClick=""javascript:print()"" value=""Print""/>")
xmax = UBound(aara, 1) 'Returns the Number of columns --- elements in first dimension
'on error resume next
on error resume next
'=== chek the number of elements in second dimension, if there is none, then the array is only a list with 1 column
ymax = UBound(aara, 2) 'Returns the Number of rows --- elements in second dimension
'=== number of dimensions in case there is only 1 column
if err<>0 then
dimnum=1
if logall=1 then
fil02.WriteLine date & " " & time & " max column: " & xmax
end if
else
dimnum=2
if logall=1 then
'fil02.WriteLine date & " " & time & " max column: " & xmax
fil02.WriteLine date & " " & time & " max row : " & ymax
'fil02.WriteLine date & " " & time & " offset : " & maxoff
'fil02.WriteLine date & " " & time & " offsetnow : " & offset
end if
end if
on error goto 0
if dimnum=2 then
if totrec>=maxoff then ymax=maxoff+offset-1
if ymax>totrec then ymax=totrec
'if ymax>maxoff then ymax=maxoff
end if
'=== web script for buttons to return the number of the button that was pressed
htmtab = htmtab & "<form name=form01>"
'=== print button
if hh=1 then
for each a in priara
htmtab = htmtab & a
'if logall=1 then fil02.writeline "*-------============*"
'ffra.WriteLn("<BODY onLoad=""document.form01." & namtmp(0) & ".focus()"">")
next
if cc01=0 then htmtab = htmtab & "<br><br>"
end if
'=== search button only if bottom frame
if ffranam="bot" and cc01<>0 then
strsearch=""
'fmid.WriteLn(" <input type=""" & typtmp(ii) & """ id=" & namtmp(ii)NAME=""" & namtmp(ii) & """ size=""" & max(20,len(deftmp(ii))) & """ value=""" & deftmp(ii) & """ onKeypress=""return event.keyCode!=13""")
if secseatag=1 then
htmtab = htmtab & "<input type=""textbox"" style=""width:15%;"" id=""boxsearch"" NAME=""boxsearch"" size=""20"" value=""" & strsearch & """ onKeypress=""return event.keyCode!=13"">"
htmtab = htmtab & "<input type=""button"" name=""Search"" value=""Search"">"
end if
end if
if totrec>=maxoff and cc01<>0 then
'htmtab = htmtab & "<input type=""button"" name=""" & "but" & trim(cstr(yy+1)) & """ value=""" & "Select " & yy+1 & """"
'htmtab = htmtab & " style=""background-color: #" & "cccccc" & "; color: #000000;""><br>"
htmtab = htmtab & "<input type=""button"" name=""Precedent"" value=""Precedent"">"
htmtab = htmtab & "<input type=""button"" name=""Next"" value=""Next"">"
'ffra.WriteLn(" style=""background-color: #" & "cccccc" & "; color: #000000;"">")
end if
if ffranam="bot" and cc01<>0 then
htmtab = htmtab & "Displaying " & offset + 1 & " to " & ymax + 1 & " / " & totrec + 1 & " Records"
htmtab = htmtab & "<br><br>"
end if
'=== select buttons
if cc01<>0 then
'=== buttons var only if select is active
if cc01<>0 then
for yy=0 to ymax
next
end if
end if
fast=0
'=== header
if hh=1 then
if logall = 1 then fil02.writeline "--- header frame"
htmtab = htmtab & ttext & "<b><table width=""100%"" BORDERCOLOR=""black"" class=MsoTableGrid border=1 CELLSPACING=0 cellpadding=2 style='border-collapse:collapse;border:none'>"
htmtab = htmtab & "<CAPTION></CAPTION><span style='color:purple'>" & vbcrlf
if fast=1 then ffra.WriteLn(htmtab):htmtab=""
'=== tableau html
htmtab = htmtab & "<TR>"
if fast=1 then ffra.WriteLn(htmtab):htmtab=""
i=0
For Each a In aaratit
'=== columns names
if cc01<>0 then if i=0 then htmtab = htmtab & "<td><p>Select</td>"
'=== test to insert text box inside each field with a default value for editing
test=0
if test=0 then
htmtab = htmtab & "<td><p>" & Trim(a) & "</td>"
if fast=1 then ffra.WriteLn(htmtab):htmtab=""
else
'=== futur button to order by that column
'=== futur textbox to search in this column
htmtab = htmtab & "<td><p>" & Trim(a) & "</td>"
if fast=1 then ffra.WriteLn(htmtab):htmtab=""
end if
i=i+1
if dimnum=1 then exit for
Next
htmtab = htmtab & "</tr>"
if fast=1 then ffra.WriteLn(htmtab):htmtab=""
end if
'=== middle
if mm=1 then
if logall = 1 then fil02.writeline "--- middle frame"
'=== x is inversed when only one column
if dimnum=1 then
ymax=xmax
'=== no offset possible here
ymin=0
else
'=== there is 2 dimensions, that mean multiple row
'=== so we must assume there is an offset
ymin=offset
end if
For yy = ymin To ymax
htmtab = htmtab & "<TR>"
if dimnum=2 then
'ffra.WriteLn(yy)
'=== multiple row
For xx = 0 To xmax
'If IsNull(myarray(xx, yy)) Then myarray(xx, yy) = ""
if xx=0 and cc01<>0 then
htmtab = htmtab & "<td><p>"
htmtab = htmtab & "<input type=""button"" name=""" & "but" & trim(cstr(yy+1)) & """ value=""" & "Select " & yy+1 & """"
htmtab = htmtab & " style=""background-color: #" & "cccccc" & "; color: #000000;""><br>"
htmtab = htmtab & "</td>"
if fast=1 then ffra.WriteLn(htmtab):htmtab=""
end if
if ttxtbox=0 then
htmtab = htmtab & "<td><p>" & aara(xx, yy) & "</td>"
if fast=1 then ffra.WriteLn(htmtab):htmtab=""
else
'aa="<input type=""textbox"" style=""width:100%;"" id=""box" & xx & "_" & yy & """ NAME=""box" & xx & "_" & yy & """ size=""" & max(1,len(aara(xx, yy))) & """ value=""" & aara(xx, yy) & """ onKeypress=""return event.keyCode!=13"""
ffra.WriteLn("<td><p><input type=""textbox"" style=""width:100%;"" id=""box" & xx & "_" & yy & """ NAME=""box" & xx & "_" & yy & """ size=""" & max(1,len(aara(xx, yy))) & """ value=""" & aara(xx, yy) & """ onKeypress=""return event.keyCode!=13""></td>")
'htmtab = htmtab & "<td><p>" & aara(yy, xx) & "</td>"
'if fast=1 then ffra.WriteLn(htmtab):htmtab=""
end if
Next
else
'=== there is only 1 row
htmtab = htmtab & "<td><p>"
htmtab = htmtab & "<input type=""button"" name=""" & "but" & trim(cstr(yy+1)) & """ value=""" & "Select " & yy+1 & """"
htmtab = htmtab & " style=""background-color: #" & "cccccc" & "; color: #000000;""><br>"
htmtab = htmtab & "</td>"
if ttxtbox=0 then
htmtab = htmtab & "<td><p>" & aara(yy) & "</td>"
else
aa="<input type=""textbox"" style=""width:100%;"" id=""box" & yy & """ NAME=""box" & yy & """ size=""" & max(1,len(aara(yy))) & """ value=""" & aara(yy) & """ onKeypress=""return event.keyCode!=13"""
htmtab = htmtab & "<td><p>" & aa & "</td>"
'htmtab = htmtab & "<td><p>" & aara(yy, xx) & "</td>"
end if
end if
htmtab = htmtab & "</tr>" & vbcrlf
if fast=1 then ffra.WriteLn(htmtab):htmtab=""
Next
end if
'=== footer
if ff=1 then
if logall = 1 then fil02.writeline "--- footer frame"
htmtab = htmtab & "</table></span></b><br>"
if logall=1 then fil02.writeline "--- writing data into frame"
if fast=1 then ffra.WriteLn(htmtab):htmtab=""
end if
htmtab = htmtab & "</form>"
if fast=1 then ffra.WriteLn(htmtab):htmtab=""
'aa = lcase(ffra.readystate)
'do until aa="complete" or aa="terminé" or aa="interactive"
' if logall = 1 then fil02.writeline "*********************************** readystate of " & ffranam & ": " & aa
' wscript.sleep 100
' aa = lcase(ffra.readystate)
'loop
call oieready
if fast=0 then ffra.WriteLn(htmtab)
'=== reload (will not reload if we are in middle of a muliple elements/query table)
if rr=1 then
if logall=1 then
'fil02.writeline htmtab
fil02.writeline "--- reloading FRAME"
end if
'oie.document.getElementById("bottom").innerhtml htmtab
'oie.document.getElementById("bottom").src
'iframe.location.reload(true)
call oieready
'aa = lcase(ffra.readystate)
'do until aa="complete" or aa="terminé" or aa="interactive"
' if logall = 1 then fil02.writeline "*********************************** readystate of " & ffranam & ": " & aa
' wscript.sleep 100
' aa = lcase(ffra.readystate)
'loop
ffra.location.reload(false)
end if
'=== ?
if mm=1 and cc01<>0 then
For yy = ymin To ymax
if dimnum=2 then
ffra.forms(0).elements("but" & trim(cstr(yy+1))).onclick = getref("button" & ffranam)
else
'=== there is only 1 column
ffra.forms(0).elements("but" & trim(cstr(yy+1))).onclick = getref("button" & ffranam)
end if
Next
end if
if logall=1 then
fil02.WriteLine date & " " & time & " max column: " & totrec
end if
if totrec>=maxoff and cc01<>0 then
ffra.forms(0).elements("Precedent").onclick = getref("button" & ffranam)
ffra.forms(0).elements("Next").onclick = getref("button" & ffranam)
end if
if ffranam="bot" and cc01<>0 then
if secseatag<>0 then
ffra.forms(0).elements("Search").onclick = getref("button" & ffranam)
end if
end if
set ffra.onkeypress = GetRef("Check" & ffranam)
'for i=0 to ubound(arabutnam)
' flef.forms(0).elements(arabutnam(i)).onclick = getref("buttonlef")
'next
end function
sub oieready()
if bready=false then
do while oie.readystate<>4
wscript.sleep 50
loop
'if logall=1 then fil02.writeline "============== oie readystate: " & oie.readystate
'Do
' wscript.sleep 100
'loop until oie.ReadyState = "Terminé" or oie.ReadyState = "Complete"
Do While (oIE.Busy)
wscript.sleep 50
Loop
end if
end sub
'=== ssea = search string
'=== tab 0 symptoms
'=== tab 1 components
'=== tab 2 diagnostics
'=== tab 3 causes
'=== ttyp 0 search
'=== ttyp 1 fast results
'=== ttyp 2 detail results
'=== ssufix = ordere by or something at the end of query
' order and %
function makque(ssea, ttab, sselect,wwhere, ssufix,ooper,wwild)
ssea = replace(ssea,"'","''")
ssea = trim(ssea)
sseaara = split(ssea," ") '=== array of all words for search
ss = "select "
ii = 0
'=== columns to search in
for each aa in allara(ttab,sselect)
ss = ss & aa
if ii<>ubound(allara(ttab,1),sselect) then ss = ss & ","
ii=ii+1
next
'=== from table
ss = ss & " from [" & alltab(ttab) & "] "
if len(ssea)<>0 then
ss = ss & "where ("
'=== search word(S) in table, AND operator
ii = 0
for each ss2 in sseaara
ii2=0
for each aa in allara(ttab,wwhere)
if wwild="" then
ss = ss & "[" & aa & "] " & ooper & " " & wwild & ss2 & wwild
else
ss = ss & "[" & aa & "] " & ooper & " '" & wwild & ss2 & wwild & "'"
end if
if ii2 <> UBound(allara(ttab,wwhere), 1) then ss = ss & " or "
ii2=ii2+1
next
if ii <> UBound(sseaara, 1) then ss = ss & ") and ("
ii=ii+1
next
'=== order by a column name
ss = ss & ")" & ssufix
else
ss = ss & ssufix
end if
makque = ss
end function
function exesql(objcon,tag,sql)
on error resume next
set tag = objcon.execute(SQL)
if err<>0 then
aaa= err.description
on error goto 0
l1 = "error in query"
l2 = "query: " & sql
l3 = "error: " & aaa
l4 = "the program will now end"
fbot.WriteLn(l1 & "<BR><br>" & l2 & "<BR><br>" & l3 & "<BR><br>" & l4 & "<BR><br>")
'msgbox(l1 & vbcrlf & l2 & vbcrlf & l3 & vbcrlf & l4 & vbcrlf)
if logall=1 then
fil02.writeline "query:"
fil02.writeline sql
fil02.writeline err.description
end if
wscript.quit
end if
end function
'=== tab = table object (adox)
'=== colnam = string containing column name
function crecol(tab,colnam)
Set objcol = CreateObject("ADOX.Column")
'typdat=202 '=== string adVarWChar
'maxlen=250
'typdat=131 '=== float adnumeric
'maxlen=10
typdat=3 '=== integer adinteger
maxlen=10
if typdat=3 then a="adinteger"
if typdat=202 then a="adVarWChar"
if typdat=131 then a="adnumeric"
objcol.name = colnam
objcol.type = typdat
if typdat = 3 or typdat = 202 then
objcol.DefinedSize = maxlen
if typdat=3 then
'=== must set parent catalog before setting autoincrement
Set objcol.ParentCatalog = objcat
objcol.Properties("AutoIncrement")=true
end if
elseif typdat = 131 then
objcol.precision = 28
objcol.numericscale = 8
end if
fbot.WriteLn("column creation: " & colnam & "<br>")
Tab.Columns.Append objcol
end function
'=== count the number of record in the array
function cnttotrec(aara)
xmax = UBound(aara, 1) 'Returns the Number of columns --- elements in first dimension
on error resume next
'=== chek the number of elements in second dimension, if there is none, then the array is only a list with 1 column
ymax = UBound(aara, 2) 'Returns the Number of rows --- elements in second dimension
'=== number of dimensions in case there is only 1 column
if err<>0 then
aa = xmax
else
aa = ymax
end if
on error goto 0
cnttotrec = aa
end function
function dynmidres(TTEXT,aara,rres,aaratit,ccoltot)
call oieready
htmtab=""
htmtab = htmtab & "<HTML><BODY>"
for each a in midara
htmtab = htmtab & a
next
htmtab = htmtab & TTEXT & ": " & rres & "<b><table width=""100%"" BORDERCOLOR=""black"" class=MsoTableGrid border=1 CELLSPACING=0 cellpadding=2 style='border-collapse:collapse;border:none'>"
htmtab = htmtab & "<CAPTION></CAPTION><span style='color:purple'>"
htmtab = htmtab & "<TR>"
i=0
For Each aa In aaratit
'=== columns names
if i=0 then htmtab = htmtab & "<td><p>Choice</td>"
htmtab = htmtab & "<td><p>" & Trim(aa) & "</td>"
i=i+1
Next
htmtab = htmtab & "</tr>"
For xx = 0 To ccoltot
'If IsNull(myarray(xx, yy)) Then myarray(xx, yy) = ""
if xx=0 then
htmtab = htmtab & "<td><p>"
htmtab = htmtab & rres
htmtab = htmtab & "</td>"
end if
htmtab = htmtab & "<td><p>" & aara(xx,rres-1) & "</td>"
'col = col & myarray(xx, yy)
Next
htmtab = htmtab & "</tr>"
htmtab = htmtab & "</table></span></b><br>"
'=== image of the component
aa = """file://" & basedir & "PhotoHydComponent\002-00_HydroCraft_HC-EC_EndCover.jpg"""
aa = replace(aa,"\","/")
'<DIV style='display:none'><IMG SRC='image.gif'></DIV>
htmtab = htmtab & "<img src=" & aa & " alt=" & aa & " />"
htmtab = htmtab & "</BODY></HTML>"
oie.document.getElementById("middle").contentWindow.document.body.innerhtml = htmtab
'fmid.WriteLn(htmtab)
end function
FUNCTION SPLIT2(AA,SS)
set bb= nothing
BB = Split(AA, SS)
set aa2=nothing
AA2 = array("newsplittedarray")
ii=0
for each cc in bb
if cc<>"" then
redim PRESERVE aa2(ii)
aa2(Ii)=cc
ii=ii+1
end if
next
split2 = aa2
END FUNCTION
function bigtablewait()
strsearch=""
offset=0
do
wscript.sleep 100
'=== while we wait for input value (or button press), user can press "escape" key, "cancel" button or close internet explorer
if resbutmidstr="cancel" or reskeymid=27 or bready=true or resbutlefstr<>"" then
'=== if user pressed escape or cancel, we clear the frames
if resbutmidstr="cancel" or reskeymid=27 then
a = clefra(array("fmid","fbot"))
resbutmidstr="cancel"
end if
exit do
end if
if resbutbotstr="Precedent" then
a=offset
offset=offset-maxoff
offset=max(0,offset)
resbutbotstr=""
if offset<>a then
'=== totrec total number of record (displayed at end of first line)
'=== maxoff maxiumm number of row in a page
'=== offset page flip number (multiple of maxoff)
a = dynbotcho(fbot, tabnam2, aratit, ara01, 1 ,1, 1, 1, 1, edtmod,"bot")
end if
end if
if resbutbotstr="Next" then
a=offset
offset=offset+maxoff
if offset>totrec then offset=offset-maxoff
resbutbotstr=""
if offset<>a then
a = dynbotcho(fbot, tabnam2, aratit, ara01, 1 ,1, 1, 1, 1, edtmod,"bot")
end if
end if
if resbutbotstr="Search" or reskeybot=13 then
strsearch=fbot.form01.boxsearch.Value
strsearch=lcase(strsearch)
'=== make a dynamic query to search for every words in every columns
'makque(ssea, ttab, sselect,wwhere, ssufix,ooper,wwild)
'if whe=3 then whe=0
sql = makque(strsearch,tab,sel,whe,"",ooper,wwild)
if logall=1 then
fil02.WriteLine date & " " & time & " QUERY: "
fil02.WriteLine sql
'fil02.WriteLine date & " " & time & " Autoincrement status: " & objcol.Properties("AutoIncrement")
end if
a = exesql(objcon,tag,sql)
if tag.eof=0 then
myarray=TAG.GetRows()
else
redim myarray(coltot,0)
'fbot.WriteLn("<br>total columns: " & coltot & "<br>")
for i=0 to coltot
myarray(i,0)="ERROR there was 0 record in this query"
next
fbot.WriteLn("<br>ERROR<br>" & sql & "<br><br>gave 0 results<br>")
end if
offset=0
totrec = cnttotrec(myarray)
if logall=1 then
fil02.WriteLine date & " " & time & " total records: " & totrec+1
end if
a = dynbotcho(fbot, tabnam2, aratit, ara01, 1 ,1, 1, 1, 1, edtmod,"bot")
resbutbotstr=""
end if
reskeybot=0
loop while resbutbotstr=""
offset=0
end function
function edit_xml_node(colNodes01,filename01)
'=== make a big table that will contain other tables inside
h = "<!DOCTYPE html>"
h = h & "<html>"
h = h & "<head>"
h = h & "<style>"
h = h & "table#items01 tr:nth-child(even) {"
h = h & "background-color: #eee;"
h = h & "}"
h = h & "</style>"
h = h & "</head>"
h = h & "<body>"
h = h & "<form name=form01>"
'=== box to focus (first editable data)
'h = h & "<BODY onLoad=""document.form01.facturation.focus()"">"
h = h & "<table width=""100%"" BORDERCOLOR=""black"" class=MsoTableGrid border=1 CELLSPACING=0 cellpadding=2 style='border-collapse:collapse;border: 1px solid black'>"
'h = h & "<script type=""text/javascript"">"
'h = h & "function message(nodename) {"
'h = h & "var text = document.getElementById(nodename).value;"
'h = h & "alert(text);"
'h = h & "}"
'h = h & "</script>"
''''''''''''''''''''''''''''''''''''''''''''''''''''
' textbox creation to be able to edit xml nodes
''''''''''''''''''''''''''''''''''''''''''''''''''''
rootcnt01 = 0
prefix01 = "x" '=== textbox id need to start by a letter to defnie an event on it
prefix02 = "a" '=== this textbox ID is an attribute in xml, we treat it differently
For Each objNode01 in colNodes01
''''''''''''''''''''''''''''''''
' root name
''''''''''''''''''''''''''''''''
h = h & "<tr>" '=== line 1
text01 = objnode01.nodeName
h = h & "<td>"
h = h & "<input type=""textbox"" id=" & text01 & " NAME=""" & text01
h = h & """ size=""" & max(15,len(text01)) & """ value=""" & text01 & """ onKeypress=""return event.keyCode!=13"">"
h = h & "<input type=""button"" name=""add" & text01 & """ value="" + "">"
h = h & "</td>"
'h = h & "<td>" & objnode01.nodeName & "</td>"
childcnt01 = 0
for each objnode02 in objnode01.childnodes
'''''''''''''''''''''''''''''''''''''
' first child
'''''''''''''''''''''''''''''''''''''
h = h & "<tr>" '=== line 1
text01 = objnode02.nodename
h = h & "<td></td><td>"
h = h & "<input type=""textbox"" id=" & text01 & " NAME=""" & text01
h = h & """ size=""" & max(15,len(text01)) & """ value=""" & text01 & """ onKeypress=""return event.keyCode!=13"">"
h = h & "<input type=""button"" name=""add" & text01 & """ value="" + "">"
h = h & "</td>"
'h = h & "<td></td><td>" & objnode02.nodename & "</td>"
''''''''''''''''''''''''''''''''''''''''
' header (in bold)
''''''''''''''''''''''''''''''''''''''''
h = h & "<tr>"
h = h & "<td></td><td></td>"
h = h & "<td><b>Nodename</b></td>"
h = h & "<td><b>Node Text</b></td>"
'For Each objChild02 In objnode02.childNodes
' for each attribute01 in objchild02.attributes
h = h & "<td><b>Attribute Name</b></td>"
h = h & "<td><b>Attribute Text</b></td>"
' next
'next
h = h & "</tr>"
recordcnt01 = 0
For Each objChild02 In objnode02.childNodes
h = h & "<tr>"
''''''''''''''''''''''''''''''''''
' node name
''''''''''''''''''''''''''''''''''
h = h & "<td></td><td></td><td>" & objchild02.nodename & "</td>"
'h = h & "<td>" & displaynamefra & "</td>"
''''''''''''''''''''''''''''''''''
' nodetext
''''''''''''''''''''''''''''''''''
'txt = colnodes01(0).childNodes(0).childnodes(1).nodename
'=== use exact rootnode/childnode/childnode number to put in the ID of the text box
'id01 = objnode02.nodename & "__" & objchild02.nodename
id01 = prefix01 & rootcnt01 & "_" & childcnt01 & "_" & recordcnt01
text01 = objchild02.text
h = h & "<td>"
'=== we add an X before the name, case a textbox without a name is BAD
h = h & "<input type=""textbox"" id=""" & id01 & """ NAME=""" & id01
'h = h & """ size=""" & max(15,len(text01)) & """ value=""" & text01 & """ onKeypress=""return event.keyCode!=13"" onblur=message(" & objchild02.nodename & ");>"
h = h & """ size=""" & max(15,len(text01)) & """ value=""" & text01 & """ onKeypress=""return event.keyCode!=13"");>"
'=== futur
'h = h & "<input type=""button"" name=""add" & text01 & """ value="" + "">"
h = h & "</td>"
'''''''''''''''''''''''''''''''''''
' node attributes
'''''''''''''''''''''''''''''''''''
attributescnt01 = 0
for each attribute01 in objchild02.attributes
'=== if there is more than one atribute, we go to the next line for the next one
if attributescnt01 > 0 then
'=== uncomment this for the attributes to display vertically
'h = h & "</tr><tr><td></td><td></td><td></td><td></td>"
end if
'displaynamefra = objchild02.getattribute("displaynamefra")
h = h & "<td>" & attribute01.name
h = h & "</td>"
text01 = attribute01.text
id01 = prefix02 & rootcnt01 & "_" & childcnt01 & "_" & recordcnt01 & "_" & attributescnt01
h = h & "<td>"
h = h & "<input type=""textbox"" id=""" & id01 & """ NAME=""" & id01
h = h & """ size=""" & max(15,len(text01)) & """ value=""" & text01 & """ onKeypress=""return event.keyCode!=13"">"
'h = h & "<input type=""button"" name=""add" & text01 & """ value="" + "">"
h = h & "</td>"
attributescnt01 = attributescnt01 + 1
next
'h = h & "<script type=""text/javascript"">"
'h = h & "document.getElementById(""" & objchild02.nodename & """).onblur=message(""" & objchild02.nodename & """);"
'h = H & "</script>"
'h = h & "<td>" & objchild02.text & "</td>"
'fbot.WriteLn("<td>" & displaynamefra & " " & objchild02.text)
'fmid.forms(0).elements(buttmp(ii)).onblur = getref("buttonmid")
'=== regenerate the event that call a sub if a button is pressed
'set fmid.onkeypress = GetRef("Checkmid")
h = h & "</tr>" '=== line 1
recordcnt01 = recordcnt01 + 1
next
h = h & "</tr>" '=== line 1
childcnt01 = childcnt01 + 1
next
rootcnt01 = rootcnt01 + 1
h = h & "</tr>" '=== line 1
next
h = h & "</form>"
h = h & "</body>"
h = h & "</html>"
fbot.WriteLn(h)
fbot.location.reload(true)
call oieready
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' event creation for unblur (leaving/unselecting a textbox)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
rootcnt01 = 0
For Each objNode01 in colNodes01
root01 = objnode01.nodeName '=== facturation
'=== any node under root
childcnt01 = 0
for each objnode02 in objnode01.childnodes
text01 = objnode02.nodename '=== bill
recordcnt01 = 0
For Each objChild02 In objnode02.childNodes
h = h & "<tr>"
'displaynamefra = objchild02.getattribute("displaynamefra")
'=== not editable
'text01 = displaynamefra
if instr(objnode02.nodename,"_")<>0 then
'fmid.WriteLn("<br>ERROR you cannot use underscore _ in name: " & objnode02.nodename )
end if
if instr(objchild02.nodename,"_")<>0 then
'fmid.WriteLn("<br>ERROR you cannot use undesrcore _ in name: " & objchild02.nodename)
end if
'name01 = objnode02.nodename & "__" & objchild02.nodename
id01 = prefix01 & rootcnt01 & "_" & childcnt01 & "_" & recordcnt01
'fmid.WriteLn("<br>Event defined on: " & id01 & " ---" & objnode02.nodename & " --- " & objChild02.nodename)
on error resume next
set fbot.form01.elements(id01).onblur = getref("onblurbot")
if err=0 then
'fmid.WriteLn("---" & name01)
else
fmid.WriteLn("<br>ERROR defining event onblur for: " & id01 & " id of the element might be defined twice in the same html form")
end if
on error goto 0
'=== attribute event
attributescnt01 = 0
for each attribute01 in objchild02.attributes
id01 = prefix02 & rootcnt01 & "_" & childcnt01 & "_" & recordcnt01 & "_" & attributescnt01
on error resume next
set fbot.form01.elements(id01).onblur = getref("onblurbot")
if err=0 then
'fmid.WriteLn("---" & name01)
else
fmid.WriteLn("<br>ERROR defining event onblur for: " & id01 & " id of the element might be defined twice in the same html form")
end if
on error goto 0
attributescnt01 = attributescnt01 + 1
next
recordcnt01 = recordcnt01 + 1
next
childcnt01 = childcnt01 + 1
next
rootcnt01 = rootcnt01 + 1
exit for '=== we use only one root for the moment
next
'fbot.body.onBlur = GetRef("onblurbot")
Do While (oIE.Busy)
wscript.sleep 50
Loop
'=== wait till document loaded
do while oie.readystate<>4
wscript.sleep 50
Loop
'set fbot.forms(0).datedue.onblur = getref("onblurbot")
'fmid.WriteLn("<br>exiting edit")
'=== wait for any modification to occur
do
'=== flag to tell if the input is not valid
err01=0
'=== flag to say input is done, since there might be a defaut value, we must validate if user was finished
inpdon=0
'=== check if blur event occured (switch out of an input box)
'=== resblubotstr = name of the
'=== resblubotval = new value in the text box
'=== resblubotid = id (from html) for the textbox
if resblubotstr<>"" and bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
'=== User has clicked on another textbox
'fmid.WriteLn("<br>" & resblubotstr & " --- " & resblubotid & " --- " & resblubotval)
'=== find the xml node parent and children (record and text) using textbox id, split chain is __ (double underscore)
'=== contain root number, childnodes number, record number
'fmid.WriteLn("<br>" & colnodes01(idara01(0)).childNodes(idara01(1)).childnodes(idara01(2)).nodename)
if mid(resblubotstr,1,1) = "x" then
'=== record text modification
'fmid.WriteLn("<br>resblubotstr: " & resblubotstr)
'=== the id of the textbox is splitted to find the index for the xml element we want to update:
'=== node (facturation)
'=== first child (bill)
'=== record (name)
idara01 = split(right(resblubotid,len(resblubotid)-1), "_")
if colnodes01(idara01(0)).childNodes(idara01(1)).childnodes(idara01(2)).text <> resblubotval then
change01 = 1
colnodes01(idara01(0)).childNodes(idara01(1)).childnodes(idara01(2)).text = resblubotval
else
change01 = 0
end if
fmid.WriteLn("<br>" & resblubotid)
'=== something changed, we save
elseif mid(resblubotstr,1,1) = "a" then
'=== attribute modification
'=== the id of the textbox is splitted to find the index for the xml element we want to update:
'=== node (facturation)
'=== first child (bill)
'=== record (name)
'=== attribute (displaynamefra)
idara01 = split(right(resblubotid,len(resblubotid)-1), "_")
if colnodes01(idara01(0)).childNodes(idara01(1)).childnodes(idara01(2)).attributes(idara01(3)).text <> resblubotval then
change01 = 1
colnodes01(idara01(0)).childNodes(idara01(1)).childnodes(idara01(2)).attributes(idara01(3)).text = resblubotval
else
change01 = 0
end if
'fmid.WriteLn("<br>" & resblubotid)
'fmid.WriteLn("<br>attribute modif: " & colnodes01(idara01(0)).childNodes(idara01(1)).childnodes(idara01(2)).attributes(idara01(3)).text)
end if
if change01 = 1 then
'=== filename may change to new invoice if we change the number
Set colNodes02 = xmlDoc.selectNodes("/" & colnodes01(idara01(0)).nodename & "/bill/id")
For Each objNode in colNodes02
numero01 = objnode.text '=== number of the invoice to change the filename before saving
Next
filename02 = basedir & "\facturation" & numero01 & ".xml"
xmlDoc.Save filename02
'=== what was modified in the xml tree
tree01 = "/" & colnodes01(idara01(0)).nodename
tree01 = tree01 & "/" & colnodes01(idara01(0)).childNodes(idara01(1)).nodename
tree01 = tree01 & "/" & colnodes01(idara01(0)).childNodes(idara01(1)).childnodes(idara01(2)).nodename
fmid.WriteLn("<br>node modified: " & tree01 & " --- xml doc saved")
end if
resblubotstr = ""
resblubotval = ""
resblubotid = ""
end if
'inpdon
wscript.sleep 50
if resbutmidstr="cancel" or reskeymid=27 or bready=true or resbutlefstr<>"" then
'=== if user pressed escape or cancel, we clear the frames
if resbutmidstr="cancel" or reskeymid=27 then
a = clefra(array("fmid","fbot"))
resbutmidstr="cancel"
end if
exit do
end if
loop while err01<>0 or inpdon=0
end function
function validate(name110)
name110 = lcase(name110)
if name110 = "id" then name110 = "id"
'if instr(name110,"address")<>0 then name110 = replace(name110,"address","adres")
validate = name110
end function
function edit_xml_node_recur(colNodes01,filename01)
'=== testintg recursive displaying of a full xml file starting at the root
'=== making a html table with it
'=== references:
'<xs:element name="xxx" type="yyy"/>
'<xs:element name="color" type="xs:string" default="red"/>
'<xs:element name="color" type="xs:string" fixed="red"/>
'xs:string
'xs:decimal
'xs:integer
'xs:boolean
'xs:date
'xs:time
' NodeType Named Constant
'1 ELEMENT_NODE
'2 ATTRIBUTE_NODE
'3 TEXT_NODE
'4 CDATA_SECTION_NODE
'5 ENTITY_REFERENCE_NODE
'6 ENTITY_NODE
'7 PROCESSING_INSTRUCTION_NODE
'8 COMMENT_NODE
'9 DOCUMENT_NODE
'10 DOCUMENT_TYPE_NODE
'11 DOCUMENT_FRAGMENT_NODE
'12 NOTATION_NODE
'Node type NodeType
'Element 1
'Attribute 2
'Text 3
'Comment 8
'Document 9
a = clefra(array("fmid","fbot"))
fmid.WriteLn("<br>Filename we will edit: " & filename01)
'=== make a big table that will contain other tables inside
h = "<!DOCTYPE html>"
h = h & "<html>"
h = h & "<head>"
h = h & "<style>"
h = h & "table#items01 tr:nth-child(even) {"
h = h & "background-color: #eee;"
h = h & "}"
h = h & "</style>"
h = h & "</head>"
h = h & "<body>"
h = h & "<form name=form01>"
'=== box to focus (first editable data)
'h = h & "<BODY onLoad=""document.form01.facturation.focus()"">"
h = h & "<table width=""100%"" BORDERCOLOR=""black"" class=MsoTableGrid border=1 CELLSPACING=0 cellpadding=2 style='border-collapse:collapse;border: 1px solid black'>"
''''''''''''''''''''''''''''''''''''''''''''''''''''
' textbox creation to be able to edit xml nodes
''''''''''''''''''''''''''''''''''''''''''''''''''''
rootcnt01 = 0
prefix01 = "x" '=== textbox id need to start by a letter to defnie an event on it
prefix02 = "a" '=== this textbox ID is an attribute in xml, we treat it differently
level01 = 0
redim idtext01(level01)
'fmid.WriteLn("<br>Type of node: " & colNodes01.nodetype)
rootcnt01 = 0
For Each objNode01 in colNodes01
''''''''''''''''''''''''''''''''
' root name
''''''''''''''''''''''''''''''''
h = h & "<tr>" '=== line 1
text01 = objnode01.nodeName
h = h & "<td>"
h = h & "<input type=""textbox"" id=" & text01 & " NAME=""" & text01
h = h & """ size=""" & max(15,len(text01)) & """ value=""" & text01 & """ onKeypress=""return event.keyCode!=13"">"
h = h & "<input type=""button"" name=""add" & text01 & """ value="" + "">"
h = h & "</td>"
h = h & "</tr>"
idtext01(level01) = rootcnt01
level01 = 1 '=== root level for html id for textbox for unblur event
'''''''''''''''''''''''''''''''''''''''''''''''''
' recusre all nodes, childrens, attributes<
'''''''''''''''''''''''''''''''''''''''''''''''''
call recursenodes(objnode01, level01, action01, idtext01)
rootcnt01 = rootcnt01 + 1
next
h = h & "</form>"
h = h & "</body>"
h = h & "</html>"
fbot.WriteLn(h)
fbot.location.reload(true)
call oieready
wscript.sleep 50
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' event definition, now the page is done we define events to manage unblur (unfocus a box) and save xml
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
rootcnt01 = 0
For Each objNode01 in colNodes01
idtext01(level01) = rootcnt01
level01 = 1 '=== root level for html id for textbox for unblur event
'''''''''''''''''''''''''''''''''''''''''''''''''
' recusre all nodes, childrens, attributes<
'''''''''''''''''''''''''''''''''''''''''''''''''
action01 = 1 '=== define event onblur for all id in html form
call recursenodes(objnode01, level01, action01, idtext01)
rootcnt01 = rootcnt01 + 1
next
'=== wait for any modification to occur
do
'=== flag to tell if the input is not valid
err01=0
'=== flag to say input is done, since there might be a defaut value, we must validate if user was finished
inpdon=0
'=== check if blur event occured (switch out of an input box)
'=== resblubotstr = name of the
'=== resblubotval = new value in the text box
'=== resblubotid = id (from html) for the textbox
if resblubotstr<>"" and bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
'=== User has clicked on another textbox
'fmid.WriteLn("<br>" & resblubotstr & " --- " & resblubotid & " --- " & resblubotval)
'=== find the xml node parent and children (record and text) using textbox id, split chain is __ (double underscore)
'=== contain root number, childnodes number, record number
'fmid.WriteLn("<br>" & colnodes01(idara01(0)).childNodes(idara01(1)).childnodes(idara01(2)).nodename)
if mid(resblubotstr,1,1) = "x" then
'=== record text modification
'fmid.WriteLn("<br>resblubotstr: " & resblubotstr)
'=== the id of the textbox is splitted to find the index for the xml element we want to update:
'=== node (facturation)
'=== first child (bill)
'=== record (name)
idara01 = split(right(resblubotid,len(resblubotid)-1), "_")
command01 = "colnodes01(idara01(0))"
for i = 0 to ubound(idara01)
if i > 0 then '=== skip root, just add as many child as we need
command01 = command01 & ".childNodes(idara01(" & i & "))"
end if
next
command01 = command01 & ".text"
command02 = "result01 = " & command01
'fmid.WriteLn("<br>" & command02)
execute command02
if result01 <> resblubotval then
change01 = 1
command02 = command01 & " = resblubotval"
'fmid.WriteLn("<br>" & command02)
execute command02
else
change01 = 0
end if
'fmid.WriteLn("<br>" & command01 & " - " & resblubotid)
'=== something changed, we save
elseif mid(resblubotstr,1,1) = "a" then
'=== attribute modification
'=== the id of the textbox is splitted to find the index for the xml element we want to update:
'=== node (facturation)
'=== first child (bill)
'=== record (name)
'=== attribute (displaynamefra)
idara01 = split(right(resblubotid,len(resblubotid)-1), "_")
command01 = "colnodes01(idara01(0))"
for i = 0 to ubound(idara01)
if i > 0 and i<ubound(idara01) then '=== skip root, just add as many child as we need
command01 = command01 & ".childNodes(idara01(" & i & "))"
end if
if i = ubound(idara01) then
command01 = command01 & ".attributes(idara01(" & i & "))"
end if
next
command01 = command01 & ".text"
command02 = "result01 = " & command01
'fmid.WriteLn("<br>" & command02)
execute command02
if result01 <> resblubotval then
change01 = 1
command02 = command01 & " = resblubotval"
'fmid.WriteLn("<br>" & command02)
execute command02
else
change01 = 0
end if
'fmid.WriteLn("<br>" & command01 & " - " & resblubotval & " - " & result01)
'fmid.WriteLn("<br>attribute modif: " & colnodes01(idara01(0)).childNodes(idara01(1)).childnodes(idara01(2)).attributes(idara01(3)).text)
elseif mid(resblubotstr,1,1) = "n" then
'=== new text element
idara01 = split(right(resblubotid,len(resblubotid)-1), "_")
command01 = "colnodes01(idara01(0))"
for i = 0 to ubound(idara01)
if i > 0 and i <> ubound(idara01) then '=== skip root, just add as many child as we need
'=== text element does not exist
'=== so we must go one branch lower in the tree
command01 = command01 & ".childNodes(idara01(" & i & "))"
end if
if i = ubound(idara01) then
'command01 = command01 & ".attributes(idara01(" & i & "))"
end if
next
if resblubotval<>"" then
change01 = 1
'=== even if text child element does not exist, assigning a value to .text will create it automatically
command02 = command01 & ".Text = """ & resblubotval & """"
'fmid.WriteLn("<br>colnodes01(idara01(0)).childNodes(idara01(1)).childnodes(idara01(2)).text = resblubotval")
'fmid.WriteLn("<br>" & command02)
execute command02
else
change01 = 0
end if
end if
if change01 = 1 then
'=== filename may change to new invoice if we change the number
if instr(filename01,"facturation")<>0 then
Set colNodes02 = xmlDoc.selectNodes("/" & colnodes01(idara01(0)).nodename & "/bill/id")
For Each objNode in colNodes02
numero01 = objnode.text '=== number of the invoice to change the filename before saving
Next
end if
if instr(filename01,"facturation")<>0 then
filename02 = basedir & "facturation" & numero01 & ".xml"
else
filename02 = filename01
'fmid.WriteLn("<br>node modified: " & tree01 & " --- xml doc saved: " & filename02)
end if
xmlDoc.Save filename02
'=== what was modified in the xml tree
tree01 = "/" & colnodes01(idara01(0)).nodename
tree01 = tree01 & "/" & colnodes01(idara01(0)).childNodes(idara01(1)).nodename
tree01 = tree01 & "/" & colnodes01(idara01(0)).childNodes(idara01(1)).childnodes(idara01(2)).nodename
fmid.WriteLn("<br>node modified: " & tree01 & " --- xml doc saved: " & filename02)
end if
resblubotstr = ""
resblubotval = ""
resblubotid = ""
end if
'inpdon
wscript.sleep 50
if resbutmidstr="cancel" or reskeymid=27 or bready=true or resbutlefstr<>"" then
'=== if user pressed escape or cancel, we clear the frames
if resbutmidstr="cancel" or reskeymid=27 then
a = clefra(array("fmid","fbot"))
resbutmidstr="cancel"
end if
exit do
end if
loop while err01<>0 or inpdon=0
end function
sub recursenodes(objnode01, level01, action01, idtext01)
'=== action01 = 0 = generate html stuff
'=== action01 = 1 = generate unblur events for internet explorer and this script
if objnode01.haschildnodes=false then
h = h & "</tr><tr>"
else
h = h & "<tr>"
nodecnt01 = 0
textnodepresent01 = 0
for each objnode02 in objnode01.childnodes
redim preserve idtext01(level01) '=== textbox id to define an event on (event: onblur, leaving the textbox will result in our script to save xml file)
if objnode02.nodetype = 1 then
'=== this node is an ELEMENT
x = 0
while x<level01
h = h & "<td></td>"
x = x + 1
wend
idtext01(level01) = nodecnt01
end if
text01 = objnode02.nodename '=== bill
if objnode02.nodetype = 3 then
'=== this node is a TEXT
'=== we go back to line before to display it, we dont want to skip to next line for nothing since a text element is always the last element of the line
h = left(h, len(h)-9) '=== removing "</tr><tr>"
idtext01(level01) = nodecnt01
'h = h & "<td>test</td>"
end if
if text01 = "#text" then
'=== text field of xml element, is the text of the element with "#text" name
textnodepresent01 = 1
'=== editable value
text01 = objnode02.text
text01 = replace(text01,"""",""")
idtext01(level01) = nodecnt01
id01 = "x"
idcnt = 0
for each x in idtext01
if idcnt = 0 then
id01 = id01 & x
else
id01 = id01 & "_" & x
end if
idcnt = idcnt + 1
next
'=== define event onblur (html must de done and refreshed)
'=== we use the same recursive sub twice, once to generate html content, once to generate vbs event for internet explorer
if action01 = 1 then
set fbot.form01.elements(id01).onblur = getref("onblurbot")
end if
h = h & "<td>"
'=== we add an X before the name, case a textbox without a name is BAD
'h = h & "<input type=""textbox"" id=""" & id01 & """ NAME=""" & id01
'h = h & """ size=""" & max(15,len(text01)) & """ value=""" & text01 & """ onKeypress=""return event.keyCode!=13"");>"
width01 = 25
height01 = int(len(text01)/width01)+1
h = h & "<textarea cols=""" & width01 & """ rows=""" & height01 & """ id=""" & id01 & """ NAME=""" & id01 & """>" & text01 & "</textarea>"
'=== futur
'h = h & "<input type=""button"" name=""add" & text01 & """ value="" + "">"
h = h & "</td>"
'h = h & "<td>" & id01 & "</td>"
'h = h & "<td>" & level01 & "</td>"
else
'=== attribute of an xml element
h = h & "<td>" & text01 & "</td>"
attributescnt01 = 0
for each attribute01 in objnode02.attributes
redim preserve idtext01(level01 + 1) '=== textbox id to define an event on (event: onblur, leaving the textbox will result in our script to save xml file)
'=== if there is more than one attribute, ident one more column, put it on next line
if attributescnt01>0 then
h = h & "<tr>"
x = -1
while x<level01
h = h & "<td></td>"
x = x + 1
wend
end if
idtext01(level01 + 1) = attributescnt01
id01 = "a"
idcnt = 0
for each x in idtext01
if idcnt = 0 then
id01 = id01 & x
else
id01 = id01 & "_" & x
end if
idcnt = idcnt + 1
next
'=== define event onblur (html must de done and refreshed)
'=== we use the same recursive sub twice, once to generate html content, once to generate vbs event for internet explorer
if action01 = 1 then
set fbot.form01.elements(id01).onblur = getref("onblurbot")
end if
h = h & "<td>" & attribute01.name
h = h & "</td>"
text01 = attribute01.text
text01 = replace(text01,"""",""")
'id01 = prefix02 & rootcnt01 & "_" & childcnt01 & "_" & recordcnt01 & "_" & attributescnt01
h = h & "<td>"
'h = h & "<input type=""textbox"" id=""" & id01 & """ NAME=""" & id01
'h = h & """ size=""" & max(15,len(text01)) & """ value=""" & text01 & """ onKeypress=""return event.keyCode!=13"">"
width01 = 25
height01 = int(len(text01)/width01)+1
h = h & "<textarea cols=""" & width01 & """ rows=""" & height01 & """ id=""" & id01 & """ NAME=""" & id01 & """>" & text01 & "</textarea>"
'h = h & "<input type=""button"" name=""add" & text01 & """ value="" + "">"
h = h & "</td>"
'h = h & "<td>" & id01 & "</td>"
attributescnt01 = attributescnt01 + 1
if attributescnt01>0 then
h = h & "</tr>"
end if
next
end if
'=== if element have attribute(s)
'=== if element is not a text node (its an element with no child with the name "#text")
'=== we add a box to be able to add a text child with a value
if attributescnt01<>0 and textnodepresent01 = 0 and objnode02.haschildnodes=false then
h = left(h, len(h)-5) '=== removing "</tr>"
id01 = "n" '=== for new node
idcnt = 0
for each x in idtext01
if idcnt = 0 then
id01 = id01 & x
else
id01 = id01 & "_" & x
end if
idcnt = idcnt + 1
next
text01 = ""
width01 = 25
height01 = int(len(text01)/width01)+1
h = h & "<td>"
h = h & "<textarea cols=""" & width01 & """ rows=""" & height01 & """ id=""" & id01 & """ NAME=""" & id01 & """></textarea>"
h = h & "</td></tr>"
'h = h & "<td>" & "test" & "</td></tr>"
if action01 = 1 then
'=== this should be an action to add a new node with text in it
set fbot.form01.elements(id01).onblur = getref("onblurbot")
end if
end if
call recursenodes(objnode02, level01 + 1, action01, idtext01)
nodecnt01 = nodecnt01 + 1
next
end if
end sub
function fPingTest( strComputer )
dim objShell,objPing
dim strPingOut, flag
set objShell = CreateObject("Wscript.Shell")
set objPing = objShell.Exec("ping " & strComputer)
strPingOut = objPing.StdOut.ReadAll
if instr(LCase(strPingOut), "reply") or instr(LCase(strPingOut), "ponse de") then
flag = TRUE
else
flag = FALSE
end if
fPingTest = flag
end function
function wrifra(frame10, msg10, verbose01)
if bready = false then
if verbose01 = 1 then
frame10.writeln(msg10)
elseIF VERBOSE01 = 2 then
frame10.writeln(msg10)
frame10.parentwindow.scrollBy 0, 1000
ELSE
'=== silent mode for a function or a sub
end if
else
'=== iexplore object is closed
end if
end function
