Saturday, April 30, 2016

remote domain ldap computer scan, program installation, group listing

Hello,

In a domain
When logged as admin of the domain
You can use WMI (windows management interface) to do a lot of things

Force execution of a local program on the remote computer
(cannot remotly execute a program that will execute a remote program, that would spread viruses)
List all computer of the domaine root
List and query the computer for some information

I use this script to remote install visual c redistribuable 2010
(must be copied on the c drive of the computer first)
Then install an ODBC mysql connector
(must be copied on the c drive of the computer first)
Then i copy on the computer a script to do an inventory in a mysql database
Then i remote execute the script to get the computer data in the inventory
(must be copied on the c drive of the computer first)

But here, i only list the program to list computers, list groups or remote execute a local program on a computer (with 3 different syntax)

example:

process01 = "c:\windows\system32\cscript.exe"
'argument01 = """\\hyntssr5\apps$\Apps\windows 7 sp1 fra pro unattend\sources\$oem$\$1\_util\inventaire\audit_v0804_v4 hyd.vbs"""
argument01 = """C:\_util\inventaire\audit_v0804_v4 hyd.vbs"""

'process01 = "cmd.exe /c"
'argument01 = """c:\_util\MysqlOdbcConnector\vcredist_x86.exe /q /norestart"""

'process01 = "msiexec.exe"
'argument01 = "/i c:\_util\MysqlOdbcConnector\mysql-connector-odbc-5.3.4-win32.msi /quiet"

================ ldap.vbs ==================================

'=== Ultimate dynamic web interface 2.0

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

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

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

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

Set objFSO    = CreateObject("Scripting.FileSystemObject")
Set objshe    = CreateObject("WScript.Shell")
Set objNet    = CreateObject("WScript.Network")

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

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

'=== for ldap
dim strInputPath, strOutputPath, strStatus
dim objFSO, objTextIn, objTextOut


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

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

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

if objFSO.fileEXISTS(a64) and instr(lcase(wscript.fullname),"syswow64")=0 then
   '=== 64 bits system
   a = """" & a64 & """ """ & basedir & filnam & """"
   objshe.Run a,0, false
   wscript.quit
end if

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

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

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


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

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





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

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

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

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

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

x=0
ReDim Preserve arabutnam(x): ReDim Preserve arabutdes(x): ReDim Preserve aradepnam(x): ReDim Preserve aradepcol(x)
arabutnam(x)="doinventory"
arabutdes(x)="New owner and majinventory"
aradepnam(x)="Inventory"
aradepcol(x)="cccccc"

x=x+1
ReDim Preserve arabutnam(x): ReDim Preserve arabutdes(x): ReDim Preserve aradepnam(x): ReDim Preserve aradepcol(x)
arabutnam(x)="scan"
arabutdes(x)="scan domain computers"
aradepnam(x)="TEST"
aradepcol(x)="cccccc"

x=x+1
ReDim Preserve arabutnam(x): ReDim Preserve arabutdes(x): ReDim Preserve aradepnam(x): ReDim Preserve aradepcol(x)
arabutnam(x)="scangroups"
arabutdes(x)="scan groups and list members"
aradepnam(x)="TEST"
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"

'=== old code for ref
'arabut=array("stristas", "striunig", "desarchive", "infocomp", "cretasks", "renamecomputer", "test", "clrframes", "quit01")
'arabutdes=array("Crée Structure i: Stas", "Crée Structure i: Unigec", "Désarchivage", "Info computer", "Create tasks", "Rename computer", "test divers",  "Clear Frames",    "Quitter")
'aradep=array("All", "All", "Informatique", "Informatique", "Informatique", "Informatique", "Other", "All")
'aradepcol=array("cccccc", "cccccc", "6699ff", "6699ff", "6699ff", "6699ff", "6699ff", "cccccc")

'=== i dont remember this one
lasdep=""
 
'=== web interface, internet explorer

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

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

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

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

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

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

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

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

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

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

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

WScript.sleep(50) ' .1 seconds

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

SET cmd = CREATEOBJECT("ADODB.Command")
SET cn = CREATEOBJECT("ADODB.Connection")
SET rs = CREATEOBJECT("ADODB.Recordset")

do


if resbutlefstr="doinventory" then

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' change owner name and force inventory
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'=== 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)="New owner name"      '===== description displayed in front of the field
namtmp(x)="text01"                  '===== name of variable for programming purpose
deftmp(x)="dc2 firm db"           '===== 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)="owner name" '===== 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)="Computer name"      '===== description displayed in front of the field
namtmp(x)="text02"                  '===== name of variable for programming purpose
deftmp(x)="hyntssr2"           '===== 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)="computer name" '===== text to display after the form "facultatif" blue text "error" red text are special keywords

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

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

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

if resbutlefstr="" and (resbutmidstr="ok" or reskeymid=13) then
'=== User has clicked the OK button, retrieve the values
text01=fmid.form01.text01.Value '=== namtmp is the variable name used earlier,before we call the dynamic form generation for input
text02=fmid.form01.text02.Value '=== namtmp is the variable name used earlier,before we call the dynamic form generation for input

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

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

'=== while we wait for input value, user can press "escape" key, "cancel" button or close internet explorer
if resbutmidstr="cancel" or reskeymid=27 or bready=true or resbutlefstr<>"" then
'=== if user pressed escape or cancel, we clear the frames
if resbutmidstr="cancel" or reskeymid=27 then
a = clefra(array("fmid","fbot"))
resbutmidstr="cancel"
end if
exit do
end if
'=== if there was an input error and no one used left control frame to exit, we keep asking for input
loop while err01<>0 or inpdon=0
   
'=== if internet explorer was not closed (bready), a button was not pressed on left frame, and no excape or cancel in middle frame
if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
a = clefra(array("fmid","fbot"))

strComputer = text02
value01 = text01

fmid.WriteLn("New owner name: " & value01 & "<br>")
fmid.WriteLn("Computer to scan: " & strComputer & "<br>")

'=== WMI

fbot.WriteLn("Getting acces to WMI on the computer...<br>")
err01 = 0: err02 = ""
on error resume next
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
err01 = err
err02 = err.description
on error goto 0

if err01 = 0 then
'=== last logon name on this computer
Set colItems = objWMIService.ExecQuery("Select * from Win32_ComputerSystem",,48)
fbot.WriteLn("Read owner name...<br>")
For Each objItem in colItems
'net_domain = objItem.Domain
net_user_name = objItem.UserName
system_part_of_domain = objItem.PartOfDomain
system_primary_owner_name = objItem.PrimaryOwnerName

Next

fbot.WriteLn("Owner name before: " & system_primary_owner_name & "<br>")
before01 = net_user_name & vbcrlf & system_primary_owner_name

fbot.WriteLn("Getting remote register base access on: " & strComputer & "...<br>")
err01 = 0: err02 = ""
on error resume next
Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv") '=== base de registre access
err01 = err
err02 = err.description
on error goto 0

if err01 <>0 then
fbot.WriteLn("ERROR cannot get remote register base access on: " & strComputer & "<br>")
end if

fbot.WriteLn("Write owner name in remote register base: " & value01 & "...<br>")
d = regwri("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\RegisteredOwner", value01, "REG_SZ")

'=== last logon name on this computer
Set colItems = objWMIService.ExecQuery("Select * from Win32_ComputerSystem",,48)
For Each objItem in colItems
'net_domain = objItem.Domain
net_user_name = objItem.UserName
system_part_of_domain = objItem.PartOfDomain
system_primary_owner_name = objItem.PrimaryOwnerName

Next

fbot.WriteLn("Owner name after: " & system_primary_owner_name & "<br>")

'=== execute process on remote computer
'a = doprocess(file01,"")
'a = doprocess(sysdir & "\cscript.exe",ser & "\users\audit_v0804_v4.vbs")

process01 = "c:\windows\system32\cscript.exe"
'argument01 = """\\hyntssr5\apps$\Apps\windows 7 sp1 fra pro unattend\sources\$oem$\$1\_util\inventaire\audit_v0804_v4 hyd.vbs"""
argument01 = """C:\_util\inventaire\audit_v0804_v4 hyd.vbs"""

'process01 = "cmd.exe /c"
'argument01 = """c:\_util\MysqlOdbcConnector\vcredist_x86.exe /q /norestart"""

'process01 = "msiexec.exe"
'argument01 = "/i c:\_util\MysqlOdbcConnector\mysql-connector-odbc-5.3.4-win32.msi /quiet"

fbot.WriteLn("<br> Remote executing process and argument:<br>" & process01 & "<br>" & argument01 & "<br>")

a = doprocess(process01, argument01)

fbot.WriteLn("<br>Code returned after remote execution: " & a & "<br>")
'msgbox("before:" & before01 & vbcrlf & "after: " & net_user_name & vbcrlf & system_primary_owner_name)

else

fmid.WriteLn("<br>ERROR opening WMI on target computer<br>")

end if


fbot.WriteLn("<br>FIN<br>")
fmid.WriteLn("<br>FIN<br>")

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

'fbot.WriteLn(h)

end if

reskeymid=0
resbutmidstr=""

end if

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' scan groups
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
if resbutlefstr="scangroups" then

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' scan users and groups
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'=== 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)="what do you want to display"      '===== description displayed in front of the field
namtmp(x)="text01"                  '===== name of variable for programming purpose
deftmp(x)="hello world"           '===== 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)="computer name" '===== text to display after the form "facultatif" blue text "error" red text are special keywords

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

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

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

