Subversion Repositories DevTools

Option Explicit
'=====================================================
'        Name:  common_subs.vbs
' Description:  Contains list of common subs and functions
'=====================================================
'-----------------------------------------------------------------------------------------------------------------
' NOTE: This is NOT USED
' It is here only to satisfy Application variable in asp which VBS don't know about
Function Application( sParam )
        If sParam = "TNS_NAME" Then
                Application = ""
        ElseIf sParam = "RELEASE_MANAGER_LOGIN" Then
                Application = ""
        End If
End Function
'-----------------------------------------------------------------------------------------------------------------
Function ReadFile( SSpath )
        Dim filesys, rfile
        Set filesys = CreateObject("Scripting.FileSystemObject")
        
        On Error Resume Next
        If filesys.FileExists ( SSpath ) Then
        Set rfile = filesys.OpenTextFile( SSpath, 1, false)
        ReadFile = rfile.ReadAll
        rfile.close
    Else
        Call Raise_Event ( enumEVENT_ERROR, "[sub:ReadFile]", _
                                                                                        "File: "& SSpath, _
                                                                                        "File not found!", enum_RELEASE_NOTES_FAILED )
    End If
        
        Call ErrorCheck ( "[sub:ReadFile]", NULL )
        
        Set filesys = nothing
End Function
'-----------------------------------------------------------------------------------------------------------------
Sub SaveFile( SSpath, SSfilename, SScontent )
        Dim filesys, filetxt
        Set filesys = CreateObject("Scripting.FileSystemObject")
    WScript.Echo "Saving file "& SSpath &"\"& SSfilename &" ..."
    
        On Error Resume Next
        Set filetxt = filesys.CreateTextFile( SSpath &"\"& SSfilename, True )
        filetxt.WriteLine(SScontent)
        filetxt.Close
        
        Call ErrorCheck ( "[sub:SaveFile]", NULL )
        
        WScript.Echo "File Saved: "& SSpath &"\"& SSfilename
        Set filetxt = nothing
        Set filesys = nothing
End Sub
'-----------------------------------------------------------------------------------------------------------------
Sub DeleteFile( SSpath )
        Dim filesys
        Set filesys = CreateObject("Scripting.FileSystemObject")
        If filesys.FileExists(SSpath) Then
                filesys.DeleteFile SSpath 
        End If 
        Set filesys = nothing
End Sub
'-----------------------------------------------------------------------------------------------------------------
Sub DeleteFolder( SSpath )
        Dim  filesys
        Set filesys = CreateObject ("Scripting.FileSystemObject")
        If filesys.FolderExists( SSpath ) Then
                filesys.DeleteFolder SSpath, TRUE
        End If
End Sub
'-----------------------------------------------------------------------------------------------------------------
Function Folder_Is_Empty ( sPath )
        Dim filesys, oFolder
        Set filesys = CreateObject("Scripting.FileSystemObject") 
        
        If filesys.FolderExists( sPath ) Then
                Set oFolder = filesys.GetFolder( sPath )  
                If ( oFolder.Files.Count + oFolder.SubFolders.Count ) > 0 Then
                        Folder_Is_Empty = FALSE
                Else
                        Folder_Is_Empty = TRUE
                End If
        Else
                Folder_Is_Empty = TRUE
        End If
        
End Function
'-----------------------------------------------------------------------------------------------------------------
Function NVL ( SSvalue )
        If IsNull(SSvalue) Or SSvalue = "" Then
                NVL = " "
        Else
                NVL = SSvalue
        End If
End Function
'-----------------------------------------------------------------------------------------------------------------
Function Format_FileName( sPkg_name, sPkg_version, nPv_id )
        Dim name, version
        name =  Replace( sPkg_name, " ", "_")
        version = Replace( sPkg_version, " ", "")
        version = Replace( version, ".", "_")
        
        Format_FileName = RELESE_NOTES_PERFIX &"_"& nPv_id &"_"& name &"_"& version &".html"
End Function
'-----------------------------------------------------------------------------------------------------------------
Function Get_Application_Path ()
        Dim tempSTR
        tempSTR = WScript.ScriptFullName

        Get_Application_Path = Left( tempSTR, InStrRev( tempSTR, "\", InStrRev( tempSTR, "\" ) -1 ) )
End Function
'-----------------------------------------------------------------------------------------------------------------
Sub Include_File ( SSFile )
        Dim myInclude
        myInclude = ReadFile( SSFile )
        myInclude = Replace ( myInclude, "<%", "" )             ' Remove ASP tags
        myInclude = Replace ( myInclude, "%>", "" )             ' Remove ASP tags
        Execute( myInclude )
End Sub
'-----------------------------------------------------------------------------------------------------------------
Sub CRC_cksum ( SSfile_name, outCRC, outSize )
        Dim sysShell, crcDump, oExec, outStdErr, outStrOut, crcARR
        Set sysShell = WScript.CreateObject("WScript.Shell")
        
        
        Set oExec = sysShell.Exec( AppPath & CKSUM_EXE &" """& SSfile_name &"""" )
        
        outStdErr = oExec.StdErr.ReadLine
        outStrOut = oExec.StdOut.ReadLine
        
        If outStdErr = "" Then
                crcDump = Trim( outStrOut )
                crcDump = Replace ( crcDump, VBNewLine, "" )            ' Remove newline characters
                While InStr( crcDump, "  ") > 0
                        crcDump = Replace ( crcDump, "  ", " " )                ' Ensure single space between items
                Wend
        
                crcARR = Split ( crcDump, " " )         ' Split with space
                outCRC = crcARR(0)
                outSize = crcARR(1)
        Else
                outCRC = -1             ' Error occuerd during cksum. Can be no read permissions
                outSize = -1
        End If
        
        Set sysShell = nothing
End Sub
'-----------------------------------------------------------------------------------------------------------------
Sub CRC_modcrc ( SSfile_name, SSfile_path, outCRC, outSize )
        Dim sysShell, crcDump, oExec, outStdErr, outStrOut, crcARR
        Set sysShell = WScript.CreateObject("WScript.Shell")
        
        Set oExec = sysShell.Exec( AppPath & MODCRC_EXE &" -m="& SSfile_path & SSfile_name &" -i=thx" )

        outStdErr = oExec.StdErr.ReadLine
        outStrOut = oExec.StdOut.ReadLine
        
        If outStdErr = "" Then
                crcDump = Trim( outStrOut )
                crcDump = Replace ( crcDump, VBNewLine, "" )            ' Remove newline characters
                While InStr( crcDump, "  ") > 0
                        crcDump = Replace ( crcDump, "  ", " " )                ' Ensure single space between items
                Wend
        
                crcARR = Split ( crcDump, " " )         ' Split with space
                outCRC = crcARR(4)
                outSize = crcARR(6)
        Else
                outCRC = -1             ' Error occuerd during cksum. Can be no read permissions
                outSize = -1
        End If
        
        Set sysShell = nothing
End Sub
'-----------------------------------------------------------------------------------------------------------------
Sub Raise_Event ( eventType, SSlocation, SSvalues, SSerror_message, sDBmsg )
        Dim WshShell, WshNetwork, objArgs, i, agrSTR, SSmsg
        Set WshShell = WScript.CreateObject("WScript.Shell")
    Set WshNetwork = WScript.CreateObject("WScript.Network")
    
        Set objArgs = WScript.Arguments
        For i = 0 to objArgs.Count - 1
           agrSTR = agrSTR & objArgs(i) & VBNewLine
        Next
        
        ' Compose Message
        SSmsg = _
        "-- Script Info  --"& VBNewLine &_
        "Host Name: "& WshNetwork.ComputerName & VBNewLine &_
        "Script Name: "& WScript.ScriptName & VBNewLine & VBNewLine &_
        "-- Script Parameters --"& VBNewLine &_
        agrSTR &_
        VBNewLine &_
        "-- Error Location --"& VBNewLine &_
        SSlocation & VBNewLine &_
        VBNewLine &_
        "-- Values --"& VBNewLine &_
        SSvalues & VBNewLine &_
        VBNewLine &_
        "-- Error Message --"& VBNewLine &_
        SSerror_message & VBNewLine 
        
        '-- Raise this message at these places...
        Wscript.Echo SSmsg
        WshShell.LogEvent eventType, SSmsg
        'Call Alert_Admin ( SSmsg )
        '----------------------------------------
        
        Set WshShell = Nothing
        
        If Not IsNull(sDBmsg) Then Call Write_To_Release_Notes_Info ( parPv_id, sDBmsg )
        If eventType = enumEVENT_ERROR Then WScript.Quit    ' Only Quit if ERROR
        
End Sub
'-----------------------------------------------------------------------------------------------------------------
Sub ErrorCheck ( ERRlocation, ERRvals )
        If Err.Number <> 0 Then
                Call Raise_Event ( enumEVENT_ERROR, ERRlocation, ERRvals, Err.Source &" "& Err.Description, enum_RELEASE_NOTES_FAILED  )
        End If
        Err.Clear
End Sub
'-----------------------------------------------------------------------------------------------------------------
Sub Alert_Admin ( SSmsg )
        'Call Send_Email ( adminEmail, adminEmail, "Windows Script Alert!", SSmsg )
End Sub
'-----------------------------------------------------------------------------------------------------------------
Sub Send_Email ( SSfrom, SSto, SSsubject, SSbody )
        'Dim objCDOMail
        'Set objCDOMail = CreateObject("CDONTS.NewMail")
        ''objCDOMail.From = Request.Form("firstName") & " " & Request.Form("lastName") & " <" & strReturnEmailAddress & ">"
        'objCDOMail.From = SSfrom
        'objCDOMail.To = SSto
        ''objCDOMail.Cc = strCCEmailAddress
        ''objCDOMail.Bcc = strBCCEmailAddress
        'objCDOMail.Subject = SSsubject
        'objCDOMail.BodyFormat = 1                              ' 0 = HTML, 1 = Plain
        'objCDOMail.MailFormat = 1                              ' 0 = MIME, 1 = Text
        'objCDOMail.Importance = 0                              ' 0 = High, 1 = Medium, 2 = Low
        ''objCDOMail.attachFile ("c:\images\mypicture.gif") ' you can also attach files 
        'objCDOMail.Body = SSbody
        ''objCDOMail.Send
        'Set objCDOMail = Nothing
End Sub
'-----------------------------------------------------------------------------------------------------------------
Sub Get_PV_ID ( SSpkg_name, SSpkg_version, outPV_ID)
        Dim Query_String, rsTemp
        
        If outPV_ID <> "" Then Exit Sub         ' PV_ID already assigned
        
        Query_String = _
        " SELECT pv.pv_id"&_
        " FROM packages pkg,"&_
        "      package_versions pv"&_
        " WHERE pv.pkg_id = pkg.pkg_id"&_
        "   AND pkg.pkg_name = '"& SSpkg_name &"'"&_
        "   AND pv.pkg_version = '"& SSpkg_version &"'"
        Set rsTemp = OraDatabase.CreateDynaset( Query_String, cint(0))
        
        If ((NOT rsTemp.BOF) AND (NOT rsTemp.EOF)) Then
                outPV_ID = rsTemp("pv_id")
        Else
                Call Raise_Event ( enumEVENT_ERROR, "[sub:Get_PV_ID]", _
                                                                                        "pkg_name: "& SSpkg_name & VBNewLine &_
                                                                                        "pkg_version: "& SSpkg_version , _
                                                                                        "pkg_name and/or pkg_version not found in Release Manager database!", enum_RELEASE_NOTES_FAILED )
        End If
        rsTemp.Close
        Set rsTemp = Nothing
End Sub
'-----------------------------------------------------------------------------------------------------------------
Function Get_Package_Type ( NNpv_id )
        Dim Query_String, rsTemp
        
        Query_String = ReadFile( AppPath & QUERIES_FOLDER & "\package_type.sql" )
        OraDatabase.Parameters.Add "PV_ID", NNpv_id, ORAPARM_INPUT, ORATYPE_NUMBER
        OraDatabase.Parameters.Add "enumBASE_VIEW_PRODUCTS", enumBASE_VIEW_PRODUCTS, ORAPARM_INPUT, ORATYPE_NUMBER
        Set rsTemp = OraDatabase.CreateDynaset( Query_String, cint(0))
        
        If ((NOT rsTemp.BOF) AND (NOT rsTemp.EOF)) Then
                If Not IsNull( rsTemp("message") ) Then 
                        Get_Package_Type = Eval(rsTemp("message"))
                Else
                        Get_Package_Type = enumPKG_TYPE_GENERIC_DPKG
                End If
        Else
                Get_Package_Type = enumPKG_TYPE_GENERIC_DPKG
        End If
        
        WScript.Echo "Package Type : "& Get_Package_Type
        
        OraDatabase.Parameters.Remove "PV_ID"
        OraDatabase.Parameters.Remove "enumBASE_VIEW_PRODUCTS"
        rsTemp.Close
        Set rsTemp = Nothing
End Function
'-----------------------------------------------------------------------------------------------------------------
Sub Get_Pkg_Name_Version ( NNpv_id, outPkg_name, outPkg_version )
        Dim Query_String, rsTemp
        
        Query_String = _
        " SELECT pkg.pkg_name, pv.pkg_version"&_
        " FROM packages pkg,"&_
        "      package_versions pv"&_
        " WHERE pv.pkg_id = pkg.pkg_id"&_
        "   AND pv.pv_id = "& NNpv_id 
        Set rsTemp = OraDatabase.CreateDynaset( Query_String, cint(0))
        
        If ((NOT rsTemp.BOF) AND (NOT rsTemp.EOF)) Then
                outPkg_name = rsTemp("pkg_name")
                outPkg_version = rsTemp("pkg_version")
        Else
                Call Raise_Event ( enumEVENT_ERROR, "[sub:Get_Pkg_Name_Version]", _
                                                                                        "PV_ID: "& NNpv_id , _
                                                                                    "PV_ID not found in Release Manager database!", enum_RELEASE_NOTES_FAILED )
        End If
        
        rsTemp.Close
        Set rsTemp = Nothing
End Sub
'-----------------------------------------------------------------------------------------------------------------
Sub Check_Requirements_To_Proceed ( nPv_id )
        Dim Query_String, rsTemp
        
        ' Exit if Release Notyes Generation is forced
        If objArgs.Named.Item("f") <> "" Then Exit Sub
        
        
        Query_String = _
        " SELECT pv.release_notes_info"&_
        " FROM package_versions pv"&_
        " WHERE pv.pv_id = "& nPv_id
        
        Set rsTemp = OraDatabase.CreateDynaset( Query_String, cint(0))
        
        If rsTemp("release_notes_info") <> enum_RELEASE_NOTES_GENERATING Then
            WScript.Echo "Exiting this job. release_notes_info in [PACKAGE_VERSIONS] table is ("& rsTemp("release_notes_info") &")"
            WScript.Echo "Expected value is ("& enum_RELEASE_NOTES_GENERATING &")"
            Call Raise_Event ( enumEVENT_ERROR, "[sub:Check_Requirements_To_Proceed]", _
                                                                                        "PV_ID: "& nPv_id , _
                                                                                    "Exiting this job. release_notes_info in [PACKAGE_VERSIONS] table is ("& rsTemp("release_notes_info") &")", NULL )
        End If
        
        rsTemp.Close
        Set rsTemp = Nothing
End Sub
'-----------------------------------------------------------------------------------------------------------------
Sub Write_To_Release_Notes_Info ( nPv_id, sMsg )
    WScript.Echo "Writing message to release_notes_info in [PACKAGE_VERSIONS] table."
    WScript.Echo sMsg
    OraSession.BeginTrans
        OraDatabase.ExecuteSQL " UPDATE package_versions "&_
                                                   " SET release_notes_info = '"& sMsg &"'"&_
                                                   " WHERE pv_id = "& nPv_id
    OraSession.CommitTrans
End Sub
'-----------------------------------------------------------------------------------------------------------------
Function FormatTextBox ( SSstr ) 
        If SSstr <> "" Or NOT IsNull(SSstr) Then
                FormatTextBox = Replace ( SSstr, VBNewLine, "<br>") 
        End If
End Function
'-----------------------------------------------------------------------------------------------------------------
Function HTML_Encode ( sSTR )
    Dim tempSTR
    tempSTR = sSTR
    If IsNull( tempSTR ) Or tempSTR = "" Then
        HTML_Encode = ""
    Else
        tempSTR = Replace ( tempSTR, "&", "&amp;" )
        tempSTR = Replace ( tempSTR, "<", "&lt;" )
        tempSTR = Replace ( tempSTR, ">", "&gt;" )
        HTML_Encode = tempSTR
    End If
End Function
'-----------------------------------------------------------------------------------------------------------------------------
Function EuroDate ( dDate )
        ' Ensures Euro Date format DD/MM/YYYY
        If IsNull(dDate) Then Exit Function
        EuroDate = Day(dDate) &"/"& Month(dDate) &"/"& Year(dDate)
End Function
'-----------------------------------------------------------------------------------------------------------------------------
Function EuroDateTime ( dDate )
        ' Ensures Euro DateTime format DD/MM/YYYY H24:MIN:SS
        If IsNull(dDate) Then Exit Function
        EuroDateTime = Day(dDate) &"/"& Month(dDate) &"/"& Year(dDate) &" "& FormatDateTime( dDate, 4 )
End Function
'-----------------------------------------------------------------------------------------------------------------