Hello,
To install the 2016 server managements tools, a french windows need to have english installed in windows 10
But, the "download" button was not present after adding english in windows 10 version 1703
Here is the solution that worked for me:
Download the .CAB for your language at one of these sites:
https://www.itechtics.com/windows-10-version-1703-language-packs/
https://www.itechtics.com/windows-10-version-1709-language-packs-direct-download-links/
Install the .CAB with DISM:
Dism /online /Add-Package /PackagePath:\\yourserver\Software\Microsoft_Windows\win10una1703frapro_work_en-us_CAB\lp_38a2c8c87c52a0dbe0c1cbf98fe79377383063ec.cab
(this worked, but the language was not visible in windows's 10 menus)
Delete the language with LPKsetup:
lpksetup.exe /u en-us
Add the language again with LPKSETUP:
lpksetup
(browse for the .cab file, install)
The new language is now in windows's menus to switch it.
Thursday, November 16, 2017
Sunday, September 17, 2017
github create folder share folder set share permissions set acl ntfs permissions powershell
Hello,
This project is in github
Based on:
powershell 5.0
lots of arrays
It will:
Create folders for each sectors of an enterprise
Share these folders for everyone (eventually for precise groups)
Apply ACL ntfs permissions on the content of these folders
Application:
Run on a windows server 2016 to create a folder and share structure in an enterprise
https://github.com/Wildboy85/create_folder_share_acl_permissions
This project is in github
Based on:
powershell 5.0
lots of arrays
It will:
Create folders for each sectors of an enterprise
Share these folders for everyone (eventually for precise groups)
Apply ACL ntfs permissions on the content of these folders
Application:
Run on a windows server 2016 to create a folder and share structure in an enterprise
https://github.com/Wildboy85/create_folder_share_acl_permissions
Tuesday, August 1, 2017
wim editing windows 10 1703
2017-09-16 folder created "generic" with same name as where this script is executed
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
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
Subscribe to:
Posts (Atom)