Monday, April 9, 2018

Access extract all vba modules for versionning support

Hello,

I wanted to extract all VBA modules from Microsoft ACCESS to be able to use GIT for versionning my VBA code

Here is a VBA macro to extract all module in a subfolder called:
[current directory of access file]\VBAProjectFiles

In microsoft access4
ALT F11
new module
copy paste this code in the module
run it

every file will be overwritten each time, but eh, GIT will see what line were added and deleted in each module

Required:
Access to VBA models in options, confidentiality center


-------------------- VBA module99 ---------------------------------

Option Compare Database

'====================================================
' exportation des modules VBA pour push dans GIT
'====================================================
Public Sub exportVBAlinebyline()

    path00 = CurrentDb.Name
    pathend00 = InStrRev(path00, "\")
    path01 = Left(path00, Len(path00) - (Len(path00) - pathend00))
    filename00 = Right(path00, (Len(path00) - pathend00))
    filename01 = Replace(filename00, ".", "")
   
    ' The reference for the FileSystemObject Object is Windows Script Host Object Model
    ' but it not necessary to add the reference for this procedure.
   
    Dim objfso As Object
    Dim file01 As Object
    Dim strMod As String
    Dim mdl As Object
    Dim i As Integer
   
    Set objfso = CreateObject("Scripting.FileSystemObject")
   
    ' Set up the file.
    ' SpFolder is a small function, but it would be better to fill in a
    ' path name instead of SpFolder(Desktop), eg "c:\users\somename\desktop"
   
    path02 = path01 & "VBAProjectFiles"
    If objfso.FolderExists(path02) = False Then
        err01 = 0: err02 = "": On Error Resume Next
        objfso.createfolder path02
        err01 = Err.number: err02 = Err.Description: On Error GoTo 0
    Else
        '=== folder already exist
    End If
   
    If err01 = 0 Then
       
        '=== list of all modules
        Set file01 = objfso.CreateTextFile(path01 & "\" & filename01 & "_liste.txt")
       
       
        '=== For each component in the project ...
        For Each mdl In VBE.ActiveVBProject.VBComponents
            '=== list of all modules
            file01.writeline mdl.Name
           
            Set file02 = objfso.CreateTextFile(path02 & "\" & mdl.Name & ".txt")
            '=== using the count of lines ...
            i = VBE.ActiveVBProject.VBComponents(mdl.Name).CodeModule.CountOfLines
            '=== put the code in a string ...
            If i > 0 Then
               strMod = VBE.ActiveVBProject.VBComponents(mdl.Name).CodeModule.Lines(1, i)
            End If
            '=== and then write it to a file, first marking the start with
            '=== some equal signs and the component name.
            file02.writeline strMod
            file02.Close
        Next
       
        '=== Close eveything
        file01.Close
        Set objfso = Nothing
       
    Else
        MsgBox ("ERROR cannot create folder: " & vbCrLf & path02)
    End If
   
End Sub

Wednesday, March 14, 2018

Windows 10 STARTMENU TILE cleanup français

Enfin!

Un vrai nettoyage du startmenu windows 10 français

Powershell script (cleanupstartmenuwin10.ps1)




############### Functions

function Pin-App
{ param(
 [string]$appname,
 [switch]$unpin
 )
 try{
     if ($unpin.IsPresent)
        {
        $action01 = "Désépingler|Désépingler de la page d'accueil"
        #((New-Object -Com Shell.Application).NameSpace('shell:::{4234d49b-0245-4df3-b780-3893943456e1}').Items() | ?{$_.Name -eq $appname}).Verbs() | ?{$_.Name.replace('&','') -match 'From "Start" UnPin|Unpin from Start'} | %{$_.DoIt()}
        ((New-Object -Com Shell.Application).NameSpace('shell:::{4234d49b-0245-4df3-b780-3893943456e1}').Items() | ?{$_.Name -eq $appname}).Verbs() | ?{$_.Name.replace('&','') -match 'From "Start" ' + $action01} | %{$_.DoIt()}
        #$action01 = "Détacher|Détacher du menu démarrer"
        #((New-Object -Com Shell.Application).NameSpace('shell:::{4234d49b-0245-4df3-b780-3893943456e1}').Items() | ?{$_.Name -eq $appname}).Verbs() | ?{$_.Name.replace('&','') -match 'From "Start" ' + $action01} | %{$_.DoIt()}
        #((New-Object -Com Shell.Application).NameSpace('shell:::{4234d49b-0245-4df3-b780-3893943456e1}').Items() | ?{$_.Name -eq $appname}).Verbs()
       
        return "App '$appname' unpinned from Start"
        }
        else
        {
        $action02 = "Épingler|Épingler à l’écran de démarrage"
        #((New-Object -Com Shell.Application).NameSpace('shell:::{4234d49b-0245-4df3-b780-3893943456e1}').Items() | ?{$_.Name -eq $appname}).Verbs()
        ((New-Object -Com Shell.Application).NameSpace('shell:::{4234d49b-0245-4df3-b780-3893943456e1}').Items() | ?{$_.Name -eq $appname}).Verbs() | ?{$_.Name.replace('&','') -match 'To "Start" ' + $action02} | %{$_.DoIt()
        }
        return "App '$appname' pinned to Start"
        }
    }
    catch
    {
    }
 }

 ############### Unpin All Apps
# shortcuts
 Export-StartLayout –path C:\startscreenlayout.xml
 [xml]$layoutfile = Get-Content C:\startscreenlayout.xml

 foreach ( $item in $layoutfile.LayoutModificationTemplate.DefaultLayoutOverride.StartLayoutCollection.StartLayout.Group.DesktopApplicationTile.DesktopApplicationLinkPath)
 {
        $outputFile = Split-Path $item -leaf
        $name = $outputFile.split('.') | Select-Object -first 1
        Pin-App "$name" -unpin
        #$name
        #((New-Object -Com Shell.Application).NameSpace('shell:::{4234d49b-0245-4df3-b780-3893943456e1}').Items() | ?{$_.Name -eq $name}).Verbs()
 }
# apps
 foreach ( $item in $layoutfile.LayoutModificationTemplate.DefaultLayoutOverride.StartLayoutCollection.StartLayout.Group.Tile.AppUserModelID)
 {
        $outputFile = Split-Path $item -leaf
        $name = $outputFile | Select-Object -first 1
        #Pin-App "$name" -unpin
        $name
        $action01 = "Désépingler|Désépingler de la page d'accueil"
        #((New-Object -Com Shell.Application).NameSpace('shell:::{4234d49b-0245-4df3-b780-3893943456e1}').Items() | ?{$_.Path -eq $name}).Verbs() | ?{$_.Name.replace('&','') -match 'From "Start" ' + $action01}
       
       
        ((New-Object -Com Shell.Application).NameSpace('shell:::{4234d49b-0245-4df3-b780-3893943456e1}').Items() | ?{$_.Path -eq $name}).Verbs() | ?{$_.Name.replace('&','') -match 'From "Start" ' + $action01} | %{$_.DoIt()}
 }
# PUB
 foreach ( $item in $layoutfile.LayoutModificationTemplate.DefaultLayoutOverride.StartLayoutCollection.StartLayout.Group.SecondaryTile.AppUserModelID)
 {
        $outputFile = Split-Path $item -leaf
        $name = $outputFile | Select-Object -first 1
        #Pin-App "$name" -unpin
        $name
        $action01 = "Désépingler|Désépingler de la page d'accueil"
        #((New-Object -Com Shell.Application).NameSpace('shell:::{4234d49b-0245-4df3-b780-3893943456e1}').Items() | ?{$_.Path -eq $name}).Verbs()
       
        ((New-Object -Com Shell.Application).NameSpace('shell:::{4234d49b-0245-4df3-b780-3893943456e1}').Items() | ?{$_.Path -eq $name}).Verbs() | ?{$_.Name.replace('&','') -match 'From "Start" ' + $action01} | %{$_.DoIt()}
 }

 ############### PIN YOUR FAVORITE APPS
 Pin-App "Netflix" -pin
 #Pin-App "Photos" -pin
 #Pin-App "Calculatrice" -pin
 #Pin-App "Snipping Tool" -pin
 #Pin-App "Notepad" -pin
 Pin-App "Explorateur de fichiers" -pin
 #Pin-App "Word 2013" -pin
 #Pin-App "Excel 2013" -pin
 #Pin-App "Outlook 2013" -pin
 #Pin-App "Powerpoint 2013" -pin
 #Pin-App "Word 2016" -pin
 #Pin-App "Excel 2016" -pin
 #Pin-App "Outlook 2016" -pin
 #Pin-App "Powerpoint 2016" -pin


Thursday, November 16, 2017

Language pack windows 10 1703 installation bug

Hello,

To install the 2016 server managements tools, a french windows need to have english installed in windows 10

But, the "download" button was not present after adding english in windows 10 version 1703

Here is the solution that worked for me:

Download the .CAB for your language at one of these sites:

https://www.itechtics.com/windows-10-version-1703-language-packs/

https://www.itechtics.com/windows-10-version-1709-language-packs-direct-download-links/

Install the .CAB with DISM:
Dism /online /Add-Package /PackagePath:\\yourserver\Software\Microsoft_Windows\win10una1703frapro_work_en-us_CAB\lp_38a2c8c87c52a0dbe0c1cbf98fe79377383063ec.cab

(this worked, but the language was not visible in windows's 10 menus)

Delete the language with LPKsetup:
lpksetup.exe /u en-us

Add the language again with LPKSETUP:
lpksetup
(browse for the .cab file, install)

The new language is now in windows's menus to switch it.




Sunday, September 17, 2017

github create folder share folder set share permissions set acl ntfs permissions powershell

Hello,

This project is in github

Based on:
powershell 5.0
lots of arrays

It will:
Create folders for each sectors of an enterprise
Share these folders for everyone (eventually for precise groups)
Apply ACL ntfs permissions on the content of these folders

Application:
Run on a windows server 2016 to create a folder and share structure in an enterprise

https://github.com/Wildboy85/create_folder_share_acl_permissions


Tuesday, August 1, 2017

wim editing windows 10 1703

2017-09-16 folder created "generic" with same name as where this script is executed
So if you put this script in a copy of dvd from windows server 2016, it will generate folders for wim editing and command according to the actual folder the script is executed in
Simply put: copy this script in dvd root folder copy and run it, folder names should be fine

wim editing windows 10 and server 2016

This script will:
Create folder in C:\ to mount .wim file, split it etc.
List all commands necessary to split this image for a usb key (with same folders)


=============================wimediting.vbs ===============
'=== Ultimate dynamic web interface 2.0

'=== this script:
'=== generate dynamically a web interface to manage virtually anything
'=== control (left frame), input (middle frame), and output (bottom frame) from vbs/wsh (windows host scripts)

'=== the first version was a simple interface made by a programmer
'=== the second version have more explanations
'=== more dynamism than ever
'=== more functions to clean up main loop code
'=== easier array display coding to add stuff more easily
'=== MDB (access type database) management (creation, edition, search/edit)
'=== futur: mdb import, mdb export, sql sync, excel export

'=== by: SergeFournier(at)hotmail.com

'=== tested on windows vista 64, internet explorer 7

Set objFSO    = CreateObject("Scripting.FileSystemObject")
Set objshe    = CreateObject("WScript.Shell")
Set objNet    = CreateObject("WScript.Network")
set objsheapp = wscript.CreateObject("Shell.Application") '=== application (permission for execution)

Const hkcr = &H80000000 'HKEY_CLASSES_ROOT
Const HKCU = &H80000001 'HKEY_CURRENT_USER
Const hklm = &H80000002 'HKEY_LOCAL_MACHINE
Const hku  = &H80000003 'HKEY_USERS
Const hkcc = &H80000005 'HKEY_CURRENT_CONFIG

dim allara(10,10)
dim alltab(10)
DIM ordcol(10,10)

'=== actual drive, actual directory, and "\"
thepath=WScript.ScriptFullName
p = instrRev(thepath,"\")
basedir  = left(thepath,p)
filnam = right(thepath,len(thepath)-p)

arr01 = split(basedir, "\")
basedir2 = arr01(0) & "\" & arr01(1) '=== will work for home and work folder

arr01 = split(filnam, ".")
scriptname01 = arr01(0)

'=== windows dir
WinDir = objfso.GetSpecialFolder(0)

'=== restart the script in 32 bits if we are on a 64 bits system
'=== (databases drivers issues)
a64 = windir & "\syswow64\wscript.exe"
Elevatedpriv01 = 0

if objFSO.fileEXISTS(a64) and instr(lcase(wscript.fullname),"syswow64")=0 then
  '=== 64 bits system
  a = """" & a64 & """ """ & basedir & filnam & """"
  if Elevatedpriv01 = 1 then
    'msgbox(a)
    'objSheapp.ShellExecute "wscript.exe ", Chr(34) & ser & "\users\_03_vista.VBS" & Chr(34), "", "runas", 1
    'objSheapp.ShellExecute a, "", "runas", 1
    'wscript.quit
  else
    objshe.Run a,0, false
    wscript.quit
  end if

end if

'=== log everything in a file
logall = 1

'=== edit mode 0=off 1=on
'=== if edtmod = 1 every results will be in editable html boxes
edtmod = 0
totrec = 0
offset = 0
'=== no second search in the lower frame (fbot)
'=== this mean the search button is removed when table is generated
secseatag=0

dim tabnam,aratit,ara01,edtmod,offset,maxoff,myarray,component, strsearch, tab,sel,whe,objcon,tabnam2,ooper,wwild


priara = array(_
"<input type=""button"" onClick=""javascript:print()"" value=""Print""/><br><br>")
lefara = array(_
"<body background=""" & basedir & "images_interface\fond_gauche.jpg"">")
midara = array(_
"<body background=""" & basedir & "images_interface\fond_gris.jpg"">")
botara = array(_
"<body background=""" & basedir & "images_interface\fond_gris.jpg"">")

if logall=1 then
   '=== debug log
   file02 = basedir & left(filnam, instr(filnam, ".")-1) & "_log.txt"
   on error resume next
   Set Fil02 = objFSo.OpenTextFile(file02, 2, true)
   on error goto 0
end if

'============================================== main loop =============================================

'=== name of the user logged in window (network or not)
usenam=lcase(objnet.username)

'=== maximum row in the grid when more than the max
'=== we display only this number and a button "precedent" and "next" to swtich page
maxoff=15 '=== since 0 is included, 24 = 25 record

'=== menu items on left side (control side, frame: flef)

'= arabutnam: name of button, purely programmation name, used later to execute functions in main loop
'= arabutdes: description of button, text inside it actually
'= aradepnam: departement name, each departement (Section) is separated by a space
'= aradepcol: color of departement, blue = computer, brown = accounting, etc will follow a standard on internet (vague)
 
'=== button at the start for control frame (flef object)
'=== you can add as many buttons as you want, it's all dynamic (extendable)
if logall=1 then
   fil02.WriteLine date & " " & time & " START"
end if

x=0
ReDim Preserve arabutnam(x): ReDim Preserve arabutdes(x): ReDim Preserve aradepnam(x): ReDim Preserve aradepcol(x)
arabutnam(x)="getwiminfo_win10"
arabutdes(x)="Get WIM info from windows 10 file"
aradepnam(x)="WIN10"
aradepcol(x)="cccccc"

x=x+1
ReDim Preserve arabutnam(x): ReDim Preserve arabutdes(x): ReDim Preserve aradepnam(x): ReDim Preserve aradepcol(x)
arabutnam(x)="delindex_win10"
arabutdes(x)="Delete an index (windows version) from wim win10"
aradepnam(x)="WIN10"
aradepcol(x)="cccccc"

x=x+1
ReDim Preserve arabutnam(x): ReDim Preserve arabutdes(x): ReDim Preserve aradepnam(x): ReDim Preserve aradepcol(x)
arabutnam(x)="extractwim_win10"
arabutdes(x)="Extract source\install.wim to folder (mount)"
aradepnam(x)="WIN10"
aradepcol(x)="cccccc"

x=x+1
ReDim Preserve arabutnam(x): ReDim Preserve arabutdes(x): ReDim Preserve aradepnam(x): ReDim Preserve aradepcol(x)
arabutnam(x)="addpackage_win10"
arabutdes(x)="Add PACKAGE (msu) to extracted wim image"
aradepnam(x)="WIN10"
aradepcol(x)="cccccc"

x=x+1
ReDim Preserve arabutnam(x): ReDim Preserve arabutdes(x): ReDim Preserve aradepnam(x): ReDim Preserve aradepcol(x)
arabutnam(x)="adddriver_win10"
arabutdes(x)="Add driver to extracted wim image"
aradepnam(x)="WIN10"
aradepcol(x)="cccccc"

x=x+1
ReDim Preserve arabutnam(x): ReDim Preserve arabutdes(x): ReDim Preserve aradepnam(x): ReDim Preserve aradepcol(x)
arabutnam(x)="commitwim_win10"
arabutdes(x)="unmount /commit wim image"
aradepnam(x)="WIN10"
aradepcol(x)="cccccc"

x=x+1
ReDim Preserve arabutnam(x): ReDim Preserve arabutdes(x): ReDim Preserve aradepnam(x): ReDim Preserve aradepcol(x)
arabutnam(x)="splitwim_win10"
arabutdes(x)="SPLIT wim image (2gig) or merge"
aradepnam(x)="WIN10"
aradepcol(x)="cccccc"

'====================== winpe
x=x+1
ReDim Preserve arabutnam(x): ReDim Preserve arabutdes(x): ReDim Preserve aradepnam(x): ReDim Preserve aradepcol(x)
arabutnam(x)="getwiminfo_winpe"
arabutdes(x)="Get WIM info from winPE file"
aradepnam(x)="WINPE"
aradepcol(x)="cccccc"

x=x+1
ReDim Preserve arabutnam(x): ReDim Preserve arabutdes(x): ReDim Preserve aradepnam(x): ReDim Preserve aradepcol(x)
arabutnam(x)="extractwim_winpe"
arabutdes(x)="Extract WIM file to directory (mount-wim)"
aradepnam(x)="WINPE"
aradepcol(x)="cccccc"

x=x+1
ReDim Preserve arabutnam(x): ReDim Preserve arabutdes(x): ReDim Preserve aradepnam(x): ReDim Preserve aradepcol(x)
arabutnam(x)="adddriverwim_winpe"
arabutdes(x)="Add driver to WIM directory (add-driver)"
aradepnam(x)="WINPE"
aradepcol(x)="cccccc"

x=x+1
ReDim Preserve arabutnam(x): ReDim Preserve arabutdes(x): ReDim Preserve aradepnam(x): ReDim Preserve aradepcol(x)
arabutnam(x)="unmountcommitwim_winpe"
arabutdes(x)="Compress WIM directory to file (unmount-wim)"
aradepnam(x)="WINPE"
aradepcol(x)="cccccc"

x=x+1
ReDim Preserve arabutnam(x): ReDim Preserve arabutdes(x): ReDim Preserve aradepnam(x): ReDim Preserve aradepcol(x)
arabutnam(x)="clrframes"
arabutdes(x)="Clear Frames"
aradepnam(x)="OTHER"
aradepcol(x)="cccccc"

x=x+1
ReDim Preserve arabutnam(x): ReDim Preserve arabutdes(x): ReDim Preserve aradepnam(x): ReDim Preserve aradepcol(x)
arabutnam(x)="info"
arabutdes(x)="Information/Help"
aradepnam(x)="OTHER"
aradepcol(x)="cccccc"

x=x+1
ReDim Preserve arabutnam(x): ReDim Preserve arabutdes(x): ReDim Preserve aradepnam(x): ReDim Preserve aradepcol(x)
arabutnam(x)="quit01"
arabutdes(x)="Quitter"
aradepnam(x)="All"
aradepcol(x)="cccccc"

'=== last departement for button sections spacing
lasdep=""
 
'=== web interface, internet explorer

'=== set the objects before calling functions, so they are global objects/variables, accessibles in all the program
set oIE = wscript.CreateObject("InternetExplorer.Application", "IE_")
dim flef, fmid, fbot

'=== title of internet explorer window
doctit = "titre de la page"

'=== title to display inside the left frame (control frame, flef object)
maitit = "Troubleshooting interface<br><br>STAS 45834"'=== title inside the left frame
maitit="<br><br><br><br>"

'=== create the main web interface with 3 frames, objects: flef, fmid, fbot
a = crewebmai(oie, doctit, maitit, arabutnam, arabutdes, aradepnam, aradepcol)

if instr(lcase(wscript.fullname),"syswow64") = 0 then
   d = wrifra(flef, "Platform: 64 bits" & "<br>", 1)
else
   d = wrifra(flef, "Platform: 32 bits" & "<br>", 1)
end if

'=== defaut menu option for certain name logged
'=== example: a certain user will use always the same function
'=== so the interface will start, by executing this function at first, not an empty frame
'=== simply enter the name of the button that should be pressed for this user when interface start

if usenam="wildboy" or usenam="fournier.serge" then
   '=== defaut choice when program start
   'resbutlefstr = "stristas"
end if

'=== sub to call for each button
'=== here we define a sub to be called when a button in the web page is pressed
Do While (oIE.Busy)
   wscript.sleep 50
loop
do while oie.readystate<>4
   wscript.sleep 50
loop

'=== set up a return value on click of each button on the left frame
'=== the returned value is the name (programmable name) of each button (arabutnam)
'=== later any action will be taken according to this value
'=== i use this method because i dont want to call a sub when a button is pressed
'=== to remain in a loop for the main program, that is standard procedure in programming (to have a main loop)

for i=0 to ubound(arabutnam)
   flef.forms(0).elements(arabutnam(i)).onclick = getref("buttonlef")
next

'=== we also chek the key presse in each frame
'=== we do this cause we want "enter" key to be used instead of pressing "ok" button with the mouse
set flef.onkeypress = GetRef("Checklef")
set fmid.onkeypress = GetRef("Checkmid")
set fbot.onkeypress = GetRef("Checkbot")

'=== if bready = true, it mean they closed internet explorer, see the sub on internet explorer closing later in this code
'=== we have to chek this value often to stop the wscript.exe from interpreting this code, when internet explorer is closed
bReady=false
resbutlefstr = ""
resbutmidstr = ""
resbutbotstr = ""
reskeylef = 0
reskeymid = 0
reskeybot = 0

resblulefstr =""
resblumidstr =""
resblubotstr =""

resblulefid = ""
resblumidid = ""
resblubotid = ""

resblulefval =""
resblumidval =""
resblubotval =""


WScript.sleep(50) ' .1 seconds

'=== main loop, infinite
'=== unless someone press QUIT button
'=== or close internet explorer (bready = true)

h = "" '=== html content, global variable must be in main loop
level01 = 0

desmountfolder01 = "_mounted"
desmountfolder02 = "_mounted"
desmountfolder03 = "_wim_splitted"
desmountfolder04 = "_wim_notsplitted"

PACKAGEPATH01 = "C:\win10una1703frapro_work_todo"
imagename01 = "Microsoft Windows PE (x64)"

do
 
  ''''''''''''''''''''''''''''''''''''''''''''''''''
  ' get wim info
  ''''''''''''''''''''''''''''''''''''''''''''''''''
if resbutlefstr="getwiminfo_win10" then
a = clefra(array("fmid","fbot"))
resbutlefstr=""

x = 0
redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
distmp(x)="Win file found (win10)"      '===== description displayed in front of the field
namtmp(x)="text01"                  '===== name of variable for programming purpose
deftmp(x)=basedir2 & "\sources\install.wim"          '===== default value
typtmp(x)="textbox"               '===== type of data: textbox password (futur: more to come)
errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords

buttmp=array("ok","cancel")       '===== at the end, there will be an "ok" button and a "cancel" button

a = dynforgen2 (distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)

'=== if internet explorer was not closed (bready), a button was not pressed on left frame, and no excape or cancel in middle frame
if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
'=== get values from input boxes
filename01 = fmid.form01.text01.Value

d = wrifra(fbot, "<br>Index 1 is second image: windows 10 professionnal<br>", 1)

cmd01 = "Dism.exe /Get-WIMinfo /WimFile:" & filename01 & " /Index:1"

d = wrifra(fbot, "<br>" & cmd01, 1)

set objPing = objShe.Exec(cmd01)
'=== extract text from dos command execution
strPingOut = objPing.StdOut.ReadAll

strpingout = replace(strpingout, chr(13)+chr(10), "<br>")

fbot.WriteLn("<br>" & strPingOut)
fbot.WriteLn("<br>")
for i = 1 to len(strpingout)
c = mid(strpingout,i,1)
if asc(c) = 13 then
fbot.WriteLn("<br>found 13")
end if
if asc(c) = 10 then
fbot.WriteLn("<br>found 10")
end if
next

if instr(LCase(strPingOut), "reply") or instr(LCase(strPingOut), "ponse de") then
flag = TRUE
else
flag = FALSE
end if
'fPingTest = flag

if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
fbot.WriteLn("<br>FIN")

end if
end if

reskeymid=0
resbutmidstr=""
reskeylef=0

end if

  ''''''''''''''''''''''''''''''''''''''''''''''''''
  ' delete index in image
  ''''''''''''''''''''''''''''''''''''''''''''''''''
  if resbutlefstr="delindex_win10" then

      tit = "Delete index 2 in wim image"
      a = clefra(array("fmid","fbot"))
      resbutlefstr=""
     
      x = 0
      redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
      distmp(x)="Win file found (win10)"      '===== description displayed in front of the field
      namtmp(x)="text01"                  '===== name of variable for programming purpose
      '=== get first folder of basedir
      deftmp(x)=basedir2 & "\sources\install.wim"          '===== default value
      typtmp(x)="textbox"               '===== type of data: textbox password (futur: more to come)
      errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords
     
      buttmp=array("ok","cancel")       '===== at the end, there will be an "ok" button and a "cancel" button
     
      a = dynforgen2 (distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)
     
      '=== if internet explorer was not closed (bready), a button was not pressed on left frame, and no excape or cancel in middle frame
      if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
        '=== get values from input boxes
        filename01 = fmid.form01.text01.Value
       
        cmd01 = "dism /Delete-Image /ImageFile:" & filename01 & " /Index:2"
       
        d = wrifra(fbot, "<br>" & cmd01, 1)
       
        set objPing = objShe.Exec(cmd01)
        '=== extract text from dos command execution
        strPingOut = objPing.StdOut.ReadAll
       
        strpingout = replace(strpingout, chr(13)+chr(10), "<br>")
       
        fbot.WriteLn("<br>" & strPingOut)
        fbot.WriteLn("<br>")
        for i = 1 to len(strpingout)
          c = mid(strpingout,i,1)
          if asc(c) = 13 then
            fbot.WriteLn("<br>found 13")
          end if
          if asc(c) = 10 then
            fbot.WriteLn("<br>found 10")
          end if
        next
       
        if instr(LCase(strPingOut), "reply") or instr(LCase(strPingOut), "ponse de") then
          flag = TRUE
        else
          flag = FALSE
        end if
        'fPingTest = flag
       
        if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
          fbot.WriteLn("<br>FIN")
         
        end if
      end if
     
      reskeymid=0
      resbutmidstr=""
      reskeylef=0
   
   
  end if

  ''''''''''''''''''''''''''''''''''''''''''''''''''
  ' extract image
  ''''''''''''''''''''''''''''''''''''''''''''''''''
  if resbutlefstr="extractwim_win10" then

   
      a = clefra(array("fmid","fbot"))
      resbutlefstr=""
     
      x = 0
      redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
      distmp(x)="Win file found (win10)"      '===== description displayed in front of the field
      namtmp(x)="text01"                  '===== name of variable for programming purpose
      '=== get first folder of basedir
      deftmp(x)=basedir2 & "\sources\install.wim"          '===== default value
      typtmp(x)="textbox"               '===== type of data: textbox password (futur: more to come)
      errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords
     
      x = x + 1
      redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
      distmp(x)="Win temp dir (win10)"      '===== description displayed in front of the field
      namtmp(x)="text02"                  '===== name of variable for programming purpose
      deftmp(x)=basedir2 & desmountfolder01         '===== default value
      typtmp(x)="textbox"               '===== type of data: textbox password (futur: more to come)
      errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords

      buttmp=array("ok","cancel")       '===== at the end, there will be an "ok" button and a "cancel" button
     
      a = dynforgen2 (distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)
     
      '=== if internet explorer was not closed (bready), a button was not pressed on left frame, and no excape or cancel in middle frame
      if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
        '=== get values from input boxes
        filename01 = fmid.form01.text01.Value
        desmountfolder01 = fmid.form01.text02.Value
        'caca

        '=== see des01 variable for temp folder containing win10 image
if not objFSO.folderEXISTS(desmountfolder01) then
d = wrifra(fbot, "<br>CREATING folder: " & desmountfolder01, 1)
objFSO.CreateFolder (desmountfolder01)
else
'=== already exist
end if
       
        cmd01 = "Dism /Mount-WIM /WimFile:" & basedir2 & desmountfolder04 & "\install.wim /Name:""Windows 10 pro"" /MountDir:" & desmountfolder01
        d = wrifra(fbot, "<br><br>" & cmd01, 1)
       
        cmd01 = "Dism /Mount-WIM /WimFile:" & filename01 & " /Name:""Windows 10 pro"" /MountDir:" & desmountfolder01
        d = wrifra(fbot, "<br><br>" & cmd01, 1)
       
        set objPing = objShe.Exec(cmd01)
        '=== extract text from dos command execution
        strPingOut = objPing.StdOut.ReadAll
       
        strpingout = replace(strpingout, chr(13)+chr(10), "<br>")
       
        fbot.WriteLn("<br>" & strPingOut)
        fbot.WriteLn("<br>")
        for i = 1 to len(strpingout)
          c = mid(strpingout,i,1)
          if asc(c) = 13 then
            fbot.WriteLn("<br>found 13")
          end if
          if asc(c) = 10 then
            fbot.WriteLn("<br>found 10")
          end if
        next
       
        if instr(LCase(strPingOut), "reply") or instr(LCase(strPingOut), "ponse de") then
          flag = TRUE
        else
          flag = FALSE
        end if
        'fPingTest = flag
       
        if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
          fbot.WriteLn("<br>FIN")
         
        end if
      end if
     
      reskeymid=0
      resbutmidstr=""
      reskeylef=0
   
   
  end if

  ''''''''''''''''''''''''''''''''''''''''''''''''''
  ' add patch windows 10
  ''''''''''''''''''''''''''''''''''''''''''''''''''
  if resbutlefstr="addpackage_win10" then

      tit = "add PACKAGE to windows 10 image"
      a = clefra(array("fmid","fbot"))
      resbutlefstr=""
     
      x = 0
      redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
      distmp(x)="mounted image folder (win10)"      '===== description displayed in front of the field
      namtmp(x)="text01"                  '===== name of variable for programming purpose
      deftmp(x)=basedir2 & desmountfolder01          '===== default value
      typtmp(x)="textbox"               '===== type of data: textbox password (futur: more to come)
      errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords
     
      x = x + 1
      redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
      distmp(x)="drivers path win10"      '===== description displayed in front of the field
      namtmp(x)="text02"                  '===== name of variable for programming purpose
      deftmp(x)=PACKAGEPATH01          '===== default value
      typtmp(x)="textbox"               '===== type of data: textbox password (futur: more to come)
      errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords

      buttmp=array("ok","cancel")       '===== at the end, there will be an "ok" button and a "cancel" button
     
      a = dynforgen2 (distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)
     
      '=== value
      '=== chek if the file already exist
      Set objFol01=objFSO.GetFolder(PACKAGEPATH01)'=== dir
      Set objfol02=objFol01.files '=== files

      x=0
      redim arr02(0)
      dimnum=1
      For Each objFil in objFol02
        filnam=objfil.name
        filnam=lcase(filnam)
        if right(filnam,4)=".msu" then
          redim preserve arr02(x)
          arr02(x)=filnam
          d = wrifra(fbot, "<br>" & filnam, 1)
          x=x+1
        end if
      next
      d = wrifra(fbot, "<br>", 1)
     
      '=== if internet explorer was not closed (bready), a button was not pressed on left frame, and no excape or cancel in middle frame
      if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
        '=== get values from input boxes
        filename01 = fmid.form01.text01.Value
        filename02 = fmid.form01.text02.Value
       
        'Dism /Add-Package /Image:C:\mount\Windows /PackagePath:C:\MSU\Windows10-KBxxxxxxx-x64.msu /LogPath:AddPackage.log
       
        for i = 0 to ubound(arr02)
          cmd01 = "Dism /Add-Package /Image:" & desmountfolder01 & " /PackagePath:" & packagepath01 & "\" & arr02(i) & " /logpath:%temp%addpackage_" & arr02(i) & ".log"
          d = wrifra(fbot, "<br>" & cmd01, 1)
        next
       
        set objPing = objShe.Exec(cmd01)
        '=== extract text from dos command execution
        strPingOut = objPing.StdOut.ReadAll
       
        strpingout = replace(strpingout, chr(13)+chr(10), "<br>")
       
        fbot.WriteLn("<br>" & strPingOut)
        fbot.WriteLn("<br>")
        for i = 1 to len(strpingout)
          c = mid(strpingout,i,1)
          if asc(c) = 13 then
            fbot.WriteLn("<br>found 13")
          end if
          if asc(c) = 10 then
            fbot.WriteLn("<br>found 10")
          end if
        next
       
        if instr(LCase(strPingOut), "reply") or instr(LCase(strPingOut), "ponse de") then
          flag = TRUE
        else
          flag = FALSE
        end if
        'fPingTest = flag
       
        if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
          fbot.WriteLn("<br>FIN")
         
        end if
      end if
     
      reskeymid=0
      resbutmidstr=""
      reskeylef=0
   
   
  end if
 
 
  ''''''''''''''''''''''''''''''''''''''''''''''''''
  ' add driver to wim
  ''''''''''''''''''''''''''''''''''''''''''''''''''
  if resbutlefstr="adddriver_win10" then

   
      a = clefra(array("fmid","fbot"))
      resbutlefstr=""
     
      x = 0
      redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
      distmp(x)="mounted image folder (win10)"      '===== description displayed in front of the field
      namtmp(x)="text01"                  '===== name of variable for programming purpose
      deftmp(x)=desmountfolder01          '===== default value
      typtmp(x)="textbox"               '===== type of data: textbox password (futur: more to come)
      errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords
     
      x = x + 1
      redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
      distmp(x)="drivers path win10"      '===== description displayed in front of the field
      namtmp(x)="text02"                  '===== name of variable for programming purpose
      deftmp(x)=driverspath01          '===== default value
      typtmp(x)="textbox"               '===== type of data: textbox password (futur: more to come)
      errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords

      buttmp=array("ok","cancel")       '===== at the end, there will be an "ok" button and a "cancel" button
     
      a = dynforgen2 (distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)
     
      '=== if internet explorer was not closed (bready), a button was not pressed on left frame, and no excape or cancel in middle frame
      if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
        '=== get values from input boxes
        filename01 = fmid.form01.text01.Value
        filename02 = fmid.form01.text02.Value
               
        cmd01 = "Dism /Image:" & desmountfolder01 & " /Add-Driver /Driver:" & driverspath01 & " /Recurse"
       
        d = wrifra(fbot, "<br>" & cmd01, 1)
       
        set objPing = objShe.Exec(cmd01)
        '=== extract text from dos command execution
        strPingOut = objPing.StdOut.ReadAll
       
        strpingout = replace(strpingout, chr(13)+chr(10), "<br>")
       
        fbot.WriteLn("<br>" & strPingOut)
        fbot.WriteLn("<br>")
        for i = 1 to len(strpingout)
          c = mid(strpingout,i,1)
          if asc(c) = 13 then
            fbot.WriteLn("<br>found 13")
          end if
          if asc(c) = 10 then
            fbot.WriteLn("<br>found 10")
          end if
        next
       
        if instr(LCase(strPingOut), "reply") or instr(LCase(strPingOut), "ponse de") then
          flag = TRUE
        else
          flag = FALSE
        end if
        'fPingTest = flag
       
        if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
          fbot.WriteLn("<br>FIN")
         
        end if
      end if
     
      reskeymid=0
      resbutmidstr=""
      reskeylef=0
   
   
  end if
  '''''''''''''''''''''''''''''''''''''''''''''''''''
  ' win10 unmount commit wim image
  '''''''''''''''''''''''''''''''''''''''''''''''''''

  if resbutlefstr="commitwim_win10" then
      a = clefra(array("fmid","fbot"))
      resbutlefstr=""
     
      tit = "Commit wim image"
     
      x = 0
      redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
      distmp(x)="Win file found (win10)"      '===== description displayed in front of the field
      namtmp(x)="text01"                  '===== name of variable for programming purpose
      '=== get first folder of basedir
      deftmp(x)=basedir2 & "\sources\install.wim"          '===== default value
      typtmp(x)="textbox"               '===== type of data: textbox password (futur: more to come)
      errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords
     
      x = x + 1
      redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
      distmp(x)="Win temp dir (win10)"      '===== description displayed in front of the field
      namtmp(x)="text02"                  '===== name of variable for programming purpose
      deftmp(x)=basedir2 & desmountfolder01          '===== default value
      typtmp(x)="textbox"               '===== type of data: textbox password (futur: more to come)
      errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords

      buttmp=array("ok","cancel")       '===== at the end, there will be an "ok" button and a "cancel" button
     
      a = dynforgen2 (distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)
     
      '=== if internet explorer was not closed (bready), a button was not pressed on left frame, and no excape or cancel in middle frame
      if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
        '=== get values from input boxes
        filename01 = fmid.form01.text01.Value
        desmountfolder01 = fmid.form01.text02.Value
       
        cmd01 = "Dism /Unmount-WIM /MountDir:" &  desmountfolder01 & " /Commit"
        d = wrifra(fbot, "<br>" & cmd01, 1)
       
        cmd01 = "Dism /Unmount-WIM /MountDir:" &  desmountfolder01 & " /Commit"
        d = wrifra(fbot, "<br>" & cmd01, 1)
       
        set objPing = objShe.Exec(cmd01)
        '=== extract text from dos command execution
        strPingOut = objPing.StdOut.ReadAll
       
        strpingout = replace(strpingout, chr(13)+chr(10), "<br>")
       
        fbot.WriteLn("<br>" & strPingOut)
        fbot.WriteLn("<br>")
        for i = 1 to len(strpingout)
          c = mid(strpingout,i,1)
          if asc(c) = 13 then
            fbot.WriteLn("<br>found 13")
          end if
          if asc(c) = 10 then
            fbot.WriteLn("<br>found 10")
          end if
        next
       
        if instr(LCase(strPingOut), "reply") or instr(LCase(strPingOut), "ponse de") then
          flag = TRUE
        else
          flag = FALSE
        end if
        'fPingTest = flag
       
        if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
          fbot.WriteLn("<br>FIN")
         
        end if
      end if
     
      reskeymid=0
      resbutmidstr=""
      reskeylef=0
   
   
  end if


'''''''''''''''''''''''''''''''''''''''''''''
' win10 split image
'''''''''''''''''''''''''''''''''''''''''''''
if resbutlefstr="splitwim_win10" then

tit = "SPLIT wim image"

a = clefra(array("fmid","fbot"))
resbutlefstr=""

      x = 0
      redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
      distmp(x)="Win file found (win10)"      '===== description displayed in front of the field
      namtmp(x)="text01"                  '===== name of variable for programming purpose
      '=== get first folder of basedir
      deftmp(x)=basedir2 & "\sources\install.wim"          '===== default value
      typtmp(x)="textbox"               '===== type of data: textbox password (futur: more to come)
      errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords

      x = x + 1
      redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
      distmp(x)="Win temp dir (win10)"      '===== description displayed in front of the field
      namtmp(x)="text02"                  '===== name of variable for programming purpose
      deftmp(x)=basedir2 & desmountfolder03          '===== default value
      typtmp(x)="textbox"               '===== type of data: textbox password (futur: more to come)
      errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords

      x = x + 1
      redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
      distmp(x)="Win file found (win10)"      '===== description displayed in front of the field
      namtmp(x)="text03"                  '===== name of variable for programming purpose
      '=== get first folder of basedir
      deftmp(x)=basedir2 & "\sources\install*.swm"          '===== default value
      typtmp(x)="textbox"               '===== type of data: textbox password (futur: more to come)
      errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords

      x = x + 1
      redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
      distmp(x)="Win temp dir (win10)"      '===== description displayed in front of the field
      namtmp(x)="text04"                  '===== name of variable for programming purpose
      deftmp(x)=basedir2 & desmountfolder04          '===== default value
      typtmp(x)="textbox"               '===== type of data: textbox password (futur: more to come)
      errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords

buttmp=array("ok","cancel")       '===== at the end, there will be an "ok" button and a "cancel" button

a = dynforgen2 (distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)

'=== if internet explorer was not closed (bready), a button was not pressed on left frame, and no excape or cancel in middle frame
if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
'=== get values from input boxes
filename01 = fmid.form01.text01.Value
desmountfolder03 = fmid.form01.text02.Value
filenameswm01 = fmid.form01.text03.Value
desmountfolder04 = fmid.form01.text04.Value

'=== create working folders
if not objFSO.folderEXISTS(desmountfolder03) then
d = wrifra(fbot, "<br>CREATING folder: " & desmountfolder03, 1)
objFSO.CreateFolder (desmountfolder03)
else
'=== already exist
end if

if not objFSO.folderEXISTS(desmountfolder04) then
d = wrifra(fbot, "<br>CREATING folder: " & desmountfolder04, 1)
objFSO.CreateFolder (desmountfolder04)
else
'=== already exist
end if


'=== unsplit
cmd01 = "DISM /Export-Image /sourceimagefile:" & replace(filenameswm01, "*", "") & " /SWMFile:" & filenameswm01 & " /Sourceindex:1 /DestinationImageFile:" & desmountfolder04 & "\install.wim"
d = wrifra(fbot, "<br><br>MERGE swm<br>" & cmd01, 1)

cmd01 = "dism /Split-Image /ImageFile:" & desmountfolder04 & "\install.wim /SWMFile:" & desmountfolder03 & "\install.swm /FileSize:1900"
d = wrifra(fbot, "<br><br>SPLIT wim<br>" & cmd01, 1)

d = wrifra(fbot, "<br><br>ORIGINAL DVD SPLIT wim", 1)

cmd01 = "dism /Split-Image /ImageFile:" & filename01 & " /SWMFile:" & desmountfolder03 & "\install.swm /FileSize:1900"
d = wrifra(fbot, "<br><br>SPLIT wim<br>" & cmd01, 1)

      'DISM /Export-Image /sourceimagefile:install.swm /SWMFile:install*.swm /Sourceindex:1  DestinationImageFile:installwim.wim

test= 1
if test=0 then
        set objPing = objShe.Exec(cmd0122)
        strPingOut = objPing.StdOut.ReadAll
       
        strpingout = replace(strpingout, chr(13)+chr(10), "<br>")
       
        fbot.WriteLn("<br>" & strPingOut)
        fbot.WriteLn("<br>")
        for i = 1 to len(strpingout)
          c = mid(strpingout,i,1)
          if asc(c) = 13 then
            fbot.WriteLn("<br>found 13")
          end if
          if asc(c) = 10 then
            fbot.WriteLn("<br>found 10")
          end if
        next
       
        if instr(LCase(strPingOut), "reply") or instr(LCase(strPingOut), "ponse de") then
          flag = TRUE
        else
          flag = FALSE
        end if
        'fPingTest = flag
end if

if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
d = wrifra(fbot, "<br><br>FIN", 1)
end if
end if

reskeymid=0
resbutmidstr=""
reskeylef=0

end if



'''''''''''''''''''''''''''''''''''''''''''''
' wim win PE get info
'''''''''''''''''''''''''''''''''''''''''''''
if resbutlefstr="getwiminfo_winpe" then
a = clefra(array("fmid","fbot"))
resbutlefstr=""

x = 0
redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
distmp(x)="Wim file found (winPE)"      '===== description displayed in front of the field
namtmp(x)="text01"                  '===== name of variable for programming purpose
deftmp(x)=basedir2 & "\sources\boot.wim"          '===== default value
typtmp(x)="textbox"               '===== type of data: textbox password (futur: more to come)
errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords

x = x + 1
redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
distmp(x)="wim temp dir (winPE)"      '===== description displayed in front of the field
namtmp(x)="text02"                  '===== name of variable for programming purpose
deftmp(x)=desmountfolder02          '===== default value
typtmp(x)="textbox"               '===== type of data: textbox password (futur: more to come)
errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords

buttmp=array("ok","cancel")       '===== at the end, there will be an "ok" button and a "cancel" button

a = dynforgen2 (distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)

'=== if internet explorer was not closed (bready), a button was not pressed on left frame, and no excape or cancel in middle frame
if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
'=== get values from input boxes
filename01 = fmid.form01.text01.Value
filename02 = fmid.form01.text02.Value

cmd01 = "Dism.exe /Get-WIMinfo /WimFile:" & filename01 & " /Index:1"
'cmd01 = "Dism.exe /Mount-WIM /WimFile:" & filename01 & " /Name:"Windows 7 PROFESSIONAL" "
d = wrifra(fbot, "<br>" & cmd01, 1)

set objPing = objShe.Exec(cmd01)
strPingOut = objPing.StdOut.ReadAll

strpingout = replace(strpingout, chr(13)+chr(10), "<br>")

fbot.WriteLn("<br>" & strPingOut)
fbot.WriteLn("<br>")
for i = 1 to len(strpingout)
c = mid(strpingout,i,1)
if asc(c) = 13 then
fbot.WriteLn("<br>found 13")
end if
if asc(c) = 10 then
fbot.WriteLn("<br>found 10")
end if
next

if instr(LCase(strPingOut), "reply") or instr(LCase(strPingOut), "ponse de") then
flag = TRUE
else
flag = FALSE
end if
'fPingTest = flag

if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
d = wrifra(fbot, "<br>FIN", 1)
end if
end if

reskeymid=0
resbutmidstr=""
reskeylef=0

end if

'''''''''''''''''''''''''''''''''''''''''''''
' wim win PE extract wim
'''''''''''''''''''''''''''''''''''''''''''''
if resbutlefstr="extractwim_winpe" then

tit = "Extract winPE image"

a = clefra(array("fmid","fbot"))
resbutlefstr=""

x = 0
redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
distmp(x)="Win file found (winpe)"      '===== description displayed in front of the field
namtmp(x)="text01"                  '===== name of variable for programming purpose
deftmp(x)=basedir2 & "\sources\boot.wim"          '===== default value
typtmp(x)="textbox"               '===== type of data: textbox password (futur: more to come)
errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords

x = x + 1
redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
distmp(x)="name of the index (image name)"      '===== description displayed in front of the field
namtmp(x)="text02"                  '===== name of variable for programming purpose
deftmp(x)=imagename01          '===== default value
typtmp(x)="textbox"               '===== type of data: textbox password (futur: more to come)
errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords

x = x + 1
redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
distmp(x)="Local destination folder"      '===== description displayed in front of the field
namtmp(x)="text03"                  '===== name of variable for programming purpose
deftmp(x)=basedir2 & desmountfolder02          '===== default value
typtmp(x)="textbox"               '===== type of data: textbox password (futur: more to come)
errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords

buttmp=array("ok","cancel")       '===== at the end, there will be an "ok" button and a "cancel" button

a = dynforgen2 (distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)

'=== if internet explorer was not closed (bready), a button was not pressed on left frame, and no excape or cancel in middle frame
if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
'=== get values from input boxes
filename01 = fmid.form01.text01.Value
imagename01 = fmid.form01.text02.Value
desmountfolder02 = fmid.form01.text03.Value

      if not objFSO.folderEXISTS(desmountfolder02) then
        d = wrifra(fbot, "<br>CREATING folder: " & desmountfolder02, 1)
        objFSO.CreateFolder (desmountfolder02)
      else
        '=== already exist
      end if

cmd01 = "Dism /Mount-WIM /WimFile:""" & filename01 & """ /Name:""" & imagename01 & """ /MountDir:""" & desmountfolder02 & """"
d = wrifra(fbot, "<br>" & cmd01, 1)

set objPing = objShe.Exec(cmd01)
strPingOut = objPing.StdOut.ReadAll

strpingout = replace(strpingout, chr(13)+chr(10), "<br>")

fbot.WriteLn("<br>" & strPingOut)
fbot.WriteLn("<br>")
for i = 1 to len(strpingout)
c = mid(strpingout,i,1)
if asc(c) = 13 then
fbot.WriteLn("<br>found 13")
end if
if asc(c) = 10 then
fbot.WriteLn("<br>found 10")
end if
next

if instr(LCase(strPingOut), "reply") or instr(LCase(strPingOut), "ponse de") then
flag = TRUE
else
flag = FALSE
end if
'fPingTest = flag

if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
d = wrifra(fbot, "<br>FIN", 1)
end if
end if

reskeymid=0
resbutmidstr=""
reskeylef=0

end if


'''''''''''''''''''''''''''''''''''''''''''''
' wim win PE driver add
'''''''''''''''''''''''''''''''''''''''''''''
if resbutlefstr="adddriverwim_winpe" then
   
    driverspath01 = basedir2 & "\sources\$oem$\$1\_drivers\vmware\pvscsi\"
     
tit = "Add driver winPE image for boot (Special controller, usually on floppy)"

a = clefra(array("fmid","fbot"))
resbutlefstr=""

x = 0
redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
distmp(x)="Win file found (winpe)"      '===== description displayed in front of the field
namtmp(x)="text01"                  '===== name of variable for programming purpose
deftmp(x)=basedir2 & desmountfolder02          '===== default value
typtmp(x)="textbox"               '===== type of data: textbox password (futur: more to come)
errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords

x = x + 1
redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
distmp(x)="name of the index (image name)"      '===== description displayed in front of the field
namtmp(x)="text02"                  '===== name of variable for programming purpose
deftmp(x)=imagename01          '===== default value
typtmp(x)="textbox"               '===== type of data: textbox password (futur: more to come)
errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords

x = x + 1
redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
distmp(x)="driver path to add to winpe"      '===== description displayed in front of the field
namtmp(x)="text03"                  '===== name of variable for programming purpose
deftmp(x)=driverspath01          '===== default value
typtmp(x)="textbox"               '===== type of data: textbox password (futur: more to come)
errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords

buttmp=array("ok","cancel")       '===== at the end, there will be an "ok" button and a "cancel" button

a = dynforgen2 (distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)

'=== if internet explorer was not closed (bready), a button was not pressed on left frame, and no excape or cancel in middle frame
if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
'=== get values from input boxes
desmountfolder02 = fmid.form01.text01.Value
imagename01 = fmid.form01.text02.Value
driverspath01 = fmid.form01.text03.Value

'cmd01 = "Dism /Mount-WIM /WimFile:""" & filename01 & """ /Name:""" & imagename01 & """ /MountDir:""" & desmountfolder02 & """"
      'if not objFSO.folderEXISTS(desmountfolder02) then
      '  d = wrifra(fbot, "<br>CREATING folder: " & desmountfolder02, 1)
      '  objFSO.CreateFolder (desmountfolder02)
      'else
      '  '=== already exist
      'end if

cmd01 = "dism /image:" & desmountfolder02 & " /add-driver:" & driverspath01 & " /recurse"

d = wrifra(fbot, "<br>" & cmd01, 1)

set objPing = objShe.Exec(cmd01)
strPingOut = objPing.StdOut.ReadAll

strpingout = replace(strpingout, chr(13)+chr(10), "<br>")

fbot.WriteLn("<br>" & strPingOut)
fbot.WriteLn("<br>")
for i = 1 to len(strpingout)
c = mid(strpingout,i,1)
if asc(c) = 13 then
fbot.WriteLn("<br>found 13")
end if
if asc(c) = 10 then
fbot.WriteLn("<br>found 10")
end if
next

if instr(LCase(strPingOut), "reply") or instr(LCase(strPingOut), "ponse de") then
flag = TRUE
else
flag = FALSE
end if
'fPingTest = flag

if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
d = wrifra(fbot, "<br>FIN", 1)
end if
end if

reskeymid=0
resbutmidstr=""
reskeylef=0

end if


'''''''''''''''''''''''''''''''''''''''''''''
' wim win PE unmount commit add
'''''''''''''''''''''''''''''''''''''''''''''
if resbutlefstr="unmountcommitwim_winpe" then

tit = "Umount Commit winPE image for boot"

a = clefra(array("fmid","fbot"))
resbutlefstr=""

x = 0
redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
distmp(x)="Win file found (winpe)"      '===== description displayed in front of the field
namtmp(x)="text01"                  '===== name of variable for programming purpose
deftmp(x)=basedir2 & desmountfolder02          '===== default value
typtmp(x)="textbox"               '===== type of data: textbox password (futur: more to come)
errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords

x = x + 1
redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
distmp(x)="name of the index (image name)"      '===== description displayed in front of the field
namtmp(x)="text02"                  '===== name of variable for programming purpose
deftmp(x)=imagename01          '===== default value
typtmp(x)="textbox"               '===== type of data: textbox password (futur: more to come)
errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords

buttmp=array("ok","cancel")       '===== at the end, there will be an "ok" button and a "cancel" button

a = dynforgen2 (distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)

'=== if internet explorer was not closed (bready), a button was not pressed on left frame, and no excape or cancel in middle frame
if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
'=== get values from input boxes
desmountfolder02 = fmid.form01.text01.Value
imagename01 = fmid.form01.text02.Value


cmd01 = "Dism /Unmount-WIM /MountDir:" &  desmountfolder02 & " /Commit"

d = wrifra(fbot, "<br>" & cmd01, 1)

set objPing = objShe.Exec(cmd01)
strPingOut = objPing.StdOut.ReadAll

strpingout = replace(strpingout, chr(13)+chr(10), "<br>")

fbot.WriteLn("<br>" & strPingOut)
fbot.WriteLn("<br>")
for i = 1 to len(strpingout)
c = mid(strpingout,i,1)
if asc(c) = 13 then
fbot.WriteLn("<br>found 13")
end if
if asc(c) = 10 then
fbot.WriteLn("<br>found 10")
end if
next

if instr(LCase(strPingOut), "reply") or instr(LCase(strPingOut), "ponse de") then
flag = TRUE
else
flag = FALSE
end if
'fPingTest = flag

if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
d = wrifra(fbot, "<br>FIN", 1)
end if
end if

reskeymid=0
resbutmidstr=""
reskeylef=0

end if

'''''''''''''''''''''''''''''''''''''''''''
' edit xml
'''''''''''''''''''''''''''''''''''''''''''
if resbutlefstr="editxmlfilerecur" then

resbutlefstr = ""

a = clefra(array("fmid","fbot"))

'=== value
'=== chek if the file already exist
Set objFol01=objFSO.GetFolder(basedir)'=== dir
Set objfol02=objFol01.files '=== files

x=0
redim ara01(0)
dimnum=1
For Each objFil in objFol02
filnam=objfil.name
filnam=lcase(filnam)
if right(filnam,4)=".xml" then
redim preserve ara01(x)
ara01(x)=filnam
x=x+1
end if
next

'=== title of the columns
aratit = array("Name of the database")

'=== array to put in table, choice button, header, middle line, bottom line, reload
a = dynbotcho(fmid, "choose the database to edit", aratit, ara01, 1 ,1, 1, 1, 1, 0, "mid")
do
wscript.sleep 100

'=== while we wait for input value (or button press), user can press "escape" key, "cancel" button or close internet explorer
if resbutmidstr="cancel" or reskeymid=27 or bready=true or resbutlefstr<>"" then
'=== if user pressed escape or cancel, we clear the frames
if resbutmidstr="cancel" or reskeymid=27 then
a = clefra(array("fmid","fbot"))
resbutmidstr="cancel"
end if
exit do
end if  

loop while resbutmidstr=""

   
if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then

'=== convert the choice made with the button to a number (remove "but" from left side)
a=right(resbutmidstr,len(resbutmidstr)-3)
resbutmidstr=""
'=== get the array that contain the choice in dbnam (database name)
filename01 = ara01(a-1)

end if

'fbot.WriteLn("<br>choice: " & xmlfile01)

'=== open xml file
Set xmlDoc = CreateObject("Microsoft.XMLDOM")

xmlDoc.Async = "False"
xmlDoc.Load(filename01)
'Set objRoot = xmlDoc.documentElement

'=== root node level 0
'Set Node00 = objroot.SelectSingleNode("/*")

node = 1

'=== references
'https://msdn.microsoft.com/en-us/library/system.xml.xmlelement(v=vs.100).aspx

Set colNodes01 = xmlDoc.selectNodes("/*")

dummy = edit_xml_node_recur(colNodes01, basedir & filename01)

'xmlDoc.Save basedir & "\facturation" & numero01 & ".xml"

if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
fmid.WriteLn("<br>FIN")
end if

reskeymid=0
resbutmidstr=""
reskeylef=0

end if
 
  ''''''''''''''''''''''''''''''''''''
  ' xml edit
  ''''''''''''''''''''''''''''''''''''
if resbutlefstr="editxmlfile" then
a = clefra(array("fmid","fbot"))
resbutlefstr=""

x=0
redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
distmp(x)="xml file name"      '===== description displayed in front of the field
namtmp(x)="text01"                  '===== name of variable for programming purpose
deftmp(x)=basedir & "facturation10.xml"          '===== default value
typtmp(x)="textbox"               '===== type of data: textbox password (futur: more to come)
errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords

buttmp=array("ok","cancel")       '===== at the end, there will be an "ok" button and a "cancel" button

a = dynforgen2 (distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)

'=== if internet explorer was not closed (bready), a button was not pressed on left frame, and no excape or cancel in middle frame
if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
'=== get values from input boxes
filename01 = fmid.form01.text01.Value

'=== open xml file
Set xmlDoc = CreateObject("Microsoft.XMLDOM")

xmlDoc.Async = "False"
xmlDoc.Load(filename01)
'Set objRoot = xmlDoc.documentElement

'=== root node level 0
'Set Node00 = objroot.SelectSingleNode("/*")

node = 1

'=== references
'https://msdn.microsoft.com/en-us/library/system.xml.xmlelement(v=vs.100).aspx

Set colNodes01 = xmlDoc.selectNodes("/*")

dummy = edit_xml_node(colNodes01, basedir & "\facturation" & numero01 & ".xml")

'xmlDoc.Save basedir & "\facturation" & numero01 & ".xml"

if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
fbot.WriteLn("<br>FIN")

end if
end if

reskeymid=0
resbutmidstr=""
reskeylef=0

end if

  ''''''''''''''''''''''''''''''''''''
  ' xml display
  ''''''''''''''''''''''''''''''''''''

if resbutlefstr="displayxmlfile" then
a = clefra(array("fmid","fbot"))
resbutlefstr=""

x=0
redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
distmp(x)="xml file name"      '===== description displayed in front of the field
namtmp(x)="text01"                  '===== name of variable for programming purpose
deftmp(x)=basedir & "facturation9.xml"          '===== default value
typtmp(x)="textbox"               '===== type of data: textbox password (futur: more to come)
errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords

buttmp=array("ok","cancel")       '===== at the end, there will be an "ok" button and a "cancel" button

a = dynforgen2 (distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)

'=== if internet explorer was not closed (bready), a button was not pressed on left frame, and no excape or cancel in middle frame
if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
'=== get values from input boxes
filename01 = fmid.form01.text01.Value

'=== display your answers
'fmid.WriteLn("<br>Answer01: " & text01)
'fmid.WriteLn("<br>Answer02: " & text02)

'=== open xml file
Set xmlDoc = CreateObject("Microsoft.XMLDOM")

xmlDoc.Async = "False"
xmlDoc.Load(filename01)
Set objRoot = xmlDoc.documentElement

'=== root node level 0
'Set Node00 = objroot.SelectSingleNode("/*")

node = 1

'=== references
'https://msdn.microsoft.com/en-us/library/system.xml.xmlelement(v=vs.100).aspx

Set colNodes01 = xmlDoc.selectNodes("/*")



'=== make a big table that will contain other tables inside
h = "<!DOCTYPE html>"
h = h & "<html>"

h = h & "<head>"
h = h & "<style>"
h = h & "table#items01 tr:nth-child(even) {"
h = h & "background-color: #eee;"
h = h & "}"
h = h & "</style>"
h = h & "</head>"

h = h & "<body>"
h = h & "<table width=""100%"" BORDERCOLOR=""black"" class=MsoTableGrid border=1 CELLSPACING=0 cellpadding=2 style='border-collapse:collapse;border: 1px solid black'>"


'=== list all root nodes
For Each objNode01 in colNodes01
h = h & "<tr>" '=== line 1

h = h & "<td>" & objnode01.nodeName & "</td>"
'=== any node under root
for each objnode02 in objnode01.childnodes
h = h & "<tr>" '=== line 1
h = h & "<td></td><td>" & objnode02.nodename & "</td>"

For Each objChild02 In objnode02.childNodes
h = h & "<tr>"
if objchild02.text <>"" then
displaynamefra = objchild02.getattribute("displaynamefra")
h = h & "<td></td><td></td><td>" & objchild02.nodename  & "</td><td>" & displaynamefra & "</td><td>" & objchild02.text & "</td>"
'fbot.WriteLn("<td>" & displaynamefra & " " & objchild02.text)

end if
h = h & "</tr>" '=== line 1
next
h = h & "</tr>" '=== line 1
next
node = node+1
h = h & "</tr>" '=== line 1
next

xmlDoc.Save basedir & "\facturation" & numero01 & ".xml"

fbot.WriteLn(h)

fbot.WriteLn("<br>FIN")
end if

reskeymid=0
resbutmidstr=""
reskeylef=0


end if

if resbutlefstr="facturationnew" then

'=== this was a test with multiple button value (one for each line)
a = clefra(array("fmid","fbot"))
resbutlefstr=""

x=0
redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
distmp(x)="Invoice number"      '===== description displayed in front of the field
namtmp(x)="text01"                  '===== name of variable for programming purpose
deftmp(x)="10"           '===== default value inside the form (the form will be 20 char long if no value here, but you can enter more)
typtmp(x)="textbox"               '===== type of data: textbox password (futur: more to come)
errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords

x=x+1
redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
distmp(x)="Quantitée (heures)"      '===== description displayed in front of the field
namtmp(x)="text02"                  '===== name of variable for programming purpose
deftmp(x)=""           '===== default value inside the form (the form will be 20 char long if no value here, but you can enter more)
typtmp(x)="textbox"               '===== type of data: textbox password (futur: more to come)
errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords

x=x+1
redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
distmp(x)="Tarif (rate)"      '===== description displayed in front of the field
namtmp(x)="text03"                  '===== name of variable for programming purpose
deftmp(x)=""           '===== default value inside the form (the form will be 20 char long if no value here, but you can enter more)
typtmp(x)="textbox"               '===== type of data: textbox password (futur: more to come)
errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords

x=x+1
redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
distmp(x)="Référence employeur (bon de commande)"      '===== description displayed in front of the field
namtmp(x)="text04"                  '===== name of variable for programming purpose
deftmp(x)=""           '===== default value inside the form (the form will be 20 char long if no value here, but you can enter more)
typtmp(x)="textbox"               '===== type of data: textbox password (futur: more to come)
errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords

x=x+1
redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
distmp(x)="Time line"      '===== description displayed in front of the field
namtmp(x)="text05"                  '===== name of variable for programming purpose
deftmp(x)="semaine du 2015"           '===== default value inside the form (the form will be 20 char long if no value here, but you can enter more)
typtmp(x)="textbox"               '===== type of data: textbox password (futur: more to come)
errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords

buttmp=array("ok","cancel")       '===== at the end, there will be an "ok" button and a "cancel" button

a = dynforgen2 (distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)


'=== if internet explorer was not closed (bready), a button was not pressed on left frame, and no excape or cancel in middle frame
if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
'=== get values from input boxes
numero01 = fmid.form01.text01.Value
quantity01 = fmid.form01.text02.Value
rate01 = fmid.form01.text03.Value
billto_reference01 = fmid.form01.text04.Value
timeline01 = fmid.form01.text05.Value

'=== display your answers
'fmid.WriteLn("<br>Answer01: " & text01)
'fmid.WriteLn("<br>Answer02: " & text02)
'reference
'http://www.w3schools.com/xml/dom_element.asp


'fbot.WriteLn("<br>TESTING XML STUFF")
'fbot.WriteLn("<br>directory where xml file is saved: " & basedir)

'=== goal: have an xml list of items to generate an invoice


'=== do not create

'=== create xml
Set xmlDoc = CreateObject("Microsoft.XMLDOM")
Set objRoot = xmlDoc.createElement("facturation")
xmlDoc.appendChild objRoot

'Set objRecord = xmlDoc.createElement("source")
'objRoot.appendChild objRecord

'Set objName = xmlDoc.createElement("nom")
'objName.Text = "Serge Fournier"
'objRecord.appendChild objName

'Set objDate = xmlDoc.createElement("datecreation")
'objDate.Text = Date
'objRecord.appendChild objDate

Set objIntro = xmlDoc.createProcessingInstruction("xml","version='1.0'")
xmlDoc.insertBefore objIntro,xmlDoc.childNodes(0)

xmlDoc.Save basedir & "\facturation" & numero01 & ".xml"

'=== add a record
Set xmlDoc = CreateObject("Microsoft.XMLDOM")

xmlDoc.Async = "False"
xmlDoc.Load(basedir & "\facturation" & numero01 & ".xml")

Set objRoot = xmlDoc.documentElement

Set objRecord = xmlDoc.createElement("bill")
objRoot.appendChild objRecord

Set objFieldValue = xmlDoc.createElement("id")
objfieldvalue.SetAttribute "displaynamefra", "Numéro"
objFieldValue.Text = numero01
objRecord.appendChild objFieldValue

Set objFieldValue = xmlDoc.createElement("date")
objfieldvalue.SetAttribute "displaynamefra", "Date émise"
objFieldValue.Text = date
objRecord.appendChild objFieldValue

Set objFieldValue = xmlDoc.createElement("datedue")
objfieldvalue.SetAttribute "displaynamefra", "Date due"
objFieldValue.Text = date
objRecord.appendChild objFieldValue

Set objFieldValue = xmlDoc.createElement("billto_reference")
objfieldvalue.SetAttribute "displaynamefra", "Référence de l'employeur"
objFieldValue.Text = billto_reference01
objRecord.appendChild objFieldValue

Set objRecord = xmlDoc.createElement("billfrom")
objRoot.appendChild objRecord
objRecord.SetAttribute "displaynamefra", "Contracteur"

Set objFieldValue = xmlDoc.createElement("compagny")
objfieldvalue.SetAttribute "displaynamefra", "Compagnie"
objFieldValue.Text = ""
objRecord.appendChild objFieldValue

Set objFieldValue = xmlDoc.createElement("name")
objfieldvalue.SetAttribute "displaynamefra", "Nom"
objFieldValue.Text = "Serge Fournier"
objRecord.appendChild objFieldValue

Set objFieldValue = xmlDoc.createElement("addressnumber")
objfieldvalue.SetAttribute "displaynamefra", "Adresse"
objFieldValue.Text = ""
objRecord.appendChild objFieldValue

Set objFieldValue = xmlDoc.createElement("addressstreet")
objfieldvalue.SetAttribute "displaynamefra", "Rue"
objFieldValue.Text = ""
objRecord.appendChild objFieldValue

Set objFieldValue = xmlDoc.createElement("addresscity")
objfieldvalue.SetAttribute "displaynamefra", "Ville"
objFieldValue.Text = "Chicoutimi"
objRecord.appendChild objFieldValue

Set objFieldValue = xmlDoc.createElement("addresszip")
objfieldvalue.SetAttribute "displaynamefra", "Code postal"
objFieldValue.Text = ""
objRecord.appendChild objFieldValue

Set objFieldValue = xmlDoc.createElement("addressstate")
objfieldvalue.SetAttribute "displaynamefra", "Province"
objFieldValue.Text = "Québec"
objRecord.appendChild objFieldValue

Set objFieldValue = xmlDoc.createElement("addresscountry")
objfieldvalue.SetAttribute "displaynamefra", "Pays"
objFieldValue.Text = "Canada"
objRecord.appendChild objFieldValue

Set objFieldValue = xmlDoc.createElement("phonehome")
objfieldvalue.SetAttribute "displaynamefra", "Téléphone (residence)"
objFieldValue.Text = ""
objRecord.appendChild objFieldValue

Set objFieldValue = xmlDoc.createElement("phonework")
objfieldvalue.SetAttribute "displaynamefra", "Téléphone (travail)"
objFieldValue.Text = "418-612-7015"
objRecord.appendChild objFieldValue

Set objFieldValue = xmlDoc.createElement("email")
objfieldvalue.SetAttribute "displaynamefra", "Courriel"
objFieldValue.Text = "sergefournier@hotmail.com"
objRecord.appendChild objFieldValue

Set objFieldValue = xmlDoc.createElement("phonecell")
objfieldvalue.SetAttribute "displaynamefra", "Téléphone (cellulaire)"
objFieldValue.Text = ""
objRecord.appendChild objFieldValue

Set objRecord = xmlDoc.createElement("billto")
objRoot.appendChild objRecord

'31, Racine O., First floor, Saguenay ,QC ,Canada ,G7J 1E4

Set objFieldValue = xmlDoc.createElement("compagny")
objfieldvalue.SetAttribute "displaynamefra", "Compagnie"
objFieldValue.Text = "Bloobuzz Studio"
objRecord.appendChild objFieldValue

Set objFieldValue = xmlDoc.createElement("name")
objfieldvalue.SetAttribute "displaynamefra", "Nom"
objFieldValue.Text = "Payables@bloobuzz.com"
objRecord.appendChild objFieldValue

Set objFieldValue = xmlDoc.createElement("addressnumber")
objfieldvalue.SetAttribute "displaynamefra", "Adresse"
objFieldValue.Text = "31"
objRecord.appendChild objFieldValue

Set objFieldValue = xmlDoc.createElement("addressstreet")
objfieldvalue.SetAttribute "displaynamefra", "Rue"
objFieldValue.Text = "Racine Ouest"
objRecord.appendChild objFieldValue

Set objFieldValue = xmlDoc.createElement("addresscity")
objfieldvalue.SetAttribute "displaynamefra", "Ville"
objFieldValue.Text = "Chicoutimi"
objRecord.appendChild objFieldValue

Set objFieldValue = xmlDoc.createElement("addresszip")
objfieldvalue.SetAttribute "displaynamefra", "Code postal"
objFieldValue.Text = "G7J 1E4"
objRecord.appendChild objFieldValue

Set objFieldValue = xmlDoc.createElement("addressstate")
objfieldvalue.SetAttribute "displaynamefra", "Province"
objFieldValue.Text = "Québec"
objRecord.appendChild objFieldValue

Set objFieldValue = xmlDoc.createElement("addresscountry")
objfieldvalue.SetAttribute "displaynamefra", "Pays"
objFieldValue.Text = "Canada"
objRecord.appendChild objFieldValue

Set objFieldValue = xmlDoc.createElement("phonework")
objfieldvalue.SetAttribute "displaynamefra", "Téléphone"
objFieldValue.Text = "418-612-7015"
objRecord.appendChild objFieldValue

Set objRecord = xmlDoc.createElement("billitems")
objRoot.appendChild objRecord

Set objFieldValue = xmlDoc.createElement("id")
objfieldvalue.SetAttribute "displaynamefra", "Item #"
objFieldValue.Text = "1"
objRecord.appendChild objFieldValue

Set objFieldValue = xmlDoc.createElement("id_bill")
objfieldvalue.SetAttribute "displaynamefra", "Référence facture"
objFieldValue.Text = numero01
objRecord.appendChild objFieldValue

Set objFieldValue = xmlDoc.createElement("description")
objfieldvalue.SetAttribute "displaynamefra", "Description"
objFieldValue.Text = "Administration réseau et technique informatique"
objRecord.appendChild objFieldValue

Set objFieldValue = xmlDoc.createElement("timeline")
objfieldvalue.SetAttribute "displaynamefra", "Période"
objFieldValue.Text = timeline01
objRecord.appendChild objFieldValue

Set objFieldValue = xmlDoc.createElement("unity")
objfieldvalue.SetAttribute "displaynamefra", "Unitée"
objFieldValue.Text = "Heures"
objRecord.appendChild objFieldValue

Set objFieldValue = xmlDoc.createElement("quantity")
objfieldvalue.SetAttribute "displaynamefra", "Quantité"
objFieldValue.Text = quantity01
objRecord.appendChild objFieldValue

Set objFieldValue = xmlDoc.createElement("rate")
objfieldvalue.SetAttribute "displaynamefra", "Tarif"
objFieldValue.Text = rate01
objRecord.appendChild objFieldValue


xmlDoc.Save basedir & "\facturation" & numero01 & ".xml"

fmid.WriteLn("<br>New invoice created")

reskeymid=0
resbutmidstr=""
reskeylef=0


end if
end if
'''''''''''''''''''''''''''''''''''''
' facturation invoice (display)
'''''''''''''''''''''''''''''''''''''
if resbutlefstr="facturation" then

'=== this was a test with multiple button value (one for each line)
a = clefra(array("fmid","fbot"))

x=0
redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
distmp(x)="Invoice number"      '===== description displayed in front of the field
namtmp(x)="text01"                  '===== name of variable for programming purpose
deftmp(x)="10"           '===== default value inside the form (the form will be 20 char long if no value here, but you can enter more)
typtmp(x)="textbox"               '===== type of data: textbox password (futur: more to come)
errtmp(x)="enter a text to display" '===== text to display after the form "facultatif" blue text "error" red text are special keywords

buttmp=array("ok","cancel")       '===== at the end, there will be an "ok" button and a "cancel" button

a = dynforgen2 (distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)

'=== if internet explorer was not closed (bready), a button was not pressed on left frame, and no excape or cancel in middle frame
if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
'=== get values from input boxes
numero01 = fmid.form01.text01.Value
'quantity01 = fmid.form01.text02.Value
'rate01 = fmid.form01.text03.Value
'billto_reference01 = fmid.form01.text04.Value
'timeline01 = fmid.form01.text05.Value

'=== display your answers
fmid.WriteLn("<br>Answer01: " & text01)
fmid.WriteLn("<br>Answer02: " & text02)
'reference
'http://www.w3schools.com/xml/dom_element.asp


'fbot.WriteLn("<br>TESTING XML STUFF")
'fbot.WriteLn("<br>directory where xml file is saved: " & basedir)

'=== goal: have an xml list of items to generate an invoice

'=== affiche la facture dans le frame du bas

Set xmlDoc = CreateObject("Microsoft.XMLDOM")

xmlDoc.Async = "False"
xmlDoc.Load(basedir & "\facturation" & numero01 & ".xml")

'=== id facture
id_bill = numero01

'=== ROOT:
'=== facturation
'=== RECORDS:
'=== bill, billfrom, billto, billitems
'Set colNodes=xmlDoc.selectNodes("/facturation/ComputerAudit [ComputerName = 'atl-ws-100']")

'=== make a big table that will contain other tables inside
h = "<!DOCTYPE html>"
h = h & "<html>"

h = h & "<head>"
h = h & "<style>"
h = h & "table#items01 tr:nth-child(even) {"
h = h & "background-color: #eee;"
h = h & "}"
h = h & "</style>"
h = h & "</head>"

h = h & "<body>"
h = h & "<table width=""100%"" BORDERCOLOR=""black"" class=MsoTableGrid border=1 CELLSPACING=0 cellpadding=2 style='border-collapse:collapse;border: 3px solid black'>"
h = h & "<tr>" '=== line 1

''''''''''''''''''''''''''''''''
' billfrom
''''''''''''''''''''''''''''''''
h = h & "<td>" '=== column

'h = h & "<h1>Facture de:</h1>"
h = h & "<table width=""100%"" BORDERCOLOR=""black"" class=MsoTableGrid border=1 CELLSPACING=0 cellpadding=2 style='border-collapse:collapse;border:none'>"

Set colNodes=xmlDoc.selectNodes("/facturation/billfrom")

node = 1
For Each objNode in colNodes

'=== there is supposed to be only one node, one bill or invoice
For Each objChild In objnode.childNodes
if objchild.text <>"" then
h = h & "<tr>"

displaynamefra = objchild.getattribute("displaynamefra")
h = h & "<td>" & displaynamefra & "</td><td>" & objchild.text & "</td>"

h = h & "</tr>"
end if

next
node = node + 1
next

h = h & "</table>"
h = h & "</td>"

''''''''''''''''''''''''''''''''
' invoice
''''''''''''''''''''''''''''''''
h = h & "<td>"
h = h & "<table width=""100%"" BORDERCOLOR=""black"" class=MsoTableGrid border=1 CELLSPACING=0 cellpadding=2 style='border-collapse:collapse;border:none'>"

h = h & "<tr><td><center><h1>FACTURE</h1></center></td></tr>"

h = h & "</table>"
h = h & "</td>"

h = h & "</tr>" '=== line 1 end

h = h & "<tr>" '=== line 2

''''''''''''''''''''''''''''''''
' billto
''''''''''''''''''''''''''''''''
Set colNodes=xmlDoc.selectNodes("/facturation/billto")
h = h & "<td>"

h = h & "<h1>Facturé à:</h1>"
h = h & "<table width=""100%"" BORDERCOLOR=""black"" class=MsoTableGrid border=1 CELLSPACING=0 cellpadding=2 style='border-collapse:collapse;border:none'>"

Set colNodes=xmlDoc.selectNodes("/facturation/billto")

node = 1
For Each objNode in colNodes

'=== there is supposed to be only one node, one bill or invoice
For Each objChild In objnode.childNodes

h = h & "<tr>"
'fbot.WriteLn("<br>child node")
if objchild.text <>"" then
displaynamefra = objchild.getattribute("displaynamefra")
h = h & "<td>" & displaynamefra & "</td><td>" & objchild.text & "</td>"
end if
h = h & "</tr>"

next
'if objnode.text <>"" then
' displaynamefra = objnode.getattribute("displaynamefra")
' fbot.WriteLn("<br>node: " & node & " --- " & displaynamefra & " --- " & objnode.text)
'end if
node = node + 1

next

h = h & "</table>"

h = h & "</td>"

''''''''''''''''''''''''''''''''
' bill id and stuff
''''''''''''''''''''''''''''''''
h = h & "<td>"
h = h & "<table width=""100%"" BORDERCOLOR=""black"" class=MsoTableGrid border=1 CELLSPACING=0 cellpadding=2 style='border-collapse:collapse;border:none'>"

Set colNodes=xmlDoc.selectNodes("/facturation/bill [id = '" & id_bill & "']")

node = 1
For Each objNode in colNodes

'=== there is supposed to be only one node, one bill or invoice
For Each objChild In objnode.childNodes

h = h & "<tr>"
'fbot.WriteLn("<br>child node")
if objchild.text <>"" then
displaynamefra = objchild.getattribute("displaynamefra")
h = h & "<td>" & displaynamefra & "</td><td>" & objchild.text & "</td>"
end if
h = h & "</tr>"

next
'if objnode.text <>"" then
' displaynamefra = objnode.getattribute("displaynamefra")
' fbot.WriteLn("<br>node: " & node & " --- " & displaynamefra & " --- " & objnode.text)
'end if
node = node + 1

next

h = h & "</table>"

h = h & "</td>"
h = h & "</tr>" '=== line 2 end

h = h & "</tr>" '=== end 4 first squares

'''''''''''''''''''''''''''
' items
'''''''''''''''''''''''''''

h = h & "<td colspan=""2"">"

h = h & "<table id=""items01"" width=""100%"" BORDERCOLOR=""black"" class=MsoTableGrid border=1 CELLSPACING=0 cellpadding=2 style='border-collapse:collapse;border:none'>"

Set colNodes=xmlDoc.selectNodes("/facturation/billitems [id_bill = '" & id_bill & "']")
'fbot.WriteLn("<br>Numéro de la facture: " & id_bill)

Set colNodes=xmlDoc.selectNodes("/facturation/billitems")

'=== column titles
node = 1
h = h & "<tr>"
For Each objNode in colNodes

'=== there is supposed to be only one node, one bill or invoice
For Each objChild In objnode.childNodes
'fbot.WriteLn("<br>child node")

displaynamefra = objchild.getattribute("displaynamefra")
h = h & "<td>" & displaynamefra & "</td>"

next

h = h & "<td>Montant</td>"
'if objnode.text <>"" then
' displaynamefra = objnode.getattribute("displaynamefra")
' fbot.WriteLn("<br>node: " & node & " --- " & displaynamefra & " --- " & objnode.text)
'end if
node = node + 1

next
h = h & "</tr>"

'=== data in columns, line by line
total01 = 0
node = 1
For Each objNode in colNodes
h = h & "<tr>"
'=== there is supposed to be only one node, one bill or invoice
quantity01 = ""
rate01 = ""
nodecol = 0
For Each objChild In objnode.childNodes
'fbot.WriteLn("<br>child node")
displaynamefra = objchild.getattribute("displaynamefra")
if objchild.nodename = "rate" then prefix01 = "$ " else prefix01 = ""
h = h & "<td>" & prefix01 & objchild.text & "</td>"
if objchild.nodename = "quantity" then quantity01 = objchild.text
if objchild.nodename = "rate" then rate01 = objchild.text
nodecol = nodecol + 1
next
subtot01 = quantity01 * rate01
h = h & "<td>$ " & subtot01 & "</td>"
'if objnode.text <>"" then
' displaynamefra = objnode.getattribute("displaynamefra")
' fbot.WriteLn("<br>node: " & node & " --- " & displaynamefra & " --- " & objnode.text)
'end if
node = node + 1
h = h & "</tr>"

total01 = total01 + subtot01
next

'=== final line - total01
h = h & "<tr>"

'=== merge this to get total on right side, last 2 columns
h = h & "<td colspan=""" & nodecol-1 & """></td>"

h = h & "<td>Total (can)</td>"
h = h & "<td>$ " & total01 & "</td>"

h = h & "</tr>"

h = h & "</table>"

h = h & "</td>"
h = h & "</tr>" '=== line 2
h = h & "</body>"
h = h & "</html>"

'h = h & "<br>Total bills found: " & node-1 & " with " & id_bill & " as ID"
fbot.WriteLn(h)

'=== XML modification
Set xmlDoc = CreateObject("Microsoft.XMLDOM")

xmlDoc.Async = "False"
xmlDoc.Load(basedir & "\facturation" & numero01 & ".xml")

Set colNodes=xmlDoc.selectNodes("/facturation/source [nom = 'Serge Fournier']/datecreation")

For Each objNode in colNodes
  objNode.Text = "dodo"
  fbot.WriteLn(text & "<br>node")
Next

xmlDoc.Save basedir & "\facturation" & numero01 & ".xml"



'=== remove an element
Set xmlDoc = CreateObject("Microsoft.XMLDOM")

xmlDoc.Async = "False"
xmlDoc.Load(basedir & "\facturation" & numero01 & ".xml")

Set colNodes=xmlDoc.selectNodes   ("/ITChecklist/ComputerAudit [ComputerName = 'atl-ws-100']")

For Each objNode in colNodes
'=== this node name does not exist, so it will bot really be removed in this program right now
'xmlDoc.documentElement.removeChild(objNode)
Next

xmlDoc.Save basedir & "\facturation" & numero01 & ".xml"

fmid.WriteLn("<br><br>Done")

'=== open xml and make a html table ready to print

end if

reskeymid=0
resbutmidstr=""
reskeylef=0
resbutlefstr=""

end if


   '=== if the button named this is pressed we do this
   '=== resbutlefstr: result from pressing a button in the left frame (control frame, flef object)
   '=== its a string that contain the programmable name of the button that was pressed in the left frame (arabutnam)
 
   if resbutlefstr="clrframes" then

      a = clefra(array("fmid","fbot"))

      'fbot.WriteLn("tried to clear middle frame")
 
   end if
 
if resbutlefstr="info" then
fil02.WriteLine date & " " & time & " Info was pressed"

a = clefra(array("fmid","fbot"))

'=== print button

call oieready

for each a in priara
fbot.WriteLn(a)
next
for each a in botara
fbot.WriteLn(a)
next


fbot.WriteLn("<H2>Dynamic Web Interface</H2><br>")

texara=array(_
"",_
"1. REQUIREMENTS:",_
"1.1 Microsoft windows xp, vista (32 or 64), seven (32 or 64) (without UAC, users access control, off)",_
"1.2 Internet explorer",_
"1.3 .NET framework 1.1 (included with windows)", _
"",_
"Run this script in a windows installation directory (where you can find source directory, the root)",_
"It will create folder with same name for each function that you need to edit WIM files", _
"[this script folder]_wim_notsplitted (Extraction of one index if there is many installs in the same dvd)",_
"[this script folder]_wim_splitted (to be able to copy the dvd on a usb key that support only file smaller than 4gb)",_
"[this script folder]_mounted (win extracted as folders)",_
"[this script folder]_an other one i dont remember",_
"",_
"Contact: Serge Fournier, Prog./Analyst", _
"Email: sergefournier(a)hotmail.com")

for each a in texara
call oieready

fbot.WriteLn(a & "<br>")
next
call oieready

fbot.location.reload(true)

reskeymid=0
resbutmidstr=""
     
end if
   '==========================================
 
   '=== .1 seconds
   wscript.sleep 50
 
'=== we loop until internet explorer was closed or the quit button was pressed
loop until bReady or resbutlefstr="quit01"

'======================
'====================== end of main loop
'======================

'=== someone pressed "quit" on left frame (control frame, flef object)

'=== at the end, if internet explorer was not closed, we close it
if bready=false then
   oie.quit
   set oie=nothing
end if
if logall=1 then
   fil02.WriteLine date & " " & time & " END"
end if
if logall = 1 then
   fil02.close
end if

'=== we end wscript.exe, exiting all running code interpretation
wscript.quit

'==================================================================================================

'=== many subs

'=== if internet explorer is closed (event) we change bready value to TRUE
sub IE_onQuit()
   bReady=true
end sub


'============================================== subs and functions ====================================

'=== frames clear content by navigating to a blank
'=== input is an array containing name of frames as "flef" = frame left
'=== this sub generate a code and execute it in a string (cc)
'=== fully dynamic programming at it's best ;)
function clefra(aara)


For Each afra In aara
intfra = Int(InStr("fleffmidfbot", afra) / 4)
'•uninitialized - Has not started loading yet
'•loading - Is loading
'•interactive - Has loaded enough and the user can interact with it
'•complete - Fully loaded
fraara = array("left","middle","bottom")

set tmpfra = crefra(fraara(intfra))

'tmpfra.writeln(
htmtab = "<input type=""hidden""/>&nbsp;"
'Call wrifra(tmpfra, htmtab)
tmpfra.writeln(htmtab)
Call fready(tmpfra)

Call relfra(tmpfra)
tmpfra.location.reload(True)
Call fready(tmpfra)

htmtab = ""

'=== backgrounds
'fraara(0) = ("<body background=""" & BASEDIR & "images_interface\fond_gauche.jpg"">")
        'fraara(1) = ("<body background=""" & BASEDIR & "images_interface\fond_gris.jpg"">")
        'fraara(2) = ("<body background=""" & BASEDIR & "images_interface\fond_gris.jpg"">")
'For Each astr In fraara(intfra)
' htmtab = htmtab & astr
'Next
tmpfra.writeln(htmtab)
Call fready(tmpfra)
Next

resbutlefstr = ""
resbutmidstr = ""
resbutbotstr = ""
reskeylef = 0
reskeymid = 0
reskeybot = 0


end function

Function crefra(ffranam)
 
'Dim ffra As Object
err01 = 0
try01 = 0
ffra = ""
maxerr = 60 '=== 3 sec before fatal error

try01 = 1
fileversion = objFSO.GetFileVersion("C:\program files\internet explorer\iexplore.exe")
finddot = instr(fileversion,".")
fileversion2 = left(fileversion,finddot-1)

If logall = 1 Then fil02.WriteLine(DateValue(Now) & " " & TimeValue(Now) & " " & ffranam)

if fileversion2 = "10" or fileversion2 = "11" then
'=== ie10 frame access
'set crefra = oIE.parent.Document.frames.item(ffranam).document
set crefra = oie.parent.document.getElementByid(ffranam).contentdocument
else
set crefra = oie.document.frames(ffranam).document
end if

'If logall = 1 Then fil02.WriteLine(DateValue(Now) & " " & TimeValue(Now) & " crash creating frame again ")

End Function

Sub relfra(ffra)

ffra.location.reload(false)
'If logall = 1 Then fil02.WriteLine(DateValue(Now) & " " & TimeValue(Now) & " error reloading frame dynbotcho")

End Sub

Sub fready(tmpfra)
'=== old sub as ref in case something still calling it
End Sub

'=== form dynamically generated =========================================================================


'=== form dynamically generated =========================================================================

function dynforgen2 (distmp, namtmp, deftmp, typtmp, errtmp, buttmp, title)
  err01 = 1

  resbutmidstr=""
  reskeymid=0

  '=== save message before error one
  redim errtmp2(ubound(errtmp))
  for i = 0 to ubound(errtmp)
errtmp2(i) = errtmp(i)
  next

  do
  if err01 = 1 then
       'd = wrifra(fmid, title)
     
       '=== generate a form for input in the input frame (fmid object)
       '=== focus on the first field with no default value
       '=== display suffix message in red if "error" (or "erreur" - french) keyword is in it
     
       htmtab=""
     
       for each a in midara
                                                                      htmtab = htmtab & a
       next
     
       htmtab = htmtab & "<h3><span class=SpellE>" & title & "</span></h3>"
       '=== default focus on empty field (with no default value)
       deffoc=0
       for ii=0 to ubound(namtmp)
          if deftmp(ii)="" then
              if instr(lcase(errtmp(ii)),"facultatif")=0 then
                  htmtab = htmtab & "<BODY onLoad=""document.form01." & namtmp(ii) & ".focus()"">"
                  deffoc=1
              end if
          end if
          '=== no default value empty, we focus on first field
       next
       if deffoc=0 then
                    htmtab = htmtab & "<BODY onLoad=""document.form01." & namtmp(0) & ".focus()"">"
       end if
       htmtab = htmtab & "<div class=MsoNormal align=center style='text-align:center'>"
       htmtab = htmtab & "</div>"
     
       htmtab = htmtab & "<form name=form01>"
     
       '=== button and error message
       for ii=0 to ubound(namtmp)
         
          htmtab = htmtab & distmp(ii) & ": "
         
          '=== we disable "enter" to submit form because we manage this event as a onkeypress in the parent frame of the form later
          '=== we had to do this, because the web page form is not run on a server, and the web page dont have control, the VBS script outside the page have control
         
          htmtab = htmtab & "<input type=""" & typtmp(ii) & """ id=" & namtmp(ii) & " NAME=""" & namtmp(ii) & """ size=""" & max(20,len(deftmp(ii))+10) & """ value=""" & deftmp(ii) & """ onKeypress=""return event.keyCode!=13"""
          'fmid.WriteLn("")
          if instr(lcase(errtmp(ii)),"error")<>0 or instr(lcase(errtmp(ii)),"erreur")<>0 then
          col="red"
          else
          col="blue"
          end if
          htmtab = htmtab & "&nbsp; <b><span style='color:" & col & "'>&nbsp" & errtmp(ii) & "</span></b><br style='mso-special-character:line-break'>"
       next
     
       htmtab = htmtab & "<![if !supportLineBreakNewLine]><br style='mso-special-character:line-break'>"
       htmtab = htmtab & "<![endif]></p>"
     
       for ii=0 to ubound(buttmp)
              typ01 = "button"
              htmtab = htmtab & "<input type=""" & typ01 & """ name=""" & buttmp(ii) & """ value=""&nbsp;" & buttmp(ii) & "&nbsp;"">"
              htmtab = htmtab & "&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp"
       next
     
       htmtab = htmtab & "</div>"
       htmtab = htmtab & "</form>"
       htmtab = htmtab & "</body>"
       htmtab = htmtab & "</html>"
       fmid.writeln htmtab
       fmid.location.reload(true)
  else
                                                                '=== there wa sno error or this is first run
  end if

  '=== wait for internet explorer to be ready after we refresh the page with the new form
  for ii=0 to ubound(buttmp)
    call oieready
    '=== value to return for each button in the form
    fmid.forms(0).elements(buttmp(ii)).onclick = getref("buttonmid")
  next

  '=== regenerate the event that call a sub if a button is pressed
  set fmid.onkeypress = GetRef("Checkmid")

  '=== clear button pressed and key pressed for this frame

  '=== flag to tell if the input is not valid
  err01=0
  '=== flag to say input is done, since there might be a defaut value, we must validate if user was finished
  inpdon=0
  '=== "ok" button or "enter" key are the same
  '=== and nothing was pressed on left frame (control frame)

  if resbutlefstr="" and (resbutmidstr="ok" or reskeymid=13) then
       '=== User has clicked the OK button, retrieve the values
       i=0
       'err01 = 0
       for each name01 in namtmp
           text01 = ""
           code01 = "text01 = fmid.form01." & name01 & ".Value"
           execute code01
           deftmp(i) = text01
           if len(text01) = 0 then
                   err01 = 1
                   errtmp(i) = "error - must be 1 char long at least"
                   reskeymid=0
                   resbutmidstr=""
           else
                   errtmp(i) = errtmp2(i)
                   'fbot.writeln "<br>restore old text suffix"
           end if
           i=i+1
       next
     
       if err01 = 0 then inpdon=1
       'fbot.writeln "<br>Error01: " & err01
  else
                                                                '=== someone pressed left frame button
  end if

  '=== while we wait for input value, user can press "escape" key, "cancel" button or close internet explorer
  if resbutmidstr="cancel" or reskeymid=27 or bready=true or resbutlefstr<>"" then
       '=== if user pressed escape or cancel, we clear the frames
       if resbutmidstr="cancel" or reskeymid=27 then
                                                                      a = clefra(array("fmid","fbot"))
                                                                      resbutmidstr="cancel"
       end if
       '=== cancel or excape was pressed
       exit do
  end if

  resbutmidstr=""
  reskeymid=0

  wscript.sleep 50

  '=== if there was an input error and no one used left control frame to exit, we keep asking for input
  loop while inpdon=0

end function

'=== use dynforgen2 (dynamic validation of inputs)
function dynforgenold (distmp, namtmp,deftmp,typtmp,errtmp,buttmp,title)
 
   '=== generate a form for input in the input frame (fmid object)
   '=== focus on the first field with no default value
   '=== display suffix message in red if "error" (or "erreur" - french) keyword is in it
   htmtab=""
 
   for each a in midara
      htmtab = htmtab & a
   next
 
   htmtab = htmtab & "<h3><span class=SpellE>" & title & "</span></h3>"
   '=== default focus on empty field (with no default value)
   deffoc=0
   for ii=0 to ubound(namtmp)
      if deftmp(ii)="" then
         if instr(lcase(errtmp(ii)),"facultatif")=0 then
            htmtab = htmtab & "<BODY onLoad=""document.form01." & namtmp(ii) & ".focus()"">"
            deffoc=1
         end if
      end if
      '=== no default value empty, we focus on first field
   next
   if deffoc=0 then
      htmtab = htmtab & "<BODY onLoad=""document.form01." & namtmp(0) & ".focus()"">"
   end if
   htmtab = htmtab & "<div class=MsoNormal align=center style='text-align:center'>"
   htmtab = htmtab & "</div>"

   htmtab = htmtab & "<form name=form01>"

   '=== button and error message
   for ii=0 to ubound(namtmp)

      htmtab = htmtab & distmp(ii) & ": "

      '=== we disable "enter" to submit form because we manage this event as a onkeypress in the parent frame of the form later
      '=== we had to do this, because the web page form is not run on a server, and the web page dont have control, the VBS script outside the page have control
     
      htmtab = htmtab & "<input type=""" & typtmp(ii) & """ id=" & namtmp(ii) & " NAME=""" & namtmp(ii) & """ size=""" & max(20,len(deftmp(ii))) & """ value=""" & deftmp(ii) & """ onKeypress=""return event.keyCode!=13"""
      'fmid.WriteLn("")
      if instr(lcase(errtmp(ii)),"error")<>0 or instr(lcase(errtmp(ii)),"erreur")<>0 then
         col="red"
      else
         col="blue"
      end if
      htmtab = htmtab & "&nbsp; <b><span style='color:" & col & "'>&nbsp" & errtmp(ii) & "</span></b><br style='mso-special-character:line-break'>"
   next

   htmtab = htmtab & "<![if !supportLineBreakNewLine]><br style='mso-special-character:line-break'>"
   htmtab = htmtab & "<![endif]></p>"
 
   for ii=0 to ubound(buttmp)
      typ01 = "button"
      htmtab = htmtab & "<input type=""" & typ01 & """ name=""" & buttmp(ii) & """ value=""&nbsp;" & buttmp(ii) & "&nbsp;"">"
      htmtab = htmtab & "&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp"
   next
 
   htmtab = htmtab & "</div>"
   htmtab = htmtab & "</form>"
   htmtab = htmtab & "</body>"
   htmtab = htmtab & "</html>"
   fmid.writeln htmtab
   fmid.location.reload(true)

   '=== wait for internet explorer to be ready after we refresh the page with the new form
   for ii=0 to ubound(buttmp)
      Do While (oIE.Busy)
         wscript.sleep 100
      loop
      do while oie.readystate<>4
         wscript.sleep 100
      Loop
      '=== value to return for each button in the form
      fmid.forms(0).elements(buttmp(ii)).onclick = getref("buttonmid")
   next
 
   '=== regenerate the event that call a sub if a button is pressed
   set fmid.onkeypress = GetRef("Checkmid")
 
   '=== clear button pressed and key pressed for this frame
   resbutmidstr=""
   reskeymid=0
end function

'===  max
Function max(a, b)
If a > b Then max = a Else max = b
End Function

function crewebmai(oie, doctit, maitit, arabutnam, arabutdes, aradepnam, aradepcol)

'=== create an internet explorer object (oie) that will be in 3 frames (flef, fmid, fbot), acting at the main interface for all this program

oie.FullScreen = False
'.ToolBar   = False
'.StatusBar = False
'.Navigate("About:Blank")
'.visible = true

oIE.left=0 ' window position
oIE.top = 0 ' and other properties
'.ParentWindow
'        .resizeto 640,300
'        .moveto (.screen.width
oIE.height = 500
oIE.width = 500
oIE.menubar = 1 '=== no menu
oIE.toolbar = 1
oIE.statusbar = 1
oIE.RegisterAsDropTarget = True
oie.Navigate("about:blank")
'oie.Navigate("about:tabs")
oie.document.title = doctit
oiewid = oie.document.parentwindow.screen.width
oiehei = oie.document.parentwindow.screen.height
sizwidpercent = 100
sizheipercent = 95
loswid = 100-sizwidpercent
loshei = 100-sizheipercent
newwid = oiewid*sizwidpercent*.01
newhei = oiehei*sizheipercent*.01
oie.document.parentwindow.resizeto newwid,newhei
newx = oiewid * loswid * .01 /2
newy = oiehei * (loshei/2) * .01 /2
oie.document.parentwindow.moveto newx, newy
oIE.visible = 1 '=== visible on
oie.addressbar=false

'=== we will always have 3 frames, control, input and output (flef, fmid, fbot)
'=== used an array to have a good view of the line of html and possibility to add something else easily

aratmp=array(_
"<HTML>",_
"<HEAD><TITLE>" & doctit & "</TITLE>",_
"<meta content=""text/html; charset=utf-8"" http-equiv=""Content-Type"">",_
"<meta http-equiv=""X-UA-Compatible"" content=""IE=8"">",_
"</HEAD>",_
"<FRAMESET id='main' COLS=""13%, *"">",_
"<FRAME SRC=""About:Blank"" NAME=""left"" id=""left"">",_
"<frameset id='main2' rows=""30%,70%"">",_
"<FRAME SRC=""About:Blank"" NAME=""middle"" id=""middle"">",_
"<FRAME SRC=""About:Blank"" NAME=""bottom"" id=""bottom"">",_
"</FRAMESET>", _
"</frameset>", _
"</HTML>")

'oie.Navigate("About:Blank")

'=== send the array content in internet explorer to create 3 frames
for i = 0 to UBound(aratmp, 1)
  oie.document.WriteLn(aratmp(i))
next

oie.refresh

Do While (oIE.Busy)
  wscript.sleep 50
Loop

'=== wait till document loaded
do while oie.readystate<>4
  wscript.sleep 50
Loop

'=== vista activate
'=== make internet explorer the main active window
a = objShe.AppActivate("http:/// - " & doctit & " - M")
a = objShe.AppActivate(doctit & " - M")

'=== theses objects are used to send data to the 3 different frames
'=== if you dont define them as object, the access to them is very slow when we use the names instead of the objects

'=== object used to write in a frame with writeln
fileversion = objFSO.GetFileVersion("C:\program files\internet explorer\iexplore.exe")
finddot = instr(fileversion,".")
fileversion2 = left(fileversion,finddot-1)

if fileversion2 = "10" or fileversion2 = "11" then
'=== ie10 frame access
set flef = oie.parent.document.getElementByid("left").contentdocument
set fmid = oie.parent.document.getElementByid("middle").contentdocument
set fbot = oie.parent.document.getElementByid("bottom").contentdocument
else
set flef = oie.document.frames("left").document
set fmid = oie.document.frames("middle").document
set fbot = oie.document.frames("bottom").document
end if

'=== object used to navigate an empty page in a frame
'set flefl = oie.document.frames("left").location
'set fmidl = oie.document.frames("middle").location
'set fbotl = oie.document.frames("bottom").location

'=== string result for a button press in a frame (lef = left frame, mid = middle frame (up))
resbutlefstr=""
resbutmidstr=""
resbutbotstr=""

reskeylef=0
reskeymid=0
reskeybot=0

'=== all the chek to be made in first page (1 at the moment, since ready have many values)

nbrbut=UBound(arabutnam, 1)
redim buttag(nbrbut)
form = "flef"

flef.WriteLn("<html><body>")
flef.WriteLn("<body background=""" & basedir & "images_interface\fond_gauche.jpg"">")
flef.WriteLn("<h3><span class=SpellE>" & maitit & "</span></h3>")
flef.WriteLn("<form name='form1'>")

'(1) Where you want the image to appear: <span id="image"></span>
'(2) Get a reference to it: var e = document.getElementById('image');
'(3) Insert the img HTML code into the span: e.innerHTML = '<img src="./images/your_picture.jpg" />';

htmtab = ""
'htmtab = htmtab & "<img src=" & aa & " alt=" & aa & " />"

fmid.location.reload(true)

for i=0 to ubound(arabutnam)
 
  '=== convert xls to mdb button appear for stas only
 
  if ((usenam="wildboy" or usenam="fournier.serge" or usenam="fortin.jp" or usenam="lavoie.daniel" or usenam="doucet.gm") and arabutnam(i)="excel2mdb") or arabutnam(i)<>"excel2mdb" then

 'style="background-color: #cc0000; color: #ffffff;" /

 b = "<input type=""button"" style=""height:50px;font-size:14px;width:100%;white-space: normal;"" name=""" & arabutnam(i) & """ value=""" & arabutdes(i) & """"

 i2=i
 if i>ubound(aradepnam) then
i2=ubound(aradepnam)
 else
a=aradepnam(i2)
 end if

 if a<>lasdep then
'=== new departement name
flef.WriteLn( "<br>" & a & "<br>")
lasdep=a      
 end if
 b = b & " style=""background-color: #" & aradepcol(i2) & "; color: #000000;""><br>"
 flef.WriteLn(b)
  end if
next

flef.WriteLn("</form>")
flef.WriteLn("</body>")
flef.WriteLn("</html>")

'=== we dont refresh this frame, its the first one

end function

'=== sub to call when something is pressed
'=== called for many buttons, return the button name or a keyboard code (Ascii)
sub buttonlef
   set src = flef.parentWindow.event.srcElement
   resbutlefstr = src.name
end sub

sub buttonmid
   set src = fmid.parentWindow.event.srcElement
   resbutmidstr = src.name
end sub

sub buttonbot
   set src = fbot.parentWindow.event.srcElement
   resbutbotstr = src.name
end sub

sub Checklef
   reskeylef = flef.parentWindow.event.keycode
end sub

sub Checkmid
   reskeymid = fmid.parentWindow.event.keycode
end sub

sub Checkbot
   reskeybot = fbot.parentWindow.event.keycode
end sub

'=== unblur (event when cursor leave a textbox)
sub onblurlef
   set src = flef.parentWindow.event.srcElement
   resblulefstr = src.name
   resblulefval = src.value
   resblulefid = src.id
end sub

sub onblurmid
   set src = fmid.parentWindow.event.srcElement
   resblumidstr = src.name
   resblumidval = src.value
   resblumidid = src.id
end sub

sub onblurbot
   set src = fbot.parentWindow.event.srcElement
   resblubotstr = src.name
   resblubotval = src.value
   resblubotid = src.id
end sub


'=== chek in the actual folder if a file exist
function filsea(filname)

'=== chek also actual folder for a "Rappel_LOG" file (instr)
Set objFolder2 = objFSO.GetFolder(basedir)'=== dir
Set objFiles2 = objFolder2.files '=== fichiers

found=0  '=== fichier de rapport pas trouve
For Each objFile3 in objFiles2
  nomfile =objfile3.name
  nomfile= lcase(nomfile)
 
next


end function

'=== delete a table in a database

function tabdel()
       
         for each tab in objcat.Tables
            If tab.Type = "TABLE" Then
               b=lcase(tab.name)
               '=== object.delete not supported, so we delete with name
               objcat.tables.delete b
               fbot.WriteLn("delete: " & b & "<br>")
            END IF
         next

end function

'=== for reference
function dynbotcho00
i3=0
For each dia01 in choiceara
 sql = makque(dia01,tab,sel,whe,"","=","")
 a = exesql(objcon,tag,sql)

 '=== make same array for a multiples queries
 if tag.eof=0 then
'a = dynbotcho("DIAGNOSTIC",tag,0,sql,1,1,1,1) '=== 1 2 3
if ubound(choiceara)=0 and i3=0 then
a = dynbotcho("DIAGNOSTIC",tag,0,sql,1,1,1,1) '=== 1 2 3
elseif i3=0 then
'=== header
a = dynbotcho("DIAGNOSTIC",tag,0,sql,1,1,0,0) '=== 1 2 3
elseif i3<>ubound(choiceara) and i3<>0 then
'=== footer
a = dynbotcho("DIAGNOSTIC",tag,0,sql,0,1,0,0) '=== 1 2 3
elseif i3=ubound(choiceara) then
a = dynbotcho("DIAGNOSTIC",tag,0,sql,0,1,1,1) '=== 1 2 3
end if
i3 = i3 + 1
 else
'=== 0 results
a = nores(sql)
 end if
next
end function

function dynbotcho(ffra, ttext, aaratit, aara, cc01 ,hh, mm, ff, rr, ttxtbox,ffranam)
   '=== ffra frame to use for display (object)
   '=== ttext to display
   '=== aara = array with what to display
   '=== cc01 = choice button (no choice button when we display disgnostics, cause of multiple tables in one)
   '=== sql = sql query for debugging
   '=== hh = 1 = header
   '=== mm = 1 = middle
   '=== bb = 1 = footer
   '=== rr = 1 = reload at end
   '=== ttxtbox = all data are in a textbox so we can edit them (1) no date in text box (0)
   '=== ffranam = frame name
 
   htmtab = ""
   if ffranam = "lef" then
      for each a in lefara
         htmtab = htmtab & a
      next
   end if
   if ffranam = "mid" then
      for each a in midara
         htmtab = htmtab & a
      next
   end if
   if ffranam = "bot" then
      for each a in botara
         htmtab = htmtab & a
      next
   end if

   if logall = 1 then fil02.writeline "--- the sub dynbotcho has been called"
 
   call oieready
   '=== print button
   'priara = array("<input type=""button"" onClick=""javascript:print()"" value=""Print""/>")
 
   xmax = UBound(aara, 1) 'Returns the Number of columns  --- elements in first dimension
   'on error resume next
   on error resume next
   '=== chek the number of elements in second dimension, if there is none, then the array is only a list with 1 column
   ymax = UBound(aara, 2) 'Returns the Number of rows     --- elements in second dimension
 
   '=== number of dimensions in case there is only 1 column
   if err<>0 then
      dimnum=1
      if logall=1 then
         fil02.WriteLine date & " " & time & " max column: " & xmax
      end if
   else
      dimnum=2
      if logall=1 then
         'fil02.WriteLine date & " " & time & " max column: " & xmax
         fil02.WriteLine date & " " & time & " max row   : " & ymax
         'fil02.WriteLine date & " " & time & " offset    : " & maxoff
         'fil02.WriteLine date & " " & time & " offsetnow : " & offset
      end if
   end if
   on error goto 0
 
   if dimnum=2 then
      if totrec>=maxoff then ymax=maxoff+offset-1
      if ymax>totrec then ymax=totrec
      'if ymax>maxoff then ymax=maxoff
   end if
   '=== web script for buttons to return the number of the button that was pressed
   htmtab = htmtab & "<form name=form01>"
   '=== print button
   if hh=1 then
      for each a in priara
         htmtab = htmtab & a
         'if logall=1 then fil02.writeline "*-------============*"
         'ffra.WriteLn("<BODY onLoad=""document.form01." & namtmp(0) & ".focus()"">")
      next
      if cc01=0 then htmtab = htmtab & "<br><br>"
   end if

   '=== search button only if bottom frame
   if ffranam="bot" and cc01<>0 then
      strsearch=""
      'fmid.WriteLn("    <input type=""" & typtmp(ii) & """           id=" & namtmp(ii)NAME=""" & namtmp(ii) & """ size=""" & max(20,len(deftmp(ii))) & """ value=""" & deftmp(ii) & """ onKeypress=""return event.keyCode!=13""")
      if secseatag=1 then
         htmtab = htmtab & "<input type=""textbox"" style=""width:15%;"" id=""boxsearch"" NAME=""boxsearch"" size=""20"" value=""" & strsearch & """ onKeypress=""return event.keyCode!=13"">"
         htmtab = htmtab & "<input type=""button"" name=""Search"" value=""Search"">"
      end if
   end if

   if totrec>=maxoff and cc01<>0 then
'htmtab = htmtab & "<input type=""button"" name=""" & "but" & trim(cstr(yy+1)) & """ value=""" & "Select " & yy+1 & """"
'htmtab = htmtab &  " style=""background-color: #" & "cccccc" & "; color: #000000;""><br>"
      htmtab = htmtab & "<input type=""button"" name=""Precedent"" value=""Precedent"">"
      htmtab = htmtab & "<input type=""button"" name=""Next"" value=""Next"">"
      'ffra.WriteLn(" style=""background-color: #" & "cccccc" & "; color: #000000;"">")
   end if
   if ffranam="bot" and cc01<>0 then
      htmtab = htmtab & "Displaying " & offset + 1 & " to " & ymax + 1 & " / " & totrec + 1 & " Records"
      htmtab = htmtab & "<br><br>"
   end if

   '=== select buttons
   if cc01<>0 then
      '=== buttons var only if select is active
      if cc01<>0 then
         for yy=0 to ymax
           
         next
      end if
   end if
 
   fast=0
   '=== header
   if hh=1 then
      if logall = 1 then fil02.writeline "--- header frame"
     
      htmtab = htmtab & ttext & "<b><table width=""100%"" BORDERCOLOR=""black"" class=MsoTableGrid border=1 CELLSPACING=0 cellpadding=2 style='border-collapse:collapse;border:none'>"
      htmtab = htmtab & "<CAPTION></CAPTION><span style='color:purple'>" & vbcrlf
   
      if fast=1 then ffra.WriteLn(htmtab):htmtab=""
      '=== tableau html
      htmtab = htmtab & "<TR>"
      if fast=1 then ffra.WriteLn(htmtab):htmtab=""
      i=0
      For Each a In aaratit
         '=== columns names
         if cc01<>0 then if i=0 then htmtab = htmtab & "<td><p>Select</td>"
         '=== test to insert text box inside each field with a default value for editing
         test=0
         if test=0 then
            htmtab = htmtab & "<td><p>" & Trim(a) & "</td>"
            if fast=1 then ffra.WriteLn(htmtab):htmtab=""
         else
            '=== futur button to order by that column
            '=== futur textbox to search in this column
            htmtab = htmtab & "<td><p>" & Trim(a) & "</td>"
            if fast=1 then ffra.WriteLn(htmtab):htmtab=""
         end if
         i=i+1
         if dimnum=1 then exit for
      Next
         htmtab = htmtab & "</tr>"
         if fast=1 then ffra.WriteLn(htmtab):htmtab=""
   end if

   '=== middle
   if mm=1 then
      if logall = 1 then fil02.writeline "--- middle frame"
      '=== x is inversed when only one column
      if dimnum=1 then
         ymax=xmax
         '=== no offset possible here
         ymin=0
      else
         '=== there is 2 dimensions, that mean multiple row
         '=== so we must assume there is an offset
         ymin=offset
      end if
     
      For yy = ymin To ymax
         htmtab = htmtab & "<TR>"
         if dimnum=2 then
            'ffra.WriteLn(yy)
           
            '=== multiple row
            For xx = 0 To xmax
               'If IsNull(myarray(xx, yy)) Then myarray(xx, yy) = ""
               if xx=0 and cc01<>0 then
                  htmtab = htmtab & "<td><p>"
                  htmtab = htmtab & "<input type=""button"" name=""" & "but" & trim(cstr(yy+1)) & """ value=""" & "Select " & yy+1 & """"
                  htmtab = htmtab &  " style=""background-color: #" & "cccccc" & "; color: #000000;""><br>"
                  htmtab = htmtab & "</td>"
                  if fast=1 then ffra.WriteLn(htmtab):htmtab=""
               end if
               
            if ttxtbox=0 then
               htmtab = htmtab & "<td><p>" & aara(xx, yy) & "</td>"
               if fast=1 then ffra.WriteLn(htmtab):htmtab=""
            else
               'aa="<input type=""textbox"" style=""width:100%;"" id=""box" & xx & "_" & yy & """ NAME=""box" & xx & "_" & yy & """ size=""" & max(1,len(aara(xx, yy))) & """ value=""" & aara(xx, yy) & """ onKeypress=""return event.keyCode!=13"""
               ffra.WriteLn("<td><p><input type=""textbox"" style=""width:100%;"" id=""box" & xx & "_" & yy & """ NAME=""box" & xx & "_" & yy & """ size=""" & max(1,len(aara(xx, yy))) & """ value=""" & aara(xx, yy) & """ onKeypress=""return event.keyCode!=13""></td>")
               'htmtab = htmtab & "<td><p>" & aara(yy, xx) & "</td>"
               'if fast=1 then ffra.WriteLn(htmtab):htmtab=""
            end if
            Next
         else
           
            '=== there is only 1 row
            htmtab = htmtab & "<td><p>"
            htmtab = htmtab & "<input type=""button"" name=""" & "but" & trim(cstr(yy+1)) & """ value=""" & "Select " & yy+1 & """"
            htmtab = htmtab &  " style=""background-color: #" & "cccccc" & "; color: #000000;""><br>"
            htmtab = htmtab & "</td>"
           
            if ttxtbox=0 then
               htmtab = htmtab & "<td><p>" & aara(yy) & "</td>"
            else
               aa="<input type=""textbox"" style=""width:100%;"" id=""box" & yy & """ NAME=""box" & yy & """ size=""" & max(1,len(aara(yy))) & """ value=""" & aara(yy) & """ onKeypress=""return event.keyCode!=13"""
               htmtab = htmtab & "<td><p>" & aa & "</td>"
               'htmtab = htmtab & "<td><p>" & aara(yy, xx) & "</td>"
            end if
           
         end if
         htmtab = htmtab & "</tr>" & vbcrlf
         if fast=1 then ffra.WriteLn(htmtab):htmtab=""
 
      Next
   end if
     
   '=== footer
   if ff=1 then
      if logall = 1 then fil02.writeline "--- footer frame"
      htmtab = htmtab & "</table></span></b><br>"
      if logall=1 then fil02.writeline "--- writing data into frame"
      if fast=1 then ffra.WriteLn(htmtab):htmtab=""
   end if
 
   htmtab = htmtab & "</form>"
   if fast=1 then ffra.WriteLn(htmtab):htmtab=""
 
   'aa = lcase(ffra.readystate)
   'do until aa="complete" or aa="terminé" or aa="interactive"
   '   if logall = 1 then fil02.writeline "*********************************** readystate of " & ffranam & ": " & aa
   '   wscript.sleep 100
   '   aa = lcase(ffra.readystate)
   'loop
   call oieready
 
   if fast=0 then ffra.WriteLn(htmtab)
     
   '=== reload (will not reload if we are in middle of a muliple elements/query table)
   if rr=1 then
      if logall=1 then
         'fil02.writeline htmtab
         fil02.writeline "--- reloading FRAME"
      end if
      'oie.document.getElementById("bottom").innerhtml htmtab
      'oie.document.getElementById("bottom").src
      'iframe.location.reload(true)
     
      call oieready
      'aa = lcase(ffra.readystate)
      'do until aa="complete" or aa="terminé" or aa="interactive"
      '   if logall = 1 then fil02.writeline "*********************************** readystate of " & ffranam & ": " & aa
      '   wscript.sleep 100
      '   aa = lcase(ffra.readystate)
      'loop    
     
      ffra.location.reload(false)

   end if
 
   '=== ?
   if mm=1 and cc01<>0 then
      For yy = ymin To ymax
         if dimnum=2 then
            ffra.forms(0).elements("but" & trim(cstr(yy+1))).onclick = getref("button" & ffranam)
         else
         '=== there is only 1 column
            ffra.forms(0).elements("but" & trim(cstr(yy+1))).onclick = getref("button" & ffranam)
         end if
      Next
   end if
   if logall=1 then
      fil02.WriteLine date & " " & time & " max column: " & totrec
   end if
   if totrec>=maxoff and cc01<>0 then
      ffra.forms(0).elements("Precedent").onclick = getref("button" & ffranam)
      ffra.forms(0).elements("Next").onclick = getref("button" & ffranam)
   end if
   if ffranam="bot" and cc01<>0 then
      if secseatag<>0 then
         ffra.forms(0).elements("Search").onclick = getref("button" & ffranam)
      end if
   end if
   set ffra.onkeypress = GetRef("Check" & ffranam)
 
   'for i=0 to ubound(arabutnam)
   '   flef.forms(0).elements(arabutnam(i)).onclick = getref("buttonlef")
   'next
end function

sub oieready()

  if bready=false then
    do while oie.readystate<>4
      wscript.sleep 50
    loop

    'if logall=1 then fil02.writeline "============== oie readystate: " & oie.readystate
    'Do
    '   wscript.sleep 100
    'loop until oie.ReadyState = "Terminé" or oie.ReadyState = "Complete"

    Do While (oIE.Busy)
      wscript.sleep 50
    Loop
  end if
end sub


'=== ssea = search string

'=== tab 0 symptoms
'=== tab 1 components
'=== tab 2 diagnostics
'=== tab 3 causes

'=== ttyp 0 search
'=== ttyp 1 fast results
'=== ttyp 2 detail results

'=== ssufix = ordere by or something at the end of query
'                                            order  and   %
function makque(ssea, ttab, sselect,wwhere, ssufix,ooper,wwild)
   ssea = replace(ssea,"'","''")
   ssea = trim(ssea)
   sseaara = split(ssea," ") '=== array of all words for search
 
   ss = "select "
 
   ii = 0
   '=== columns to search in
   for each aa in allara(ttab,sselect)
      ss = ss & aa
      if ii<>ubound(allara(ttab,1),sselect) then ss = ss & ","
      ii=ii+1
   next
 
   '=== from table
   ss = ss & " from [" & alltab(ttab) & "] "
   if len(ssea)<>0 then
      ss = ss & "where ("
 
      '=== search word(S) in table, AND operator
      ii = 0
      for each ss2 in sseaara
         ii2=0
         for each aa in allara(ttab,wwhere)
            if wwild="" then
               ss = ss & "[" & aa & "] " & ooper & " " & wwild & ss2 & wwild
            else
               ss = ss & "[" & aa & "] " & ooper & " '" & wwild & ss2 & wwild & "'"
            end if
            if ii2 <> UBound(allara(ttab,wwhere), 1) then ss = ss & " or "
            ii2=ii2+1
         next
         if ii <> UBound(sseaara, 1) then ss = ss & ") and ("
         ii=ii+1
      next
      '=== order by a column name
      ss = ss & ")" & ssufix
   else
      ss = ss & ssufix
   end if
   makque = ss

end function

function exesql(objcon,tag,sql)
     
   on error resume next
   set tag = objcon.execute(SQL)
   if err<>0 then
      aaa= err.description
      on error goto 0
      l1 = "error in query"
      l2 = "query: " & sql
      l3 = "error: " & aaa
      l4 = "the program will now end"
      fbot.WriteLn(l1 & "<BR><br>" & l2 & "<BR><br>" & l3 & "<BR><br>" & l4 & "<BR><br>")
      'msgbox(l1 & vbcrlf & l2 & vbcrlf & l3 & vbcrlf & l4 & vbcrlf)
      if logall=1 then
          fil02.writeline "query:"
          fil02.writeline sql
          fil02.writeline err.description
         
      end if
      wscript.quit
   end if
     
end function

'=== tab = table object (adox)
'=== colnam = string containing column name

function crecol(tab,colnam)

Set objcol = CreateObject("ADOX.Column")

'typdat=202   '=== string adVarWChar
'maxlen=250
'typdat=131   '=== float adnumeric
'maxlen=10
typdat=3     '=== integer adinteger
maxlen=10

if typdat=3 then a="adinteger"
if typdat=202 then a="adVarWChar"
if typdat=131 then a="adnumeric"

objcol.name = colnam
objcol.type = typdat
if typdat = 3 or typdat = 202 then
objcol.DefinedSize = maxlen
if typdat=3 then
'=== must set parent catalog before setting autoincrement
Set objcol.ParentCatalog = objcat
objcol.Properties("AutoIncrement")=true
end if
elseif typdat = 131 then
objcol.precision = 28
objcol.numericscale = 8
end if
fbot.WriteLn("column creation: " & colnam & "<br>")
Tab.Columns.Append objcol

end function

'=== count the number of record in the array
function cnttotrec(aara)
 
   xmax = UBound(aara, 1) 'Returns the Number of columns  --- elements in first dimension
   on error resume next
   '=== chek the number of elements in second dimension, if there is none, then the array is only a list with 1 column
   ymax = UBound(aara, 2) 'Returns the Number of rows     --- elements in second dimension
 
   '=== number of dimensions in case there is only 1 column
   if err<>0 then
      aa = xmax
   else
      aa = ymax
   end if

   on error goto 0
 
   cnttotrec = aa

end function

function dynmidres(TTEXT,aara,rres,aaratit,ccoltot)
 
call oieready
htmtab=""
htmtab = htmtab & "<HTML><BODY>"
for each a in midara
htmtab = htmtab & a
next

htmtab = htmtab & TTEXT & ": " & rres & "<b><table  width=""100%"" BORDERCOLOR=""black"" class=MsoTableGrid border=1 CELLSPACING=0 cellpadding=2 style='border-collapse:collapse;border:none'>"
htmtab = htmtab & "<CAPTION></CAPTION><span style='color:purple'>"
htmtab = htmtab & "<TR>"

i=0
For Each aa In aaratit
'=== columns names
if i=0 then htmtab = htmtab & "<td><p>Choice</td>"
htmtab = htmtab & "<td><p>" & Trim(aa) & "</td>"
i=i+1
Next

htmtab = htmtab & "</tr>"

For xx = 0 To ccoltot
'If IsNull(myarray(xx, yy)) Then myarray(xx, yy) = ""
if xx=0 then
htmtab = htmtab & "<td><p>"
htmtab = htmtab & rres
htmtab = htmtab & "</td>"
end if

htmtab = htmtab & "<td><p>" & aara(xx,rres-1) & "</td>"
'col = col & myarray(xx, yy)
Next
htmtab = htmtab & "</tr>"
htmtab = htmtab & "</table></span></b><br>"

'=== image of the component
aa = """file://" & basedir & "PhotoHydComponent\002-00_HydroCraft_HC-EC_EndCover.jpg"""
aa = replace(aa,"\","/")
'<DIV style='display:none'><IMG SRC='image.gif'></DIV>
htmtab = htmtab & "<img src=" & aa & " alt=" & aa & " />"
htmtab = htmtab & "</BODY></HTML>"

oie.document.getElementById("middle").contentWindow.document.body.innerhtml = htmtab
'fmid.WriteLn(htmtab)

end function

FUNCTION SPLIT2(AA,SS)
             
   set bb= nothing
   BB = Split(AA, SS)
             
   set aa2=nothing
   AA2 = array("newsplittedarray")
   ii=0
   for each cc in bb
      if cc<>"" then
         redim PRESERVE aa2(ii)
         aa2(Ii)=cc
         ii=ii+1
      end if
   next

   split2 = aa2

END FUNCTION



function bigtablewait()
 
   strsearch=""
   offset=0
   do
      wscript.sleep 100
     
      '=== while we wait for input value (or button press), user can press "escape" key, "cancel" button or close internet explorer
      if resbutmidstr="cancel" or reskeymid=27 or bready=true or resbutlefstr<>"" then
         '=== if user pressed escape or cancel, we clear the frames
         if resbutmidstr="cancel" or reskeymid=27 then
            a = clefra(array("fmid","fbot"))
            resbutmidstr="cancel"
         end if
         exit do
      end if  
                 
      if resbutbotstr="Precedent" then
         a=offset
         offset=offset-maxoff
         offset=max(0,offset)
         resbutbotstr=""
         if offset<>a then
            '=== totrec total number of record (displayed at end of first line)
            '=== maxoff maxiumm number of row in a page
            '=== offset page flip number (multiple of maxoff)
            a = dynbotcho(fbot, tabnam2, aratit, ara01, 1 ,1, 1, 1, 1, edtmod,"bot")
         end if
      end if              
     
      if resbutbotstr="Next" then
         a=offset
         offset=offset+maxoff
         if offset>totrec then offset=offset-maxoff
            resbutbotstr=""
            if offset<>a then
               a = dynbotcho(fbot, tabnam2, aratit, ara01, 1 ,1, 1, 1, 1, edtmod,"bot")
            end if
         end if
             
      if resbutbotstr="Search" or reskeybot=13 then
               
         strsearch=fbot.form01.boxsearch.Value
         strsearch=lcase(strsearch)
                 
         '=== make a dynamic query to search for every words in every columns
         'makque(ssea, ttab, sselect,wwhere, ssufix,ooper,wwild)
           
         'if whe=3 then whe=0
         sql = makque(strsearch,tab,sel,whe,"",ooper,wwild)
           
         if logall=1 then
            fil02.WriteLine date & " " & time & " QUERY: "
            fil02.WriteLine sql
            'fil02.WriteLine date & " " & time & " Autoincrement status: " & objcol.Properties("AutoIncrement")
         end if
         a = exesql(objcon,tag,sql)
         
         if tag.eof=0 then
            myarray=TAG.GetRows()
         else
            redim myarray(coltot,0)
            'fbot.WriteLn("<br>total columns: " & coltot & "<br>")
            for i=0 to coltot
               myarray(i,0)="ERROR there was 0 record in this query"
            next
            fbot.WriteLn("<br>ERROR<br>" & sql & "<br><br>gave 0 results<br>")
         end if
                 
         offset=0
         totrec = cnttotrec(myarray)
         if logall=1 then
            fil02.WriteLine date & " " & time & " total records: " & totrec+1
         end if
         a = dynbotcho(fbot, tabnam2, aratit, ara01, 1 ,1, 1, 1, 1, edtmod,"bot")
               
         resbutbotstr=""
      end if
      reskeybot=0
     
   loop while resbutbotstr=""
   offset=0
end function



function edit_xml_node(colNodes01,filename01)

'=== make a big table that will contain other tables inside
h = "<!DOCTYPE html>"
h = h & "<html>"

h = h & "<head>"
h = h & "<style>"
h = h & "table#items01 tr:nth-child(even) {"
h = h & "background-color: #eee;"
h = h & "}"
h = h & "</style>"
h = h & "</head>"

h = h & "<body>"
h = h & "<form name=form01>"
'=== box to focus (first editable data)
'h = h & "<BODY onLoad=""document.form01.facturation.focus()"">"

h = h & "<table width=""100%"" BORDERCOLOR=""black"" class=MsoTableGrid border=1 CELLSPACING=0 cellpadding=2 style='border-collapse:collapse;border: 1px solid black'>"

'h = h & "<script type=""text/javascript"">"
'h = h & "function message(nodename) {"
    'h = h & "var text = document.getElementById(nodename).value;"
    'h = h & "alert(text);"
    'h = h & "}"
'h = h & "</script>"

''''''''''''''''''''''''''''''''''''''''''''''''''''
' textbox creation to be able to edit xml nodes
''''''''''''''''''''''''''''''''''''''''''''''''''''
rootcnt01 = 0
prefix01 = "x" '=== textbox id need to start by a letter to defnie an event on it
prefix02 = "a" '=== this textbox ID is an attribute in xml, we treat it differently
For Each objNode01 in colNodes01
''''''''''''''''''''''''''''''''
' root name
''''''''''''''''''''''''''''''''
h = h & "<tr>" '=== line 1
text01 = objnode01.nodeName
h = h & "<td>"
h = h & "<input type=""textbox"" id=" & text01  & " NAME=""" & text01
h = h & """ size=""" & max(15,len(text01)) & """ value=""" & text01 & """ onKeypress=""return event.keyCode!=13"">"
h = h & "<input type=""button"" name=""add" & text01 & """ value=""&nbsp;+&nbsp;"">"
h = h & "</td>"
'h = h & "<td>" & objnode01.nodeName & "</td>"

childcnt01 = 0
for each objnode02 in objnode01.childnodes
'''''''''''''''''''''''''''''''''''''
' first child
'''''''''''''''''''''''''''''''''''''

h = h & "<tr>" '=== line 1
text01 = objnode02.nodename
h = h & "<td></td><td>"
h = h & "<input type=""textbox"" id=" & text01  & " NAME=""" & text01
h = h & """ size=""" & max(15,len(text01)) & """ value=""" & text01 & """ onKeypress=""return event.keyCode!=13"">"
h = h & "<input type=""button"" name=""add" & text01 & """ value=""&nbsp;+&nbsp;"">"
h = h & "</td>"
'h = h & "<td></td><td>" & objnode02.nodename & "</td>"

''''''''''''''''''''''''''''''''''''''''
' header (in bold)
''''''''''''''''''''''''''''''''''''''''
h = h & "<tr>"
h = h & "<td></td><td></td>"
h = h & "<td><b>Nodename</b></td>"
h = h & "<td><b>Node Text</b></td>"
'For Each objChild02 In objnode02.childNodes
' for each attribute01 in objchild02.attributes
h = h & "<td><b>Attribute Name</b></td>"
h = h & "<td><b>Attribute Text</b></td>"
' next
'next

h = h & "</tr>"

recordcnt01 = 0
For Each objChild02 In objnode02.childNodes
h = h & "<tr>"

''''''''''''''''''''''''''''''''''
' node name
''''''''''''''''''''''''''''''''''
h = h & "<td></td><td></td><td>" & objchild02.nodename  & "</td>"
'h = h & "<td>" & displaynamefra & "</td>"

''''''''''''''''''''''''''''''''''
' nodetext
''''''''''''''''''''''''''''''''''
'txt = colnodes01(0).childNodes(0).childnodes(1).nodename
'=== use exact rootnode/childnode/childnode number to put in the ID of the text box
'id01 = objnode02.nodename & "__" & objchild02.nodename

id01 = prefix01 & rootcnt01 & "_" & childcnt01 & "_" & recordcnt01

text01 = objchild02.text

h = h & "<td>"
'=== we add an X before the name, case a textbox without a name is BAD
h = h & "<input type=""textbox"" id=""" & id01 & """ NAME=""" & id01
'h = h & """ size=""" & max(15,len(text01)) & """ value=""" & text01 & """ onKeypress=""return event.keyCode!=13"" onblur=message(" & objchild02.nodename & ");>"

h = h & """ size=""" & max(15,len(text01)) & """ value=""" & text01 & """ onKeypress=""return event.keyCode!=13"");>"
'=== futur
'h = h & "<input type=""button"" name=""add" & text01 & """ value=""&nbsp;+&nbsp;"">"
h = h & "</td>"

'''''''''''''''''''''''''''''''''''
' node attributes
'''''''''''''''''''''''''''''''''''
attributescnt01 = 0
for each attribute01 in objchild02.attributes
'=== if there is more than one atribute, we go to the next line for the next one
if attributescnt01 > 0 then
'=== uncomment this for the attributes to display vertically
'h = h & "</tr><tr><td></td><td></td><td></td><td></td>"
end if
'displaynamefra = objchild02.getattribute("displaynamefra")

h = h & "<td>" & attribute01.name
h = h & "</td>"
text01 = attribute01.text
id01 = prefix02 & rootcnt01 & "_" & childcnt01 & "_" & recordcnt01 & "_" & attributescnt01

h = h & "<td>"
h = h & "<input type=""textbox"" id=""" & id01  & """ NAME=""" & id01
h = h & """ size=""" & max(15,len(text01)) & """ value=""" & text01 & """ onKeypress=""return event.keyCode!=13"">"

'h = h & "<input type=""button"" name=""add" & text01 & """ value=""&nbsp;+&nbsp;"">"
h = h & "</td>"

attributescnt01 = attributescnt01 + 1
next


'h = h & "<script type=""text/javascript"">"
'h = h & "document.getElementById(""" & objchild02.nodename & """).onblur=message(""" & objchild02.nodename & """);"
'h = H & "</script>"

'h = h & "<td>" & objchild02.text & "</td>"
'fbot.WriteLn("<td>" & displaynamefra & " " & objchild02.text)
'fmid.forms(0).elements(buttmp(ii)).onblur = getref("buttonmid")

'=== regenerate the event that call a sub if a button is pressed
'set fmid.onkeypress = GetRef("Checkmid")

h = h & "</tr>" '=== line 1
recordcnt01 = recordcnt01 + 1
next
h = h & "</tr>" '=== line 1
childcnt01 = childcnt01 + 1
next
rootcnt01 = rootcnt01 + 1
h = h & "</tr>" '=== line 1
next
h = h & "</form>"
h = h & "</body>"
h = h & "</html>"

fbot.WriteLn(h)
fbot.location.reload(true)

call oieready

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' event creation for unblur (leaving/unselecting a textbox)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
rootcnt01 = 0
For Each objNode01 in colNodes01
root01 = objnode01.nodeName '=== facturation
'=== any node under root
childcnt01 = 0
for each objnode02 in objnode01.childnodes
text01 = objnode02.nodename '=== bill
recordcnt01 = 0
For Each objChild02 In objnode02.childNodes
h = h & "<tr>"

'displaynamefra = objchild02.getattribute("displaynamefra")
'=== not editable
'text01 = displaynamefra
if instr(objnode02.nodename,"_")<>0 then
'fmid.WriteLn("<br>ERROR you cannot use underscore _ in name: " & objnode02.nodename )
end if

if instr(objchild02.nodename,"_")<>0 then
'fmid.WriteLn("<br>ERROR you cannot use undesrcore _ in name: " & objchild02.nodename)
end if

'name01 = objnode02.nodename & "__" & objchild02.nodename

id01 = prefix01 & rootcnt01 & "_" & childcnt01 & "_" & recordcnt01
'fmid.WriteLn("<br>Event defined on: " & id01 & " ---" & objnode02.nodename & " --- " & objChild02.nodename)
on error resume next

set fbot.form01.elements(id01).onblur = getref("onblurbot")
if err=0 then
'fmid.WriteLn("---" & name01)
else
fmid.WriteLn("<br>ERROR defining event onblur for: " & id01 & " id of the element might be defined twice in the same html form")
end if
on error goto 0

'=== attribute event
attributescnt01 = 0
for each attribute01 in objchild02.attributes
id01 = prefix02 & rootcnt01 & "_" & childcnt01 & "_" & recordcnt01 & "_" & attributescnt01

on error resume next

set fbot.form01.elements(id01).onblur = getref("onblurbot")
if err=0 then
'fmid.WriteLn("---" & name01)
else
fmid.WriteLn("<br>ERROR defining event onblur for: " & id01 & " id of the element might be defined twice in the same html form")
end if
on error goto 0

attributescnt01 = attributescnt01 + 1
next
recordcnt01 = recordcnt01 + 1
next
childcnt01 = childcnt01 + 1
next
rootcnt01 = rootcnt01 + 1
exit for '=== we use only one root for the moment
next
'fbot.body.onBlur = GetRef("onblurbot")

Do While (oIE.Busy)
  wscript.sleep 50
Loop

'=== wait till document loaded
do while oie.readystate<>4
  wscript.sleep 50
Loop

'set fbot.forms(0).datedue.onblur = getref("onblurbot")
'fmid.WriteLn("<br>exiting edit")

'=== wait for any modification to occur
do

'=== flag to tell if the input is not valid
err01=0
'=== flag to say input is done, since there might be a defaut value, we must validate if user was finished
inpdon=0

'=== check if blur event occured (switch out of an input box)
'=== resblubotstr = name of the
'=== resblubotval = new value in the text box
'=== resblubotid = id (from html) for the textbox
if resblubotstr<>"" and bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then

'=== User has clicked on another textbox
'fmid.WriteLn("<br>" & resblubotstr & " --- " & resblubotid & " --- " & resblubotval)

'=== find the xml node parent and children (record and text) using textbox id, split chain is __ (double underscore)
'=== contain root number, childnodes number, record number
'fmid.WriteLn("<br>" & colnodes01(idara01(0)).childNodes(idara01(1)).childnodes(idara01(2)).nodename)

if mid(resblubotstr,1,1) = "x" then

'=== record text modification
'fmid.WriteLn("<br>resblubotstr: " & resblubotstr)

'=== the id of the textbox is splitted to find the index for the xml element we want to update:
'=== node (facturation)
'=== first child (bill)
'=== record (name)

idara01 = split(right(resblubotid,len(resblubotid)-1), "_")

if colnodes01(idara01(0)).childNodes(idara01(1)).childnodes(idara01(2)).text <> resblubotval then
change01 = 1
colnodes01(idara01(0)).childNodes(idara01(1)).childnodes(idara01(2)).text = resblubotval
else
change01 = 0
end if

fmid.WriteLn("<br>" & resblubotid)

'=== something changed, we save

elseif mid(resblubotstr,1,1) = "a" then

'=== attribute modification

'=== the id of the textbox is splitted to find the index for the xml element we want to update:
'=== node (facturation)
'=== first child (bill)
'=== record (name)
'=== attribute (displaynamefra)

idara01 = split(right(resblubotid,len(resblubotid)-1), "_")

if colnodes01(idara01(0)).childNodes(idara01(1)).childnodes(idara01(2)).attributes(idara01(3)).text <> resblubotval then
change01 = 1
colnodes01(idara01(0)).childNodes(idara01(1)).childnodes(idara01(2)).attributes(idara01(3)).text = resblubotval
else
change01 = 0
end if

'fmid.WriteLn("<br>" & resblubotid)

'fmid.WriteLn("<br>attribute modif: " & colnodes01(idara01(0)).childNodes(idara01(1)).childnodes(idara01(2)).attributes(idara01(3)).text)

end if

if change01 = 1 then
'=== filename may change to new invoice if we change the number
Set colNodes02 = xmlDoc.selectNodes("/" & colnodes01(idara01(0)).nodename & "/bill/id")

For Each objNode in colNodes02
numero01 = objnode.text '=== number of the invoice to change the filename before saving
Next

filename02 = basedir & "\facturation" & numero01 & ".xml"
xmlDoc.Save filename02

'=== what was modified in the xml tree
tree01 = "/" & colnodes01(idara01(0)).nodename
tree01 = tree01 & "/" & colnodes01(idara01(0)).childNodes(idara01(1)).nodename
tree01 = tree01 & "/" & colnodes01(idara01(0)).childNodes(idara01(1)).childnodes(idara01(2)).nodename
fmid.WriteLn("<br>node modified: " & tree01 & " --- xml doc saved")
end if

resblubotstr = ""
resblubotval = ""
resblubotid = ""

end if
'inpdon

wscript.sleep 50

if resbutmidstr="cancel" or reskeymid=27 or bready=true or resbutlefstr<>"" then
'=== if user pressed escape or cancel, we clear the frames
if resbutmidstr="cancel" or reskeymid=27 then
a = clefra(array("fmid","fbot"))
resbutmidstr="cancel"
end if
exit do
end if

loop while err01<>0 or inpdon=0

end function


function validate(name110)
name110 = lcase(name110)
if name110 = "id" then name110 = "id"
'if instr(name110,"address")<>0 then name110 = replace(name110,"address","adres")
validate = name110
end function

function edit_xml_node_recur(colNodes01,filename01)
'=== testintg recursive displaying of a full xml file starting at the root
'=== making a html table with it

'=== references:
'<xs:element name="xxx" type="yyy"/>
'<xs:element name="color" type="xs:string" default="red"/>
'<xs:element name="color" type="xs:string" fixed="red"/>

'xs:string
'xs:decimal
'xs:integer
'xs:boolean
'xs:date
'xs:time

' NodeType Named Constant
'1 ELEMENT_NODE
'2 ATTRIBUTE_NODE
'3 TEXT_NODE
'4 CDATA_SECTION_NODE
'5 ENTITY_REFERENCE_NODE
'6 ENTITY_NODE
'7 PROCESSING_INSTRUCTION_NODE
'8 COMMENT_NODE
'9 DOCUMENT_NODE
'10 DOCUMENT_TYPE_NODE
'11 DOCUMENT_FRAGMENT_NODE
'12 NOTATION_NODE

'Node type NodeType
'Element 1
'Attribute 2
'Text 3
'Comment 8
'Document 9

a = clefra(array("fmid","fbot"))

fmid.WriteLn("<br>Filename we will edit: " & filename01)
'=== make a big table that will contain other tables inside
h = "<!DOCTYPE html>"
h = h & "<html>"

h = h & "<head>"
h = h & "<style>"
h = h & "table#items01 tr:nth-child(even) {"
h = h & "background-color: #eee;"
h = h & "}"
h = h & "</style>"
h = h & "</head>"

h = h & "<body>"
h = h & "<form name=form01>"
'=== box to focus (first editable data)
'h = h & "<BODY onLoad=""document.form01.facturation.focus()"">"

h = h & "<table width=""100%"" BORDERCOLOR=""black"" class=MsoTableGrid border=1 CELLSPACING=0 cellpadding=2 style='border-collapse:collapse;border: 1px solid black'>"

''''''''''''''''''''''''''''''''''''''''''''''''''''
' textbox creation to be able to edit xml nodes
''''''''''''''''''''''''''''''''''''''''''''''''''''
rootcnt01 = 0
prefix01 = "x" '=== textbox id need to start by a letter to defnie an event on it
prefix02 = "a" '=== this textbox ID is an attribute in xml, we treat it differently
level01 = 0
redim idtext01(level01)

'fmid.WriteLn("<br>Type of node: " & colNodes01.nodetype)

rootcnt01 = 0
For Each objNode01 in colNodes01

''''''''''''''''''''''''''''''''
' root name
''''''''''''''''''''''''''''''''
h = h & "<tr>" '=== line 1
text01 = objnode01.nodeName
h = h & "<td>"
h = h & "<input type=""textbox"" id=" & text01  & " NAME=""" & text01
h = h & """ size=""" & max(15,len(text01)) & """ value=""" & text01 & """ onKeypress=""return event.keyCode!=13"">"
h = h & "<input type=""button"" name=""add" & text01 & """ value=""&nbsp;+&nbsp;"">"
h = h & "</td>"
h = h & "</tr>"
idtext01(level01) = rootcnt01
level01 = 1 '=== root level for html id for textbox for unblur event

'''''''''''''''''''''''''''''''''''''''''''''''''
' recusre all nodes, childrens, attributes<
'''''''''''''''''''''''''''''''''''''''''''''''''
call recursenodes(objnode01, level01, action01, idtext01)
rootcnt01 = rootcnt01 + 1
next

h = h & "</form>"
h = h & "</body>"
h = h & "</html>"

fbot.WriteLn(h)
fbot.location.reload(true)

call oieready

wscript.sleep 50

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' event definition, now the page is done we define events to manage unblur (unfocus a box) and save xml
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
rootcnt01 = 0
For Each objNode01 in colNodes01
idtext01(level01) = rootcnt01
level01 = 1 '=== root level for html id for textbox for unblur event

'''''''''''''''''''''''''''''''''''''''''''''''''
' recusre all nodes, childrens, attributes<
'''''''''''''''''''''''''''''''''''''''''''''''''
action01 = 1 '=== define event onblur for all id in html form
call recursenodes(objnode01, level01, action01, idtext01)
rootcnt01 = rootcnt01 + 1
next


'=== wait for any modification to occur
do

'=== flag to tell if the input is not valid
err01=0
'=== flag to say input is done, since there might be a defaut value, we must validate if user was finished
inpdon=0

'=== check if blur event occured (switch out of an input box)
'=== resblubotstr = name of the
'=== resblubotval = new value in the text box
'=== resblubotid = id (from html) for the textbox
if resblubotstr<>"" and bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then

'=== User has clicked on another textbox
'fmid.WriteLn("<br>" & resblubotstr & " --- " & resblubotid & " --- " & resblubotval)

'=== find the xml node parent and children (record and text) using textbox id, split chain is __ (double underscore)
'=== contain root number, childnodes number, record number
'fmid.WriteLn("<br>" & colnodes01(idara01(0)).childNodes(idara01(1)).childnodes(idara01(2)).nodename)

if mid(resblubotstr,1,1) = "x" then

'=== record text modification
'fmid.WriteLn("<br>resblubotstr: " & resblubotstr)

'=== the id of the textbox is splitted to find the index for the xml element we want to update:
'=== node (facturation)
'=== first child (bill)
'=== record (name)

idara01 = split(right(resblubotid,len(resblubotid)-1), "_")

command01 = "colnodes01(idara01(0))"

for i = 0 to ubound(idara01)
if i > 0 then '=== skip root, just add as many child as we need
command01 = command01 & ".childNodes(idara01(" & i & "))"
end if
next

command01 = command01 & ".text"

command02 = "result01 = " & command01
'fmid.WriteLn("<br>" & command02)
execute command02

if result01 <> resblubotval then
change01 = 1
command02 = command01 & " = resblubotval"
'fmid.WriteLn("<br>" & command02)
execute command02
else
change01 = 0
end if

'fmid.WriteLn("<br>" & command01 & " - " & resblubotid)

'=== something changed, we save

elseif mid(resblubotstr,1,1) = "a" then

'=== attribute modification

'=== the id of the textbox is splitted to find the index for the xml element we want to update:
'=== node (facturation)
'=== first child (bill)
'=== record (name)
'=== attribute (displaynamefra)

idara01 = split(right(resblubotid,len(resblubotid)-1), "_")

command01 = "colnodes01(idara01(0))"

for i = 0 to ubound(idara01)
if i > 0 and i<ubound(idara01) then '=== skip root, just add as many child as we need
command01 = command01 & ".childNodes(idara01(" & i & "))"
end if
if i = ubound(idara01) then
command01 = command01 & ".attributes(idara01(" & i & "))"
end if
next
command01 = command01 & ".text"

command02 = "result01 = " & command01
'fmid.WriteLn("<br>" & command02)
execute command02


if result01 <> resblubotval then
change01 = 1
command02 = command01 & " = resblubotval"
'fmid.WriteLn("<br>" & command02)
execute command02
else
change01 = 0
end if

'fmid.WriteLn("<br>" & command01 & " - " & resblubotval & " - " & result01)

'fmid.WriteLn("<br>attribute modif: " & colnodes01(idara01(0)).childNodes(idara01(1)).childnodes(idara01(2)).attributes(idara01(3)).text)
elseif mid(resblubotstr,1,1) = "n" then

'=== new text element
idara01 = split(right(resblubotid,len(resblubotid)-1), "_")

command01 = "colnodes01(idara01(0))"

for i = 0 to ubound(idara01)
if i > 0 and i <> ubound(idara01) then '=== skip root, just add as many child as we need
'=== text element does not exist
'=== so we must go one branch lower in the tree
command01 = command01 & ".childNodes(idara01(" & i & "))"
end if
if i = ubound(idara01) then
'command01 = command01 & ".attributes(idara01(" & i & "))"
end if
next


if resblubotval<>"" then
change01 = 1
'=== even if text child element does not exist, assigning a value to .text will create it automatically
command02 = command01 & ".Text = """ & resblubotval & """"
'fmid.WriteLn("<br>colnodes01(idara01(0)).childNodes(idara01(1)).childnodes(idara01(2)).text = resblubotval")
'fmid.WriteLn("<br>" & command02)

execute command02
else
change01 = 0
end if

end if

if change01 = 1 then
'=== filename may change to new invoice if we change the number
if instr(filename01,"facturation")<>0 then
Set colNodes02 = xmlDoc.selectNodes("/" & colnodes01(idara01(0)).nodename & "/bill/id")
For Each objNode in colNodes02
numero01 = objnode.text '=== number of the invoice to change the filename before saving
Next
end if

if instr(filename01,"facturation")<>0 then
filename02 = basedir & "facturation" & numero01 & ".xml"
else
filename02 = filename01
'fmid.WriteLn("<br>node modified: " & tree01 & " --- xml doc saved: " & filename02)
end if
xmlDoc.Save filename02

'=== what was modified in the xml tree
tree01 = "/" & colnodes01(idara01(0)).nodename
tree01 = tree01 & "/" & colnodes01(idara01(0)).childNodes(idara01(1)).nodename
tree01 = tree01 & "/" & colnodes01(idara01(0)).childNodes(idara01(1)).childnodes(idara01(2)).nodename
fmid.WriteLn("<br>node modified: " & tree01 & " --- xml doc saved: " & filename02)
end if

resblubotstr = ""
resblubotval = ""
resblubotid = ""

end if
'inpdon

wscript.sleep 50

if resbutmidstr="cancel" or reskeymid=27 or bready=true or resbutlefstr<>"" then
'=== if user pressed escape or cancel, we clear the frames
if resbutmidstr="cancel" or reskeymid=27 then
a = clefra(array("fmid","fbot"))
resbutmidstr="cancel"
end if
exit do
end if

loop while err01<>0 or inpdon=0

end function


sub recursenodes(objnode01, level01, action01, idtext01)

'=== action01 = 0 = generate html stuff
'=== action01 = 1 = generate unblur events for internet explorer and this script

if objnode01.haschildnodes=false then

h = h & "</tr><tr>"
else

h = h & "<tr>"

nodecnt01 = 0
textnodepresent01 = 0
for each objnode02 in objnode01.childnodes
redim preserve idtext01(level01) '=== textbox id to define an event on (event: onblur, leaving the textbox will result in our script to save xml file)
if objnode02.nodetype = 1 then
'=== this node is an ELEMENT
x = 0
while x<level01
h = h & "<td></td>"
x = x + 1
wend
idtext01(level01) = nodecnt01
end if
text01 = objnode02.nodename '=== bill
if objnode02.nodetype = 3 then
'=== this node is a TEXT
'=== we go back to line before to display it, we dont want to skip to next line for nothing since a text element is always the last element of the line
h = left(h, len(h)-9) '=== removing "</tr><tr>"
idtext01(level01) = nodecnt01
'h = h & "<td>test</td>"
end if

if text01 = "#text" then
'=== text field of xml element, is the text of the element with "#text" name
textnodepresent01 = 1
'=== editable value
text01 = objnode02.text
text01 = replace(text01,"""","&quot;")

idtext01(level01) = nodecnt01

id01 = "x"
idcnt = 0
for each x in idtext01
if idcnt = 0 then
id01 = id01 & x
else
id01 = id01 & "_" & x
end if
idcnt = idcnt + 1
next

'=== define event onblur (html must de done and refreshed)
'=== we use the same recursive sub twice, once to generate html content, once to generate vbs event for internet explorer
if action01 = 1 then
set fbot.form01.elements(id01).onblur = getref("onblurbot")
end if

h = h & "<td>"
'=== we add an X before the name, case a textbox without a name is BAD
'h = h & "<input type=""textbox"" id=""" & id01 & """ NAME=""" & id01
'h = h & """ size=""" & max(15,len(text01)) & """ value=""" & text01 & """ onKeypress=""return event.keyCode!=13"");>"
width01 = 25
height01 = int(len(text01)/width01)+1

h = h & "<textarea cols=""" & width01 & """ rows=""" & height01 & """ id=""" & id01 & """ NAME=""" & id01 & """>" & text01 & "</textarea>"
'=== futur
'h = h & "<input type=""button"" name=""add" & text01 & """ value=""&nbsp;+&nbsp;"">"
h = h & "</td>"
'h = h & "<td>" & id01 & "</td>"
'h = h & "<td>" & level01 & "</td>"

else
'=== attribute of an xml element
h = h & "<td>" & text01 & "</td>"
attributescnt01 = 0
for each attribute01 in objnode02.attributes
redim preserve idtext01(level01 + 1) '=== textbox id to define an event on (event: onblur, leaving the textbox will result in our script to save xml file)
'=== if there is more than one attribute, ident one more column, put it on next line
if attributescnt01>0 then
h = h & "<tr>"
x = -1
while x<level01
h = h & "<td></td>"
x = x + 1
wend

end if

idtext01(level01 + 1) = attributescnt01

id01 = "a"
idcnt = 0
for each x in idtext01
if idcnt = 0 then
id01 = id01 & x
else
id01 = id01 & "_" & x
end if
idcnt = idcnt + 1
next

'=== define event onblur (html must de done and refreshed)
'=== we use the same recursive sub twice, once to generate html content, once to generate vbs event for internet explorer
if action01 = 1 then
set fbot.form01.elements(id01).onblur = getref("onblurbot")
end if

h = h & "<td>" & attribute01.name
h = h & "</td>"
text01 = attribute01.text
text01 = replace(text01,"""","&quot;")
'id01 = prefix02 & rootcnt01 & "_" & childcnt01 & "_" & recordcnt01 & "_" & attributescnt01

h = h & "<td>"
'h = h & "<input type=""textbox"" id=""" & id01  & """ NAME=""" & id01
'h = h & """ size=""" & max(15,len(text01)) & """ value=""" & text01 & """ onKeypress=""return event.keyCode!=13"">"
width01 = 25
height01 = int(len(text01)/width01)+1

h = h & "<textarea cols=""" & width01 & """ rows=""" & height01 & """ id=""" & id01 & """ NAME=""" & id01 & """>" & text01 & "</textarea>"

'h = h & "<input type=""button"" name=""add" & text01 & """ value=""&nbsp;+&nbsp;"">"
h = h & "</td>"

'h = h & "<td>" & id01 & "</td>"

attributescnt01 = attributescnt01 + 1
if attributescnt01>0 then
h = h & "</tr>"
end if
next

end if
'=== if element have attribute(s)
'=== if element is not a text node (its an element with no child with the name "#text")
'=== we add a box to be able to add a text child with a value

if attributescnt01<>0 and textnodepresent01 = 0 and objnode02.haschildnodes=false then
h = left(h, len(h)-5) '=== removing "</tr>"

id01 = "n" '=== for new node
idcnt = 0
for each x in idtext01
if idcnt = 0 then
id01 = id01 & x
else
id01 = id01 & "_" & x
end if
idcnt = idcnt + 1
next

text01 = ""
width01 = 25
height01 = int(len(text01)/width01)+1
h = h & "<td>"
h = h & "<textarea cols=""" & width01 & """ rows=""" & height01 & """ id=""" & id01 & """ NAME=""" & id01 & """></textarea>"
h = h & "</td></tr>"
'h = h & "<td>" & "test" & "</td></tr>"
if action01 = 1 then
'=== this should be an action to add a new node with text in it
set fbot.form01.elements(id01).onblur = getref("onblurbot")
end if
end if
call recursenodes(objnode02, level01 + 1, action01, idtext01)
nodecnt01 = nodecnt01 + 1
next
end if


end sub

function fPingTest( strComputer )
dim objShell,objPing
dim strPingOut, flag
set objShell = CreateObject("Wscript.Shell")
set objPing = objShell.Exec("ping " & strComputer)
strPingOut = objPing.StdOut.ReadAll
if instr(LCase(strPingOut), "reply") or instr(LCase(strPingOut), "ponse de") then
flag = TRUE
else
flag = FALSE
end if
fPingTest = flag

end function


function wrifra(frame10, msg10, verbose01)
                if bready = false then
                   if verbose01 = 1 then
                                  frame10.writeln(msg10)
                   elseIF VERBOSE01 = 2 then
                                  frame10.writeln(msg10)
                                  frame10.parentwindow.scrollBy 0, 1000
                   ELSE
                                  '=== silent mode for a function or a sub
                   end if
                else
                   '=== iexplore object is closed
                end if
end function