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""/> "
'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 & " <b><span style='color:" & col & "'> " & errtmp(ii) & "</span></b><br style='mso-special-character:line-break'>"
next
htmtab = htmtab & "<![if !supportLineBreakNewLine]><br style='mso-special-character:line-break'>"
htmtab = htmtab & "<![endif]></p>"
for ii=0 to ubound(buttmp)
typ01 = "button"
htmtab = htmtab & "<input type=""" & typ01 & """ name=""" & buttmp(ii) & """ value="" " & buttmp(ii) & " "">"
htmtab = htmtab & "          "
next
htmtab = htmtab & "</div>"
htmtab = htmtab & "</form>"
htmtab = htmtab & "</body>"
htmtab = htmtab & "</html>"
fmid.writeln htmtab
fmid.location.reload(true)
'=== wait for internet explorer to be ready after we refresh the page with the new form
for ii=0 to ubound(buttmp)
Do While (oIE.Busy)
wscript.sleep 100
loop
do while oie.readystate<>4
wscript.sleep 100
Loop
'=== value to return for each button in the form
fmid.forms(0).elements(buttmp(ii)).onclick = getref("buttonmid")
next
'=== regenerate the event that call a sub if a button is pressed
set fmid.onkeypress = GetRef("Checkmid")
'=== clear button pressed and key pressed for this frame
resbutmidstr=""
reskeymid=0
end function
'=== max
Function max(a, b)
If a > b Then max = a Else max = b
End Function
function crewebmai(oie, doctit, maitit, arabutnam, arabutdes, aradepnam, aradepcol)
'=== create an internet explorer object (oie) that will be in 3 frames (flef, fmid, fbot), acting at the main interface for all this program
oie.FullScreen = False
'.ToolBar = False
'.StatusBar = False
'.Navigate("About:Blank")
'.visible = true
oIE.left=0 ' window position
oIE.top = 0 ' and other properties
'.ParentWindow
' .resizeto 640,300
' .moveto (.screen.width
oIE.height = 500
oIE.width = 500
oIE.menubar = 1 '=== no menu
oIE.toolbar = 1
oIE.statusbar = 1
oIE.RegisterAsDropTarget = True
oie.Navigate("about:blank")
'oie.Navigate("about:tabs")
oie.document.title = doctit
oiewid = oie.document.parentwindow.screen.width
oiehei = oie.document.parentwindow.screen.height
sizwidpercent = 100
sizheipercent = 95
loswid = 100-sizwidpercent
loshei = 100-sizheipercent
newwid = oiewid*sizwidpercent*.01
newhei = oiehei*sizheipercent*.01
oie.document.parentwindow.resizeto newwid,newhei
newx = oiewid * loswid * .01 /2
newy = oiehei * (loshei/2) * .01 /2
oie.document.parentwindow.moveto newx, newy
oIE.visible = 1 '=== visible on
oie.addressbar=false
'=== we will always have 3 frames, control, input and output (flef, fmid, fbot)
'=== used an array to have a good view of the line of html and possibility to add something else easily
aratmp=array(_
"<HTML>",_
"<HEAD><TITLE>" & doctit & "</TITLE>",_
"<meta content=""text/html; charset=utf-8"" http-equiv=""Content-Type"">",_
"<meta http-equiv=""X-UA-Compatible"" content=""IE=8"">",_
"</HEAD>",_
"<FRAMESET id='main' COLS=""13%, *"">",_
"<FRAME SRC=""About:Blank"" NAME=""left"" id=""left"">",_
"<frameset id='main2' rows=""30%,70%"">",_
"<FRAME SRC=""About:Blank"" NAME=""middle"" id=""middle"">",_
"<FRAME SRC=""About:Blank"" NAME=""bottom"" id=""bottom"">",_
"</FRAMESET>", _
"</frameset>", _
"</HTML>")
'oie.Navigate("About:Blank")
'=== send the array content in internet explorer to create 3 frames
for i = 0 to UBound(aratmp, 1)
oie.document.WriteLn(aratmp(i))
next
oie.refresh
Do While (oIE.Busy)
wscript.sleep 50
Loop
'=== wait till document loaded
do while oie.readystate<>4
wscript.sleep 50
Loop
'=== vista activate
'=== make internet explorer the main active window
a = objShe.AppActivate("http:/// - " & doctit & " - M")
a = objShe.AppActivate(doctit & " - M")
'=== theses objects are used to send data to the 3 different frames
'=== if you dont define them as object, the access to them is very slow when we use the names instead of the objects
'=== object used to write in a frame with writeln
fileversion = objFSO.GetFileVersion("C:\program files\internet explorer\iexplore.exe")
finddot = instr(fileversion,".")
fileversion2 = left(fileversion,finddot-1)
if fileversion2 = "10" or fileversion2 = "11" then
'=== ie10 frame access
set flef = oie.parent.document.getElementByid("left").contentdocument
set fmid = oie.parent.document.getElementByid("middle").contentdocument
set fbot = oie.parent.document.getElementByid("bottom").contentdocument
else
set flef = oie.document.frames("left").document
set fmid = oie.document.frames("middle").document
set fbot = oie.document.frames("bottom").document
end if
'=== object used to navigate an empty page in a frame
'set flefl = oie.document.frames("left").location
'set fmidl = oie.document.frames("middle").location
'set fbotl = oie.document.frames("bottom").location
'=== string result for a button press in a frame (lef = left frame, mid = middle frame (up))
resbutlefstr=""
resbutmidstr=""
resbutbotstr=""
reskeylef=0
reskeymid=0
reskeybot=0
'=== all the chek to be made in first page (1 at the moment, since ready have many values)
nbrbut=UBound(arabutnam, 1)
redim buttag(nbrbut)
form = "flef"
flef.WriteLn("<html><body>")
flef.WriteLn("<body background=""" & basedir & "images_interface\fond_gauche.jpg"">")
flef.WriteLn("<h3><span class=SpellE>" & maitit & "</span></h3>")
flef.WriteLn("<form name='form1'>")
'(1) Where you want the image to appear: <span id="image"></span>
'(2) Get a reference to it: var e = document.getElementById('image');
'(3) Insert the img HTML code into the span: e.innerHTML = '<img src="./images/your_picture.jpg" />';
htmtab = ""
'htmtab = htmtab & "<img src=" & aa & " alt=" & aa & " />"
fmid.location.reload(true)
for i=0 to ubound(arabutnam)
'=== convert xls to mdb button appear for stas only
if ((usenam="wildboy" or usenam="fournier.serge" or usenam="fortin.jp" or usenam="lavoie.daniel" or usenam="doucet.gm") and arabutnam(i)="excel2mdb") or arabutnam(i)<>"excel2mdb" then
'style="background-color: #cc0000; color: #ffffff;" /
b = "<input type=""button"" style=""height:50px;font-size:14px;width:100%;"" 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="" + "">"
h = h & "</td>"
'h = h & "<td>" & objnode01.nodeName & "</td>"
childcnt01 = 0
for each objnode02 in objnode01.childnodes
'''''''''''''''''''''''''''''''''''''
' first child
'''''''''''''''''''''''''''''''''''''
h = h & "<tr>" '=== line 1
text01 = objnode02.nodename
h = h & "<td></td><td>"
h = h & "<input type=""textbox"" id=" & text01 & " NAME=""" & text01
h = h & """ size=""" & max(15,len(text01)) & """ value=""" & text01 & """ onKeypress=""return event.keyCode!=13"">"
h = h & "<input type=""button"" name=""add" & text01 & """ value="" + "">"
h = h & "</td>"
'h = h & "<td></td><td>" & objnode02.nodename & "</td>"
''''''''''''''''''''''''''''''''''''''''
' header (in bold)
''''''''''''''''''''''''''''''''''''''''
h = h & "<tr>"
h = h & "<td></td><td></td>"
h = h & "<td><b>Nodename</b></td>"
h = h & "<td><b>Node Text</b></td>"
'For Each objChild02 In objnode02.childNodes
' for each attribute01 in objchild02.attributes
h = h & "<td><b>Attribute Name</b></td>"
h = h & "<td><b>Attribute Text</b></td>"
' next
'next
h = h & "</tr>"
recordcnt01 = 0
For Each objChild02 In objnode02.childNodes
h = h & "<tr>"
''''''''''''''''''''''''''''''''''
' node name
''''''''''''''''''''''''''''''''''
h = h & "<td></td><td></td><td>" & objchild02.nodename & "</td>"
'h = h & "<td>" & displaynamefra & "</td>"
''''''''''''''''''''''''''''''''''
' nodetext
''''''''''''''''''''''''''''''''''
'txt = colnodes01(0).childNodes(0).childnodes(1).nodename
'=== use exact rootnode/childnode/childnode number to put in the ID of the text box
'id01 = objnode02.nodename & "__" & objchild02.nodename
id01 = prefix01 & rootcnt01 & "_" & childcnt01 & "_" & recordcnt01
text01 = objchild02.text
h = h & "<td>"
'=== we add an X before the name, case a textbox without a name is BAD
h = h & "<input type=""textbox"" id=""" & id01 & """ NAME=""" & id01
'h = h & """ size=""" & max(15,len(text01)) & """ value=""" & text01 & """ onKeypress=""return event.keyCode!=13"" onblur=message(" & objchild02.nodename & ");>"
h = h & """ size=""" & max(15,len(text01)) & """ value=""" & text01 & """ onKeypress=""return event.keyCode!=13"");>"
'=== futur
'h = h & "<input type=""button"" name=""add" & text01 & """ value="" + "">"
h = h & "</td>"
'''''''''''''''''''''''''''''''''''
' node attributes
'''''''''''''''''''''''''''''''''''
attributescnt01 = 0
for each attribute01 in objchild02.attributes
'=== if there is more than one atribute, we go to the next line for the next one
if attributescnt01 > 0 then
'=== uncomment this for the attributes to display vertically
'h = h & "</tr><tr><td></td><td></td><td></td><td></td>"
end if
'displaynamefra = objchild02.getattribute("displaynamefra")
h = h & "<td>" & attribute01.name
h = h & "</td>"
text01 = attribute01.text
id01 = prefix02 & rootcnt01 & "_" & childcnt01 & "_" & recordcnt01 & "_" & attributescnt01
h = h & "<td>"
h = h & "<input type=""textbox"" id=""" & id01 & """ NAME=""" & id01
h = h & """ size=""" & max(15,len(text01)) & """ value=""" & text01 & """ onKeypress=""return event.keyCode!=13"">"
'h = h & "<input type=""button"" name=""add" & text01 & """ value="" + "">"
h = h & "</td>"
attributescnt01 = attributescnt01 + 1
next
'h = h & "<script type=""text/javascript"">"
'h = h & "document.getElementById(""" & objchild02.nodename & """).onblur=message(""" & objchild02.nodename & """);"
'h = H & "</script>"
'h = h & "<td>" & objchild02.text & "</td>"
'fbot.WriteLn("<td>" & displaynamefra & " " & objchild02.text)
'fmid.forms(0).elements(buttmp(ii)).onblur = getref("buttonmid")
'=== regenerate the event that call a sub if a button is pressed
'set fmid.onkeypress = GetRef("Checkmid")
h = h & "</tr>" '=== line 1
recordcnt01 = recordcnt01 + 1
next
h = h & "</tr>" '=== line 1
childcnt01 = childcnt01 + 1
next
rootcnt01 = rootcnt01 + 1
h = h & "</tr>" '=== line 1
next
h = h & "</form>"
h = h & "</body>"
h = h & "</html>"
fbot.WriteLn(h)
fbot.location.reload(true)
call oieready
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' event creation for unblur (leaving/unselecting a textbox)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
rootcnt01 = 0
For Each objNode01 in colNodes01
root01 = objnode01.nodeName '=== facturation
'=== any node under root
childcnt01 = 0
for each objnode02 in objnode01.childnodes
text01 = objnode02.nodename '=== bill
recordcnt01 = 0
For Each objChild02 In objnode02.childNodes
h = h & "<tr>"
'displaynamefra = objchild02.getattribute("displaynamefra")
'=== not editable
'text01 = displaynamefra
if instr(objnode02.nodename,"_")<>0 then
'fmid.WriteLn("<br>ERROR you cannot use underscore _ in name: " & objnode02.nodename )
end if
if instr(objchild02.nodename,"_")<>0 then
'fmid.WriteLn("<br>ERROR you cannot use undesrcore _ in name: " & objchild02.nodename)
end if
'name01 = objnode02.nodename & "__" & objchild02.nodename
id01 = prefix01 & rootcnt01 & "_" & childcnt01 & "_" & recordcnt01
'fmid.WriteLn("<br>Event defined on: " & id01 & " ---" & objnode02.nodename & " --- " & objChild02.nodename)
on error resume next
set fbot.form01.elements(id01).onblur = getref("onblurbot")
if err=0 then
'fmid.WriteLn("---" & name01)
else
fmid.WriteLn("<br>ERROR defining event onblur for: " & id01 & " id of the element might be defined twice in the same html form")
end if
on error goto 0
'=== attribute event
attributescnt01 = 0
for each attribute01 in objchild02.attributes
id01 = prefix02 & rootcnt01 & "_" & childcnt01 & "_" & recordcnt01 & "_" & attributescnt01
on error resume next
set fbot.form01.elements(id01).onblur = getref("onblurbot")
if err=0 then
'fmid.WriteLn("---" & name01)
else
fmid.WriteLn("<br>ERROR defining event onblur for: " & id01 & " id of the element might be defined twice in the same html form")
end if
on error goto 0
attributescnt01 = attributescnt01 + 1
next
recordcnt01 = recordcnt01 + 1
next
childcnt01 = childcnt01 + 1
next
rootcnt01 = rootcnt01 + 1
exit for '=== we use only one root for the moment
next
'fbot.body.onBlur = GetRef("onblurbot")
Do While (oIE.Busy)
wscript.sleep 50
Loop
'=== wait till document loaded
do while oie.readystate<>4
wscript.sleep 50
Loop
'set fbot.forms(0).datedue.onblur = getref("onblurbot")
'fmid.WriteLn("<br>exiting edit")
'=== wait for any modification to occur
do
'=== flag to tell if the input is not valid
err01=0
'=== flag to say input is done, since there might be a defaut value, we must validate if user was finished
inpdon=0
'=== check if blur event occured (switch out of an input box)
'=== resblubotstr = name of the
'=== resblubotval = new value in the text box
'=== resblubotid = id (from html) for the textbox
if resblubotstr<>"" and bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
'=== User has clicked on another textbox
'fmid.WriteLn("<br>" & resblubotstr & " --- " & resblubotid & " --- " & resblubotval)
'=== find the xml node parent and children (record and text) using textbox id, split chain is __ (double underscore)
'=== contain root number, childnodes number, record number
'fmid.WriteLn("<br>" & colnodes01(idara01(0)).childNodes(idara01(1)).childnodes(idara01(2)).nodename)
if mid(resblubotstr,1,1) = "x" then
'=== record text modification
'fmid.WriteLn("<br>resblubotstr: " & resblubotstr)
'=== the id of the textbox is splitted to find the index for the xml element we want to update:
'=== node (facturation)
'=== first child (bill)
'=== record (name)
idara01 = split(right(resblubotid,len(resblubotid)-1), "_")
if colnodes01(idara01(0)).childNodes(idara01(1)).childnodes(idara01(2)).text <> resblubotval then
change01 = 1
colnodes01(idara01(0)).childNodes(idara01(1)).childnodes(idara01(2)).text = resblubotval
else
change01 = 0
end if
fmid.WriteLn("<br>" & resblubotid)
'=== something changed, we save
elseif mid(resblubotstr,1,1) = "a" then
'=== attribute modification
'=== the id of the textbox is splitted to find the index for the xml element we want to update:
'=== node (facturation)
'=== first child (bill)
'=== record (name)
'=== attribute (displaynamefra)
idara01 = split(right(resblubotid,len(resblubotid)-1), "_")
if colnodes01(idara01(0)).childNodes(idara01(1)).childnodes(idara01(2)).attributes(idara01(3)).text <> resblubotval then
change01 = 1
colnodes01(idara01(0)).childNodes(idara01(1)).childnodes(idara01(2)).attributes(idara01(3)).text = resblubotval
else
change01 = 0
end if
'fmid.WriteLn("<br>" & resblubotid)
'fmid.WriteLn("<br>attribute modif: " & colnodes01(idara01(0)).childNodes(idara01(1)).childnodes(idara01(2)).attributes(idara01(3)).text)
end if
if change01 = 1 then
'=== filename may change to new invoice if we change the number
Set colNodes02 = xmlDoc.selectNodes("/" & colnodes01(idara01(0)).nodename & "/bill/id")
For Each objNode in colNodes02
numero01 = objnode.text '=== number of the invoice to change the filename before saving
Next
filename02 = basedir & "\facturation" & numero01 & ".xml"
xmlDoc.Save filename02
'=== what was modified in the xml tree
tree01 = "/" & colnodes01(idara01(0)).nodename
tree01 = tree01 & "/" & colnodes01(idara01(0)).childNodes(idara01(1)).nodename
tree01 = tree01 & "/" & colnodes01(idara01(0)).childNodes(idara01(1)).childnodes(idara01(2)).nodename
fmid.WriteLn("<br>node modified: " & tree01 & " --- xml doc saved")
end if
resblubotstr = ""
resblubotval = ""
resblubotid = ""
end if
'inpdon
wscript.sleep 50
if resbutmidstr="cancel" or reskeymid=27 or bready=true or resbutlefstr<>"" then
'=== if user pressed escape or cancel, we clear the frames
if resbutmidstr="cancel" or reskeymid=27 then
a = clefra(array("fmid","fbot"))
resbutmidstr="cancel"
end if
exit do
end if
loop while err01<>0 or inpdon=0
end function
function validate(name110)
name110 = lcase(name110)
if name110 = "id" then name110 = "id"
'if instr(name110,"address")<>0 then name110 = replace(name110,"address","adres")
validate = name110
end function
function edit_xml_node_recur(colNodes01,filename01)
'=== testintg recursive displaying of a full xml file starting at the root
'=== making a html table with it
'=== references:
'<xs:element name="xxx" type="yyy"/>
'<xs:element name="color" type="xs:string" default="red"/>
'<xs:element name="color" type="xs:string" fixed="red"/>
'xs:string
'xs:decimal
'xs:integer
'xs:boolean
'xs:date
'xs:time
' NodeType Named Constant
'1 ELEMENT_NODE
'2 ATTRIBUTE_NODE
'3 TEXT_NODE
'4 CDATA_SECTION_NODE
'5 ENTITY_REFERENCE_NODE
'6 ENTITY_NODE
'7 PROCESSING_INSTRUCTION_NODE
'8 COMMENT_NODE
'9 DOCUMENT_NODE
'10 DOCUMENT_TYPE_NODE
'11 DOCUMENT_FRAGMENT_NODE
'12 NOTATION_NODE
'Node type NodeType
'Element 1
'Attribute 2
'Text 3
'Comment 8
'Document 9
a = clefra(array("fmid","fbot"))
fmid.WriteLn("<br>Filename we will edit: " & filename01)
'=== make a big table that will contain other tables inside
h = "<!DOCTYPE html>"
h = h & "<html>"
h = h & "<head>"
h = h & "<style>"
h = h & "table#items01 tr:nth-child(even) {"
h = h & "background-color: #eee;"
h = h & "}"
h = h & "</style>"
h = h & "</head>"
h = h & "<body>"
h = h & "<form name=form01>"
'=== box to focus (first editable data)
'h = h & "<BODY onLoad=""document.form01.facturation.focus()"">"
h = h & "<table width=""100%"" BORDERCOLOR=""black"" class=MsoTableGrid border=1 CELLSPACING=0 cellpadding=2 style='border-collapse:collapse;border: 1px solid black'>"
''''''''''''''''''''''''''''''''''''''''''''''''''''
' textbox creation to be able to edit xml nodes
''''''''''''''''''''''''''''''''''''''''''''''''''''
rootcnt01 = 0
prefix01 = "x" '=== textbox id need to start by a letter to defnie an event on it
prefix02 = "a" '=== this textbox ID is an attribute in xml, we treat it differently
level01 = 0
redim idtext01(level01)
'fmid.WriteLn("<br>Type of node: " & colNodes01.nodetype)
rootcnt01 = 0
For Each objNode01 in colNodes01
''''''''''''''''''''''''''''''''
' root name
''''''''''''''''''''''''''''''''
h = h & "<tr>" '=== line 1
text01 = objnode01.nodeName
h = h & "<td>"
h = h & "<input type=""textbox"" id=" & text01 & " NAME=""" & text01
h = h & """ size=""" & max(15,len(text01)) & """ value=""" & text01 & """ onKeypress=""return event.keyCode!=13"">"
h = h & "<input type=""button"" name=""add" & text01 & """ value="" + "">"
h = h & "</td>"
h = h & "</tr>"
idtext01(level01) = rootcnt01
level01 = 1 '=== root level for html id for textbox for unblur event
'''''''''''''''''''''''''''''''''''''''''''''''''
' recusre all nodes, childrens, attributes<
'''''''''''''''''''''''''''''''''''''''''''''''''
call recursenodes(objnode01, level01, action01, idtext01)
rootcnt01 = rootcnt01 + 1
next
h = h & "</form>"
h = h & "</body>"
h = h & "</html>"
fbot.WriteLn(h)
fbot.location.reload(true)
call oieready
wscript.sleep 50
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' event definition, now the page is done we define events to manage unblur (unfocus a box) and save xml
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
rootcnt01 = 0
For Each objNode01 in colNodes01
idtext01(level01) = rootcnt01
level01 = 1 '=== root level for html id for textbox for unblur event
'''''''''''''''''''''''''''''''''''''''''''''''''
' recusre all nodes, childrens, attributes<
'''''''''''''''''''''''''''''''''''''''''''''''''
action01 = 1 '=== define event onblur for all id in html form
call recursenodes(objnode01, level01, action01, idtext01)
rootcnt01 = rootcnt01 + 1
next
'=== wait for any modification to occur
do
'=== flag to tell if the input is not valid
err01=0
'=== flag to say input is done, since there might be a defaut value, we must validate if user was finished
inpdon=0
'=== check if blur event occured (switch out of an input box)
'=== resblubotstr = name of the
'=== resblubotval = new value in the text box
'=== resblubotid = id (from html) for the textbox
if resblubotstr<>"" and bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
'=== User has clicked on another textbox
'fmid.WriteLn("<br>" & resblubotstr & " --- " & resblubotid & " --- " & resblubotval)
'=== find the xml node parent and children (record and text) using textbox id, split chain is __ (double underscore)
'=== contain root number, childnodes number, record number
'fmid.WriteLn("<br>" & colnodes01(idara01(0)).childNodes(idara01(1)).childnodes(idara01(2)).nodename)
if mid(resblubotstr,1,1) = "x" then
'=== record text modification
'fmid.WriteLn("<br>resblubotstr: " & resblubotstr)
'=== the id of the textbox is splitted to find the index for the xml element we want to update:
'=== node (facturation)
'=== first child (bill)
'=== record (name)
idara01 = split(right(resblubotid,len(resblubotid)-1), "_")
command01 = "colnodes01(idara01(0))"
for i = 0 to ubound(idara01)
if i > 0 then '=== skip root, just add as many child as we need
command01 = command01 & ".childNodes(idara01(" & i & "))"
end if
next
command01 = command01 & ".text"
command02 = "result01 = " & command01
'fmid.WriteLn("<br>" & command02)
execute command02
if result01 <> resblubotval then
change01 = 1
command02 = command01 & " = resblubotval"
'fmid.WriteLn("<br>" & command02)
execute command02
else
change01 = 0
end if
'fmid.WriteLn("<br>" & command01 & " - " & resblubotid)
'=== something changed, we save
elseif mid(resblubotstr,1,1) = "a" then
'=== attribute modification
'=== the id of the textbox is splitted to find the index for the xml element we want to update:
'=== node (facturation)
'=== first child (bill)
'=== record (name)
'=== attribute (displaynamefra)
idara01 = split(right(resblubotid,len(resblubotid)-1), "_")
command01 = "colnodes01(idara01(0))"
for i = 0 to ubound(idara01)
if i > 0 and i<ubound(idara01) then '=== skip root, just add as many child as we need
command01 = command01 & ".childNodes(idara01(" & i & "))"
end if
if i = ubound(idara01) then
command01 = command01 & ".attributes(idara01(" & i & "))"
end if
next
command01 = command01 & ".text"
command02 = "result01 = " & command01
'fmid.WriteLn("<br>" & command02)
execute command02
if result01 <> resblubotval then
change01 = 1
command02 = command01 & " = resblubotval"
'fmid.WriteLn("<br>" & command02)
execute command02
else
change01 = 0
end if
'fmid.WriteLn("<br>" & command01 & " - " & resblubotval & " - " & result01)
'fmid.WriteLn("<br>attribute modif: " & colnodes01(idara01(0)).childNodes(idara01(1)).childnodes(idara01(2)).attributes(idara01(3)).text)
elseif mid(resblubotstr,1,1) = "n" then
'=== new text element
idara01 = split(right(resblubotid,len(resblubotid)-1), "_")
command01 = "colnodes01(idara01(0))"
for i = 0 to ubound(idara01)
if i > 0 and i <> ubound(idara01) then '=== skip root, just add as many child as we need
'=== text element does not exist
'=== so we must go one branch lower in the tree
command01 = command01 & ".childNodes(idara01(" & i & "))"
end if
if i = ubound(idara01) then
'command01 = command01 & ".attributes(idara01(" & i & "))"
end if
next
if resblubotval<>"" then
change01 = 1
'=== even if text child element does not exist, assigning a value to .text will create it automatically
command02 = command01 & ".Text = """ & resblubotval & """"
'fmid.WriteLn("<br>colnodes01(idara01(0)).childNodes(idara01(1)).childnodes(idara01(2)).text = resblubotval")
'fmid.WriteLn("<br>" & command02)
execute command02
else
change01 = 0
end if
end if
if change01 = 1 then
'=== filename may change to new invoice if we change the number
if instr(filename01,"facturation")<>0 then
Set colNodes02 = xmlDoc.selectNodes("/" & colnodes01(idara01(0)).nodename & "/bill/id")
For Each objNode in colNodes02
numero01 = objnode.text '=== number of the invoice to change the filename before saving
Next
end if
if instr(filename01,"facturation")<>0 then
filename02 = basedir & "facturation" & numero01 & ".xml"
else
filename02 = filename01
'fmid.WriteLn("<br>node modified: " & tree01 & " --- xml doc saved: " & filename02)
end if
xmlDoc.Save filename02
'=== what was modified in the xml tree
tree01 = "/" & colnodes01(idara01(0)).nodename
tree01 = tree01 & "/" & colnodes01(idara01(0)).childNodes(idara01(1)).nodename
tree01 = tree01 & "/" & colnodes01(idara01(0)).childNodes(idara01(1)).childnodes(idara01(2)).nodename
fmid.WriteLn("<br>node modified: " & tree01 & " --- xml doc saved: " & filename02)
end if
resblubotstr = ""
resblubotval = ""
resblubotid = ""
end if
'inpdon
wscript.sleep 50
if resbutmidstr="cancel" or reskeymid=27 or bready=true or resbutlefstr<>"" then
'=== if user pressed escape or cancel, we clear the frames
if resbutmidstr="cancel" or reskeymid=27 then
a = clefra(array("fmid","fbot"))
resbutmidstr="cancel"
end if
exit do
end if
loop while err01<>0 or inpdon=0
end function
sub recursenodes(objnode01, level01, action01, idtext01)
'=== action01 = 0 = generate html stuff
'=== action01 = 1 = generate unblur events for internet explorer and this script
if objnode01.haschildnodes=false then
h = h & "</tr><tr>"
else
h = h & "<tr>"
nodecnt01 = 0
textnodepresent01 = 0
for each objnode02 in objnode01.childnodes
redim preserve idtext01(level01) '=== textbox id to define an event on (event: onblur, leaving the textbox will result in our script to save xml file)
if objnode02.nodetype = 1 then
'=== this node is an ELEMENT
x = 0
while x<level01
h = h & "<td></td>"
x = x + 1
wend
idtext01(level01) = nodecnt01
end if
text01 = objnode02.nodename '=== bill
if objnode02.nodetype = 3 then
'=== this node is a TEXT
'=== we go back to line before to display it, we dont want to skip to next line for nothing since a text element is always the last element of the line
h = left(h, len(h)-9) '=== removing "</tr><tr>"
idtext01(level01) = nodecnt01
'h = h & "<td>test</td>"
end if
if text01 = "#text" then
'=== text field of xml element, is the text of the element with "#text" name
textnodepresent01 = 1
'=== editable value
text01 = objnode02.text
text01 = replace(text01,"""",""")
idtext01(level01) = nodecnt01
id01 = "x"
idcnt = 0
for each x in idtext01
if idcnt = 0 then
id01 = id01 & x
else
id01 = id01 & "_" & x
end if
idcnt = idcnt + 1
next
'=== define event onblur (html must de done and refreshed)
'=== we use the same recursive sub twice, once to generate html content, once to generate vbs event for internet explorer
if action01 = 1 then
set fbot.form01.elements(id01).onblur = getref("onblurbot")
end if
h = h & "<td>"
'=== we add an X before the name, case a textbox without a name is BAD
'h = h & "<input type=""textbox"" id=""" & id01 & """ NAME=""" & id01
'h = h & """ size=""" & max(15,len(text01)) & """ value=""" & text01 & """ onKeypress=""return event.keyCode!=13"");>"
width01 = 25
height01 = int(len(text01)/width01)+1
h = h & "<textarea cols=""" & width01 & """ rows=""" & height01 & """ id=""" & id01 & """ NAME=""" & id01 & """>" & text01 & "</textarea>"
'=== futur
'h = h & "<input type=""button"" name=""add" & text01 & """ value="" + "">"
h = h & "</td>"
'h = h & "<td>" & id01 & "</td>"
'h = h & "<td>" & level01 & "</td>"
else
'=== attribute of an xml element
h = h & "<td>" & text01 & "</td>"
attributescnt01 = 0
for each attribute01 in objnode02.attributes
redim preserve idtext01(level01 + 1) '=== textbox id to define an event on (event: onblur, leaving the textbox will result in our script to save xml file)
'=== if there is more than one attribute, ident one more column, put it on next line
if attributescnt01>0 then
h = h & "<tr>"
x = -1
while x<level01
h = h & "<td></td>"
x = x + 1
wend
end if
idtext01(level01 + 1) = attributescnt01
id01 = "a"
idcnt = 0
for each x in idtext01
if idcnt = 0 then
id01 = id01 & x
else
id01 = id01 & "_" & x
end if
idcnt = idcnt + 1
next
'=== define event onblur (html must de done and refreshed)
'=== we use the same recursive sub twice, once to generate html content, once to generate vbs event for internet explorer
if action01 = 1 then
set fbot.form01.elements(id01).onblur = getref("onblurbot")
end if
h = h & "<td>" & attribute01.name
h = h & "</td>"
text01 = attribute01.text
text01 = replace(text01,"""",""")
'id01 = prefix02 & rootcnt01 & "_" & childcnt01 & "_" & recordcnt01 & "_" & attributescnt01
h = h & "<td>"
'h = h & "<input type=""textbox"" id=""" & id01 & """ NAME=""" & id01
'h = h & """ size=""" & max(15,len(text01)) & """ value=""" & text01 & """ onKeypress=""return event.keyCode!=13"">"
width01 = 25
height01 = int(len(text01)/width01)+1
h = h & "<textarea cols=""" & width01 & """ rows=""" & height01 & """ id=""" & id01 & """ NAME=""" & id01 & """>" & text01 & "</textarea>"
'h = h & "<input type=""button"" name=""add" & text01 & """ value="" + "">"
h = h & "</td>"
'h = h & "<td>" & id01 & "</td>"
attributescnt01 = attributescnt01 + 1
if attributescnt01>0 then
h = h & "</tr>"
end if
next
end if
'=== if element have attribute(s)
'=== if element is not a text node (its an element with no child with the name "#text")
'=== we add a box to be able to add a text child with a value
if attributescnt01<>0 and textnodepresent01 = 0 and objnode02.haschildnodes=false then
h = left(h, len(h)-5) '=== removing "</tr>"
id01 = "n" '=== for new node
idcnt = 0
for each x in idtext01
if idcnt = 0 then
id01 = id01 & x
else
id01 = id01 & "_" & x
end if
idcnt = idcnt + 1
next
text01 = ""
width01 = 25
height01 = int(len(text01)/width01)+1
h = h & "<td>"
h = h & "<textarea cols=""" & width01 & """ rows=""" & height01 & """ id=""" & id01 & """ NAME=""" & id01 & """></textarea>"
h = h & "</td></tr>"
'h = h & "<td>" & "test" & "</td></tr>"
if action01 = 1 then
'=== this should be an action to add a new node with text in it
set fbot.form01.elements(id01).onblur = getref("onblurbot")
end if
end if
call recursenodes(objnode02, level01 + 1, action01, idtext01)
nodecnt01 = nodecnt01 + 1
next
end if
end sub
