Sunday, November 22, 2015

vbs invoice program using recursive xml editor with dynamic stand alone html interface

Hi,

This program use my usual web interface:
A vbscript (windows host script or wsh) program to display html in internet explorer

It is a program to generate invoices
Button 1 will generate a nice html table with the invoice
Button 2 will generate a new invoice content in an xml file
Button 3 will use a recursive xml editor that will scan the script's folder for xml files to edit
The editor can modify the attributes and value of any xml field available in the xml file
Exept for the value of an xml field that have an attribute, but no value
In this case, the editor will still generate a textbox to input a value that will be assigned to the xml text element if it is not empty

The xml editor is recursive, so it can edit any xml file, not only invoices
If the keyword "facturation" is in the xml file name, it will use bill id field as number to add at the end of the xml file to save it
This way, you can load an old invoice, change the id and save it as a new invoice
There is no save button. Changing any value in the xml editor will save the invoice as a xml file
Or if it is not a file name with "facturation" in it, simply save the xml file with original name

Use notepad.exe to insert the code, then save as a .VBS file

Now if you try to change the recursive xml editor section (at the end), do not let your head explode as you try to understand the code ;)

I use the recursive sub twice
The first time (action01 = 0) it generate html content to display in frame
The ID of the textbox is generated wit different prefix
"a" for an attribute
"x" for a xml element
"n" for a xml element without a value
The level 0 of the element is not really necessary, because we always pass the root of the xml elements to the sub as an object
The ID look like this:
x_0_0_1 mean the child 0, child 0, child 1 fo an xml value

On the second use of the recursive sub (action01 = 1), i define the events unblur (leaving a textbox in html)
The event is attached to the ID (example: "x_0_0_1")
When the event occur in the vbs script, the ID is split in an array to identify what textbox was unblured (which textbox the cursor was before the user moved it)
I use this array to generate dynamic code to acces an infinite number of childrens (infinite is a big word)
Then, using execution of code inside code, i get ot set the value of the xml element

There is a special case, when the element have no value
Then I acces one level lower, because XML does not assign a child element containing a value to an xml element if the element have no value

--------------------------------facturation.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")

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)

'=== 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"

if objFSO.fileEXISTS(a64) and instr(lcase(wscript.fullname),"syswow64")=0 then
   '=== 64 bits system
   a = """" & a64 & """ """ & basedir & filnam & """"
   objshe.Run a,0, false
   wscript.quit
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 & "zzz_troubleshooting.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)="facturation"
arabutdes(x)="Facturation Invoice Result for print"
aradepnam(x)="print"
aradepcol(x)="cccccc"

x=x+1
ReDim Preserve arabutnam(x): ReDim Preserve arabutdes(x): ReDim Preserve aradepnam(x): ReDim Preserve aradepcol(x)
arabutnam(x)="facturationnew"
arabutdes(x)="Facturation Invoice New"
aradepnam(x)="new"
aradepcol(x)="cccccc"

'x=x+1
'ReDim Preserve arabutnam(x): ReDim Preserve arabutdes(x): ReDim Preserve aradepnam(x): ReDim Preserve aradepcol(x)
'arabutnam(x)="editxmlfile"
'arabutdes(x)="Edit xml file"
'aradepnam(x)="edition"
'aradepcol(x)="cccccc"

'x=x+1
'ReDim Preserve arabutnam(x): ReDim Preserve arabutdes(x): ReDim Preserve aradepnam(x): ReDim Preserve aradepcol(x)
'arabutnam(x)="displayxmlfile"
'arabutdes(x)="Display xml file"
'aradepnam(x)="display"
'aradepcol(x)="cccccc"

x=x+1
ReDim Preserve arabutnam(x): ReDim Preserve arabutdes(x): ReDim Preserve aradepnam(x): ReDim Preserve aradepcol(x)
arabutnam(x)="editxmlfilerecur"
arabutdes(x)="Edit xml file recursivly"
aradepnam(x)="edition"
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)

'=== 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

do
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

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 = dynforgen (distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)

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
'=== "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
text=fmid.form01.text01.Value '=== namtmp is the variable name used earlier,before we call the dynamic form generation for input

if len(text) < 1 then
err01=1
'=== error message for the first form (if the keyword "error" is in this string, its displayed in RED)
if len(text) < 1 then
errtmp(0)="error - must be 1 char long at least"
else
errtmp(0)="ok"
end if

'=== if the value was not good, we generate the dynamic input for again, with an error message after the form in red
a = dynforgen(distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)
'=== there was an invalid input so we reset the key or button pressed to nothing so the loop can continue
reskeymid=0
resbutmidstr=""
else
'=== the input was validated, we flag err01 to none, and flag inpdon to exit the loop
inpdon=1
err01=0
end if