if resbutlefstr="" and (resbutmidstr="ok" or reskeymid=13) then
'=== User has clicked the OK button, retrieve the values
text=fmid.form01.text01.Value '=== namtmp is the variable name used earlier,before we call the dynamic form generation for input

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

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

'=== while we wait for input value, user can press "escape" key, "cancel" button or close internet explorer
if resbutmidstr="cancel" or reskeymid=27 or bready=true or resbutlefstr<>"" then
'=== if user pressed escape or cancel, we clear the frames
if resbutmidstr="cancel" or reskeymid=27 then
a = clefra(array("fmid","fbot"))
resbutmidstr="cancel"
end if
exit do
end if
'=== if there was an input error and no one used left control frame to exit, we keep asking for input
loop while err01<>0 or inpdon=0
   

'=== if internet explorer was not closed (bready), a button was not pressed on left frame, and no excape or cancel in middle frame
if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
a = clefra(array("fmid","fbot"))

cn.open "Provider=ADsDSOObject;"
cmd.activeconnection = cn

fbot.WriteLn("<br>Scanning domain computers")
'fbot.WriteLn("<br>directory where xml file is saved: " & basedir)

'strInputPath = basedir & "\serverlist.txt" '- location of input
'strOutputPath = basedir & "\output.csv" '- location of output

'set objFSO = CreateObject("Scripting.FileSystemObject")
'set objTextIn = objFSO.OpenTextFile( strInputPath,1 )
'set objTextOut = objFSO.CreateTextFile( strOutputPath )
'objTextOut.WriteLine("computer,status")

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

'=== domain root
fbot.WriteLn("<br>Getting domain root...")
SET objRoot = GETOBJECT("LDAP://RootDSE")
'for each propName in objRoot.Properties.PropertyNames

'=== DC=quebecormedia,DC=com

defaultNamingContext01 = objRoot.GET("defaultNamingContext")

fbot.WriteLn("<br>" & objRoot.GET("defaultNamingContext"))

defaultNamingContext01 = defaultNamingContext01 & ",OU=gemel"

'=== Query for all computers in the domain
'description Computer description (in AD)
'distinguishedName DN: OU location of the computer account can be read from here. No wildcard matching possible!
'dNSHostName FQDN
'location Location field
'memberOf Groups the computer account is a member of. No wildcard matching possible!
'name Netbios computer name
'operatingSystem e.g. Windows Server 2003
'operatingSystemServicePack e.g. Service Pack 1
'operatingSystemVersion e.g. 5.2 (3790)
'primaryGroupID 515: Computers
'516: Domain Controllers
'sAMAccountName Computer account name (name$)
'sAMAccountType always 805306369 (computer account)
'servicePrincipalName list of registered SPNs

'=== nice doc on ldap queries
'http://ldapwiki.willeke.com/wiki/Active%20Directory%20Computer%20Related%20LDAP%20Query#section-Active+Directory+Computer+Related+LDAP+Query-FindAllWorkstations

cmd.commandtext = "<LDAP://" & objRoot.GET("defaultNamingContext") & ">;(objectCategory=Group);dnsHostName,distinguishedName,description"
'**** Bypass 1000 record limitation ****
cmd.properties("page size")=1000
fbot.WriteLn("<br>Getting computers...")
SET rs = cmd.EXECUTE

fbot.WriteLn("<br>Looping through computers...")
fbot.WriteLn("<br>")

'=== check all columns in the recordset (debug separator was , not ; )
test=0
if test=1 then
compucnt01 = 0
rs.movefirst
WHILE rs.eof<>true AND rs.bof<>true and compucnt01<1
for each field01 in rs.fields
fbot.WriteLn("<br>Field: " & field01.name)
next
rs.movenext
compucnt01 = compucnt01 + 1
wend
end if

'=== want to see progress live, make talbe now in html frame
fbot.WriteLn(h)

compucnt01 = 0
compucnt02 = 0
rs.movefirst
WHILE rs.eof <> true AND rs.bof <> true
'=== WRTIE A DOT EVERY 20 RECORDS
IF compucnt02/10 = INT(compucnt02/10) THEN fbot.WriteLn(".")

distinguishedName01 = lcase(rs("distinguishedName"))
dnsHostName01 = rs("dnsHostName")
description01 = rs("description")

'fbot.WriteLn("<br>Description is vartype: " & vartype(description01))

'=== is the computer from bloobuzz?
if instr(distinguishedName01, "ou=gemel groupes")<>0 then
'=== bloobuzz total
compucnt01 = compucnt01 + 1

h = ""
h = h & "<tr>" '=== line 1
h = h & "<td>" & compucnt01 & "</td>"
'h = h & "<td>" & dnsHostName01 & "</td>"
h = h & "<td>" & distinguishedName01 & "</td>"
if vartype(description01) = 8204 then
for each des02 in description01
h = h & "<td>" & des02 & "</td>"
next
else
h = h & "<td>" & description01 & "</td>"
end if

'=== go inside each group to list members
strContainer = "cn=TicPriv"

strContainer = left(distinguishedName01,instr(distinguishedName01,",")-1)

wanted01 = strContainer & ", ou=gemel groupes, " & objRoot.GET("defaultNamingContext")
fmid.WriteLn("<br>" &  wanted01)

Set objGroup = GetObject("LDAP://" & wanted01 )
objGroup.getInfo

on error resume next
err01 = 0 : err02 = ""
arrMemberOf = objGroup.GetEx("member")
err01 = err
err02 = err.description
on error goto 0

if err01 = 0 then
h = h & "<td>"
for each member01 in arrmemberof
h = h & member01 & "<br>"
next
h = left(h,len(h)-4) '=== remove <br>
h = h & "</td>"

end if
'=== testing
test=0
if test =1 then
cmd.commandtext = "<LDAP://" & objRoot.GET("defaultNamingContext") & ">;(objectCategory=User);dnsHostName,distinguishedName,description"
'**** Bypass 1000 record limitation ****
cmd.properties("page size")=1000
fmid.WriteLn("<br>Getting users...")
SET rs2 = cmd.EXECUTE
if  rs2.eof <> true AND rs2.bof <> true then
rs2.movefirst
WHILE rs2.eof <> true AND rs2.bof <> true
distinguishedName02 = lcase(rs2("distinguishedName"))
if instr(lcase(distinguishedName02), "serge fournier")<>0 then
h = h & "<td>rs2: " & distinguishedName02 & "</td>"
else
'fmid.WriteLn("<br>" & distinguishedName02)
end if
rs2.movenext
wend
else
'=== no records / results
'fmid.WriteLn("<br>ERROR - 0 results")

end if
end if
''''''''''''''''''''''''''''
' end of line in table
''''''''''''''''''''''''''''
h = h & "</tr>"
fbot.WriteLn(h)
else
'fbot.WriteLn(distinguishedName01 & " --- " & dnsHostName01 & "<br>")
end if '=== bbz found

compucnt02 = compucnt02 + 1
rs.movenext

wend

fmid.WriteLn("FIN")

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

fbot.WriteLn(h)

end if

reskeymid=0
resbutmidstr=""

end if


if resbutlefstr="scan" then

'''''''''''''''''''''''''''''''''''''''''''''''''''''''
' scan computers
'''''''''''''''''''''''''''''''''''''''''''''''''''''''

'=== 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)="what do you want to display"      '===== description displayed in front of the field
namtmp(x)="text01"                  '===== name of variable for programming purpose
deftmp(x)="hello world"           '===== 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)="computer name" '===== text to display after the form "facultatif" blue text "error" red text are special keywords

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

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

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

if resbutlefstr="" and (resbutmidstr="ok" or reskeymid=13) then
'=== User has clicked the OK button, retrieve the values
text=fmid.form01.text01.Value '=== namtmp is the variable name used earlier,before we call the dynamic form generation for input

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

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

'=== while we wait for input value, user can press "escape" key, "cancel" button or close internet explorer
if resbutmidstr="cancel" or reskeymid=27 or bready=true or resbutlefstr<>"" then
'=== if user pressed escape or cancel, we clear the frames
if resbutmidstr="cancel" or reskeymid=27 then
a = clefra(array("fmid","fbot"))
resbutmidstr="cancel"
end if
exit do
end if
'=== if there was an input error and no one used left control frame to exit, we keep asking for input
loop while err01<>0 or inpdon=0
   

'=== if internet explorer was not closed (bready), a button was not pressed on left frame, and no excape or cancel in middle frame
if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
a = clefra(array("fmid","fbot"))

cn.open "Provider=ADsDSOObject;"
cmd.activeconnection = cn

fbot.WriteLn("<br>Scanning domain computers")
'fbot.WriteLn("<br>directory where xml file is saved: " & basedir)

strInputPath = basedir & "\serverlist.txt" '- location of input
strOutputPath = basedir & "\output.csv" '- location of output

set objFSO = CreateObject("Scripting.FileSystemObject")
'set objTextIn = objFSO.OpenTextFile( strInputPath,1 )
set objTextOut = objFSO.CreateTextFile( strOutputPath )
objTextOut.WriteLine("computer,status")

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

'=== domain root
fbot.WriteLn("<br>Getting domain root...")
SET objRoot = GETOBJECT("LDAP://RootDSE")
'for each propName in objRoot.Properties.PropertyNames
'=== DC=quebecormedia,DC=com

defaultNamingContext01 = objRoot.GET("defaultNamingContext")

fbot.WriteLn("<br>" & objRoot.GET("defaultNamingContext"))

defaultNamingContext01 = defaultNamingContext01 & ",OU=gemel"

