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("" "")" & 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 & " "
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 & " "
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 & " "
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 & " <b><span style='color:" & col & "'> " & errtmp(ii) & "</span></b><br style='mso-special-character:line-break'>"
next
htmtab = htmtab & "<![if !supportLineBreakNewLine]><br style='mso-special-character:line-break'>"
htmtab = htmtab & "<![endif]></p>"
for ii=0 to ubound(buttmp)
typ01 = "button"
htmtab = htmtab & "<input type=""" & typ01 & """ name=""" & buttmp(ii) & """ value="" " & buttmp(ii) & " "">"
htmtab = htmtab & "          "
next
htmtab = htmtab & "</div>"
htmtab = htmtab & "</form>"
htmtab = htmtab & "</body>"
htmtab = htmtab & "</html>"
fmid.writeln htmtab
fmid.location.reload(true)
'=== wait for internet explorer to be ready after we refresh the page with the new form
for ii=0 to ubound(buttmp)
Do While (oIE.Busy)
wscript.sleep 100
loop
do while oie.readystate<>4
wscript.sleep 100
Loop
'=== value to return for each button in the form
fmid.forms(0).elements(buttmp(ii)).onclick = getref("buttonmid")
next
'=== regenerate the event that call a sub if a button is pressed
set fmid.onkeypress = GetRef("Checkmid")
'=== clear button pressed and key pressed for this frame
resbutmidstr=""
reskeymid=0
end function
'=== max
Function max(a, b)
If a > b Then max = a Else max = b
End Function
function crewebmai(oie, doctit, maitit, arabutnam, arabutdes, aradepnam, aradepcol)
'=== create an internet explorer object (oie) that will be in 3 frames (flef, fmid, fbot), acting at the main interface for all this program
oie.FullScreen = False
'.ToolBar = False
'.StatusBar = False
'.Navigate("About:Blank")
'.visible = true
oIE.left=0 ' window position
oIE.top = 0 ' and other properties
'.ParentWindow
' .resizeto 640,300
' .moveto (.screen.width
oIE.height = 500
oIE.width = 500
oIE.menubar = 1 '=== no menu
oIE.toolbar = 1
oIE.statusbar = 1
oIE.RegisterAsDropTarget = True
oie.Navigate("about:blank")
'oie.Navigate("about:tabs")
oie.document.title = doctit
oiewid = oie.document.parentwindow.screen.width
oiehei = oie.document.parentwindow.screen.height
sizwidpercent = 100
sizheipercent = 95
loswid = 100-sizwidpercent
loshei = 100-sizheipercent
newwid = oiewid*sizwidpercent*.01
newhei = oiehei*sizheipercent*.01
oie.document.parentwindow.resizeto newwid,newhei
newx = oiewid * loswid * .01 /2
newy = oiehei * (loshei/2) * .01 /2
oie.document.parentwindow.moveto newx, newy
oIE.visible = 1 '=== visible on
oie.addressbar=false
'=== we will always have 3 frames, control, input and output (flef, fmid, fbot)
'=== used an array to have a good view of the line of html and possibility to add something else easily
aratmp=array(_
"<HTML>",_
"<HEAD><TITLE>" & doctit & "</TITLE>",_
"<meta content=""text/html; charset=utf-8"" http-equiv=""Content-Type"">",_
"<meta http-equiv=""X-UA-Compatible"" content=""IE=8"">",_
"</HEAD>",_
"<FRAMESET id='main' COLS=""13%, *"">",_
"<FRAME SRC=""About:Blank"" NAME=""left"" id=""left"">",_
"<frameset id='main2' rows=""30%,70%"">",_
"<FRAME SRC=""About:Blank"" NAME=""middle"" id=""middle"">",_
"<FRAME SRC=""About:Blank"" NAME=""bottom"" id=""bottom"">",_
"</FRAMESET>", _
"</frameset>", _
"</HTML>")
'oie.Navigate("About:Blank")
'=== send the array content in internet explorer to create 3 frames
for i = 0 to UBound(aratmp, 1)
oie.document.WriteLn(aratmp(i))
next
oie.refresh
Do While (oIE.Busy)
wscript.sleep 50
Loop
'=== wait till document loaded
do while oie.readystate<>4
wscript.sleep 50
Loop
'=== vista activate
'=== make internet explorer the main active window
a = objShe.AppActivate("http:/// - " & doctit & " - M")
a = objShe.AppActivate(doctit & " - M")
'=== theses objects are used to send data to the 3 different frames
'=== if you dont define them as object, the access to them is very slow when we use the names instead of the objects
'=== object used to write in a frame with writeln
fileversion = objFSO.GetFileVersion("C:\program files\internet explorer\iexplore.exe")
finddot = instr(fileversion,".")
fileversion2 = left(fileversion,finddot-1)
if fileversion2 = "10" or fileversion2 = "11" then
'=== ie10 frame access
set flef = oie.parent.document.getElementByid("left").contentdocument
set fmid = oie.parent.document.getElementByid("middle").contentdocument
set fbot = oie.parent.document.getElementByid("bottom").contentdocument
else
set flef = oie.document.frames("left").document
set fmid = oie.document.frames("middle").document
set fbot = oie.document.frames("bottom").document
end if
'=== object used to navigate an empty page in a frame
'set flefl = oie.document.frames("left").location
'set fmidl = oie.document.frames("middle").location
'set fbotl = oie.document.frames("bottom").location
'=== string result for a button press in a frame (lef = left frame, mid = middle frame (up))
resbutlefstr=""
resbutmidstr=""
resbutbotstr=""
reskeylef=0
reskeymid=0
reskeybot=0
'=== all the chek to be made in first page (1 at the moment, since ready have many values)
nbrbut=UBound(arabutnam, 1)
redim buttag(nbrbut)
form = "flef"
flef.WriteLn("<html><body>")
flef.WriteLn("<body background=""" & basedir & "images_interface\fond_gauche.jpg"">")
flef.WriteLn("<h3><span class=SpellE>" & maitit & "</span></h3>")
flef.WriteLn("<form name='form1'>")
'(1) Where you want the image to appear: <span id="image"></span>
'(2) Get a reference to it: var e = document.getElementById('image');
'(3) Insert the img HTML code into the span: e.innerHTML = '<img src="./images/your_picture.jpg" />';
'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