end if
wscript.sleep 100

'=== 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
exit do
end if
'=== if there was an input error and no one used left control frame to exit, we keep asking for input
loop while err01<>0 or inpdon=0

'=== 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



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 = dynforgen (distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)

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
'=== "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
text=fmid.form01.text01.Value '=== namtmp is the variable name used earlier,before we call the dynamic form generation for input

if len(text) < 1 then
err01=1
'=== error message for the first form (if the keyword "error" is in this string, its displayed in RED)
if len(text) < 1 then
errtmp(0)="error - must be 1 char long at least"
else
errtmp(0)="ok"
end if

'=== if the value was not good, we generate the dynamic input for again, with an error message after the form in red
a = dynforgen(distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)
'=== there was an invalid input so we reset the key or button pressed to nothing so the loop can continue
reskeymid=0
resbutmidstr=""
else
'=== the input was validated, we flag err01 to none, and flag inpdon to exit the loop
inpdon=1
err01=0
end if

end if
wscript.sleep 100

'=== 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
exit do
end if
'=== if there was an input error and no one used left control frame to exit, we keep asking for input
loop while err01<>0 or inpdon=0

'=== 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 = dynforgen (distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)

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
'=== "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
text=fmid.form01.text01.Value '=== namtmp is the variable name used earlier,before we call the dynamic form generation for input

if len(text) < 1 then
err01=1
'=== error message for the first form (if the keyword "error" is in this string, its displayed in RED)
if len(text) < 1 then
errtmp(0)="error - must be 1 char long at least"
else
errtmp(0)="ok"
end if

'=== if the value was not good, we generate the dynamic input for again, with an error message after the form in red
a = dynforgen(distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)
'=== there was an invalid input so we reset the key or button pressed to nothing so the loop can continue
reskeymid=0
resbutmidstr=""
else
'=== the input was validated, we flag err01 to none, and flag inpdon to exit the loop
inpdon=1
err01=0
end if

end if
wscript.sleep 100

'=== 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
exit do
end if
'=== if there was an input error and no one used left control frame to exit, we keep asking for input
loop while err01<>0 or inpdon=0

'=== 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 = "418-973-1133"
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 = dynforgen (distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)

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
'=== "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
text=fmid.form01.text01.Value '=== namtmp is the variable name used earlier,before we call the dynamic form generation for input

if len(text) < 1 then
err01=1
'=== error message for the first form (if the keyword "error" is in this string, its displayed in RED)
if len(text) < 1 then
errtmp(0)="error - must be 1 char long at least"
else
errtmp(0)="ok"
end if

'=== if the value was not good, we generate the dynamic input for again, with an error message after the form in red
a = dynforgen(distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)
'=== there was an invalid input so we reset the key or button pressed to nothing so the loop can continue
reskeymid=0
resbutmidstr=""
else
'=== the input was validated, we flag err01 to none, and flag inpdon to exit the loop
inpdon=1
err01=0
end if

end if
wscript.sleep 100

'=== 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
exit do
end if
'=== if there was an input error and no one used left control frame to exit, we keep asking for input
loop while err01<>0 or inpdon=0

'=== 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 = "caca"
  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
      a = clefra(array("fmid","fbot"))
   
      '=== print button
      aa = lcase(fbot.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(fbot.readystate)
      loop
     
      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)", _
      "1.5 images directory: PhotoHydComponent",_
      "",_
      "3. REFERENCES:",_
      "",_
      "Email: sergefournier(a)hotmail.com",_
      "Contact: Serge Fournier, Prog./Analyst")
   
      for each a in texara
         aa = lcase(fbot.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(fbot.readystate)
         loop
         fbot.WriteLn(a & "<br>")
      next
      aa = lcase(fbot.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(fbot.readystate)
      loop
   
      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 =========================================================================

function dynforgen (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%;"" 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()
   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 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









2 comments:

  1. Programming Corner Wildboy85: Vbs Invoice Program Using Recursive Xml Editor With Dynamic Stand Alone Html Interface >>>>> Download Now

    >>>>> Download Full

    Programming Corner Wildboy85: Vbs Invoice Program Using Recursive Xml Editor With Dynamic Stand Alone Html Interface >>>>> Download LINK

    >>>>> Download Now

    Programming Corner Wildboy85: Vbs Invoice Program Using Recursive Xml Editor With Dynamic Stand Alone Html Interface >>>>> Download Full

    >>>>> Download LINK P2

    ReplyDelete