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""/>&nbsp;"
'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 & "&nbsp; <b><span style='color:" & col & "'>&nbsp" & 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=""&nbsp;" & buttmp(ii) & "&nbsp;"">"
              htmtab = htmtab & "&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp"
       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 & "&nbsp; <b><span style='color:" & col & "'>&nbsp" & 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=""&nbsp;" & buttmp(ii) & "&nbsp;"">"
      htmtab = htmtab & "&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp"
   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=""&nbsp;+&nbsp;"">"
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=""&nbsp;+&nbsp;"">"
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=""&nbsp;+&nbsp;"">"
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=""&nbsp;+&nbsp;"">"
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=""&nbsp;+&nbsp;"">"
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,"""","&quot;")

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=""&nbsp;+&nbsp;"">"
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,"""","&quot;")
'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=""&nbsp;+&nbsp;"">"
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

4 comments:

  1. Really cool tutorial, i really like the web interface tho, but i think i already seen it on a older project, or maybe more than one, but i might be mistaken.

    ReplyDelete
  2. Do you How to Remove the Sync Issues Folder in Outlook 2003as 'Not formed in NEO folders' by catching the following steps: Go within NEO to the Outlook Folder Tab. Detect and right-click the clash folder. Facing problems in sync issues folder in outlook known more call us +1-844-872-1287

    ReplyDelete