'=== Query for all computers in the domain
'description Computer description (in AD)
'distinguishedName DN: OU location of the computer account can be read from here. No wildcard matching possible!
'dNSHostName FQDN
'location Location field
'memberOf Groups the computer account is a member of. No wildcard matching possible!
'name Netbios computer name
'operatingSystem e.g. Windows Server 2003
'operatingSystemServicePack e.g. Service Pack 1
'operatingSystemVersion e.g. 5.2 (3790)
'primaryGroupID 515: Computers
'516: Domain Controllers
'sAMAccountName Computer account name (name$)
'sAMAccountType always 805306369 (computer account)
'servicePrincipalName list of registered SPNs

'=== nice doc on ldap queries
'http://ldapwiki.willeke.com/wiki/Active%20Directory%20Computer%20Related%20LDAP%20Query#section-Active+Directory+Computer+Related+LDAP+Query-FindAllWorkstations

cmd.commandtext = "<LDAP://" & objRoot.GET("defaultNamingContext") & ">;(objectCategory=Computer);dnsHostName,distinguishedName,description"
'**** Bypass 1000 record limitation ****
cmd.properties("page size")=1000
fbot.WriteLn("<br>Getting computers...")
SET rs = cmd.EXECUTE

fbot.WriteLn("<br>Looping through computers...")
fbot.WriteLn("<br>")


'=== check all columns in the recordset (debug separator was , not ; )
test=0
if test=1 then
compucnt01 = 0
rs.movefirst
WHILE rs.eof<>true AND rs.bof<>true and compucnt01<1
for each field01 in rs.fields
fbot.WriteLn("<br>Field: " & field01.name)
next
rs.movenext
compucnt01 = compucnt01 + 1
wend
end if

'=== want to see progress live, make talbe now in html frame
fbot.WriteLn(h)

compucnt01 = 0
compucnt02 = 0
rs.movefirst
WHILE rs.eof <> true AND rs.bof <> true
'=== WRTIE A DOT EVERY 20 RECORDS
IF compucnt02/10 = INT(compucnt02/10) THEN fbot.WriteLn(".")

distinguishedName01 = lcase(rs("distinguishedName"))
dnsHostName01 = rs("dnsHostName")
'=== is the computer from bloobuzz?
if instr(distinguishedName01, "dc=gemel,dc=ca")<>0 then
'=== bloobuzz total
compucnt01 = compucnt01 + 1

h = ""
h = h & "<tr>" '=== line 1
h = h & "<td>" & compucnt01 & "</td>"
h = h & "<td>" & dnsHostName01 & "</td>" '<td>" & distinguishedName01 & "</td>"

ping01 = ping(dnsHostName01)
h = h & "<td>" & ping01 & "</td>"
'fmid.WriteLn("ping " & dnsHostName01 & " " &  ping01)


if ping01 = true then
'=== last logonname of this computer

strComputer = dnsHostName01
err01 = 0: err02 = ""
on error resume next
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
err01 = err
err02 = err.description
on error goto 0

if err01 = 0 then

'=== last logon name on this computer
Set colItems = objWMIService.ExecQuery("Select * from Win32_ComputerSystem",,48)
For Each objItem in colItems
'net_domain = objItem.Domain
net_user_name = objItem.UserName
Next
h = h & "<td>" & net_user_name & "</td>"

mem01 = 0
if mem01 = 1 then

'''''''''''''''''''''''''''
'   Memory Information
'''''''''''''''''''''''''''
if verbose = "y" then
  'objOutputFile.WriteLine date & " " & time & " Memory Info ... DEBUT"
  'wscript.echo "Memory Info"
end if
'sql = "DELETE FROM memory WHERE memory_mac_address = '" & net_mac_address & "'"
'create_sql sql, objTextFile, database

Set colItems = objWMIService.ExecQuery("Select MemoryDevices FROM Win32_PhysicalMemoryArray",,48)
For Each objItem in colItems
  system_memory_banks = objItem.MemoryDevices
Next

On Error Resume Next

Set colItems = objWMIService.ExecQuery("Select Capacity,DeviceLocator,FormFactor,MemoryType,TypeDetail,Speed FROM Win32_PhysicalMemory",,48)
mem_count = 0
For Each objItem in colItems
  mem_count = mem_count + 1
  If mem_count > int(system_memory_banks) then
  Exit For
  End If
  If objItem.FormFactor = "7" then
 mem_formfactor = "SIMM"
  ElseIf objItem.FormFactor = "8" then
 mem_formfactor = "DIMM"
  ElseIf objItem.FormFactor = "11" then
 mem_formfactor = "RIMM"
  ElseIf objItem.FormFactor = "12" then
 mem_formfactor = "SODIMM"
  ElseIf objItem.FormFactor = "13" then
 mem_formfactor = "SRIMM"
  Else
 mem_formfactor = "Unknown"
  End If

  If objItem.MemoryType = "0" then
 mem_detail = "Unknown"
  ElseIf objItem.MemoryType = "1" then
 mem_detail = "Other"
  ElseIf objItem.MemoryType = "2" then
 mem_detail = "DRAM"
  ElseIf objItem.MemoryType = "3" then
 mem_detail = "Synchronous DRAM"
  ElseIf objItem.MemoryType = "4" then
 mem_detail = "Cache DRAM"
  ElseIf objItem.MemoryType = "5" then
 mem_detail = "EDO"
  ElseIf objItem.MemoryType = "6" then
 mem_detail = "EDRAM"
  ElseIf objItem.MemoryType = "7" then
 mem_detail = "VRAM"
  ElseIf objItem.MemoryType = "8" then
 mem_detail = "SRAM"
  ElseIf objItem.MemoryType = "9" then
 mem_detail = "RAM"
  ElseIf objItem.MemoryType = "10" then
 mem_detail = "ROM"
  ElseIf objItem.MemoryType = "11" then
 mem_detail = "Flash"
  ElseIf objItem.MemoryType = "12" then
 mem_detail = "EEPROM"
  ElseIf objItem.MemoryType = "13" then
 mem_detail = "FEPROM"
  ElseIf objItem.MemoryType = "14" then
 mem_detail = "EPROM"
  ElseIf objItem.MemoryType = "15" then
 mem_detail = "CDRAM"
  ElseIf objItem.MemoryType = "16" then
 mem_detail = "3DRAM"
  ElseIf objItem.MemoryType = "17" then
 mem_detail = "SDRAM"
  ElseIf objItem.MemoryType = "18" then
 mem_detail = "SGRAM"
  ElseIf objItem.MemoryType = "19" then
 mem_detail = "RDRAM"
  ElseIf objItem.MemoryType = "20" then
 mem_detail = "DDR"
  End If

  If objItem.TypeDetail = "1" then
 mem_typedetail = "Reserved"
  ElseIf objItem.TypeDetail = "2" then
 mem_typedetail = "Other"
  ElseIf objItem.TypeDetail = "4" then
 mem_typedetail = "Unknown"
  ElseIf objItem.TypeDetail = "8" then
 mem_typedetail = "Fast-paged"
  ElseIf objItem.TypeDetail = "16" then
 mem_typedetail = "Static column"
  ElseIf objItem.TypeDetail = "32" then
 mem_typedetail = "Pseudo-static"
  ElseIf objItem.TypeDetail = "64" then
 mem_typedetail = "RAMBUS"
  ElseIf objItem.TypeDetail = "128" then
 mem_typedetail = "Synchronous"
  ElseIf objItem.TypeDetail = "256" then
 mem_typedetail = "CMOS"
  ElseIf objItem.TypeDetail = "512" then
 mem_typedetail = "EDO"
  ElseIf objItem.TypeDetail = "1024" then
 mem_typedetail = "Window DRAM"
  ElseIf objItem.TypeDetail = "2048" then
 mem_typedetail = "Cache DRAM"
  ElseIf objItem.TypeDetail = "4096" then
 mem_typedetail = "Non-volatile"
  Else
 mem_typedetail = "Unknown"
  End If

  sql = "INSERT INTO memory ( memory_mac_address, memory_bank, " _
  & "memory_form_factor, memory_type, memory_detail, memory_capacity, memory_speed) " _
  & "VALUES ('" _
  & net_mac_address & "','" _
  & objItem.DeviceLocator & "','" _
  & mem_formfactor & "','" _
  & mem_detail & "','" _
  & mem_typedetail & "','" _
  & int(objItem.Capacity /1024 /1024) & "','" _
  & objItem.Speed & "')"
  'create_sql sql, objTextFile, database
Next
'sql = ""
'objOutputFile.WriteLine date & " " & time & " Memory Info ... FIN"

h = h & "<td>memory info " & sql & " </td>"
end if '=== mem01
else
'=== wmi error
h = h & "<td>ERROR WMI</td>"
end if '=== on error

else
'=== ping did not succeed

end if '=== ping true

''''''''''''''''''''''''''''
' end of line in table
''''''''''''''''''''''''''''
h = h & "</tr>"
fbot.WriteLn(h)
else
fbot.WriteLn(distinguishedName01 & " --- " & dnsHostName01 & "<br>")
end if '=== bbz found

compucnt02 = compucnt02 + 1
rs.movenext

wend

fmid.WriteLn("FIN")

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

fbot.WriteLn(h)

end if

