Language - Vbs
About
Vbs is a scripting language.
Its interpreter is Windows - Script Host (WSH) that you will also found in Internet Explorer. See Html script
Articles Related
Snippet
In the repository of OBIEE (OracleBI_HOME\server\Bin), you can find this good script to get information on a server.
'===============================================================
' Copyright (c) 2001, 2006, Oracle. All rights reserved.
'
' File: DiagCap.vbs
'
' Created: 6/1/2003
'
' Purpose: This script is used for capturing diagnostic information of system
' where Oracle Business Intelligence Server 10.1.3 is installed.
' The result of the script should be sent to Oracle technical support
' when reporting errors with the Oracle BI Server.
' The script is tested under WSH 5.6 and also WMI 1.5 on Windows 2000
'
' History:
'==================================================================
Option Explicit
'===========================
' Declare the Global objects
'===========================
Dim Arguments, computerName, currentOS
Dim FSO,Shell,InfoLogFile,SAInfoName
Dim DestDir
'==========================================
' Drive / Folder Name that we will access
'==========================================
Dim strProgramDir, strServerDir, strDataDir, SystemRootDir
'==========================
' FileName for Informations
'==========================
Dim SysInfoFileName, SysEnvName, saRegFileName, SARootDriveLog, SADataDriveLog, ipconfigFileName, OdbcFileName, OdbcInstFileName, InfoOutput, InfoOutputFileName, SARpdFile
Dim EvtAppLogName, EvtSysLogName
Dim DDFFileName, DestCabName, CabOutName, CabInfFileName, CabRptFileName, CabDirectory
Dim nowStr
'==========================================
' FileName for BI Server Specific
'==========================================
Dim NonSAFiles 'Array of Non SAFiles
'====================================================
' Options for calling some subroutines alternatively
'====================================================
Dim ExecOptions
Dim BoolOptions(9)
Dim DefaultExecOptions
DefaultExecOptions = "111111111"
Dim boolDefaultRepository
boolDefaultRepository = false
Dim DefaultRepository
DefaultRepository= "SiebelAnalytics.rpd"
'==========================================
' Utility Programs that is used for getting information
'==========================================
Dim MAKECAB, WINMSD, REGEDIT, IPCONFIG, EVTLOGDUMP, objWMIService, bWMIService
'==========================================
'Consts used in the program
'==========================================
const OSProductKey = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\CurrentBuildNumber"
const SAProgramDirKey = "HKEY_LOCAL_MACHINE\SOFTWARE\Siebel Systems, Inc.\Siebel Analytics\Common\7.7\ProgramDir"
const ODBCINIKey = """HKEY_LOCAL_MACHINE\SOFTWARE\ODBC\ODBC.INI"""
const ODBCINSTKEY = """HKEY_LOCAL_MACHINE\SOFTWARE\ODBC\ODBCINST.INI"""
const SARootReg = """HKEY_LOCAL_MACHINE\SOFTWARE\Siebel Systems, Inc.\Siebel Analytics"""
const SAProgramDirEnvVar = "%SAROOTDIR%"
const SADataDirEnvVar = "%SADATADIR%"
'=============================
'Initialize the global Objects
'===============================
Set Arguments = Wscript.Arguments
Set Shell = Wscript.CreateObject("Wscript.Shell")
Set FSO = Wscript.CreateObject("Scripting.FileSystemObject")
'=============
' Script Main
'=============
call VerifyScriptMode
call ValidateScriptVersion
call VerifyArguments
call InitializeVars
call ValidateSARoot
'call ValidateUtility
Log "--------------------------------------"
Log " Gather Information for your Machine: "
Log "--------------------------------------"
Log " "
Log " "
call ComputeOptionsMask
Dim OptionsIndex
Dim OptionIndex
OptionIndex = 0
If (BoolOptions(OptionIndex) = 1) Then
call GetSysInfo
End If
OptionIndex = OptionIndex + 1
If (BoolOptions(OptionIndex) = 1) Then
call GetSysEnvInfo
End If
OptionIndex = OptionIndex + 1
If (BoolOptions(OptionIndex) = 1 ) Then
call GetRegInfo
End If
OptionIndex = OptionIndex + 1
If (BoolOptions(OptionIndex) = 1 ) Then
call GetNetInfo
End If
OptionIndex = OptionIndex + 1
If BoolOptions(OptionIndex) = 1 and bWMIService = "Y" Then
call GetEvt (EvtAppLogName, "Application")
End If
OptionIndex = OptionIndex + 1
If BoolOptions(OptionIndex) = 1 and bWMIService = "Y" Then
call GetEvt (EvtSysLogName, "System")
End If
Log "-----------------------------------------"
Log " Gather Information of Oracle BI Server: "
Log "-----------------------------------------"
Log " "
Log " "
OptionIndex = OptionIndex + 1
If BoolOptions(OptionIndex) = 1 Then
call GetSARootInfo
End If
OptionIndex = OptionIndex + 1
If (BoolOptions(OptionIndex) = 1 ) Then
call GetConfigAndLogs
End If
Log "--------------------------------------------------------------------"
Log " Gather Information of Server Repository, This can take for a while "
Log "--------------------------------------------------------------------"
Log " "
Log " "
OptionIndex = OptionIndex + 1
If (BoolOptions(OptionIndex) = 1 ) Then
call GetRepository
End If
Log "--------------------------------------------------------------------"
Log " Packaging up, this can take for a while "
Log "--------------------------------------------------------------------"
Log " "
Log " "
call PackageUp
Wscript.Echo ""
call MyQuit(0)
'====================
' End Of Script Main
'====================
'===============================================
' Verfiy that script is invoked by cscript.exe
'===============================================
Function VerifyScriptMode()
Dim BtnCode
'==========================================
' We need to run the script in interactive mode
'==========================================
If Wscript.Interactive = False Then
Wscript.Interactive = True
End If
If LCase(FSO.GetFileName(Wscript.FullName)) <> "cscript.exe" Then
BtnCode=Shell.Popup("Please run the script by cscript.exe " & Wscript.ScriptName & " -d Target Directory " ,7, "WARNING!",0+64)
Select Case BtnCode
case 1 Wscript.Quit(1)
case -1 Wscript.Quit(1)
End Select
End If
'Wscript.Echo ""
'Wscript.Echo " ******************** W A R N I N G ***********************************"
'Wscript.Echo " * You will need to be the administrator to access the information. *"
'Wscript.Echo " * Press Ctrl-C to stop the script if you are not the administrator.*"
'Wscript.Echo " * Press enter to continue *"
'Wscript.Echo " ******************** W A R N I N G ***********************************"
'Wscript.Echo ""
'Do While Not Wscript.StdIn.AtEndOfStream
' Wscript.StdIn.ReadLine
' Exit Do
'Loop
End Function
'===============================================
' Verify the script's input arguments
''===============================================
Function VerifyArguments()
Dim bContinue
Dim bValidArg
bValidArg = False
If ( Arguments.Count = 0 ) Then
Wscript.Echo ""
Wscript.Echo " **************** W A R N I N G ***************"
Wscript.Echo " * *"
Wscript.Echo " * No destination folder specified. *"
Wscript.Echo " * *"
Wscript.Echo " ***************** W A R N I N G **************"
Wscript.Echo ""
Else
Dim iArg
iArg = 0
For iArg = 0 To Arguments.Count - 1
'Wscript.Echo "Current argument " & iArg & " value : " & Arguments(iArg)
If Arguments(iArg) = "-h" Or Arguments(iArg) = "-help" Then
call Usage()
call MyQuit(1)
ElseIf Left(Arguments(iArg), 1) = "-" and (iArg + 1) < Arguments.Count Then
Select Case Arguments(iArg)
Case "-d"
bValidArg = True
DestDir = Arguments( iArg + 1 )
If FSO.FolderExists(DestDir) Then
If (FSO.GetFolder(DestDir).files.Count <> 0 ) Then
DestDir = DestDir & FormatCurrentDate
Wscript.Echo "** Created Folder " & DestDir & " to store information gathered"
FSO.CreateFolder(DestDir)
End If
Else
Dim destFolder
set destFolder = FSO.CreateFolder(DestDir)
Wscript.Echo "Created Folder Path " & destFolder.Path
End If
destDir = FSO.GetAbsolutePathName(destDir)
iArg = iArg + 1
case "-o"
ExecOptions = Arguments( iArg + 1 )
if ExecOptions = "" or Len(ExecOptions) <> 9 Then
'Put Default Execoptions
ExecOptions= DefaultExecOptions
End If
iArg = iArg + 1
Case "-r"
DefaultRepository = Arguments(iArg + 1 )
if DefaultRepository <> "" Then
Wscript.Echo "Default Repository set to " & DefaultRepository
boolDefaultRepository = true
Else
Wscript.Echo "Default Repository set to false"
boolDefaultRepository = false
End If
iArg = iArg + 1
End Select
Else
Wscript.Echo ""
Wscript.Echo " Invalid argument is specified: " & Arguments(iArg)
call Usage()
call MyQuit(1)
End If
Next
End If
If bValidArg = False Then
Call Usage()
Call MyQuit(1)
End If
If Right(DestDir,1) <> "\" Then
DestDir = DestDir & "\"
End If
End Function
Function InitializeVars()
'==================================
'Programs that we need from OS
'==================================
Dim OSBuild
OSBuild = Replace(Trim(Shell.RegRead(OSProductKey)),",","")
Select Case OSBuild
Case "1381"
currentOS = "Windows_NT"
WINMSD = "winmsd.exe"
Case "2195"
currentOS = "Windows_2000"
WINMSD = "msinfo32.exe"
Case "2600"
currentOS = "Windows_XP"
WINMSD = "msinfo32.exe"
Case "3790"
currentOS = "Windows_2003"
WINMSD = "msinfo32.exe"
Case Else
currentOS = "Windows_Unknown"
WINMSD = "msinfo32.exe"
End Select
SystemRootDir = Shell.ExpandEnvironmentStrings("%SystemRoot%")
MAKECAB = SystemRootDir & "\system32\makecab.exe"
REGEDIT = SystemRootDir & "\regedit.exe"
IPCONFIG = SystemRootDir & "\system32\ipconfig.exe"
On Error Resume Next
Err.Clear
Dim strComputer
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
If err.Number <> 0 Then
Wscript.Echo " ********************* W A R N I N G ****************************"
Wscript.Echo " One utility program is missing. "
Wscript.Echo " Please download Windows Management Instrument 1.5 from the following URL: "
Wscript.Echo " http://www.microsoft.com/downloads/details.aspx?displaylang="
Wscript.Echo " en&FamilyID=C174CFB1-EF67-471D-9277-4C2B1014A31E"
Wscript.Echo " You might not be able to collect the system information"
Wscript.Echo " and event logs if you continue to run the script."
Wscript.Echo " ********************* W A R N I N G *****************************"
Err.Clear
bWMIService = "N"
Else
bWMIService = "Y"
End If
On Error Goto 0
computerName = Shell.ExpandEnvironmentStrings("%ComputerName%")
SAInfoName = computerName
SysInfoFileName = DestDir & "SystemInfo.txt"
SysEnvName = DestDir & "SysEnv.txt"
SARootDriveLog = DestDir & "SARootDrive.log"
SADataDriveLog = DestDir & "SADataDrive.log"
IpconfigFileName = DestDir & "Ipconfig.txt"
saRegFileName = DestDir & "sa.reg__"
OdbcFileName = DestDir & "odbcini.reg__"
OdbcInstFileName = DestDir & "odbcinst.reg__"
EvtAppLogName = DestDir & "AppEvt.log"
EvtSysLogName = DestDir & "SysEvt.log"
DDFFileName = DestDir & "MakeCab" & ".ddf"
CabRptFileName = DestDir & "MakeCab" & ".rpt"
CabInfFileName = DestDir & "MakeCab" & ".inf"
CabOutName = DestDir & "MakeCab.log"
NonSAFiles = Array(SysInfoFileName, SysEnvName, SARootDriveLog, SADataDriveLog, IpconfigFileName, saRegFileName, OdbcFileName, OdbcInstFileName,EvtAppLogName, EvtSysLogName)
Dim nowMonth, nowDay, nowYear
nowMonth = Month (Now())
nowDay = Day (Now())
nowYear = Year (Now())
If Len(nowMonth) = 1 Then
nowMonth = "0" & nowMonth
End If
If Len(nowDay) = 1 Then
nowDay = "0" & nowDay
End If
If Len(nowYear) = 1 Then
nowYear = "0" & nowYear
End If
nowStr = nowYear & "_" & nowMonth & "_" & nowDay
InfoOutputFileName = Wscript.ScriptName & ".log"
InfoOutput = DestDir & InfoOutputFilename
DestCabName = SAInfoName & "_" & nowStr & "_*.cab"
CabDirectory = DestDir
On Error Resume Next
Set infoLogFile = FSO.CreateTextFile(InfoOutput, true)
If (err) Then
Wscript.Echo "Error creating the file " & infoOutput & ", reason is " & err.Description
call MyQuit (1)
End If
If Shell.ExpandEnvironmentStrings(SAProgramDirEnvVar) <> SAProgramDirEnvVar Then
strProgramDir = Shell.ExpandEnvironmentStrings(SAProgramDirEnvVar)
Else
strProgramDir = Shell.RegRead(SAProgramDirKey)
If (err) Then
Log "Environment variable " & SAProgramDirEnvVar & " does not exist"
Log "Error occurred while reading registry key: " & SAProgramDirKey & ", reason is " & err.Description
End If
End If
If Shell.ExpandEnvironmentStrings(SADataDirEnvVar) <> SADataDirEnvVar Then
strDataDir = Shell.ExpandEnvironmentStrings(SADataDirEnvVar)
End If
On Error Goto 0
If fso.FolderExists(strProgramDir & "\server") Then
strServerDir = strProgramDir & "\server"
Else
strServerDir = strProgramDir
End If
End Function
'===================
' SysInfo Sub
'===================
Sub GetSysInfo()
If currentOS = "Windows_NT" Then
Wscript.sleep 10
cmd ( "start /wait " & WINMSD & " /a /f " )
cmd ( "copy " & computerName & ".TXT " & SysInfoFileName )
ElseIf currentOS = "Windows_XP" Then
Wscript.Echo ""
Wscript.Echo "Gathering data from Microsoft System Information..."
Wscript.Echo "If you encounter an ""Invalid command line option specified"" error,"
Wscript.Echo "please select File > Save in Microsoft System Information"
Wscript.Echo "then close Microsoft System Information."
Wscript.sleep 2000
cmd ( "start /wait " & WINMSD & " /categories +SWEnv+SystemSummary+ComponentsStorage /report " & SysInfoFileName)
If Not fso.FileExists(SysInfoFileName) Then
cmd ( "copy " & SystemRootDir & "\MSINFO32.TXT " & SysInfoFileName )
End If
Else
cmd ( "start /wait " & WINMSD & " /categories +SWEnv+SystemSummary+ComponentsStorage /report " & SysInfoFileName)
End If
End Sub
'==================================
' Dump the System Environment Info
'==================================
Sub GetSysEnvInfo()
On Error Resume Next
Dim colItems, envFile, strComputer, objItem
strComputer = "."
set envFile = fso.OpenTextFile (SysEnvName, 8, true)
If Err.Number <> 0 Then
Log " Error occurred while opening the file " & SysEnvName & ". Reason is : " & err.Description
err.Clear
On Error Goto 0
Exit Sub
End If
If objWMIService <> nothing Then
Set colItems = objWMIService.ExecQuery("Select * from Win32_Environment where SystemVariable = True")
envFile.WriteLine ""
envFile.WriteLine "*********************************************************"
envFile.WriteLine "* System Environment Variables *"
envFile.WriteLine "*********************************************************"
envFile.WriteLine ""
For Each objItem in colItems
envFile.Write objItem.Description & vbtab & vbtab & vbtab & " = "
envFile.Write objItem.VariableValue
envFile.WriteLine ""
Next
End If
envFile.WriteLine ""
envFile.WriteLine "*********************************************************"
envFile.WriteLine "* All Environment Variables *"
envFile.WriteLine "*********************************************************"
envFile.WriteLine ""
envFile.Close
cmd ("set >> " & SysEnvName )
set envFile = Nothing
On Error Goto 0
End Sub
'===================
' Registry Info Sub
'===================
Sub GetRegInfo()
If true <> FSO.FileExists(REGEDIT) Then
Log " One utility program is missing, Please make sure you have the following program in place " & REGEDIT
Exit Sub
End If
cmd (REGEDIT & " /e " & SaRegFileName & " " & SARootReg )
cmd (REGEDIT & " /e " & ODBCFileName & " " & ODBCINIKey )
cmd (REGEDIT & " /e " & OdbcInstFileName & " " & ODBCINSTKey )
'Log ""
End Sub
'===================
' Net Info Sub
'===================
Sub GetNetInfo()
If true <> FSO.FileExists(IPCONFIG) Then
Log " One utility program is missing, Please make sure you have the following program in place " & IPCONFIG
Exit Sub
End If
cmd (IPCONFIG & " /all > " & IpConfigFileName )
End Sub
'===========================================
' Get the System or Application Event Logs
'=============================================
Sub GetEvt(filename, eventType)
Dim LogFile, objItem, colItems, dataItem, strComputer
strComputer = "."
set LogFile = FSO.CreateTextFile(fileName, True)
Set colItems = objWMIService.ExecQuery("Select * from Win32_NTLogEvent where LogFile = '" & eventType & "'",,48)
On Error Resume Next
For Each objItem in colItems
LogFile.WriteLine "RecordNumber: " & vbtab & objItem.RecordNumber
LogFile.WriteLine "TimeGenerated: " & vbtab & FormatDMTFDate(objItem.TimeGenerated)
LogFile.WriteLine "TimeWritten: " & vbtab & FormatDMTFDate(objItem.TimeWritten)
LogFile.WriteLine "Source: " & vbtab & objItem.SourceName
LogFile.WriteLine "Category: " & vbtab & objItem.CategoryString
LogFile.WriteLine "EventCode: " & vbtab & objItem.EventCode
LogFile.WriteLine "Type: " & vbtab & objItem.Type
LogFile.WriteLine "Event Identifier:" & vbtab & Right(("0000" & objItem.EventIdentifier), 4)
LogFile.WriteLine "User: " & vbtab & objItem.User
LogFile.WriteLine "Computer: " & vbtab & objItem.ComputerName
LogFile.WriteLine "Message: " & vbtab & objItem.Message
If IsArray(objItem.InsertionStrings) Then
LogFile.WriteLine "Insertion Strings: "
Dim i
i = 0
For Each dataItem In objItem.InsertionStrings
LogFile.WriteLine "[" & i &"] " & dataItem & vbLf
i = i + 1
Next
End If
LogFile.WriteLine
If IsArray(objItem.Data) Then
Dim j
Dim ascBuf
ascBuf=""
Dim ascConverted
ascConverted=""
Dim dataUBound
dataUBound = UBound(objItem.Data)
j = 0
LogFile.WriteLine "Data: "
For Each dataItem In objItem.Data
If j mod 16 = 0 Then
LogFile.Write Right(("00000000" & hex(j)), 8)
LogFile.Write " "
End If
LogFile.Write Right(("00" & Hex(dataItem)), 2) & " "
ascConverted=Chr(dataItem)
If dataItem < 32 or dataItem > 126 Then
ascConverted = "."
End If
ascBuf = ascBuf & ascConverted
If j mod 16 = 15 Then
logFile.Write vbtab
LogFile.WriteLine ascBuf
ascBuf=""
ElseIf j = dataUBound Then
LogFile.Write Left(" ", 3 * ( 16 - (j mod 16 ) - 1 ))
ascBuf = Left( (ascBuf & " "), 16 )
logFile.Write vbtab
LogFile.WriteLine ascBuf
ascBuf=""
Exit For
End If
j=j+1
Next
End If
LogFile.WriteLine
LogFile.WriteLine
Next
On Error Goto 0
LogFile.Close
Set colItems = Nothing
Set LogFile = Nothing
End Sub
Function FormatDMTFDate(sDate)
Dim regEx
Set regEx = New RegExp
regEx.Global = True
regEx.Pattern = "(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})\.\d{6}([\+|\-])(\d{3})"
FormatDMTFDate = regEx.Replace(sDate,"$2/$3/$1 $4:$5:$6")
Set RegEx = Nothing
End Function
Function FormatCurrentDate
Dim regEx
Dim myCurrentDate
Dim myCurrentTime
Dim Seperator
Seperator = "_"
myCurrentDate = Date
myCurrentTime = Time
set regEx = new RegExp
regEx.Global = True
regEx.Pattern = "/"
FormatCurrentDate = regEx.Replace(myCurrentDate, Seperator)
FormatCurrentDate = FormatCurrentDate & Seperator & Hour(myCurrentTime) & Seperator & Minute(myCurrentTime) & Seperator & Second(myCurrentTime)
Set regEx = Nothing
End Function
'===================
' Events Sub
'===================
Sub GetEvtEXE()
EVTLOGDUMP = strProgramDir & "\\Bin\\" & "evtlogdump.exe"
If true <> FSO.FileExists(EVTLOGDUMP) Then
Log " One utility program is missing, Please make sure you have the following program in place "& EVTLOGDUMP
Log ""
Exit Sub
End If
'Log " Getting application events by " & EVTLOGDUMP
'Log ""
cmd ( EVTLOGDUMP & " " & computerName & " " & "Application > " & EvtAppLogName)
'Log " Getting system events"
'Log ""
cmd (EVTLOGDUMP & " " & computerName & " " & "System > " & EvtSysLogName)
End Sub
'=============================================================
' Get the Oracle BI Program Dir's Owner and Files info
'=============================================================
Sub GetSARootInfo
If currentOS <> "Windows_NT" Then
cmd( "dir /q " & strProgramDir & "\ > " & SARootDriveLog)
If strDataDir <> "" Then
cmd( "dir /q " & strDataDir & "\ > " & SADataDriveLog)
End If
End If
cmd ("dir /s " & strProgramDir & "\ >> " & SARootDriveLog)
If strDataDir <> "" Then
cmd ("dir /s " & strDataDir & "\ >> " & SADataDriveLog)
End If
End Sub
'===================
' Config and Logs Sub
'===================
Sub CopyAllFiles(copyFromDir, copyToDir, collisionPrefix)
If fso.FolderExists(copyFromDir) Then
Dim copyFromFolder, files, file, newFileName
Set copyFromFolder = fso.GetFolder(copyFromDir)
Set files = copyFromFolder.Files
For Each file in files
newFileName = file.Name
If fso.FileExists(copyToDir & "\" & newFileName) Then
newFileName = collisionPrefix & newFileName
End If
fso.CopyFile copyFromDir & "\" & file.Name, copyToDir & "\" & newFileName, false
If Err.Number <> 0 Then
Log " WARNING! Error copying " & file & ". " & err.Description
Log ""
err.Clear
End If
Next
End If
End Sub
Sub GetConfigAndLogs()
On Error Resume Next
CopyAllFiles strServerDir & "\Log", destDir, "server"
CopyAllFiles strServerDir & "\Config", destDir, "server"
If strDataDir <> "" Then
CopyAllFiles strDataDir & "\web\log", destDir, "web"
CopyAllFiles strDataDir & "\web\log\javahost", destDir, "javahost"
CopyAllFiles strDataDir & "\web\config", destDir, "web"
CopyAllFiles strDataDir & "\scheduler\config", destDir, "sch"
End If
On Error Goto 0
End Sub
'=========================
' Get the repository files
'=========================
Sub GetRepository()
On Error Resume Next
Dim SARepDir
Dim iNum
Dim Choice
Dim ChoiceNum
Dim filesDict
Dim fileItem
set SARepDir = FSO.GetFolder( strServerDir & "\Repository")
If err.Number <> 0 Then
Wscript.Echo " Err accessing repository directory: " & err.Description
Exit Sub
End If
set filesDict = Wscript.CreateObject("Scripting.Dictionary")
iNum = 0
If boolDefaultRepository = true Then
SARpdFile = DefaultRepository
Else
For Each fileItem in SARepDir.Files
If fileItem.Type = "Siebel Analytics Repository File" or fileItem.Type = "Oracle BI Repository File" Then
Wscript.Echo " [" & iNum + 1& "] " & fileItem.name
filesDict.Add iNum + 1, fileItem.name
iNum = iNum + 1
End If
Next
If (iNum > 0) Then
Wscript.Echo " "
Wscript.StdOut.Write " There are total " & iNum & " repositories, Please choose one repository to send ==> "
Do While Not WScript.StdIn.AtEndOfStream
Choice = WScript.StdIn.ReadLine
Exit Do
Loop
ChoiceNum = Cint(Choice)
If ChoiceNum <= iNum and ChoiceNum > 0 Then
Log " "
Log " Your choice is " & Choice & " - " & filesDict.Item(ChoiceNum)
Else
Log "Invalid choice, no repository will be sent "
Log ""
Exit Sub
End If
SARpdFile = filesDict.Item(ChoiceNum)
End If
End If
fso.CopyFile strServerDir & "\Repository\" & SARpdFile, destDir, false
SARpdFile = destDir & SARpdFile
If Err.Number <> 0 and fileItem <> "" Then
Log ""
Log " WARNING! error copying " & fileItem & " . The reason is : " & err.Description
Log " "
err.Clear
End If
On Error Goto 0
End Sub
'===========================
' Generate the Cab Files Sub
'===========================
Sub PackageUp()
If True <> FSO.FileExists(MAKECAB) Then
Log ""
Log " One utility program is missing, Please make sure you have the following program in place " & MAKECAB
Log " Please zip up " & destDir & " and send the information to Oracle"
call MyQuit(1)
End If
call PrintDDF
If 1 = cmd (MAKECAB & " /f " & DDFFileName & " > " & CabOutName ) Then
call MyQuit(1)
End If
Dim cabRptFileStream, cabRptFile
If FSO.FileExists(CabRptFileName) Then
Log " "
Log "========================================================"
Log " The report of compression and packing : "
Log "========================================================"
Log " "
set cabRptFileStream = fso.OpenTextFile (CabRptFileName, 1)
Log cabRptFileStream.ReadAll
Log " "
cabRptFileStream.Close
set cabRptFileStream = nothing
End If
Log ("")
Log ("")
Log ("====================================================================================================")
Log (" Please send all the files under " & CabDirectory & " to your Oracle consultant / technical support..")
Log ("====================================================================================================")
Log ("")
End Sub
'===========================================================
' Function: Log, this will echo to the Console also to the log file
'===========================================================
Function Log(str)
infoLogFile.Write Cstr(Now()) & " "
infoLogFile.WriteLine str
Wscript.Echo str
End Function
'===========================================================
' Function: Cmd, this will execute Command Line and wait for it to finish
'===========================================================
Function Cmd(cmdline)
' Wrapper for getting StdOut from a console command
Dim sCmd
Dim exec
sCmd = "%COMSPEC% /c " & cmdline
'Set exec = Shell.Exec (sCmd)
exec = Shell.Run(sCmd, 0, true)
'Do While exec.Status = 0
' WScript.Sleep 100
'Loop
If exec <> 0 Then
Log " Warning! error executing command " & cmdline
Cmd = 1
Else
Cmd = 0
End If
Set sCmd = nothing
Set exec = nothing
End Function
'===========================================================
' Function: Print DDF, This will generate the DDF file for MakeCab
'===========================================================
Function PrintDDF()
On Error Resume Next
Dim ddfFile
Dim destDirObj
Dim file, files
If Fso.FileExists(DDFFileName) Then
Fso.DeleteFile DDFFileName
End If
'Log " Create DDF File for MakeCab : " & DDFFileName
Set ddfFile = Fso.CreateTextFile(DDFFileName, true)
If Err.Number <> 0 Then
Log "Can't create DDF File, please check If your filesystem If full, err description " & err.Description
err.Clear
MyQuit 1
End If
ddfFile.WriteLine ";*** Generating Directive File for MakeCab ***"
ddfFile.WriteLine ".OPTION EXPLICIT ; Generate errors on variable typos"
ddfFile.WriteLine ".Set CabinetNameTemplate=" & DestCabName
ddfFile.WriteLine ".Set DestinationDir=" & destDir
ddfFile.WriteLine ".Set MaxDiskFileCount=1000 ; Limit file count per cabinet, so that"
ddfFile.WriteLine ".Set GenerateInf=On"
ddfFile.WriteLine ".Set InfFileName=" & CabInfFileName
ddfFile.WriteLine ".Set RptFileName=" & CabRptFileName
ddfFile.WriteLine ".Set DiskDirectoryTemplate=" & CabDirectory
ddfFile.WriteLine ".Set MaxCabinetSize=10000000 ; scanning is not too slow"
ddfFile.WriteLine ".Set FolderSizeThreshold=1000000000 ; So only one file per folder"
ddfFile.WriteLine ".Set CompressionType=MSZIP"
ddfFile.WriteLine ";** All files are compressed in cabinet files"
ddfFile.WriteLine ".Set Cabinet=on"
ddfFile.WriteLine ".Set Compress=on"
set destDirObj = fso.GetFolder(destDir)
set files = destDirObj.Files
For Each file in files
If file.Name <> InfoOutputFileName Then
ddfFile.WriteLine file
End If
Next
ddfFile.Close
On Error Goto 0
End Function
'=================================
' Error Exit, Clean up the global objects
'=================================
Function myQuit(exitCode)
On Error Resume Next
Err.Clear
If exitCode = 0 Then
call CleanUp
End If
Set Shell = Nothing
Set FSO = Nothing
If Err.Number <> 0 Then
Log "Error when quitting"
Wscript.Sleep 100
WScript.Quit 1
End If
Wscript.Quit exitCode
End Function
Sub ValidateScriptVersion()
If ScriptEngineMajorVersion < 2 Then
Wscript.Echo "Error executing script. This script requires Version 2"
call MyQuit(1)
End If
If ScriptEngineMajorVersion < 5 or ( ScriptEngineMajorVersion = 5 And ScriptEngineMinorVersion < 6 ) Then
Wscript.Echo " WARNING! The script has been tested under WSH 5.6."
Wscript.Echo " You script host version is " & ScriptEngineMajorVersion & "." & ScriptEngineMinorVersion
Wscript.Echo " There might be errors during runtime! "
End If
End Sub
Sub ValidateSARoot()
If strProgramDir <> "" Then
'Log " Resolved Oracle BI Program Dir : " & strProgramDir
Else
Log " Oracle BI is not installed in this machine!"
call MyQuit(1)
End If
End Sub
Sub ValidateUtility()
If true <> FSO.FileExists(REGEDIT) Then
Log " One utility program is missing, Please make sure you have the following program in place " & REGEDIT
'call MyQuit(1)
End If
If true <> FSO.FileExists(IPCONFIG) Then
Log " One utility program is missing, Please make sure you have the following program in place " & IPCONFIG
'call MyQuit(1)
End If
If true <> FSO.FileExists(EVTLOGDUMP) Then
Log " One utility program is missing, Please make sure you have the following program in place "& EVTLOGDUMP
End If
End Sub
Sub Usage()
Wscript.Echo ""
Wscript.Echo "Usage : "
Wscript.Echo " cscript.exe " & Wscript.ScriptName & " -d OutputDirectory [-h]"
Wscript.Echo ""
Wscript.Echo " OutputDirectory: The relative or absolute directory path that output information will be stored."
Wscript.Echo " This directory must be empty. If the directory does not exist, the script will create a directory"
Wscript.Echo ""
Wscript.Echo " Please use cscript.exe to run the script in interactive mode"
End Sub
Sub CleanUp()
On Error Resume Next
Dim destDirObj
Dim file, files
Dim tempDir
set destDirObj = fso.GetFolder(destDir)
set files = destDirObj.Files
tempDir = destDir & "temp"
fso.CreateFolder tempDir
fso.MoveFile destDir & DestCabName, tempDir
For Each file in files
file.Delete
Next
fso.MoveFile tempDir & "\" & DestCabName, destDir
fso.DeleteFolder tempDir
On Error Goto 0
End Sub
Sub ComputeOptionsMask
Dim iOption
if ExecOptions = "" or Len(ExecOptions) <> 9 Then
ExecOptions = DefaultExecOptions
End If
For iOption = 1 to 9
if Mid(ExecOptions, iOption, 1) = 1 Then
BoolOptions(iOption-1) = 1
Else
BoolOptions(iOption-1) = 0
End If
Next
Log "Option executed: " & ExecOptions
End Sub