unattended windows 10 usb installation français Canada
2017-07-29
autounattend.xml script generation
http://wildboy85.blogspot.ca/2017/07/autounattend-xml-file-generation-with.html
powershell script to remove unwanted apps (for work computers)
http://wildboy85.blogspot.ca/2017/07/powershell-script-to-clean-unwanted.html
2017-07-27 9:50
Changed for usb key to boot BIOS and UEFI
1. This should generate a windows 10 build 1703, without patches (4 + 1 for defender at this date)
2. Make a usb key with MediaCreationTool.exe from microsoft
https://www.microsoft.com/en-ca/software-download/windows10
3. Copy the content of the usb key created by MediaCreationTool in c:\win10una1703frapro_work
4. Assume usb key is Z:
5. Assume C:\win10una1703frapro_work\sources\$oem$\$1 is where you keep the personalized files for your windows installation (the files autounattend.xml use during installation)
6. Copy C:\win10una1703frapro_work\sources\$oem$\$1 to Z:\sources\$oem$\$1
7. Copy C:\win10una1703frapro_work\autounattend.xml to Z:\
8. Use DISM to integrate the latest patches in the install.wim file:
C:\win10una1703frapro_work\sources\install.wim
9. Split the install.wim with DISM if it is bigger that 4 gig
10. If you use a splitted file for windows image:
Delete C:\win10una1703frapro_work\sources\install.wim
Copy your splitted files in C:\win10una1703frapro_work\sources\
11. Copy mirror purge C:\win10una1703frapro_work\ to Z: with robocopy
12. The key will not wipe disk 0 automatically anymore (UEFI prevent that automation)
So if "willwipedisk" if in your autounattend filoe, remove it
13. The image from microsoft will contain 3 windows versions, use the image index to select pro version (index 1 is pro)
14. The key should work fine (tested in BIOS and UEFI, secureboot off)
15. i Also programmed a autounattend.xml generator (in vbs) for the sequence of synchronous command to be... sequential, and cleaner
2016-12-31 22:19
java runtime update (jre)
google chrome 64 bits update
k-lite codec update
privacy setting added in a .bat
no usb indexing added in policies (by reg key)
control pannel classic display
Hi,
Here is a usb unattended installation of windows 10 pro french Canada
Voici l'installation sans attention (pas besoin de cliquer) de windows 10 professionnel français Canada
1.
This usb key will WIPE disk 0 (connector 0 on the main board)
2.
Not working on EFI bios installation aka secure boot (failed to create partition 0)
3.
It will install avast antivirus and office 2013 and acrobat reader or pro etc.
4.
There is no drivers automated in it, since updating drivers online is working fine with windows 10
5.
Put this unattend file in the root of a usb key that contain windows 10 dvd content
Acrobat did not want to install on first pass, I had to do it after a reboot
All folder from usb key in this folder:
\sources\$oem$\$1\
Are copied on c:\ by windows
The BAT file running after first reboot is:
c:\_updates\phase02_acrobat_pro.bat
The phase02*.bat will then write in registry the next .BAT to run after next reboot
------ c:\_updates\phase02.bat (originally in sources\$oem$\$1\_updates directory on key) -------
rem === acrobat reader after reboot installation
c:
cd c:\_appsall\acrobat_reader_adobe
for /F %%A in ('dir /b *.exe') do start /wait %%A /sPB /rs
reg add HKLM\Software\Microsoft\Windows\CurrentVersion\RunOnce /v NewSetupScript /t Reg_SZ /d "c:\_updates\phase03.bat" /f
---------------------- end of file ---------------------
-------------------------- phase03.bat ---------------------------
cmd.exe /c c:\_appsmaison\antivirus\avast_free_antivirus_setup.exe /silent /NORESTART /SP- /"Chrome"="false"
rem clean desktop
del "C:\Users\Public\Desktop\Avast SafeZone Browser.lnk"
del "C:\Users\Public\Desktop\Avast Antivirus Gratuit.lnk"
reg add HKLM\Software\Microsoft\Windows\CurrentVersion\RunOnce /v NewSetupScript /t Reg_SZ /d "c:\_updates\phase05_privacy.bat" /f
rem reboot
Shutdown /r /t 30
---------------------- end of file ---------------------
-------------------- autounattend.xml ----------------------------
<?xml version="1.0" encoding="UTF-8"?>
-<unattend xmlns="urn:schemas-microsoft-com:unattend">
-<settings pass="windowsPE">
-<component language="neutral" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:wcm="http://schemas.microsoft.com/WMIConfig/2002/State" versionScope="nonSxS" publicKeyToken="31bf3856ad364e35" processorArchitecture="amd64" name="Microsoft-Windows-International-Core-WinPE">
-<SetupUILanguage>
<UILanguage>fr-FR</UILanguage>
</SetupUILanguage>
<InputLocale>0c0c:00001009</InputLocale>
<SystemLocale>fr-FR</SystemLocale>
<UILanguage>fr-FR</UILanguage>
<UILanguageFallback>fr-FR</UILanguageFallback>
<UserLocale>fr-CA</UserLocale>
</component>
-<component language="neutral" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:wcm="http://schemas.microsoft.com/WMIConfig/2002/State" versionScope="nonSxS" publicKeyToken="31bf3856ad364e35" processorArchitecture="amd64" name="Microsoft-Windows-Setup">
-<ImageInstall>
-<OSImage>
-<InstallFrom>
-<MetaData wcm:action="add">
<Value>1</Value>
<key>/IMAGE/INDEX</key>
</MetaData>
</InstallFrom>
<InstallToAvailablePartition>false</InstallToAvailablePartition>
<WillShowUI>OnError</WillShowUI>
</OSImage>
</ImageInstall>
-<UserData>
<AcceptEula>true</AcceptEula>
<FullName>Maison</FullName>
-<ProductKey>
<Key>W269N-WFGWX-YVC9B-4J6C9-T83GX</Key>
</ProductKey>
</UserData>
<EnableFirewall>true</EnableFirewall>
</component>
</settings>
-<settings pass="offlineServicing">
-<component language="neutral" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:wcm="http://schemas.microsoft.com/WMIConfig/2002/State" versionScope="nonSxS" publicKeyToken="31bf3856ad364e35" processorArchitecture="amd64" name="Microsoft-Windows-LUA-Settings">
<EnableLUA>false</EnableLUA>
</component>
</settings>
-<settings pass="generalize">
-<component language="neutral" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:wcm="http://schemas.microsoft.com/WMIConfig/2002/State" versionScope="nonSxS" publicKeyToken="31bf3856ad364e35" processorArchitecture="amd64" name="Microsoft-Windows-Security-SPP">
<SkipRearm>1</SkipRearm>
</component>
</settings>
-<settings pass="specialize">
-<component language="neutral" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:wcm="http://schemas.microsoft.com/WMIConfig/2002/State" versionScope="nonSxS" publicKeyToken="31bf3856ad364e35" processorArchitecture="amd64" name="Microsoft-Windows-International-Core">
<InputLocale>0c0c:00001009</InputLocale>
<SystemLocale>fr-CA</SystemLocale>
<UILanguage>fr-CA</UILanguage>
<UILanguageFallback>fr-CA</UILanguageFallback>
<UserLocale>fr-CA</UserLocale>
</component>
-<component language="neutral" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:wcm="http://schemas.microsoft.com/WMIConfig/2002/State" versionScope="nonSxS" publicKeyToken="31bf3856ad364e35" processorArchitecture="amd64" name="Microsoft-Windows-Security-SPP-UX">
<SkipAutoActivation>true</SkipAutoActivation>
</component>
-<component language="neutral" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:wcm="http://schemas.microsoft.com/WMIConfig/2002/State" versionScope="nonSxS" publicKeyToken="31bf3856ad364e35" processorArchitecture="amd64" name="Microsoft-Windows-SQMApi">
<CEIPEnabled>0</CEIPEnabled>
</component>
-<component language="neutral" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:wcm="http://schemas.microsoft.com/WMIConfig/2002/State" versionScope="nonSxS" publicKeyToken="31bf3856ad364e35" processorArchitecture="amd64" name="Microsoft-Windows-Shell-Setup">
<ProductKey>W269N-WFGWX-YVC9B-4J6C9-T83GX</ProductKey>
</component>
</settings>
-<settings pass="oobeSystem">
-<component language="neutral" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:wcm="http://schemas.microsoft.com/WMIConfig/2002/State" versionScope="nonSxS" publicKeyToken="31bf3856ad364e35" processorArchitecture="amd64" name="Microsoft-Windows-Shell-Setup">
-<AutoLogon>
-<Password>
<Value/>
<PlainText>true</PlainText>
</Password>
<Enabled>true</Enabled>
<Username>Maison</Username>
</AutoLogon>
-<OOBE>
<HideEULAPage>true</HideEULAPage>
<HideOEMRegistrationScreen>true</HideOEMRegistrationScreen>
<HideOnlineAccountScreens>true</HideOnlineAccountScreens>
<HideWirelessSetupInOOBE>true</HideWirelessSetupInOOBE>
<NetworkLocation>Home</NetworkLocation>
<SkipUserOOBE>true</SkipUserOOBE>
<SkipMachineOOBE>true</SkipMachineOOBE>
<ProtectYourPC>2</ProtectYourPC>
</OOBE>
-<UserAccounts>
-<LocalAccounts>
-<LocalAccount wcm:action="add">
-<Password>
<Value/>
<PlainText>true</PlainText>
</Password>
<Description>Utilisateuradmin</Description>
<DisplayName>Maison</DisplayName>
<Group>Administrators</Group>
<Name>Maison</Name>
</LocalAccount>
</LocalAccounts>
</UserAccounts>
<DisableAutoDaylightTimeSet>false</DisableAutoDaylightTimeSet>
-<FirstLogonCommands>
-<SynchronousCommand wcm:action="add">
<Description>klite and media classic player any version</Description>
<Order>1</Order>
<CommandLine>cmd /c c:\_appsall\7zip\commandline.bat</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>explorer open in this PC</Description>
<Order>2</Order>
<CommandLine>REG ADD "HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Advanced" /v LaunchTo /t REG_DWORD /d 1 /f</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>java</Description>
<Order>3</Order>
<CommandLine>cmd /c c:\_appsall\java_sun\commandline.bat</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>video codec and media player classic</Description>
<Order>4</Order>
<CommandLine>cmd /c c:\_appsall\video_codecs_convert\commandline.bat</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>vcredist</Description>
<Order>5</Order>
<CommandLine>cmd.exe /c "c:\_appsall\vcredist2010sp1\vcredist_x86.exe" /q /norestart</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>vcredist</Description>
<Order>6</Order>
<CommandLine>cmd.exe /c "c:\_appsall\vcredist2010sp1\vcredist_x64.exe" /q /norestart</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>vcredist</Description>
<Order>7</Order>
<CommandLine>cmd.exe /c "c:\_appsall\vcredist2012upd4\vcredist_x86.exe" /q /norestart</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>vcredist</Description>
<Order>8</Order>
<CommandLine>cmd.exe /c "c:\_appsall\vcredist2012upd4\vcredist_x64.exe" /q /norestart</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>vcredist</Description>
<Order>9</Order>
<CommandLine>cmd.exe /c "c:\_appsall\vcredist2013\vcredist_x64.exe" /q /norestart</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>vcredist</Description>
<Order>10</Order>
<CommandLine>cmd.exe /c "c:\_appsall\vcredist2013\vcredist_x86.exe" /q /norestart</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>vcredist</Description>
<Order>11</Order>
<CommandLine>cmd.exe /c "c:\_appsall\vcredist2015\vc_redist.x86.exe" /q /norestart</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>vcredist</Description>
<Order>12</Order>
<CommandLine>cmd.exe /c "c:\_appsall\vcredist2015\vc_redist.x64.exe" /q /norestart</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>vcredist 2017</Description>
<Order>13</Order>
<CommandLine>cmd.exe /c "c:\_appsall\vcredist2017\vc_redist.x64.exe" /q /norestart</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>removable drive index</Description>
<Order>14</Order>
<CommandLine>cmd /c reg add "HKLM\Software\Policies\Microsoft\Windows\Windows Search" /v DisableRemovableDriveIndexing /t REG_DWORD /d 1 /f</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>chrome 64</Description>
<Order>15</Order>
<CommandLine>cmd /c c:\_appsall\chrome\chromeStandaloneSetup64.exe /silent /install</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>defender patch</Description>
<Order>16</Order>
<CommandLine>cmd /c c:\_updates\defender\commandline.bat</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>drivers search path c drivers</Description>
<Order>17</Order>
<CommandLine>cmd /c reg add "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion" /v DevicePath /t REG_EXPAND_SZ /d %SystemRoot%\inf;c:\_drivers /f</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>blue screen crash reboot</Description>
<Order>18</Order>
<CommandLine>cmd /c reg add "HKLM\SYSTEM\CurrentControlSet\Control\CrashControl" /v AutoReboot /t REG_DWORD /d 0 /f</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>blue screen crash</Description>
<Order>19</Order>
<CommandLine>cmd /c reg add "HKLM\SYSTEM\CurrentControlSet\Control\CrashControl" /v AUState /t REG_DWORD /d 1 /f</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>windows update</Description>
<Order>20</Order>
<CommandLine>cmd /c reg add "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\WindowsUpdate\Auto Update" /v AUOptions /t REG_DWORD /d 1 /f</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>notepad2 vbs edit</Description>
<Order>21</Order>
<CommandLine>cmd /c reg add "HKLM\SOFTWARE\Classes\VBSFile\Shell\Edit\command" /v "" /t REG_SZ /d "C:\WINDOWS\System32\Notepad2.exe %1" /f</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>notepad2 edit</Description>
<Order>22</Order>
<CommandLine>cmd /c reg add "HKLM\SOFTWARE\Classes\txtFile\Shell\Edit\command" /v "" /t REG_SZ /d "C:\WINDOWS\System32\Notepad2.exe %1" /f</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>notepad2 edit</Description>
<Order>23</Order>
<CommandLine>cmd /c reg add "HKLM\SOFTWARE\Classes\batFile\Shell\Edit\command" /v "" /t REG_SZ /d "C:\WINDOWS\System32\Notepad2.exe %1" /f</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>notepad2 edit</Description>
<Order>24</Order>
<CommandLine>cmd /c reg add "HKLM\SOFTWARE\Classes\regFile\Shell\Edit\command" /v "" /t REG_SZ /d "C:\WINDOWS\System32\Notepad2.exe %1" /f</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>notepad2 edit</Description>
<Order>25</Order>
<CommandLine>cmd /c reg add "HKLM\SOFTWARE\Classes\cmdFile\Shell\Edit\command" /v "" /t REG_SZ /d "C:\WINDOWS\System32\Notepad2.exe %1" /f</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>notepad2 edit</Description>
<Order>26</Order>
<CommandLine>cmd /c reg add "HKLM\SOFTWARE\Classes\xmlFile\Shell\Edit\command" /v "" /t REG_SZ /d "C:\WINDOWS\System32\Notepad2.exe %1" /f</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>notepad2 edit</Description>
<Order>27</Order>
<CommandLine>cmd /c reg add "HKLM\SOFTWARE\Classes\logfile\Shell\Edit\command" /v "" /t REG_SZ /d "C:\WINDOWS\System32\Notepad2.exe %1" /f</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>notification off</Description>
<Order>28</Order>
<CommandLine>cmd /c reg add "HKCU\Software\Policies\Microsoft\Windows\Explorer" /v DisableNotificationCenter /t REG_DWORD /d 1 /f</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>iexplore dont ask for info retention</Description>
<Order>29</Order>
<CommandLine>cmd /c reg add "HKCU\Software\Microsoft\Internet Explorer\IntelliForms" /v AskUser /t REG_DWORD /d 0 /f</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>classic panel</Description>
<Order>30</Order>
<CommandLine>cmd /c reg add "HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer" /v ForceClassicControlPanel /t REG_DWORD /d 1 /f</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>explorer classi view</Description>
<Order>31</Order>
<CommandLine>cmd /c reg add "HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced" /v ClassicViewState /t REG_DWORD /d 1 /f</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>explorer webview off</Description>
<Order>32</Order>
<CommandLine>cmd /c reg add "HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced" /v WebView /t REG_DWORD /d 0 /f</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>hide icons</Description>
<Order>33</Order>
<CommandLine>cmd /c reg add "HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced" /v HideIcons /t REG_DWORD /d 0 /f</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>show hidden files</Description>
<Order>34</Order>
<CommandLine>cmd /c reg add "HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced" /v Hidden /t REG_DWORD /d 1 /f</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>show all icon taskbar</Description>
<Order>35</Order>
<CommandLine>cmd /c reg add "HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced" /v TaskbarGlomming /t REG_DWORD /d 0 /f</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>taskbar change size</Description>
<Order>36</Order>
<CommandLine>cmd /c reg add "HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced" /v TaskbarSizeMove /t REG_DWORD /d 1 /f</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>task bar dont group icons</Description>
<Order>37</Order>
<CommandLine>cmd /c reg add "HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced" /v TaskbarGlomLevel /t REG_DWORD /d 2 /f</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>explorer shell state</Description>
<Order>38</Order>
<CommandLine>cmd /c reg add "HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer" /v ShellState /t REG_BINARY /d 2400000033080000000000000000000000000000010000000d0000000000000000000000 /f</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>no icone on shortcut maybe</Description>
<Order>39</Order>
<CommandLine>cmd /c reg add "HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer" /v IconUnderline /t REG_BINARY /d 030000 /f</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>dont hide right side icons</Description>
<Order>40</Order>
<CommandLine>cmd /c reg add "HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer" /v EnableAutoTray /t REG_DWORD /d 0 /f</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>Control Panel View</Description>
<Order>41</Order>
<CommandLine>reg add "HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\ControlPanel" /v StartupPage /t REG_DWORD /d 1 /f</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>Control Panel Icon Size type</Description>
<Order>42</Order>
<CommandLine>reg add "HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\ControlPanel" /v AllItemsIconView /t REG_DWORD /d 1 /f</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>explorer dont hide file extensions</Description>
<Order>43</Order>
<CommandLine>cmd /c reg add "HKCU\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Advanced" /v HideFileExt /t REG_DWORD /d 0 /f</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>explorer classic view state</Description>
<Order>44</Order>
<CommandLine>cmd /c reg add "HKCU\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Advanced" /v ClassicViewState /t REG_DWORD /d 1 /f</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>media player privacy statement</Description>
<Order>45</Order>
<CommandLine>cmd /c reg add "HKCU\Software\Microsoft\MediaPlayer\Preferences" /v AcceptedPrivacyStatement /t REG_DWORD /d 1 /f</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>media player</Description>
<Order>46</Order>
<CommandLine>cmd /c reg add "HKCU\Software\Microsoft\MediaPlayer\Preferences" /v FirstRun /t REG_DWORD /d 0 /f</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>iexplore runonce done</Description>
<Order>47</Order>
<CommandLine>cmd /c reg add "HKCU\Software\Microsoft\Internet Explorer\Main" /v RunOnceHasShown /t REG_DWORD /d 1 /f</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>iexplore runonce done</Description>
<Order>48</Order>
<CommandLine>cmd /c reg add "HKCU\Software\Microsoft\Internet Explorer\Main" /v RunOnceComplete /t REG_DWORD /d 1 /f</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>screenhunter</Description>
<Order>49</Order>
<CommandLine>msiexec /i c:\_appsall\screenhunterfree_prt_scr\setupscreenhunterfree.msi /quiet</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>klite and media classic player any version</Description>
<Order>50</Order>
<CommandLine>cmd /c c:\_appsall\video_codecs_convert\commandline.bat</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>java 23 and 64 any version</Description>
<Order>51</Order>
<CommandLine>cmd /c c:\_appsall\java_sun\commandline.bat</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>skype</Description>
<Order>52</Order>
<CommandLine>cmd /c c:\_appsall\skype\Skype_silent.exe</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>office 2013</Description>
<Order>53</Order>
<CommandLine>c:\_appsmaison\microsoft_office_2013_64_fra_files\setup.exe /adminfile office2013unattend.MSP</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>flash player</Description>
<Order>54</Order>
<CommandLine>msiexec.exe /i "C:\_appsall\flashplayer\install_flash_player_20_active_x.msi" /qn</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>flash player plugin</Description>
<Order>55</Order>
<CommandLine>msiexec.exe /i "C:\_appsall\flashplayer\install_flash_player_20_plugin.msi" /qn</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>administrateur account not expire after 3 months</Description>
<Order>56</Order>
<CommandLine>cmd.exe /c wmic useraccount where "name='administrateur'" set PasswordExpires=FALSE</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>utilisateur account not expire after 3 months</Description>
<Order>57</Order>
<CommandLine>cmd.exe /c wmic useraccount where "name='utilisateur'" set PasswordExpires=FALSE</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>install firefox</Description>
<Order>58</Order>
<CommandLine>cmd.exe /c "c:\_appsall\firefox\Firefox Setup 43.0.2.exe" -ms</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>mysql odbc connector 32</Description>
<Order>59</Order>
<CommandLine>msiexec /i c:\_appsall\MysqlOdbcConnector\mysql-connector-odbc-5.3.4-win32.msi /quiet</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>mysql odbc connector 64</Description>
<Order>60</Order>
<CommandLine>msiexec /i c:\_appsall\MysqlOdbcConnector\mysql-connector-odbc-5.3.4-winx64.msi /quiet</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>acrobat reader eula accepted</Description>
<Order>61</Order>
<CommandLine>cmd /c reg add "HKCU\SOFTWARE\Adobe\Acrobat Reader\11.0\AdobeViewer" /v EULA /t REG_DWORD /d 1 /f</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>todo folder on desktop</Description>
<Order>62</Order>
<CommandLine>cmd /c mkdir "%USERPROFILE%\desktop\A Faire - ToDo\"</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>activation office 2013 et win10</Description>
<Order>63</Order>
<CommandLine>cmd /c c:\_util\shortcut\Shortcut.exe /f:"%USERPROFILE%\Desktop\A Faire - ToDo\activate windows 10 and office 2013.lnk" /a:c /t:"C:\_appsmaison\microsoft_office_2013_64_fra_files\_activation_off2013_fra\KMSAuto Net 2014 v1.3.4 Portable\KMSAuto Net.exe"</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>avast registration</Description>
<Order>64</Order>
<CommandLine>cmd /c c:\_util\shortcut\Shortcut.exe /f:"%USERPROFILE%\Desktop\A Faire - ToDo\register avast antivirus free.lnk" /a:c /t:"C:\Program Files\AVAST Software\Avast\avastui.exe"</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>tweaks windows</Description>
<Order>65</Order>
<CommandLine>cmd /c c:\_util\shortcut\Shortcut.exe /f:"%USERPROFILE%\Desktop\A Faire - ToDo\Tweaks (setup profile).lnk" /a:c /t:"c:\_appsall\_01_tweaks.reg"</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>malwarebyte setup</Description>
<Order>66</Order>
<CommandLine>cmd /c c:\_util\shortcut\Shortcut.exe /f:"%USERPROFILE%\Desktop\A Faire - ToDo\Malwarebyte Setup.lnk" /a:c /t:"c:\_appsall\malwarebyte\mbam-setup-2.2.1.1043.exe"</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>spyware blaster setup</Description>
<Order>67</Order>
<CommandLine>cmd /c c:\_util\shortcut\Shortcut.exe /f:"%USERPROFILE%\Desktop\A Faire - ToDo\spywareblaster54 setup.lnk" /a:c /t:"c:\_appsall\spywareblaster\spywareblastersetup54.exe"</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>virtual drive setup</Description>
<Order>68</Order>
<CommandLine>cmd /c c:\_util\shortcut\Shortcut.exe /f:"%USERPROFILE%\Desktop\A Faire - ToDo\virtualclonedrive setup.lnk" /a:c /t:"c:\_appsall\virtualclonedrive\SetupVirtualCloneDrive5470.exe"</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>imgburn graveur program setup</Description>
<Order>69</Order>
<CommandLine>cmd /c c:\_util\shortcut\Shortcut.exe /f:"%USERPROFILE%\Desktop\A Faire - ToDo\imageburn graveur dvd setup.lnk" /a:c /t:"c:\_appsall\imageburn\SetupImgBurn_2.5.7.0.exe"</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>verification montage poste maison</Description>
<Order>70</Order>
<CommandLine>cmd /c c:\_util\shortcut\Shortcut.exe /f:"%USERPROFILE%\Desktop\A Faire - ToDo\verification_montage_poste_maison.lnk" /a:c /t:"c:\_util\installation\verification_montage_poste_maison.vbs"</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>steam setup</Description>
<Order>71</Order>
<CommandLine>cmd /c c:\_util\shortcut\Shortcut.exe /f:"%USERPROFILE%\Desktop\A Faire - ToDo\Steam for games.lnk" /a:c /t:"c:\_appsmaison\steam_installer\SteamSetup.exe"</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>torrent setup</Description>
<Order>72</Order>
<CommandLine>cmd /c c:\_util\shortcut\Shortcut.exe /f:"%USERPROFILE%\Desktop\A Faire - ToDo\Qbitorrent for torrents.lnk" /a:c /t:"c:\_appsmaison\torrent_client\qbittorrent_3.3.10_setup.exe"</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>opera web browser setup</Description>
<Order>73</Order>
<CommandLine>cmd /c c:\_util\shortcut\Shortcut.exe /f:"%USERPROFILE%\Desktop\A Faire - ToDo\Opera internet browser for 3d flash games.lnk" /a:c /t:"c:\_appsall\opera\Opera_42.0.2393.94_Setup.exe"</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>powerdvd setup</Description>
<Order>74</Order>
<CommandLine>cmd /c c:\_util\shortcut\Shortcut.exe /f:"%USERPROFILE%\Desktop\A Faire - ToDo\powerDVD for bluerays movies.lnk" /a:c /t:"c:\_appsmaison\powerdvd\Setup.exe"</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>teamviewer setup</Description>
<Order>75</Order>
<CommandLine>cmd /c c:\_util\shortcut\Shortcut.exe /f:"%USERPROFILE%\Desktop\A Faire - ToDo\Teamviewer pour controle a distance.lnk" /a:c /t:"c:\_util\teamviewer\TeamViewer_Setup_fr-aiiz.exe"</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>power always on</Description>
<Order>76</Order>
<CommandLine>cmd /c c:\_util\shortcut\Shortcut.exe /f:"%USERPROFILE%\Desktop\A Faire - ToDo\Power management jamaisoff run as admin.lnk" /a:c /t:"c:\_appsall\power.bat"</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>vision viewer</Description>
<Order>77</Order>
<CommandLine>cmd /c c:\_util\shortcut\Shortcut.exe /f:"%USERPROFILE%\Desktop\A Faire - ToDo\Visio viewer.lnk" /a:c /t:"c:\_appsall\visio_viewer\vsdviewer.exe"</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>video drivers intel</Description>
<Order>78</Order>
<CommandLine>cmd /c c:\_util\shortcut\Shortcut.exe /f:"%USERPROFILE%\Desktop\A Faire - ToDo\Video driver intel.lnk" /a:c /t:"c:\_drivers_manual\video\win64_154510.4542.exe</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>video drivers nvidia</Description>
<Order>79</Order>
<CommandLine>cmd /c c:\_util\shortcut\Shortcut.exe /f:"%USERPROFILE%\Desktop\A Faire - ToDo\Video driver Nvidia.lnk" /a:c /t:"c:\_drivers_manual\video\"</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>amd radeon drivers</Description>
<Order>80</Order>
<CommandLine>cmd /c c:\_util\shortcut\Shortcut.exe /f:"%USERPROFILE%\Desktop\A Faire - ToDo\Video driver AMD.lnk" /a:c /t:"c:\_drivers_manual\video\non-whql-win10-64bit-radeon-software-crimson-relive-16.12.2-dec19.exe"</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>power 2 hours</Description>
<Order>81</Order>
<CommandLine>cmd /c c:\_util\shortcut\Shortcut.exe /f:"%USERPROFILE%\Desktop\A Faire - ToDo\Power management 2 hours run as admin.lnk" /a:c /t:"c:\_appsall\power_2hours.bat"</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>vlc video player</Description>
<Order>82</Order>
<CommandLine>cmd /c c:\_util\shortcut\Shortcut.exe /f:"%USERPROFILE%\Desktop\A Faire - ToDo\VLC video player 2016-12-31.lnk" /a:c /t:"c:\_appsall\video_vlc_player\vlc-2.2.4-win32.exe"</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>execute command after first reboot</Description>
<Order>83</Order>
<CommandLine>reg add HKLM\Software\Microsoft\Windows\CurrentVersion\RunOnce /v NewSetupScript /t Reg_SZ /d "c:\_updates\phase103.bat" /f</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
-<SynchronousCommand wcm:action="add">
<Description>restart computer</Description>
<Order>84</Order>
<CommandLine>C:\Windows\System32\shutdown.exe /r /t 120</CommandLine>
<RequiresUserInput>false</RequiresUserInput>
</SynchronousCommand>
</FirstLogonCommands>
<TimeZone>Eastern Standard Time</TimeZone>
</component>
</settings>
</unattend>
Friday, December 30, 2016
Wednesday, December 7, 2016
ribbon generation in excel
Hello,
I wanted to generate a nice ribbon in excel with just VBA.
I like jagged / nested arrays.
Si here is my code to generate a ribbon in excel in vba:
It generate only one tab of a personalized ribbon called "Tables et dessins"
This tab contain id, name and groups (array)
These groups contains id, name and buttons (array)
These buttons contain id, label, on action (sub to execute when pressed), color (or image)
After executing the sub LoadCustRibbon2, you must restart excel for the ribbon to appear cause excel need to load the file.
--------------------- code excel 2010 or 2013 VBA 64 bits ----------------------
'=== ajout boutons
Sub LoadCustRibbon2()
'http://stackoverflow.com/questions/8850836/how-to-add-a-custom-ribbon-tab-using-vba
Dim hFile As Long
Dim path As String, fileName As String, ribbonXML As String, user As String
'=== location of the custom ribbon file in the user profile
hFile = FreeFile
user = Environ("Username")
path = "C:\Users\" & user & "\AppData\Local\Microsoft\Office\"
fileName = "Excel.officeUI"
'=== id, label, on action, color
buttons0000 = Array("rearrangetable", "Ajuster la table sur cette feuille", "autofit_table_data", "AppointmentColor2")
'=== id, label
groups00 = Array("Tables", "Tables", buttons0000)
'=== id, label, on action, color
buttons0100 = Array("addthistodrawing", "Ajouter la selection a la feuille Donnees_Dessin", "add_line_in_drawings", "AppointmentColor3")
buttons0101 = Array("drawgeomaticgrid", "Dessiner sur la feuille Dessin les donnees dans Donnees_Dessin", "geo_grid_generation", "AppointmentColor4")
'=== id, label
groups01 = Array("Dessin", "Dessin", buttons0100, buttons0101)
'=== id, label, on action, color
buttons0200 = Array("generatesheets", "Genere feuille pour chaque ligne avec hyperlien", "sheet_generation", "AppointmentColor5")
groups02 = Array("Feuilles", "Feuilles", buttons0200)
'=== id, label
tabs01 = Array("TablesandDrawing", "Tables et Dessins", groups00, groups01, groups02)
'=== data
ribbonXML = "
ribbonXML = ribbonXML + "
ribbonXML = ribbonXML + "
ribbonXML = ribbonXML + "
ribbonXML = ribbonXML + "
For grocnt01 = 2 To UBound(tabs01) '=== elements 2 and more are arrays
group01 = tabs01(grocnt01)
ribbonXML = ribbonXML + "
For butcnt01 = 2 To UBound(group01) '=== elements 2 and more are arrays
button01 = group01(butcnt01)
ribbonXML = ribbonXML + "
ribbonXML = ribbonXML + "imageMso='" & button01(3) & "' onAction='" & button01(2) & "'/>" & vbNewLine
Next 'butcnt01
ribbonXML = ribbonXML + "
Next 'grocnt01
ribbonXML = ribbonXML + "
" & vbNewLine
ribbonXML = ribbonXML + "
" & vbNewLine ribbonXML = ribbonXML + "
" & vbNewLine ribbonXML = ribbonXML + "
"
ribbonXML = Replace(ribbonXML, """", "")
test = 0
If test = 0 Then
Open path & fileName For Output Access Write As hFile
Print #hFile, ribbonXML
Close hFile
Else
MsgBox (ribbonXML)
End If
End Sub
Saturday, April 30, 2016
remote domain ldap computer scan, program installation, group listing
Hello,
In a domain
When logged as admin of the domain
You can use WMI (windows management interface) to do a lot of things
Force execution of a local program on the remote computer
(cannot remotly execute a program that will execute a remote program, that would spread viruses)
List all computer of the domaine root
List and query the computer for some information
I use this script to remote install visual c redistribuable 2010
(must be copied on the c drive of the computer first)
Then install an ODBC mysql connector
(must be copied on the c drive of the computer first)
Then i copy on the computer a script to do an inventory in a mysql database
Then i remote execute the script to get the computer data in the inventory
(must be copied on the c drive of the computer first)
But here, i only list the program to list computers, list groups or remote execute a local program on a computer (with 3 different syntax)
example:
process01 = "c:\windows\system32\cscript.exe"
'argument01 = """\\hyntssr5\apps$\Apps\windows 7 sp1 fra pro unattend\sources\$oem$\$1\_util\inventaire\audit_v0804_v4 hyd.vbs"""
argument01 = """C:\_util\inventaire\audit_v0804_v4 hyd.vbs"""
'process01 = "cmd.exe /c"
'argument01 = """c:\_util\MysqlOdbcConnector\vcredist_x86.exe /q /norestart"""
'process01 = "msiexec.exe"
'argument01 = "/i c:\_util\MysqlOdbcConnector\mysql-connector-odbc-5.3.4-win32.msi /quiet"
================ ldap.vbs ==================================
'=== Ultimate dynamic web interface 2.0
'=== this script:
'=== generate dynamically a web interface to manage virtually anything
'=== control (left frame), input (middle frame), and output (bottom frame) from vbs/wsh (windows host scripts)
'=== the first version was a simple interface made by a programmer
'=== the second version have more explanations
'=== more dynamism than ever
'=== more functions to clean up main loop code
'=== easier array display coding to add stuff more easily
'=== MDB (access type database) management (creation, edition, search/edit)
'=== futur: mdb import, mdb export, sql sync, excel export
'=== by: SergeFournier(at)hotmail.com
'=== tested on windows vista 64, internet explorer 7
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objshe = CreateObject("WScript.Shell")
Set objNet = CreateObject("WScript.Network")
Const hkcr = &H80000000 'HKEY_CLASSES_ROOT
Const HKCU = &H80000001 'HKEY_CURRENT_USER
Const hklm = &H80000002 'HKEY_LOCAL_MACHINE
Const hku = &H80000003 'HKEY_USERS
Const hkcc = &H80000005 'HKEY_CURRENT_CONFIG
dim allara(10,10)
dim alltab(10)
DIM ordcol(10,10)
'=== for ldap
dim strInputPath, strOutputPath, strStatus
dim objFSO, objTextIn, objTextOut
'=== actual drive, actual directory, and "\"
thepath=WScript.ScriptFullName
p = instrRev(thepath,"\")
basedir = left(thepath,p)
filnam = right(thepath,len(thepath)-p)
'=== windows dir
WinDir = objfso.GetSpecialFolder(0)
'=== restart the script in 32 bits if we are on a 64 bits system
'=== (databases drivers issues)
a64 = windir & "\syswow64\wscript.exe"
if objFSO.fileEXISTS(a64) and instr(lcase(wscript.fullname),"syswow64")=0 then
'=== 64 bits system
a = """" & a64 & """ """ & basedir & filnam & """"
objshe.Run a,0, false
wscript.quit
end if
'=== log everything in a file
logall = 0
'=== edit mode 0=off 1=on
'=== if edtmod = 1 every results will be in editable html boxes
edtmod = 0
totrec = 0
offset = 0
'=== no second search in the lower frame (fbot)
'=== this mean the search button is removed when table is generated
secseatag=0
dim tabnam,aratit,ara01,edtmod,offset,maxoff,myarray,component, strsearch, tab,sel,whe,objcon,tabnam2,ooper,wwild
priara = array(_
"<input type=""button"" onClick=""javascript:print()"" value=""Print""/><br><br>")
lefara = array(_
"<body background=""" & basedir & "images_interface\fond_gauche.jpg"">")
midara = array(_
"<body background=""" & basedir & "images_interface\fond_gris.jpg"">")
botara = array(_
"<body background=""" & basedir & "images_interface\fond_gris.jpg"">")
if logall=1 then
'=== debug log
file02 = basedir & "zzz_troubleshooting.txt"
on error resume next
Set Fil02 = objFSo.OpenTextFile(file02, 2, true)
on error goto 0
end if
'============================================== main loop =============================================
'=== name of the user logged in window (network or not)
usenam=lcase(objnet.username)
'=== maximum row in the grid when more than the max
'=== we display only this number and a button "precedent" and "next" to swtich page
maxoff=15 '=== since 0 is included, 24 = 25 record
'=== menu items on left side (control side, frame: flef)
'= arabutnam: name of button, purely programmation name, used later to execute functions in main loop
'= arabutdes: description of button, text inside it actually
'= aradepnam: departement name, each departement (Section) is separated by a space
'= aradepcol: color of departement, blue = computer, brown = accounting, etc will follow a standard on internet (vague)
'=== button at the start for control frame (flef object)
'=== you can add as many buttons as you want, it's all dynamic (extendable)
if logall=1 then
fil02.WriteLine date & " " & time & " START"
end if
x=0
ReDim Preserve arabutnam(x): ReDim Preserve arabutdes(x): ReDim Preserve aradepnam(x): ReDim Preserve aradepcol(x)
arabutnam(x)="doinventory"
arabutdes(x)="New owner and majinventory"
aradepnam(x)="Inventory"
aradepcol(x)="cccccc"
x=x+1
ReDim Preserve arabutnam(x): ReDim Preserve arabutdes(x): ReDim Preserve aradepnam(x): ReDim Preserve aradepcol(x)
arabutnam(x)="scan"
arabutdes(x)="scan domain computers"
aradepnam(x)="TEST"
aradepcol(x)="cccccc"
x=x+1
ReDim Preserve arabutnam(x): ReDim Preserve arabutdes(x): ReDim Preserve aradepnam(x): ReDim Preserve aradepcol(x)
arabutnam(x)="scangroups"
arabutdes(x)="scan groups and list members"
aradepnam(x)="TEST"
aradepcol(x)="cccccc"
x=x+1
ReDim Preserve arabutnam(x): ReDim Preserve arabutdes(x): ReDim Preserve aradepnam(x): ReDim Preserve aradepcol(x)
arabutnam(x)="clrframes"
arabutdes(x)="Clear Frames"
aradepnam(x)="OTHER"
aradepcol(x)="cccccc"
x=x+1
ReDim Preserve arabutnam(x): ReDim Preserve arabutdes(x): ReDim Preserve aradepnam(x): ReDim Preserve aradepcol(x)
arabutnam(x)="info"
arabutdes(x)="Information/Help"
aradepnam(x)="OTHER"
aradepcol(x)="cccccc"
x=x+1
ReDim Preserve arabutnam(x): ReDim Preserve arabutdes(x): ReDim Preserve aradepnam(x): ReDim Preserve aradepcol(x)
arabutnam(x)="quit01"
arabutdes(x)="Quitter"
aradepnam(x)="All"
aradepcol(x)="cccccc"
'=== old code for ref
'arabut=array("stristas", "striunig", "desarchive", "infocomp", "cretasks", "renamecomputer", "test", "clrframes", "quit01")
'arabutdes=array("Crée Structure i: Stas", "Crée Structure i: Unigec", "Désarchivage", "Info computer", "Create tasks", "Rename computer", "test divers", "Clear Frames", "Quitter")
'aradep=array("All", "All", "Informatique", "Informatique", "Informatique", "Informatique", "Other", "All")
'aradepcol=array("cccccc", "cccccc", "6699ff", "6699ff", "6699ff", "6699ff", "6699ff", "cccccc")
'=== i dont remember this one
lasdep=""
'=== web interface, internet explorer
'=== set the objects before calling functions, so they are global objects/variables, accessibles in all the program
set oIE = wscript.CreateObject("InternetExplorer.Application", "IE_")
dim flef, fmid, fbot
'=== title of internet explorer window
doctit = "titre de la page"
'=== title to display inside the left frame (control frame, flef object)
maitit = "Troubleshooting interface<br><br>STAS 45834"'=== title inside the left frame
maitit="<br><br><br><br>"
'=== create the main web interface with 3 frames, objects: flef, fmid, fbot
a = crewebmai(oie, doctit, maitit, arabutnam, arabutdes, aradepnam, aradepcol)
'=== defaut menu option for certain name logged
'=== example: a certain user will use always the same function
'=== so the interface will start, by executing this function at first, not an empty frame
'=== simply enter the name of the button that should be pressed for this user when interface start
if usenam="wildboy" or usenam="fournier.serge" then
'=== defaut choice when program start
'resbutlefstr = "stristas"
end if
'=== sub to call for each button
'=== here we define a sub to be called when a button in the web page is pressed
Do While (oIE.Busy)
wscript.sleep 50
loop
do while oie.readystate<>4
wscript.sleep 50
loop
'=== set up a return value on click of each button on the left frame
'=== the returned value is the name (programmable name) of each button (arabutnam)
'=== later any action will be taken according to this value
'=== i use this method because i dont want to call a sub when a button is pressed
'=== to remain in a loop for the main program, that is standard procedure in programming (to have a main loop)
for i=0 to ubound(arabutnam)
flef.forms(0).elements(arabutnam(i)).onclick = getref("buttonlef")
next
'=== we also chek the key presse in each frame
'=== we do this cause we want "enter" key to be used instead of pressing "ok" button with the mouse
set flef.onkeypress = GetRef("Checklef")
set fmid.onkeypress = GetRef("Checkmid")
set fbot.onkeypress = GetRef("Checkbot")
'=== if bready = true, it mean they closed internet explorer, see the sub on internet explorer closing later in this code
'=== we have to chek this value often to stop the wscript.exe from interpreting this code, when internet explorer is closed
bReady=false
resbutlefstr = ""
resbutmidstr = ""
resbutbotstr = ""
reskeylef = 0
reskeymid = 0
reskeybot = 0
WScript.sleep(50) ' .1 seconds
'=== main loop, infinite
'=== unless someone press QUIT button
'=== or close internet explorer (bready = true)
SET cmd = CREATEOBJECT("ADODB.Command")
SET cn = CREATEOBJECT("ADODB.Connection")
SET rs = CREATEOBJECT("ADODB.Recordset")
do
if resbutlefstr="doinventory" then
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' change owner name and force inventory
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'=== this was a test with multiple button value (one for each line)
a = clefra(array("fmid","fbot"))
x=0
redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
distmp(x)="New owner name" '===== description displayed in front of the field
namtmp(x)="text01" '===== name of variable for programming purpose
deftmp(x)="dc2 firm db" '===== default value inside the form (the form will be 20 char long if no value here, but you can enter more)
typtmp(x)="textbox" '===== type of data: textbox password (futur: more to come)
errtmp(x)="owner name" '===== text to display after the form "facultatif" blue text "error" red text are special keywords
x=x+1
redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
distmp(x)="Computer name" '===== description displayed in front of the field
namtmp(x)="text02" '===== name of variable for programming purpose
deftmp(x)="hyntssr2" '===== default value inside the form (the form will be 20 char long if no value here, but you can enter more)
typtmp(x)="textbox" '===== type of data: textbox password (futur: more to come)
errtmp(x)="computer name" '===== text to display after the form "facultatif" blue text "error" red text are special keywords
buttmp=array("ok","cancel") '===== at the end, there will be an "ok" button and a "cancel" button
a = dynforgen (distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)
do
'=== flag to tell if the input is not valid
err01=0
'=== flag to say input is done, since there might be a defaut value, we must validate if user was finished
inpdon=0
'=== "ok" button or "enter" key are the same
'=== and nothing was pressed on left frame (control frame)
if resbutlefstr="" and (resbutmidstr="ok" or reskeymid=13) then
'=== User has clicked the OK button, retrieve the values
text01=fmid.form01.text01.Value '=== namtmp is the variable name used earlier,before we call the dynamic form generation for input
text02=fmid.form01.text02.Value '=== namtmp is the variable name used earlier,before we call the dynamic form generation for input
if len(text01) < 1 then
err01=1
'=== error message for the first form (if the keyword "error" is in this string, its displayed in RED)
if len(text01) < 1 then
errtmp(0)="error - must be 1 char long at least"
else
errtmp(0)="ok"
end if
'=== if the value was not good, we generate the dynamic input for again, with an error message after the form in red
a = dynforgen(distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)
'=== there was an invalid input so we reset the key or button pressed to nothing so the loop can continue
reskeymid=0
resbutmidstr=""
else
'=== the input was validated, we flag err01 to none, and flag inpdon to exit the loop
inpdon=1
err01=0
end if
end if
wscript.sleep 100
'=== while we wait for input value, user can press "escape" key, "cancel" button or close internet explorer
if resbutmidstr="cancel" or reskeymid=27 or bready=true or resbutlefstr<>"" then
'=== if user pressed escape or cancel, we clear the frames
if resbutmidstr="cancel" or reskeymid=27 then
a = clefra(array("fmid","fbot"))
resbutmidstr="cancel"
end if
exit do
end if
'=== if there was an input error and no one used left control frame to exit, we keep asking for input
loop while err01<>0 or inpdon=0
'=== if internet explorer was not closed (bready), a button was not pressed on left frame, and no excape or cancel in middle frame
if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
a = clefra(array("fmid","fbot"))
strComputer = text02
value01 = text01
fmid.WriteLn("New owner name: " & value01 & "<br>")
fmid.WriteLn("Computer to scan: " & strComputer & "<br>")
'=== WMI
fbot.WriteLn("Getting acces to WMI on the computer...<br>")
err01 = 0: err02 = ""
on error resume next
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
err01 = err
err02 = err.description
on error goto 0
if err01 = 0 then
'=== last logon name on this computer
Set colItems = objWMIService.ExecQuery("Select * from Win32_ComputerSystem",,48)
fbot.WriteLn("Read owner name...<br>")
For Each objItem in colItems
'net_domain = objItem.Domain
net_user_name = objItem.UserName
system_part_of_domain = objItem.PartOfDomain
system_primary_owner_name = objItem.PrimaryOwnerName
Next
fbot.WriteLn("Owner name before: " & system_primary_owner_name & "<br>")
before01 = net_user_name & vbcrlf & system_primary_owner_name
fbot.WriteLn("Getting remote register base access on: " & strComputer & "...<br>")
err01 = 0: err02 = ""
on error resume next
Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv") '=== base de registre access
err01 = err
err02 = err.description
on error goto 0
if err01 <>0 then
fbot.WriteLn("ERROR cannot get remote register base access on: " & strComputer & "<br>")
end if
fbot.WriteLn("Write owner name in remote register base: " & value01 & "...<br>")
d = regwri("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\RegisteredOwner", value01, "REG_SZ")
'=== last logon name on this computer
Set colItems = objWMIService.ExecQuery("Select * from Win32_ComputerSystem",,48)
For Each objItem in colItems
'net_domain = objItem.Domain
net_user_name = objItem.UserName
system_part_of_domain = objItem.PartOfDomain
system_primary_owner_name = objItem.PrimaryOwnerName
Next
fbot.WriteLn("Owner name after: " & system_primary_owner_name & "<br>")
'=== execute process on remote computer
'a = doprocess(file01,"")
'a = doprocess(sysdir & "\cscript.exe",ser & "\users\audit_v0804_v4.vbs")
process01 = "c:\windows\system32\cscript.exe"
'argument01 = """\\hyntssr5\apps$\Apps\windows 7 sp1 fra pro unattend\sources\$oem$\$1\_util\inventaire\audit_v0804_v4 hyd.vbs"""
argument01 = """C:\_util\inventaire\audit_v0804_v4 hyd.vbs"""
'process01 = "cmd.exe /c"
'argument01 = """c:\_util\MysqlOdbcConnector\vcredist_x86.exe /q /norestart"""
'process01 = "msiexec.exe"
'argument01 = "/i c:\_util\MysqlOdbcConnector\mysql-connector-odbc-5.3.4-win32.msi /quiet"
fbot.WriteLn("<br> Remote executing process and argument:<br>" & process01 & "<br>" & argument01 & "<br>")
a = doprocess(process01, argument01)
fbot.WriteLn("<br>Code returned after remote execution: " & a & "<br>")
'msgbox("before:" & before01 & vbcrlf & "after: " & net_user_name & vbcrlf & system_primary_owner_name)
else
fmid.WriteLn("<br>ERROR opening WMI on target computer<br>")
end if
fbot.WriteLn("<br>FIN<br>")
fmid.WriteLn("<br>FIN<br>")
h = ""
h = h & "</table>"
'fbot.WriteLn(h)
end if
reskeymid=0
resbutmidstr=""
end if
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' scan groups
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
if resbutlefstr="scangroups" then
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' scan users and groups
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'=== this was a test with multiple button value (one for each line)
a = clefra(array("fmid","fbot"))
x=0
redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
distmp(x)="what do you want to display" '===== description displayed in front of the field
namtmp(x)="text01" '===== name of variable for programming purpose
deftmp(x)="hello world" '===== default value inside the form (the form will be 20 char long if no value here, but you can enter more)
typtmp(x)="textbox" '===== type of data: textbox password (futur: more to come)
errtmp(x)="computer name" '===== text to display after the form "facultatif" blue text "error" red text are special keywords
buttmp=array("ok","cancel") '===== at the end, there will be an "ok" button and a "cancel" button
a = dynforgen (distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)
do
'=== flag to tell if the input is not valid
err01=0
'=== flag to say input is done, since there might be a defaut value, we must validate if user was finished
inpdon=0
'=== "ok" button or "enter" key are the same
'=== and nothing was pressed on left frame (control frame)
if resbutlefstr="" and (resbutmidstr="ok" or reskeymid=13) then
'=== User has clicked the OK button, retrieve the values
text=fmid.form01.text01.Value '=== namtmp is the variable name used earlier,before we call the dynamic form generation for input
if len(text) < 1 then
err01=1
'=== error message for the first form (if the keyword "error" is in this string, its displayed in RED)
if len(text) < 1 then
errtmp(0)="error - must be 1 char long at least"
else
errtmp(0)="ok"
end if
'=== if the value was not good, we generate the dynamic input for again, with an error message after the form in red
a = dynforgen(distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)
'=== there was an invalid input so we reset the key or button pressed to nothing so the loop can continue
reskeymid=0
resbutmidstr=""
else
'=== the input was validated, we flag err01 to none, and flag inpdon to exit the loop
inpdon=1
err01=0
end if
end if
wscript.sleep 100
'=== while we wait for input value, user can press "escape" key, "cancel" button or close internet explorer
if resbutmidstr="cancel" or reskeymid=27 or bready=true or resbutlefstr<>"" then
'=== if user pressed escape or cancel, we clear the frames
if resbutmidstr="cancel" or reskeymid=27 then
a = clefra(array("fmid","fbot"))
resbutmidstr="cancel"
end if
exit do
end if
'=== if there was an input error and no one used left control frame to exit, we keep asking for input
loop while err01<>0 or inpdon=0
'=== if internet explorer was not closed (bready), a button was not pressed on left frame, and no excape or cancel in middle frame
if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
a = clefra(array("fmid","fbot"))
cn.open "Provider=ADsDSOObject;"
cmd.activeconnection = cn
fbot.WriteLn("<br>Scanning domain computers")
'fbot.WriteLn("<br>directory where xml file is saved: " & basedir)
'strInputPath = basedir & "\serverlist.txt" '- location of input
'strOutputPath = basedir & "\output.csv" '- location of output
'set objFSO = CreateObject("Scripting.FileSystemObject")
'set objTextIn = objFSO.OpenTextFile( strInputPath,1 )
'set objTextOut = objFSO.CreateTextFile( strOutputPath )
'objTextOut.WriteLine("computer,status")
h = "<table width=""100%"" BORDERCOLOR=""black"" class=MsoTableGrid border=1 CELLSPACING=0 cellpadding=2 style='border-collapse:collapse;border:none'>"
'=== domain root
fbot.WriteLn("<br>Getting domain root...")
SET objRoot = GETOBJECT("LDAP://RootDSE")
'for each propName in objRoot.Properties.PropertyNames
'=== DC=quebecormedia,DC=com
defaultNamingContext01 = objRoot.GET("defaultNamingContext")
fbot.WriteLn("<br>" & objRoot.GET("defaultNamingContext"))
defaultNamingContext01 = defaultNamingContext01 & ",OU=gemel"
'=== Query for all computers in the domain
'description Computer description (in AD)
'distinguishedName DN: OU location of the computer account can be read from here. No wildcard matching possible!
'dNSHostName FQDN
'location Location field
'memberOf Groups the computer account is a member of. No wildcard matching possible!
'name Netbios computer name
'operatingSystem e.g. Windows Server 2003
'operatingSystemServicePack e.g. Service Pack 1
'operatingSystemVersion e.g. 5.2 (3790)
'primaryGroupID 515: Computers
'516: Domain Controllers
'sAMAccountName Computer account name (name$)
'sAMAccountType always 805306369 (computer account)
'servicePrincipalName list of registered SPNs
'=== nice doc on ldap queries
'http://ldapwiki.willeke.com/wiki/Active%20Directory%20Computer%20Related%20LDAP%20Query#section-Active+Directory+Computer+Related+LDAP+Query-FindAllWorkstations
cmd.commandtext = "<LDAP://" & objRoot.GET("defaultNamingContext") & ">;(objectCategory=Group);dnsHostName,distinguishedName,description"
'**** Bypass 1000 record limitation ****
cmd.properties("page size")=1000
fbot.WriteLn("<br>Getting computers...")
SET rs = cmd.EXECUTE
fbot.WriteLn("<br>Looping through computers...")
fbot.WriteLn("<br>")
'=== check all columns in the recordset (debug separator was , not ; )
test=0
if test=1 then
compucnt01 = 0
rs.movefirst
WHILE rs.eof<>true AND rs.bof<>true and compucnt01<1
for each field01 in rs.fields
fbot.WriteLn("<br>Field: " & field01.name)
next
rs.movenext
compucnt01 = compucnt01 + 1
wend
end if
'=== want to see progress live, make talbe now in html frame
fbot.WriteLn(h)
compucnt01 = 0
compucnt02 = 0
rs.movefirst
WHILE rs.eof <> true AND rs.bof <> true
'=== WRTIE A DOT EVERY 20 RECORDS
IF compucnt02/10 = INT(compucnt02/10) THEN fbot.WriteLn(".")
distinguishedName01 = lcase(rs("distinguishedName"))
dnsHostName01 = rs("dnsHostName")
description01 = rs("description")
'fbot.WriteLn("<br>Description is vartype: " & vartype(description01))
'=== is the computer from bloobuzz?
if instr(distinguishedName01, "ou=gemel groupes")<>0 then
'=== bloobuzz total
compucnt01 = compucnt01 + 1
h = ""
h = h & "<tr>" '=== line 1
h = h & "<td>" & compucnt01 & "</td>"
'h = h & "<td>" & dnsHostName01 & "</td>"
h = h & "<td>" & distinguishedName01 & "</td>"
if vartype(description01) = 8204 then
for each des02 in description01
h = h & "<td>" & des02 & "</td>"
next
else
h = h & "<td>" & description01 & "</td>"
end if
'=== go inside each group to list members
strContainer = "cn=TicPriv"
strContainer = left(distinguishedName01,instr(distinguishedName01,",")-1)
wanted01 = strContainer & ", ou=gemel groupes, " & objRoot.GET("defaultNamingContext")
fmid.WriteLn("<br>" & wanted01)
Set objGroup = GetObject("LDAP://" & wanted01 )
objGroup.getInfo
on error resume next
err01 = 0 : err02 = ""
arrMemberOf = objGroup.GetEx("member")
err01 = err
err02 = err.description
on error goto 0
if err01 = 0 then
h = h & "<td>"
for each member01 in arrmemberof
h = h & member01 & "<br>"
next
h = left(h,len(h)-4) '=== remove <br>
h = h & "</td>"
end if
'=== testing
test=0
if test =1 then
cmd.commandtext = "<LDAP://" & objRoot.GET("defaultNamingContext") & ">;(objectCategory=User);dnsHostName,distinguishedName,description"
'**** Bypass 1000 record limitation ****
cmd.properties("page size")=1000
fmid.WriteLn("<br>Getting users...")
SET rs2 = cmd.EXECUTE
if rs2.eof <> true AND rs2.bof <> true then
rs2.movefirst
WHILE rs2.eof <> true AND rs2.bof <> true
distinguishedName02 = lcase(rs2("distinguishedName"))
if instr(lcase(distinguishedName02), "serge fournier")<>0 then
h = h & "<td>rs2: " & distinguishedName02 & "</td>"
else
'fmid.WriteLn("<br>" & distinguishedName02)
end if
rs2.movenext
wend
else
'=== no records / results
'fmid.WriteLn("<br>ERROR - 0 results")
end if
end if
''''''''''''''''''''''''''''
' end of line in table
''''''''''''''''''''''''''''
h = h & "</tr>"
fbot.WriteLn(h)
else
'fbot.WriteLn(distinguishedName01 & " --- " & dnsHostName01 & "<br>")
end if '=== bbz found
compucnt02 = compucnt02 + 1
rs.movenext
wend
fmid.WriteLn("FIN")
h = ""
h = h & "</table>"
fbot.WriteLn(h)
end if
reskeymid=0
resbutmidstr=""
end if
if resbutlefstr="scan" then
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
' scan computers
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
'=== this was a test with multiple button value (one for each line)
a = clefra(array("fmid","fbot"))
x=0
redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
distmp(x)="what do you want to display" '===== description displayed in front of the field
namtmp(x)="text01" '===== name of variable for programming purpose
deftmp(x)="hello world" '===== default value inside the form (the form will be 20 char long if no value here, but you can enter more)
typtmp(x)="textbox" '===== type of data: textbox password (futur: more to come)
errtmp(x)="computer name" '===== text to display after the form "facultatif" blue text "error" red text are special keywords
buttmp=array("ok","cancel") '===== at the end, there will be an "ok" button and a "cancel" button
a = dynforgen (distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)
do
'=== flag to tell if the input is not valid
err01=0
'=== flag to say input is done, since there might be a defaut value, we must validate if user was finished
inpdon=0
'=== "ok" button or "enter" key are the same
'=== and nothing was pressed on left frame (control frame)
if resbutlefstr="" and (resbutmidstr="ok" or reskeymid=13) then
'=== User has clicked the OK button, retrieve the values
text=fmid.form01.text01.Value '=== namtmp is the variable name used earlier,before we call the dynamic form generation for input
if len(text) < 1 then
err01=1
'=== error message for the first form (if the keyword "error" is in this string, its displayed in RED)
if len(text) < 1 then
errtmp(0)="error - must be 1 char long at least"
else
errtmp(0)="ok"
end if
'=== if the value was not good, we generate the dynamic input for again, with an error message after the form in red
a = dynforgen(distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)
'=== there was an invalid input so we reset the key or button pressed to nothing so the loop can continue
reskeymid=0
resbutmidstr=""
else
'=== the input was validated, we flag err01 to none, and flag inpdon to exit the loop
inpdon=1
err01=0
end if
end if
wscript.sleep 100
'=== while we wait for input value, user can press "escape" key, "cancel" button or close internet explorer
if resbutmidstr="cancel" or reskeymid=27 or bready=true or resbutlefstr<>"" then
'=== if user pressed escape or cancel, we clear the frames
if resbutmidstr="cancel" or reskeymid=27 then
a = clefra(array("fmid","fbot"))
resbutmidstr="cancel"
end if
exit do
end if
'=== if there was an input error and no one used left control frame to exit, we keep asking for input
loop while err01<>0 or inpdon=0
'=== if internet explorer was not closed (bready), a button was not pressed on left frame, and no excape or cancel in middle frame
if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
a = clefra(array("fmid","fbot"))
cn.open "Provider=ADsDSOObject;"
cmd.activeconnection = cn
fbot.WriteLn("<br>Scanning domain computers")
'fbot.WriteLn("<br>directory where xml file is saved: " & basedir)
strInputPath = basedir & "\serverlist.txt" '- location of input
strOutputPath = basedir & "\output.csv" '- location of output
set objFSO = CreateObject("Scripting.FileSystemObject")
'set objTextIn = objFSO.OpenTextFile( strInputPath,1 )
set objTextOut = objFSO.CreateTextFile( strOutputPath )
objTextOut.WriteLine("computer,status")
h = "<table width=""100%"" BORDERCOLOR=""black"" class=MsoTableGrid border=1 CELLSPACING=0 cellpadding=2 style='border-collapse:collapse;border:none'>"
'=== domain root
fbot.WriteLn("<br>Getting domain root...")
SET objRoot = GETOBJECT("LDAP://RootDSE")
'for each propName in objRoot.Properties.PropertyNames
'=== DC=quebecormedia,DC=com
defaultNamingContext01 = objRoot.GET("defaultNamingContext")
fbot.WriteLn("<br>" & objRoot.GET("defaultNamingContext"))
defaultNamingContext01 = defaultNamingContext01 & ",OU=gemel"
'=== Query for all computers in the domain
'description Computer description (in AD)
'distinguishedName DN: OU location of the computer account can be read from here. No wildcard matching possible!
'dNSHostName FQDN
'location Location field
'memberOf Groups the computer account is a member of. No wildcard matching possible!
'name Netbios computer name
'operatingSystem e.g. Windows Server 2003
'operatingSystemServicePack e.g. Service Pack 1
'operatingSystemVersion e.g. 5.2 (3790)
'primaryGroupID 515: Computers
'516: Domain Controllers
'sAMAccountName Computer account name (name$)
'sAMAccountType always 805306369 (computer account)
'servicePrincipalName list of registered SPNs
'=== nice doc on ldap queries
'http://ldapwiki.willeke.com/wiki/Active%20Directory%20Computer%20Related%20LDAP%20Query#section-Active+Directory+Computer+Related+LDAP+Query-FindAllWorkstations
cmd.commandtext = "<LDAP://" & objRoot.GET("defaultNamingContext") & ">;(objectCategory=Computer);dnsHostName,distinguishedName,description"
'**** Bypass 1000 record limitation ****
cmd.properties("page size")=1000
fbot.WriteLn("<br>Getting computers...")
SET rs = cmd.EXECUTE
fbot.WriteLn("<br>Looping through computers...")
fbot.WriteLn("<br>")
'=== check all columns in the recordset (debug separator was , not ; )
test=0
if test=1 then
compucnt01 = 0
rs.movefirst
WHILE rs.eof<>true AND rs.bof<>true and compucnt01<1
for each field01 in rs.fields
fbot.WriteLn("<br>Field: " & field01.name)
next
rs.movenext
compucnt01 = compucnt01 + 1
wend
end if
'=== want to see progress live, make talbe now in html frame
fbot.WriteLn(h)
compucnt01 = 0
compucnt02 = 0
rs.movefirst
WHILE rs.eof <> true AND rs.bof <> true
'=== WRTIE A DOT EVERY 20 RECORDS
IF compucnt02/10 = INT(compucnt02/10) THEN fbot.WriteLn(".")
distinguishedName01 = lcase(rs("distinguishedName"))
dnsHostName01 = rs("dnsHostName")
'=== is the computer from bloobuzz?
if instr(distinguishedName01, "dc=gemel,dc=ca")<>0 then
'=== bloobuzz total
compucnt01 = compucnt01 + 1
h = ""
h = h & "<tr>" '=== line 1
h = h & "<td>" & compucnt01 & "</td>"
h = h & "<td>" & dnsHostName01 & "</td>" '<td>" & distinguishedName01 & "</td>"
ping01 = ping(dnsHostName01)
h = h & "<td>" & ping01 & "</td>"
'fmid.WriteLn("ping " & dnsHostName01 & " " & ping01)
if ping01 = true then
'=== last logonname of this computer
strComputer = dnsHostName01
err01 = 0: err02 = ""
on error resume next
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
err01 = err
err02 = err.description
on error goto 0
if err01 = 0 then
'=== last logon name on this computer
Set colItems = objWMIService.ExecQuery("Select * from Win32_ComputerSystem",,48)
For Each objItem in colItems
'net_domain = objItem.Domain
net_user_name = objItem.UserName
Next
h = h & "<td>" & net_user_name & "</td>"
mem01 = 0
if mem01 = 1 then
'''''''''''''''''''''''''''
' Memory Information
'''''''''''''''''''''''''''
if verbose = "y" then
'objOutputFile.WriteLine date & " " & time & " Memory Info ... DEBUT"
'wscript.echo "Memory Info"
end if
'sql = "DELETE FROM memory WHERE memory_mac_address = '" & net_mac_address & "'"
'create_sql sql, objTextFile, database
Set colItems = objWMIService.ExecQuery("Select MemoryDevices FROM Win32_PhysicalMemoryArray",,48)
For Each objItem in colItems
system_memory_banks = objItem.MemoryDevices
Next
On Error Resume Next
Set colItems = objWMIService.ExecQuery("Select Capacity,DeviceLocator,FormFactor,MemoryType,TypeDetail,Speed FROM Win32_PhysicalMemory",,48)
mem_count = 0
For Each objItem in colItems
mem_count = mem_count + 1
If mem_count > int(system_memory_banks) then
Exit For
End If
If objItem.FormFactor = "7" then
mem_formfactor = "SIMM"
ElseIf objItem.FormFactor = "8" then
mem_formfactor = "DIMM"
ElseIf objItem.FormFactor = "11" then
mem_formfactor = "RIMM"
ElseIf objItem.FormFactor = "12" then
mem_formfactor = "SODIMM"
ElseIf objItem.FormFactor = "13" then
mem_formfactor = "SRIMM"
Else
mem_formfactor = "Unknown"
End If
If objItem.MemoryType = "0" then
mem_detail = "Unknown"
ElseIf objItem.MemoryType = "1" then
mem_detail = "Other"
ElseIf objItem.MemoryType = "2" then
mem_detail = "DRAM"
ElseIf objItem.MemoryType = "3" then
mem_detail = "Synchronous DRAM"
ElseIf objItem.MemoryType = "4" then
mem_detail = "Cache DRAM"
ElseIf objItem.MemoryType = "5" then
mem_detail = "EDO"
ElseIf objItem.MemoryType = "6" then
mem_detail = "EDRAM"
ElseIf objItem.MemoryType = "7" then
mem_detail = "VRAM"
ElseIf objItem.MemoryType = "8" then
mem_detail = "SRAM"
ElseIf objItem.MemoryType = "9" then
mem_detail = "RAM"
ElseIf objItem.MemoryType = "10" then
mem_detail = "ROM"
ElseIf objItem.MemoryType = "11" then
mem_detail = "Flash"
ElseIf objItem.MemoryType = "12" then
mem_detail = "EEPROM"
ElseIf objItem.MemoryType = "13" then
mem_detail = "FEPROM"
ElseIf objItem.MemoryType = "14" then
mem_detail = "EPROM"
ElseIf objItem.MemoryType = "15" then
mem_detail = "CDRAM"
ElseIf objItem.MemoryType = "16" then
mem_detail = "3DRAM"
ElseIf objItem.MemoryType = "17" then
mem_detail = "SDRAM"
ElseIf objItem.MemoryType = "18" then
mem_detail = "SGRAM"
ElseIf objItem.MemoryType = "19" then
mem_detail = "RDRAM"
ElseIf objItem.MemoryType = "20" then
mem_detail = "DDR"
End If
If objItem.TypeDetail = "1" then
mem_typedetail = "Reserved"
ElseIf objItem.TypeDetail = "2" then
mem_typedetail = "Other"
ElseIf objItem.TypeDetail = "4" then
mem_typedetail = "Unknown"
ElseIf objItem.TypeDetail = "8" then
mem_typedetail = "Fast-paged"
ElseIf objItem.TypeDetail = "16" then
mem_typedetail = "Static column"
ElseIf objItem.TypeDetail = "32" then
mem_typedetail = "Pseudo-static"
ElseIf objItem.TypeDetail = "64" then
mem_typedetail = "RAMBUS"
ElseIf objItem.TypeDetail = "128" then
mem_typedetail = "Synchronous"
ElseIf objItem.TypeDetail = "256" then
mem_typedetail = "CMOS"
ElseIf objItem.TypeDetail = "512" then
mem_typedetail = "EDO"
ElseIf objItem.TypeDetail = "1024" then
mem_typedetail = "Window DRAM"
ElseIf objItem.TypeDetail = "2048" then
mem_typedetail = "Cache DRAM"
ElseIf objItem.TypeDetail = "4096" then
mem_typedetail = "Non-volatile"
Else
mem_typedetail = "Unknown"
End If
sql = "INSERT INTO memory ( memory_mac_address, memory_bank, " _
& "memory_form_factor, memory_type, memory_detail, memory_capacity, memory_speed) " _
& "VALUES ('" _
& net_mac_address & "','" _
& objItem.DeviceLocator & "','" _
& mem_formfactor & "','" _
& mem_detail & "','" _
& mem_typedetail & "','" _
& int(objItem.Capacity /1024 /1024) & "','" _
& objItem.Speed & "')"
'create_sql sql, objTextFile, database
Next
'sql = ""
'objOutputFile.WriteLine date & " " & time & " Memory Info ... FIN"
h = h & "<td>memory info " & sql & " </td>"
end if '=== mem01
else
'=== wmi error
h = h & "<td>ERROR WMI</td>"
end if '=== on error
else
'=== ping did not succeed
end if '=== ping true
''''''''''''''''''''''''''''
' end of line in table
''''''''''''''''''''''''''''
h = h & "</tr>"
fbot.WriteLn(h)
else
fbot.WriteLn(distinguishedName01 & " --- " & dnsHostName01 & "<br>")
end if '=== bbz found
compucnt02 = compucnt02 + 1
rs.movenext
wend
fmid.WriteLn("FIN")
h = ""
h = h & "</table>"
fbot.WriteLn(h)
end if
reskeymid=0
resbutmidstr=""
end if
'=== if the button named this is pressed we do this
'=== resbutlefstr: result from pressing a button in the left frame (control frame, flef object)
'=== its a string that contain the programmable name of the button that was pressed in the left frame (arabutnam)
if resbutlefstr="clrframes" then
a = clefra(array("fmid","fbot"))
'fbot.WriteLn("tried to clear middle frame")
end if
if resbutlefstr="info" then
a = clefra(array("fmid","fbot"))
'=== print button
aa = lcase(fbot.readystate)
do until aa="complete" or aa="terminé" or aa="interactive"
'if logall = 1 then fil02.writeline "*********************************** readystate of " & ffranam & ": " & aa
wscript.sleep 100
aa = lcase(fbot.readystate)
loop
for each a in priara
fbot.WriteLn(a)
next
for each a in botara
fbot.WriteLn(a)
next
fbot.WriteLn("<H2>Crucible Cleaner Troubleshooting Database with Dynamic Web Interface</H2><br>")
texara=array(_
"",_
"1. REQUIREMENTS:",_
"1.1 Microsoft windows xp, vista (32 or 64), seven (32 or 64) (without UAC, users access control, off)",_
"1.2 Internet explorer",_
"1.3 .NET framework 1.1 (included with windows)",_
"1.4 microsoft access database: 45834_crucible_cleaning_diagnostic.mdb",_
"1.5 images directory: PhotoHydComponent",_
"",_
"2. CARACTERISTICS:",_
"",_
"2.1 This dynamic web interface was programmed to access a microsoft access database information to troubleshoot a Crucible Cleaner",_
"",_
"3. REFERENCES:",_
"",_
"3.1 This program was made by STAS",_
"3.2 STAS project number: 45834",_
"",_
"STAS Inc.",_
"1846 Outarde, Chicoutimi (Qué.), Canada G7K 1H1",_
"Tél.: 418-545-6574",_
"Fax 1: 418-545-8335, Fax 2: 418-696-1951",_
"Email: fournier.serge@STAS.com",_
"Contact: Serge Fournier, Prog./Analyst")
for each a in texara
aa = lcase(fbot.readystate)
do until aa="complete" or aa="terminé" or aa="interactive"
if logall = 1 then fil02.writeline "*********************************** readystate of " & ffranam & ": " & aa
wscript.sleep 100
aa = lcase(fbot.readystate)
loop
fbot.WriteLn(a & "<br>")
next
aa = lcase(fbot.readystate)
do until aa="complete" or aa="terminé" or aa="interactive"
if logall = 1 then fil02.writeline "*********************************** readystate of " & ffranam & ": " & aa
wscript.sleep 100
aa = lcase(fbot.readystate)
loop
fbot.location.reload(true)
reskeymid=0
resbutmidstr=""
end if
'=== .1 seconds
wscript.sleep 50
'=== we loop until internet explorer was closed or the quit button was pressed
loop until bReady or resbutlefstr="quit01"
'======================
'====================== end of main loop
'======================
'=== someone pressed "quit" on left frame (control frame, flef object)
'=== at the end, if internet explorer was not closed, we close it
if bready=false then
oie.quit
set oie=nothing
end if
if logall=1 then
fil02.WriteLine date & " " & time & " END"
end if
if logall = 1 then
fil02.close
end if
'=== we end wscript.exe, exiting all running code interpretation
wscript.quit
'==================================================================================================
'=== many subs
'=== if internet explorer is closed (event) we change bready value to TRUE
sub IE_onQuit()
bReady=true
end sub
'============================================== subs and functions ====================================
'=== frames clear content by navigating to a blank
'=== input is an array containing name of frames as "flef" = frame left
'=== this sub generate a code and execute it in a string (cc)
'=== fully dynamic programming at it's best ;)
function clefra(aara)
cc=""
for each aa in aara
'cc = cc & "Do While (oIE.Busy)" & vbcrlf
'cc = cc & " wscript.sleep 200" & vbcrlf
'cc = cc & "Loop" & vbcrlf
'cc = cc & "Do While oie.readystate<>4" & vbcrlf
'cc = cc & " wscript.sleep 200" & vbcrlf
'cc = cc & "Loop" & vbcrlf
'cc = cc & aa & ".location.reload(true)" & vbcrlf
'cc = cc & "Do While (oIE.Busy)" & vbcrlf
'cc = cc & " wscript.sleep 200" & vbcrlf
'cc = cc & "Loop" & vbcrlf
'cc = cc & "Do While oie.readystate<>4" & vbcrlf
'cc = cc & " wscript.sleep 200" & vbcrlf
'cc = cc & "Loop" & vbcrlf
'cc = cc & aa & ".WriteLn("" "")" & 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
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
Subscribe to:
Posts (Atom)