reskeymid=0
resbutmidstr=""

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

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

      'fbot.WriteLn("tried to clear middle frame")
 
   end if
 
   if resbutlefstr="info" then
      a = clefra(array("fmid","fbot"))
   
      '=== print button
      aa = lcase(fbot.readystate)
      do until aa="complete" or aa="terminé" or aa="interactive"
         'if logall = 1 then fil02.writeline "*********************************** readystate of " & ffranam & ": " & aa
         wscript.sleep 100
         aa = lcase(fbot.readystate)
      loop
     
      for each a in priara
         fbot.WriteLn(a)
      next
      for each a in botara
         fbot.WriteLn(a)
      next
   
 
      fbot.WriteLn("<H2>Crucible Cleaner Troubleshooting Database with Dynamic Web Interface</H2><br>")
 
      texara=array(_
      "",_
      "1. REQUIREMENTS:",_
      "1.1 Microsoft windows xp, vista (32 or 64), seven (32 or 64) (without UAC, users access control, off)",_
      "1.2 Internet explorer",_
      "1.3 .NET framework 1.1 (included with windows)",_
      "1.4 microsoft access database: 45834_crucible_cleaning_diagnostic.mdb",_
      "1.5 images directory: PhotoHydComponent",_
      "",_
      "2. CARACTERISTICS:",_
      "",_
      "2.1 This dynamic web interface was programmed to access a microsoft access database information to troubleshoot a Crucible Cleaner",_
      "",_
      "3. REFERENCES:",_
      "",_
      "3.1 This program was made by STAS",_
      "3.2 STAS project number: 45834",_
      "",_
      "STAS Inc.",_
      "1846 Outarde, Chicoutimi (Qué.), Canada G7K 1H1",_
      "Tél.: 418-545-6574",_
      "Fax 1: 418-545-8335, Fax 2: 418-696-1951",_
      "Email: fournier.serge@STAS.com",_
      "Contact: Serge Fournier, Prog./Analyst")
   
      for each a in texara
         aa = lcase(fbot.readystate)
         do until aa="complete" or aa="terminé" or aa="interactive"
            if logall = 1 then fil02.writeline "*********************************** readystate of " & ffranam & ": " & aa
            wscript.sleep 100
            aa = lcase(fbot.readystate)
         loop
         fbot.WriteLn(a & "<br>")
      next
      aa = lcase(fbot.readystate)
      do until aa="complete" or aa="terminé" or aa="interactive"
         if logall = 1 then fil02.writeline "*********************************** readystate of " & ffranam & ": " & aa
         wscript.sleep 100
         aa = lcase(fbot.readystate)
      loop
   
      fbot.location.reload(true)
   
      reskeymid=0
      resbutmidstr=""
   
   end if
 
   '=== .1 seconds
   wscript.sleep 50
 
'=== we loop until internet explorer was closed or the quit button was pressed
loop until bReady or resbutlefstr="quit01"

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

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

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

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

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

'=== many subs

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


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

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

function clefra(aara)
 
   cc=""
   for each aa in aara
      'cc = cc & "Do While (oIE.Busy)" & vbcrlf
      'cc = cc & "   wscript.sleep 200" & vbcrlf
      'cc = cc & "Loop" & vbcrlf
      'cc = cc & "Do While oie.readystate<>4" & vbcrlf
      'cc = cc & "   wscript.sleep 200" & vbcrlf
      'cc = cc & "Loop" & vbcrlf
      'cc = cc & aa & ".location.reload(true)" & vbcrlf
      'cc = cc & "Do While (oIE.Busy)" & vbcrlf
      'cc = cc & "   wscript.sleep 200" & vbcrlf
      'cc = cc & "Loop" & vbcrlf
      'cc = cc & "Do While oie.readystate<>4" & vbcrlf
      'cc = cc & "   wscript.sleep 200" & vbcrlf
      'cc = cc & "Loop" & vbcrlf
      'cc = cc & aa & ".WriteLn(""&nbsp;"")" & vbcrlf
      'cc = cc & aa & ".location.reload(true)" & vbcrlf
      'cc = cc & "Do While oie.readystate<>4" & vbcrlf
      'cc = cc & "   wscript.sleep 200" & vbcrlf
      'cc = cc & "Loop" & vbcrlf
      'cc = cc & "Do While (oIE.Busy)" & vbcrlf
      'cc = cc & "   wscript.sleep 200" & vbcrlf
      'cc = cc & "Loop" & vbcrlf
      'cc = cc & "Do until " & aa & ".ReadyState = ""Terminé"" or " & aa & ".ReadyState = ""Complete""" & vbcrlf
      'cc = cc & "   wscript.sleep 200" & vbcrlf
      'cc = cc & "Loop" & vbcrlf
   
      '•uninitialized - Has not started loading yet
      '•loading - Is loading
      '•interactive - Has loaded enough and the user can interact with it
      '•complete - Fully loaded


      htmtab=""
      if aa = "flef" then
         aa = lcase(flef.readystate)
         do until aa="complete" or aa="terminé" or aa="interactive"
            if logall=1 then fil02.writeline "*********************************** readystate of flef: " & aa
            wscript.sleep 100
            aa = lcase(flef.readystate)
         loop
         htmtab = htmtab & "&nbsp;"
         aa = lcase(flef.readystate)
         do until aa="complete" or aa="terminé" or aa="interactive"
            if logall=1 then fil02.writeline "*********************************** readystate of flef: " & aa
            wscript.sleep 100
            aa = lcase(flef.readystate)
         loop
         for each a in lefara
            htmtab = htmtab & a
         next
         flef.writeln(htmtab)
         flef.location.reload(true)
         aa = lcase(flef.readystate)
         do until aa="complete" or aa="terminé" or aa="interactive"
            if logall=1 then fil02.writeline "*********************************** readystate of flef: " & aa
            wscript.sleep 100
            aa = lcase(flef.readystate)
         loop    
      end if
   
      if aa = "fmid" then
         aa = lcase(fmid.readystate)
         do until aa="complete" or aa="terminé" or aa="interactive"
            if logall=1 then fil02.writeline "*********************************** readystate of fmid: " & aa
            wscript.sleep 100
            aa = lcase(fmid.readystate)
         loop
         htmtab = htmtab & "&nbsp;"
         aa = lcase(fmid.readystate)
         do until aa="complete" or aa="terminé" or aa="interactive"
            if logall=1 then fil02.writeline "*********************************** readystate of fmid: " & aa
            wscript.sleep 100
            aa = lcase(fmid.readystate)
         loop
         for each a in midara
            htmtab = htmtab & a
         next
         fmid.writeln(htmtab)
       
         fmid.location.reload(true)
         aa = lcase(fmid.readystate)
         do until aa="complete" or aa="terminé" or aa="interactive"
            if logall=1 then fil02.writeline "*********************************** readystate of fmid: " & aa
            wscript.sleep 100
            aa = lcase(fmid.readystate)
         loop
         if logall=1 then fil02.writeline "mid frame cleared----------- ccc -----------"                    
      end if
   
      if aa = "fbot" then
         aa = lcase(fbot.readystate)
         do until aa="complete" or aa="terminé" or aa="interactive"
            if logall = 1 then fil02.writeline "*****************111****************** readystate of fbot: " & aa
            wscript.sleep 100
            aa = lcase(fbot.readystate)
         loop
         htmtab = htmtab & "&nbsp;"
         aa = lcase(fbot.readystate)
         do until aa="complete" or aa="terminé" or aa="interactive"
            if logall = 1 then fil02.writeline "*****************222****************** readystate of fbot: " & aa
            wscript.sleep 100
            aa = lcase(fbot.readystate)
         loop
         for each a in midara
            htmtab = htmtab & a
         next
         fbot.writeln(htmtab)
       
         fbot.location.reload(true)
         aa = lcase(fbot.readystate)
         do until aa="complete" or aa="terminé" or aa="interactive"
            if logall = 1 then fil02.writeline "*****************333****************** readystate of fbot: " & aa
            wscript.sleep 100
            aa = lcase(fbot.readystate)
         loop                
      end if
   
   next

   'execute cc
 
   '=== we also clear the variables used to control the action buttons and the key pressed in each frames
   '=== so the action wont be taken twice (or infinitly) in the main loop
 
   'set flef = oie.document.frames("left").document
   'set fmid = oie.document.frames("middle").document
   'set fbot = oie.document.frames("bottom").document
 
'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")

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

end function

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

'oie.Navigate("About:Blank")

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

oie.refresh

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

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

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

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

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

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

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

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

reskeylef=0
reskeymid=0
reskeybot=0

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

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

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

'(1) Where you want the image to appear: <span id="image"></span>

'(2) Get a reference to it: var e = document.getElementById('image');

'(3) Insert the img HTML code into the span: e.innerHTML = '<img src="./images/your_picture.jpg" />';

'aa = """file:///" & basedir & "PhotoHydComponent\002-00_HydroCraft_HC-EC_EndCover.jpg"""
'aa = "'" & basedir & "PhotoHydComponent\002-00_HydroCraft_HC-EC_EndCover.jpg'"
'aa = """./test.jpg"""
'aa = replace(aa,"\","/")
htmtab = ""
'htmtab = htmtab & "<img src=" & aa & " alt=" & aa & " />"

fmid.location.reload(true)
'msgbox(htmtab)
'oie.document.getElementById("middle").document.body.innerhtml = htmtab
'document.getElementById("myiframe").contentWindow.document.body.innerHTML = "<input type='button' value='Click' onclick='parent.buttonClick()'>";
'<script type="text/javascript">


'<script type="text/javascript">
'function chanceImage() {
'document.getElementById('image).innerHTML = '<img src="image.png" alt="Image" border="0">';
'}
'</script>

