VBScript

Function GetFileName( myDir, myFilter )
' This function opens a File Open Dialog and returns the
' fully qualified path of the selected file as a string.
' http://www.robvanderwoude.com/vbstech_ui_fileopen.php
' Arguments:
' myDir is the initial directory; if no directory is
' specified "My Documents" is used;
' NOTE: this default requires the WScript.Shell
' object, and works only in WSH, not in HTAs!
' myFilter is the file type filter; format "File type description|*.ext"
' ALL arguments MUST get A value (use "" for defaults), OR otherwise you must
' use "On Error Resume Next" to prevent error messages.
'
' Dependencies:
' Requires NUSRMGRLib (nusrmgr.cpl), available in Windows XP and later.
' To use the default "My Documents" WScript.Shell is used, which isn't
' available in HTAs.
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com

' Standard housekeeping
Dim objDialog

' Create a dialog object
Set objDialog = CreateObject( "UserAccounts.CommonDialog" )

' Check arguments and use defaults when necessary
If myDir = "" Then
' Default initial folder is "My Documents"
        objDialog.InitialDir = CreateObject( "WScript.Shell" ).SpecialFolders( "MyDocuments" )
Else
' Use the specified initial folder
        objDialog.InitialDir = myDir
End If
If myFilter = "" Then
' Default file filter is "All files"
        objDialog.Filter = "All files|*.*"
Else
' Use the specified file filter
        objDialog.Filter = myFilter
End If

' Open the dialog and return the selected file name
If objDialog.ShowOpen Then
        GetFileName = objDialog.FileName
Else
        GetFileName = ""
End If
End Function

'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

MSILog "My CA : ", "Event to record"

Function MSILog(strPrefix, strMessage)

    ' Create a Windows Installer Error Log entry and pass it to the session.

    Dim LogRecord

    Set LogRecord = Installer.CreateRecord(1)

    LogRecord.StringData(1) = strPrefix & strMessage

    Session.Message &H04000000, LogRecord

    Set LogRecord = Nothing

 End Function

'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
function isCScript()
'returns True of False depending on whether we are using the cscript script engine or not
if InStr(1,WScript.FullName,"cscript.exe",vbTextCompare)>0 Then
      isCScript = true
    Else
      isCScript = False
    End If
End Function
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Function GetSpecialFolder(ByVal hSpecialFolder)
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' Function for returning Special folders
' takes a special folder name and retruns the location if it can or an empty
' string if it is not supported by this function.  Note that the folder can
' be defined by the OS without necessarily existing
' see TechNet Enumerating Special Folders for a list:
' http://technet.microsoft.com/en-us/library/ee176604.aspx
' http://msdn.microsoft.com/en-us/library/bb774096(v=VS.85).aspx
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Dim objShell, objFolder, objFolderItem
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(hSpecialFolder)
On Error Resume Next
Set objFolderItem = objFolder.Self
'WScript.Echo Err.Number & ":" & Err.Description
If Err.Number = 0 Then
On Error Goto 0
GetSpecialFolder = objFolderItem.Path
Else
GetSpecialFolder = "ERROR_" & Err.Number & "_" & Replace(Err.Description," ","_")
On Error Goto 0
End if
End Function
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Function CSI_GetOSBits() 
    CSI_GetOSBits = GetObject("winmgmts:root\cimv2:Win32_Processor='cpu0'").AddressWidth 
End Function
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Function CreateFullFolder (strFolder)
'recursively creates a folder branch to put a log file into
    Dim objFSO
    Set objFSO = CreateObject( "Scripting.FileSystemObject" )
    CreateFullFolder = False
    'msgbox strfolder
    If Not objFSO.FolderExists(strFolder) Then
    'msgbox objFSO.GetParentFolderName(strFolder)
CreateFullFolder (objFSO.GetParentFolderName(strFolder))
'create it
objFSO.CreateFolder strFolder
CreateFullFolder = objFSO.FolderExists(strFolder)
Else
CreateFullFolder = True
End If
End Function
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Const EVT_LOG_EVENT_SUCCESS = 0
Const EVT_LOG_EVENT_ERROR = 1
Const EVT_LOG_EVENT_WARNING = 2
Const EVT_LOG_EVENT_INFORMATION = 4
Const EVT_LOG_EVENT_AUDIT_SUCCESS = 8
Const EVT_LOG_EVENT_AUDIT_FAILURE = 16

Const EVT_LOG_LEVEL_VERBOSE = 2
Const EVT_LOG_LEVEL_ERROR_ONLY = 1
Const EVT_LOG_LEVEL_NONE = 0

Dim intLogLevel
intLogLevel = EVT_LOG_LEVEL_ERROR_ONLY

If intLogLevel > EVT_LOG_LEVEL_ERROR_ONLY Then EventLog EVT_LOG_EVENT_INFORMATION, "Hello World"

Function EventLog(intType,strEvtText)
'writes WSH event to application Log, prefixed with script filename
'returns vbTrue if written ok or vbFalse if failed (eg bad parms or perms perhaps)
Dim WshShell
Set WshShell = WScript.CreateObject("WScript.Shell")
On Error Resume Next
    WshShell.LogEvent intType, "Event logged by " & WScript.ScriptFullName & ":" & vbCrLf & strEvtText
If Err.Number = 0 Then
        EventLog = vbTrue
Else
        EventLog = vbFalse
End If
On Error Goto 0
End Function

'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
ċ
James Delap,
16 Mar 2016, 02:23
ċ
James Delap,
16 Mar 2016, 02:24
ċ
James Delap,
16 Mar 2016, 02:24
ċ
James Delap,
16 Mar 2016, 02:24
ċ
James Delap,
16 Mar 2016, 02:24
ċ
James Delap,
16 Mar 2016, 02:22
Comments