'htmtab = ""
'htmtab = htmtab & "<script type=""text/javascript"">"
'htmtab = htmtab & "document.getElementById(""middle"").contentWindow.document.body.innerHTML = '<img src=" & aa & " alt=""Image"" border=""0"">';"
'htmtab = htmtab & "</script>"

'fmid.writeln htmtab
'fmid.location.reload(true)
oie.document.getElementById("middle").contentWindow.document.body.innerhtml = htmtab

'fmid.location.reload(true)

for i=0 to ubound(arabutnam)
 
   '=== convert xls to mdb button appear for stas only
 
   if ((usenam="wildboy" or usenam="fournier.serge" or usenam="fortin.jp" or usenam="lavoie.daniel" or usenam="doucet.gm") and arabutnam(i)="excel2mdb") or arabutnam(i)<>"excel2mdb" then
 
      'style="background-color: #cc0000; color: #ffffff;" /
      b = "<input type=""button"" style=""height:50px;font-size:14px;width:100%;"" name=""" & arabutnam(i) & """ value=""" & arabutdes(i) & """"
      i2=i
      if i>ubound(aradepnam) then
         i2=ubound(aradepnam)
      else
         a=aradepnam(i2)
      end if

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

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

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

end function

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

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

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

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

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

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

'=== 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
   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)
   
      aa = lcase(ffra.readystate)
      do until aa="complete" or aa="terminé" or aa="interactive"
         if logall = 1 then fil02.writeline "*********************************** readystate of " & ffranam & ": " & aa
         wscript.sleep 100
         aa = lcase(ffra.readystate)
      loop    
   
      ffra.location.reload(false)

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

sub oieready()
   do while oie.readystate<>4
      wscript.sleep 100
   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 100
   Loop
end sub


'=== ssea = search string

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

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

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

end function

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

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

function crecol(tab,colnam)

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

end function

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

   on error goto 0
 
   cnttotrec = aa

end function

function dynmidres(TTEXT,aara,rres,aaratit,ccoltot)
 
   call oieready
   htmtab=""
   htmtab = htmtab & "<HTML><BODY>"
   for each a in midara
      htmtab = htmtab & a
   next
 
         htmtab = htmtab & TTEXT & ": " & rres & "<b><table  width=""100%"" BORDERCOLOR=""black"" class=MsoTableGrid border=1 CELLSPACING=0 cellpadding=2 style='border-collapse:collapse;border:none'>"
         htmtab = htmtab & "<CAPTION></CAPTION><span style='color:purple'>"
         htmtab = htmtab & "<TR>"
 
         i=0
         For Each aa In aaratit
            '=== columns names
            if i=0 then htmtab = htmtab & "<td><p>Choice</td>"
            htmtab = htmtab & "<td><p>" & Trim(aa) & "</td>"
            i=i+1
         Next
       
         htmtab = htmtab & "</tr>"
       
         For xx = 0 To ccoltot
            'If IsNull(myarray(xx, yy)) Then myarray(xx, yy) = ""
            if xx=0 then
               htmtab = htmtab & "<td><p>"
               htmtab = htmtab & rres
               htmtab = htmtab & "</td>"
            end if
         
            htmtab = htmtab & "<td><p>" & aara(xx,rres-1) & "</td>"
            'col = col & myarray(xx, yy)
         Next
         htmtab = htmtab & "</tr>"
         htmtab = htmtab & "</table></span></b><br>"
       
         '=== image of the component
         aa = """file://" & basedir & "PhotoHydComponent\002-00_HydroCraft_HC-EC_EndCover.jpg"""
         aa = replace(aa,"\","/")
         '<DIV style='display:none'><IMG SRC='image.gif'></DIV>
         htmtab = htmtab & "<img src=" & aa & " alt=" & aa & " />"
         htmtab = htmtab & "</BODY></HTML>"

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

end function

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

   split2 = aa2

END FUNCTION



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


function symptomssearch(strsea)

   mdbfil02 = basedir & "45834_crucible_cleaning_diagnostic.mdb"
   set objcon = nothing
   Set objcon = CreateObject("ADODB.Connection")
   constr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & mdbfil02
   objcon.open constr
 
   '=== symptom words to search (separated by a space)
   tab = 0 '=== table to seach in    (alltab)
   sel = 1 '=== columns to list      (allara)
   whe = 0 '=== columns to search in (Allara)

   'sql = "select top 1 * from " & alltab(tab)
   'a = exesql(objcon,tag,sql)
 
   sql = makque(strsea,tab,sel,whe," order by [probabilité] DESC","LIKE","%")
   if logall=1 then
      fil02.writeline "query:   " & sql
   end if
 
   a = exesql(objcon,tag,sql)

   '=== get all column names      
   coltot=0
   redim aratit(coltot)
   For Each a In TAG.fields
   '=== columns names
      redim preserve aratit(coltot)
      aratit(coltot)=Trim(a.Name)
      coltot=coltot+1
   Next
   coltot=coltot-1
 
   if tag.eof=0 then
      ara01 = tag.GetRows()
      if logall=1 then fil02.writeline "ara01 a été rempli de data"
   else
      redim ara01(coltot,0)
      fbot.WriteLn("<br>total columns: " & coltot & "<br>")
      for i=0 to coltot
         ara01(i,0)="ERROR there was 0 record in this query"
      next
      fbot.WriteLn("<br>ERROR<br>" & sql & "<br>gave 0 results<br>")    
   end if
 
   '=== get all data in a two dimensionnal array
 
   '=== ffra frame to use for display (object)
   '=== ttext to display
   '=== aara = array with what to display
   '=== cc = choice button
   '=== 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
   actrec = 0
   offset = 0
   search=""
   '=== total of records (max y in array if there is a x only)
   totrec = cnttotrec(ara01)
 
   tabnam2="SYMPTOMS"
   a = dynbotcho(fbot, tabnam2, aratit, ara01, 1 ,1, 1, 1, 1, edtmod, "bot")
 
   ooper = "LIKE"
   wwild="%"
   whe2tag=0 '=== no search in a search here, cause we are already looking for words in all search columns
   whe2 = 1 '=== search in a search
   a = bigtablewait

   if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
             
      '================= symptom done ========================================
     
      '=== convert the choice made with the button to a number (remove "but" from left side)
      ressym = right(resbutbotstr,len(resbutbotstr)-3)
      resbutmidstr=""
   
      '=== get the array that contain the choice in dbnam (database name)
      'fbot.WriteLn(ressym)

      a = clefra(array("fmid","fbot"))          '=== doing the job, all input are ok

      '=== look for our choice in the array in the right column, num1
      i = 0
      for each a in aratit
         b=lcase(a)
         if instr(b,"num1") then
            coldia = i
         end if
         i=i+1
      next
   
      ressym2 = ara01(coldia,ressym-1)
      if logall=1 then fil02.writeline "--- choice made.........: " & ressym2
   
      a = dynmidres("PROBLEM SELECTED",ara01,ressym,aratit,coltot)     '=== RESULTS SELECTED in ara01, ressym = result for symptom

      a = clrmenu
      'choice = trim(cstr(ara01(0,ressym)))
   
      '=== put 0 before result for component table search
      'IF len(chosym)<3 then chosym = string("0",len(3-len(chosym))) & chosym
   
      '========================== component choice
   
      '===
      tab = 1 '=== table to seach in    (alltab)
      sel = 1 '=== columns to list      (allara)
      whe = 3 '=== columns to search in (Allara) (3=symptoms, 4=diagnostics, 5=causes)
   
      sql = makque("-" & ressym2 & "-",tab,sel,whe,"","LIKE","%")
      'fbot.WriteLn(sql & "<br>")
      a = exesql(objcon,tag,sql)

      '=== get all column names      
      coltot=0
      redim aratit(coltot)
      For Each a In TAG.fields
      '=== columns names
         redim preserve aratit(coltot)
         aratit(coltot)=Trim(a.Name)
         coltot=coltot+1
      Next
      coltot=coltot-1
 
      if tag.eof=0 then
         ara01 = tag.GetRows()
         if logall=1 then fil02.writeline "ara01 a été rempli de data"
      else
         redim ara01(coltot,0)
         fbot.WriteLn("<br>total columns: " & coltot & "<br>")
         for i=0 to coltot
            ara01(i,0)="ERROR there was 0 record in this query"
         next
         fbot.WriteLn("<br>ERROR<br>" & sql & "<br>gave 0 results<br>")    
      end if
   
      '=== get all data in a two dimensionnal array
      totrec = cnttotrec(ara01)
   
      tabnam2="COMPONENTS"
      a = dynbotcho(fbot, tabnam2, aratit, ara01, 1 ,1, 1, 1, 1, edtmod,"bot")
   
      ooper = "LIKE"
      wwild = "%"
      'whe=0
      whe2tag=1
      whe2 = 1 '=== search in a search, we look for words, but in the result containing the number from the symptom
      a = bigtablewait

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

         '=== convert the choice made with the button to a number (remove "but" from left side)
         rescom = right(resbutbotstr,len(resbutbotstr)-3)
         resbutmidstr=""
   
         '=== get the array that contain the choice in dbnam (database name)
         'fbot.WriteLn(rescom)
       
         call oieready
         a = clefra(array("fmid","fbot"))          '=== doing the job, all input are ok
       
         a = dynmidres("COMPONENT SELECTED",ara01,rescom,aratit,coltot)     '=== RESULTS SELECTED in ara01, ressym = result for symptom

         a = clrmenu

          '=== (3=symptoms, 4=diagnostics, 5=causes)
             
         'alltab(0) = "symptoms"
         'alltab(1) = "components"
         'alltab(2) = "diagnostic"
         'alltab(3) = "causes"
       
         '=== the result is many numbers, for all diagnostics (diganostics column)
         i = 0
         for each a in aratit
            b=lcase(a)
            if instr(b,"diagnostic") then
               coldia = i
            end if
            i=i+1
         next
       
         if logall=1 then
            fil02.writeline "diagnostic column: " & coldia & "   NAME: " & aratit(coldia)
            fil02.writeline "diagnostic column: " & ara01(coldia,rescom-1)
         end if

         rescom2 = ara01(coldia,rescom-1)
       
         set choiceara= nothing
         choiceara = Split2(rescom2, "-")
         totrec2 = ubound(choiceara)
           
         tab = 2 '=== table to seach in    (alltab)
         sel = 1 '=== columns to list      (allara)
         whe = 3 '=== columns to search in (Allara) (tab,3 = "num1")

         i3=0
         ooper = "LIKE"
         wwild = "%"
         whe2tag=0
         'whe2 = 1 '=== search in a search
         For each dia01 in choiceara
            sql = makque(dia01,tab,sel,whe,"","=","")
            if logall=1 then
               fil02.writeline "query:"
               fil02.writeline sql
            end if
            a = exesql(objcon,tag,sql)
         
            coltot=0
         
            redim aratit(coltot)
            For Each a In TAG.fields
            '=== columns names
               redim preserve aratit(coltot)
               aratit(coltot)=Trim(a.Name)
               coltot=coltot+1
            Next
            coltot=coltot-1
         
            if tag.eof=0 then
               ara01 = tag.GetRows()
               if logall=1 then fil02.writeline "=== ara01 a été rempli de data"
            else
               if logall = 1 then fil02.writeline "no results in the first search for symptoms"
            end if
         
            totrec = cnttotrec(ara01)

            if logall=1 then
               fil02.writeline "numbers of results   : " & totrec2
               fil02.writeline "number of disgnostics: " & i3
            end if
         
            '=== make same array for a multiples queries
            if totrec2+1 > 0 then
               if totrec2=0 and i3=0 then
                  '=== there is only 1 result, with diagnostics
                  actrec = 0
                  offset = 0
                  search=""
                  if logall=1 then fil02.writeline "1 1 1 1"
                  'dynbotcho(ffra, ttext, aaratit, aara, selectbutton ,hh, mm,ff,   rr  , ttxtbox ,ffranam)
                  a = dynbotcho(fbot, "DIAGNOSTIC", aratit, ara01, 0 , 1, 1, 1, 1, edtmod  ,"bot")
               
                  '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
                  actrec = 0
                  offset = 0
                  search=""
                  if logall=1 then fil02.writeline "1 1 0 0"
                  a = dynbotcho(fbot, "DIAGNOSTIC", aratit, ara01, 0 ,1, 1, 0, 0, edtmod,"bot")
               elseif i3<>totrec2 and i3<>0 then
                  '=== footer
                  'a = dynbotcho("DIAGNOSTIC",tag,0,sql,0,1,0,0) '=== 1 2 3
                  actrec = 0
                  offset = 0
                  search=""
                  if logall=1 then fil02.writeline                  "0  1  0  0"
                  a = dynbotcho(fbot, "DIAGNOSTIC", aratit, ara01, 0 ,0, 1, 0, 0, edtmod,"bot")
               elseif i3=totrec2 then
                  'a = dynbotcho("DIAGNOSTIC",tag,0,sql,0,1,1,1) '=== 1 2 3
                  actrec = 0
                  offset = 0
                  search=""
                  if logall=1 then fil02.writeline "0 1 1 1"
                  a = dynbotcho(fbot, "DIAGNOSTIC", aratit, ara01, 0 ,0, 1, 1, 1, edtmod,"bot")
               end if
               i3 = i3 + 1
               'if logall=1 then fil02.writeline "i3    : " & i3 & " / "& totrec2
               'if logall=1 then fil02.writeline "dia013: " & dia01
            end if
         next
         if logall=1 then fil02.writeline "i3    : " & i3 & " / "& totrec2
         'wscript.quit
             
      elseif resbutlef=0 and button="cancel" then '=== cancel was pressed
         'fbot.WriteLn("cancelled<br>")
         a = clrmenu
         a = clefra(array("fmid","fbot"))
      end if
   
      '====== cause
      objcon.Close

   elseif resbutlefstr="" and (resbutmidstr="cancel" or reskeymid=27) then
      '=== nothing was pressed on left, but cancel was used or escape
      a=clrmenu
      a = clefra(array("fmid","fbot"))
   'elseif resbutlefstr<>"" then
      '=== sometthing hapenned with the buton on the left side (menu/control)
   
   end if
 
end function

'============---------------===============--------------============

function causessearch(strsea)
   '===
   mdbfil02 = basedir & "45834_crucible_cleaning_diagnostic.mdb"
   set objcon = nothing
   Set objcon = CreateObject("ADODB.Connection")
   constr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & mdbfil02
   objcon.open constr
 
   '=== cause = words to search (separated by a space)
   tab = 3 '=== table to seach in    (alltab)
   sel = 1 '=== columns to list      (allara)
   whe = 0 '=== columns to search in (Allara)

   'sql = "select top 1 * from " & alltab(tab)
   'a = exesql(objcon,tag,sql)
 
   sql = makque(strsea,tab,sel,whe,"","LIKE","%")
   if logall=1 then
      fil02.writeline "query:   " & sql
   end if
 
   a = exesql(objcon,tag,sql)

   '=== get all column names      
   coltot=0
   redim aratit(coltot)
   For Each a In TAG.fields
   '=== columns names
      redim preserve aratit(coltot)
      aratit(coltot)=Trim(a.Name)
      coltot=coltot+1
   Next
   coltot=coltot-1
 
   if tag.eof=0 then
      ara01 = tag.GetRows()
      if logall=1 then fil02.writeline "ara01 a été rempli de data"
   else
      redim ara01(coltot,0)
      fbot.WriteLn("<br>total columns: " & coltot & "<br>")
      for i=0 to coltot
         ara01(i,0)="ERROR there was 0 record in this query"
      next
      fbot.WriteLn("<br>ERROR<br>" & sql & "<br>gave 0 results<br>")    
   end if
 
   '=== get all data in a two dimensionnal array
 
   '=== ffra frame to use for display (object)
   '=== ttext to display
   '=== aara = array with what to display
   '=== cc = choice button
   '=== 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
   actrec = 0
   offset = 0
   search=""
   '=== total of records (max y in array if there is a x only)
   totrec = cnttotrec(ara01)
 
   tabnam2="CAUSE"
   a = dynbotcho(fbot, tabnam2, aratit, ara01, 1 ,1, 1, 1, 1, edtmod, "bot")
 
   ooper = "LIKE"
   wwild="%"
   whe2tag=0 '=== no search in a search here, cause we are already looking for words in all search columns
   whe2 = 1 '=== search in a search
   a = bigtablewait

   if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
             
      '================= symptom done ========================================
     
      '=== convert the choice made with the button to a number (remove "but" from left side)
      ressym = right(resbutbotstr,len(resbutbotstr)-3)
      resbutmidstr=""
   
      '=== get the array that contain the choice in dbnam (database name)
      'fbot.WriteLn(ressym)

      a = clefra(array("fmid","fbot"))          '=== doing the job, all input are ok

      '=== look for our choice in the array in the right column, num1
      i = 0
      for each a in aratit
         b=lcase(a)
         if instr(b,"num1") then
            coldia = i
         end if
         i=i+1
      next
   
      ressym2 = ara01(coldia,ressym-1)
      if logall=1 then fil02.writeline "--- choice made.........: " & ressym2
   
      a = dynmidres("CAUSE SELECTED",ara01,ressym,aratit,coltot)     '=== RESULTS SELECTED in ara01, ressym = result for symptom

      a = clrmenu
      'choice = trim(cstr(ara01(0,ressym)))
   
      '=== put 0 before result for component table search
      'IF len(chosym)<3 then chosym = string("0",len(3-len(chosym))) & chosym
   
      '========================== component choice
   
      '===
      tab = 1 '=== table to seach in    (alltab)
      sel = 1 '=== columns to list      (allara)
      whe = 5 '=== columns to search in (Allara) (3=symptoms, 4=diagnostics, 5=causes)
   
      sql = makque("-" & ressym2 & "-",tab,sel,whe,"","LIKE","%")
      'fbot.WriteLn(sql & "<br>")
      a = exesql(objcon,tag,sql)

      '=== get all column names      
      coltot=0
      redim aratit(coltot)
      For Each a In TAG.fields
      '=== columns names
         redim preserve aratit(coltot)
         aratit(coltot)=Trim(a.Name)
         coltot=coltot+1
      Next
      coltot=coltot-1
 
      if tag.eof=0 then
         ara01 = tag.GetRows()
         if logall=1 then fil02.writeline "ara01 a été rempli de data"
      else
         redim ara01(coltot,0)
         fbot.WriteLn("<br>total columns: " & coltot & "<br>")
         for i=0 to coltot
            ara01(i,0)="ERROR there was 0 record in this query"
         next
         fbot.WriteLn("<br>ERROR<br>" & sql & "<br>gave 0 results<br>")    
      end if
   
      '=== get all data in a two dimensionnal array
      totrec = cnttotrec(ara01)
   
      tabnam2="COMPONENTS"
      a = dynbotcho(fbot, tabnam2, aratit, ara01, 1 ,1, 1, 1, 1, edtmod,"bot")
   
      ooper = "LIKE"
      wwild = "%"
      'whe=0
      whe2tag=1
      whe2 = 1 '=== search in a search, we look for words, but in the result containing the number from the symptom
      a = bigtablewait

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

         '=== convert the choice made with the button to a number (remove "but" from left side)
         rescom = right(resbutbotstr,len(resbutbotstr)-3)
         resbutmidstr=""
   
         '=== get the array that contain the choice in dbnam (database name)
         'fbot.WriteLn(rescom)
       
         call oieready
         a = clefra(array("fmid","fbot"))          '=== doing the job, all input are ok
       
         a = dynmidres("COMPONENT SELECTED",ara01,rescom,aratit,coltot)     '=== RESULTS SELECTED in ara01, ressym = result for symptom

         a = clrmenu

          '=== (3=symptoms, 4=diagnostics, 5=causes)
             
         'alltab(0) = "symptoms"
         'alltab(1) = "components"
         'alltab(2) = "diagnostic"
         'alltab(3) = "causes"
       
         '=== the result is many numbers, for all diagnostics (diganostics column)
         i = 0
         for each a in aratit
            b=lcase(a)
            if instr(b,"diagnostic") then
               coldia = i
            end if
            i=i+1
         next
       
         if logall=1 then
            fil02.writeline "diagnostic column: " & coldia & "   NAME: " & aratit(coldia)
            fil02.writeline "diagnostic column: " & ara01(coldia,rescom-1)
         end if

         rescom2 = ara01(coldia,rescom-1)
       
         set choiceara= nothing
         choiceara = Split2(rescom2, "-")
         totrec2 = ubound(choiceara)
           
         tab = 2 '=== table to seach in    (alltab)
         sel = 1 '=== columns to list      (allara)
         whe = 3 '=== columns to search in (Allara) (tab,3 = "num1")

         i3=0
         ooper = "LIKE"
         wwild = "%"
         whe2tag=0
         'whe2 = 1 '=== search in a search
         For each dia01 in choiceara
            sql = makque(dia01,tab,sel,whe,"","=","")
            if logall=1 then
               fil02.writeline "query:"
               fil02.writeline sql
            end if
            a = exesql(objcon,tag,sql)
         
            coltot=0
         
            redim aratit(coltot)
            For Each a In TAG.fields
            '=== columns names
               redim preserve aratit(coltot)
               aratit(coltot)=Trim(a.Name)
               coltot=coltot+1
            Next
            coltot=coltot-1
         
            if tag.eof=0 then
               ara01 = tag.GetRows()
               if logall=1 then fil02.writeline "=== ara01 a été rempli de data"
            else
               if logall = 1 then fil02.writeline "no results in the first search for symptoms"
            end if
         
            totrec = cnttotrec(ara01)

            if logall=1 then
               fil02.writeline "numbers of results   : " & totrec2
               fil02.writeline "number of disgnostics: " & i3
            end if
         
            '=== make same array for a multiples queries
            if totrec2+1 > 0 then
               if totrec2=0 and i3=0 then
                  '=== there is only 1 result, with diagnostics
                  actrec = 0
                  offset = 0
                  search=""
                  if logall=1 then fil02.writeline "1 1 1 1"
                  'dynbotcho(ffra, ttext, aaratit, aara, selectbutton ,hh, mm,ff,   rr  , ttxtbox ,ffranam)
                  a = dynbotcho(fbot, "DIAGNOSTIC", aratit, ara01, 0 , 1, 1, 1, 1, edtmod  ,"bot")
               
                  '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
                  actrec = 0
                  offset = 0
                  search=""
                  if logall=1 then fil02.writeline "1 1 0 0"
                  a = dynbotcho(fbot, "DIAGNOSTIC", aratit, ara01, 0 ,1, 1, 0, 0, edtmod,"bot")
               elseif i3<>totrec2 and i3<>0 then
                  '=== footer
                  'a = dynbotcho("DIAGNOSTIC",tag,0,sql,0,1,0,0) '=== 1 2 3
                  actrec = 0
                  offset = 0
                  search=""
                  if logall=1 then fil02.writeline                  "0  1  0  0"
                  a = dynbotcho(fbot, "DIAGNOSTIC", aratit, ara01, 0 ,0, 1, 0, 0, edtmod,"bot")
               elseif i3=totrec2 then
                  'a = dynbotcho("DIAGNOSTIC",tag,0,sql,0,1,1,1) '=== 1 2 3
                  actrec = 0
                  offset = 0
                  search=""
                  if logall=1 then fil02.writeline "0 1 1 1"
                  a = dynbotcho(fbot, "DIAGNOSTIC", aratit, ara01, 0 ,0, 1, 1, 1, edtmod,"bot")
               end if
               i3 = i3 + 1
               'if logall=1 then fil02.writeline "i3    : " & i3 & " / "& totrec2
               'if logall=1 then fil02.writeline "dia013: " & dia01
            end if
         next
         if logall=1 then fil02.writeline "i3    : " & i3 & " / "& totrec2
         'wscript.quit
             
      elseif resbutlef=0 and button="cancel" then '=== cancel was pressed
         'fbot.WriteLn("cancelled<br>")
         a = clrmenu
         a = clefra(array("fmid","fbot"))
      end if
   
      '====== cause
      objcon.Close

   elseif resbutlefstr="" and (resbutmidstr="cancel" or reskeymid=27) then
      '=== nothing was pressed on left, but cancel was used or escape
      a=clrmenu
      a = clefra(array("fmid","fbot"))
   'elseif resbutlefstr<>"" then
      '=== sometthing hapenned with the buton on the left side (menu/control)
   
   end if
 

end function

function componentssearch(strsea)

   mdbfil02 = basedir & "45834_crucible_cleaning_diagnostic.mdb"
   set objcon = nothing
   Set objcon = CreateObject("ADODB.Connection")
   constr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & mdbfil02
   objcon.open constr
 
   '=== COMPONENT = words to search (separated by a space)
   tab = 1 '=== table to seach in    (alltab)
   sel = 1 '=== columns to list      (allara)
   whe = 0 '=== columns to search in (Allara)
 
   'sql = "select top 1 * from " & alltab(tab)
   'a = exesql(objcon,tag,sql)
 
   sql = makque(strsea,tab,sel,whe,"","LIKE","%")
   if logall=1 then
      fil02.writeline "query:   " & sql
   end if
 
   a = exesql(objcon,tag,sql)

   '=== get all column names      
   coltot=0
   redim aratit(coltot)
   For Each a In TAG.fields
   '=== columns names
      redim preserve aratit(coltot)
      aratit(coltot)=Trim(a.Name)
      coltot=coltot+1
   Next
   coltot=coltot-1
 
   if tag.eof=0 then
      ara01 = tag.GetRows()
      if logall=1 then fil02.writeline "ara01 a été rempli de data"
   else
      redim ara01(coltot,0)
      fbot.WriteLn("<br>total columns: " & coltot & "<br>")
      for i=0 to coltot
         ara01(i,0)="ERROR there was 0 record in this query"
      next
      fbot.WriteLn("<br>ERROR<br>" & sql & "<br>gave 0 results<br>")    
   end if
 
   '=== get all data in a two dimensionnal array
 
   '=== ffra frame to use for display (object)
   '=== ttext to display
   '=== aara = array with what to display
   '=== cc = choice button
   '=== 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
   actrec = 0
   offset = 0
   search=""
   '=== total of records (max y in array if there is a x only)
   totrec = cnttotrec(ara01)
 
   tabnam2="COMPONENT"
   a = dynbotcho(fbot, tabnam2, aratit, ara01, 1 ,1, 1, 1, 1, edtmod, "bot")
 
   ooper = "LIKE"
   wwild="%"
   whe2tag=0 '=== no search in a search here, cause we are already looking for words in all search columns
   whe2 = 1 '=== search in a search
   a = bigtablewait

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

         '=== convert the choice made with the button to a number (remove "but" from left side)
         rescom = right(resbutbotstr,len(resbutbotstr)-3)
         resbutmidstr=""
   
         '=== get the array that contain the choice in dbnam (database name)
         'fbot.WriteLn(rescom)
       
         call oieready
         a = clefra(array("fmid","fbot"))          '=== doing the job, all input are ok
       
         a = dynmidres("COMPONENT SELECTED",ara01,rescom,aratit,coltot)     '=== RESULTS SELECTED in ara01, ressym = result for symptom

         a = clrmenu

          '=== (3=symptoms, 4=diagnostics, 5=causes)
             
         'alltab(0) = "symptoms"
         'alltab(1) = "components"
         'alltab(2) = "diagnostic"
         'alltab(3) = "causes"
       
         '=== the result is many numbers, for all diagnostics (diganostics column)
         i = 0
         for each a in aratit
            b=lcase(a)
            if instr(b,"diagnostic") then
               coldia = i
            end if
            i=i+1
         next
       
         if logall=1 then
            fil02.writeline "diagnostic column: " & coldia & "   NAME: " & aratit(coldia)
            fil02.writeline "diagnostic column: " & ara01(coldia,rescom-1)
         end if

         rescom2 = ara01(coldia,rescom-1)
       
         set choiceara= nothing
         choiceara = Split2(rescom2, "-")
         totrec2 = ubound(choiceara)
           
         tab = 2 '=== table to seach in    (alltab)
         sel = 1 '=== columns to list      (allara)
         whe = 3 '=== columns to search in (Allara) (tab,3 = "num1")

         i3=0
         ooper = "LIKE"
         wwild = "%"
         whe2tag=0
         'whe2 = 1 '=== search in a search
         For each dia01 in choiceara
            sql = makque(dia01,tab,sel,whe,"","=","")
            if logall=1 then
               fil02.writeline "query:"
               fil02.writeline sql
            end if
            a = exesql(objcon,tag,sql)
         
            coltot=0
         
            redim aratit(coltot)
            For Each a In TAG.fields
            '=== columns names
               redim preserve aratit(coltot)
               aratit(coltot)=Trim(a.Name)
               coltot=coltot+1
            Next
            coltot=coltot-1
         
            if tag.eof=0 then
               ara01 = tag.GetRows()
               if logall=1 then fil02.writeline "=== ara01 a été rempli de data"
            else
               if logall = 1 then fil02.writeline "no results in the first search for symptoms"
            end if
         
            totrec = cnttotrec(ara01)

            if logall=1 then
               fil02.writeline "numbers of results   : " & totrec2
               fil02.writeline "number of disgnostics: " & i3
            end if
         
            '=== make same array for a multiples queries
            if totrec2+1 > 0 then
               if totrec2=0 and i3=0 then
                  '=== there is only 1 result, with diagnostics
                  actrec = 0
                  offset = 0
                  search=""
                  if logall=1 then fil02.writeline "1 1 1 1"
                  'dynbotcho(ffra, ttext, aaratit, aara, selectbutton ,hh, mm,ff,   rr  , ttxtbox ,ffranam)
                  a = dynbotcho(fbot, "DIAGNOSTIC", aratit, ara01, 0 , 1, 1, 1, 1, edtmod  ,"bot")
               
                  '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
                  actrec = 0
                  offset = 0
                  search=""
                  if logall=1 then fil02.writeline "1 1 0 0"
                  a = dynbotcho(fbot, "DIAGNOSTIC", aratit, ara01, 0 ,1, 1, 0, 0, edtmod,"bot")
               elseif i3<>totrec2 and i3<>0 then
                  '=== footer
                  'a = dynbotcho("DIAGNOSTIC",tag,0,sql,0,1,0,0) '=== 1 2 3
                  actrec = 0
                  offset = 0
                  search=""
                  if logall=1 then fil02.writeline                  "0  1  0  0"
                  a = dynbotcho(fbot, "DIAGNOSTIC", aratit, ara01, 0 ,0, 1, 0, 0, edtmod,"bot")
               elseif i3=totrec2 then
                  'a = dynbotcho("DIAGNOSTIC",tag,0,sql,0,1,1,1) '=== 1 2 3
                  actrec = 0
                  offset = 0
                  search=""
                  if logall=1 then fil02.writeline "0 1 1 1"
                  a = dynbotcho(fbot, "DIAGNOSTIC", aratit, ara01, 0 ,0, 1, 1, 1, edtmod,"bot")
               end if
               i3 = i3 + 1
               'if logall=1 then fil02.writeline "i3    : " & i3 & " / "& totrec2
               'if logall=1 then fil02.writeline "dia013: " & dia01
            end if
         next
         if logall=1 then fil02.writeline "i3    : " & i3 & " / "& totrec2
         'wscript.quit
             
      elseif resbutlef=0 and button="cancel" then '=== cancel was pressed
         'fbot.WriteLn("cancelled<br>")
         a = clrmenu
         a = clefra(array("fmid","fbot"))
      end if
   
      '====== cause
      objcon.Close

end function

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 Ping(strHost)
Dim objPing, objRetStatus
'progressText strHost, "Pinging"

Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery("select * from Win32_PingStatus where address = '" & strHost & "' AND ResolveAddressNames = TRUE")

For Each objRetStatus in objPing
If IsNull(objRetStatus.StatusCode) or objRetStatus.StatusCode <> 0 then
Ping = False
Else
Ping = True
End if
Next
End Function



'====== write a value in registry, trap error
function regwri(regkey, value, type01)
   aa = lcase(type01)

   if aa = "reg_multi_sz" then
      '=== split keyname from keypath cause for a multi sz the technique is different
      regnam = right(regkey, len(regkey) - instrrev(regkey,"\"))
      regpat = left(regkey,len(regkey) - instr(regkey,"\")-3)
      if mid(regpat,1,19)="HKEY_LOCAL_MACHINE\" then
         regpat = mid(regpat,20,len(regpat))
      end if
   
      objReg.SetMultiStringValue hklm,regpat,regnam,value
      'msgbox("test done" & vbcrlf & hklm & vbcrlf & regpat & vbcrlf & regnam & vbcrlf)   elseif type01<>"" then
   elseif aa<>"" then
   
      if mid(regkey,1,19)="HKEY_LOCAL_MACHINE\" then
        regpat = right(regkey,len(regkey)-19)
      end if
   
      regpat = left(regpat, instrrev(regpat,"\"))
      'msgbox(regpat)
      regnam = right(regkey, len(regkey) - instrrev(regkey,"\"))
   
      'HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\RegisteredOwner
   
      err01 = 0 : err02 = ""
      'on error resume next
      'objshe.RegWrite regkey,value,type01
   
      fbot.WriteLn("<br>Before regwrite: " & type01 & "<br>")
      fbot.WriteLn("Before regwrite: " & hklm & "<br>")
      fbot.WriteLn("Before regwrite: " & regpat & "<br>")
      fbot.WriteLn("Before regwrite: " & regnam & "<br>")
      fbot.WriteLn("Before regwrite: " & value & "<br><br>")
   
      Return01 = objReg.SetStringValue(hklm,regpat,regnam,value)
      'msgbox(return01)
      if return01 <>0 then
        msgbox("ERROR" & vbcrlf & return01 & vbcrlf & "regpat: " & regpat & vbcrlf & regnam & vbcrlf & value & vbcrlf & regkey)
      else
        'msgbox("ERROR" & vbcrlf & return01 & vbcrlf & "regpat: " & regpat & vbcrlf & regnam & vbcrlf & value & vbcrlf & regkey)
      end if
      'If (Return01 = 0) And (Err.Number = 0) Then
          'Wscript.Echo "HKEY_LOCAL_MACHINE\Software\MyKey" & " contains 'string value'"
   
      err01 = err
      err02 = err.description
      on error goto 0
   
      'on error goto 0
      if err01 <>0 then
        'msgbox("ERROR writing register base")
        'objFil01.WriteLine date & " " & time & " ERREUR regwri écriture dans le base de registre: " & regkey & " Value: " & value & " type: " & type01
        'objFil01.WriteLine date & " " & time & " " & err01 & " " & err02
      end if
   else
      objshe.RegWrite regkey,""
   end if
   if err.number<>0 then
      'msgfin = msgfin & "`n" & regkey & "`n"
      toterrcop = toterrcop + 1
      msgfin03 = msgfin03 & vbcrlf & "error - register base not written: " & vbcrlf & regkey & vbcrlf & err.description & vbcrlf
      if usenam = debugname then
         'msgbox("cannot write key" & vbcrlf & regkey & vbcrlf & value)
      end if
   end if
end function


'====== create a process
function doprocess(strcommand, param)
Const SW_NORMAL = 1
'strComputer = "."
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

' Configure the Notepad process to show a window
Set objStartup = objWMIService.Get("Win32_ProcessStartup")
Set objConfig = objStartup.SpawnInstance_

' 1 - Window is shown minimized
' 3 - Window is shown maximized
' 5 - Window is shown in normal view
' 12 - Window is hidden and not displayed to the user

objConfig.ShowWindow = 1
a=right(strcommand,11)
if a="cscript.exe" or a="wscript.exe" then
objConfig.ShowWindow = 12
end if

IF A ="outlook.exe" then
strQuery = "Select * from Win32_Process Where Name = 'Outlook.exe'"
Set colProcesses = objWMIService.ExecQuery(strQuery)
For Each objProcess In colProcesses
If lCase(objProcess.Name) = "outlook.exe" Then
outrun=1
Else
Outrun=0
End If
Next
end if
'Const LOW = 64
'Const BELOW_NORMAL = 16384
'Const NORMAL = 32
'Const ABOVE_NORMAL = 32768
'Const HIGH = 128

objConfig.PriorityClass = 16384
'=== Create Notepad process
Set objProcess = objWMIService.Get("Win32_Process")
if param<>"" then
   strcommand = strcommand & " " & param
end if
IF (A ="outlook.exe" and outrun=0) or a<>"outlook.exe" then

   '=== localhost start process

   'intReturn = objProcess.Create(strCommand, Null, objConfig, intProcessID)
end if

'============== remote start
'=== Connect to WMI
'set objWMIService = getobject("winmgmts://" & strComputer & "/root/cimv2")
'=== Obtain the Win32_Process class of object.
Set objProcess = objWMIService.Get("Win32_Process")
Set objProgram = objProcess.Methods_("Create").InParameters.SpawnInstance_
objProgram.CommandLine = strCommand

'msgbox("ordinateur: " & strcomputer)

'Execute the program now at the command line.

Set strShell = objWMIService.ExecMethod("Win32_Process", "Create", objProgram)  



end function

'====== adjust a process priority
function adjprocess()
   'Const LOW = 64
   'Const BELOW_NORMAL = 16384
   'Const NORMAL = 32
   'Const ABOVE_NORMAL = 32768
   'Const HIGH = 128
 
   Const ABOVE_NORMAL = 32768
   strComputer = "."
   Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
   Set colProcesses = objWMIService.ExecQuery("Select * from Win32_Process Where Name = 'nsrexecd.exe'")
   For Each objProcess in colProcesses
       objProcess.SetPriority(ABOVE_NORMAL)
   Next
end function


1 comment: