PC Pro 2005 June (DVD)/DPPRO0605DVD.iso/dotNETJSharp/VJREDIST.EXE/jsredist.msi/Binary.BIN_File_138136

Text File | 2003-03-19 | 6.9 KB | 250 lines

REM
REM Script add Script Maps to the IIS MetaBase
REM
REM Partha Pratim Das 02/12/2002
REM (c) Microsoft Corporation
REM
REM Arguments passed as "[DEBUG]|[Add]|[MSNETINSTALLDIR]|"
REM
REM Adding Script Maps for .jsl, .vjsproj, .java to exclude GET, HEAD, POST, DEBUG
REM Example: 1|0|C:\WINDOWS\Microsoft.NET\Framework\v1.0.3705\|
REM
REM Options:
REM   1 : The script is allowed to run in directories given Script permission. If
REM       this value is not set, then the script can only be executed in directories
REM       that are flagged for Execute permission.
REM   4 : The server attempts to access the PATH_INFO portion of the URL, as a file,
REM       before starting the scripting engine. If the file canREMt be opened, or
REM       doesn't exist, an error is returned to the client.
REM   5 : Both of the above conditions are TRUE.
REM


REM Initializations...
' Please declare before you use
Option Explicit
' Ignore all errors
On Error Resume Next

' Constants
Const Handler = "aspnet_isapi.dll"
Const IISPath = "IIS://localhost/W3SVC"
Const ExList = "GET,HEAD,POST,DEBUG"
Const Opt = "1"


REM Parse the arguments
'For private testing
'Dim arg : arg = "1|0|C:\WINDOWS\Microsoft.NET\Framework\v1.0.3705\|"
' This is the actual stuff
Dim arg : arg = Session.Property( "CustomActionData" )
Dim argv : argv = Split( arg, "|", -1, 1 )

' Example: .jsl - C:\WINDOWS\Microsoft.NET\Framework\v1.0.3705\aspnet_isapi.dll 1 - GET,HEAD,POST,DEBUG
' Set the debug flag
Dim debug
If ( argv(0) = "0" ) Then
    debug = False
Else
    debug = True
End If

' Register or Unregister the maps...
Dim regSM
If ( argv(1) = "0" ) Then
    regSM = False
Else
    regSM = True
End If

' The stuff to register
Dim extns : extns = Array( ".jsl", ".java", ".vjsproj" )
Dim trailer : trailer = "," & argv(2) & Handler & "," & Opt & "," & ExList
Dim HandlerFullPath : HandlerFullPath = argv(2) & Handler

' Show what we have parsed
Dim Action : Action = "Unregister Script Map"
If debug Then
    If regSM Then Action = "Register Script Map"
    Dim pos, lst
    For pos = LBound( extns ) to UBound( extns )
          lst = lst & " " & extns(pos)
    Next
    lst = lst & " "
    MsgBox "Action : " & Action & vbCrLf & "Script Map : { " & lst & "}" & trailer
End If


REM Recursively Go Mad
Call RecursivelyGoMad( "w3svc" )


REM Subroutines and functions...
' Check is the map for the extension already exists
Function ScriptMapExist( IISObj, ext )

    Dim pos, Items, ScriptMaps

    ScriptMapExist = false
    ext = UCase( ext )
    ScriptMaps = IISObj.Scriptmaps
    ' Search for the ext in the map set
    For pos = LBound( ScriptMaps ) to UBound( ScriptMaps )
        Items = Split( Scriptmaps(pos), "," )
        If ( UCase( items(0) ) = ext ) Then
            ScriptMapExist = true
            Exit Function
        End If
    Next

End Function

Function AspnetInstalled( IISObj )

    Dim pos, ScriptMaps

    AspnetInstalled = false
    ScriptMaps = IISObj.Scriptmaps
    ' Search for the ext in the map set
    For pos = LBound( ScriptMaps ) to UBound( ScriptMaps )
        If ( InStr(UCase(Scriptmaps(pos)), UCase(HandlerFullPath)) > 0 ) Then
            AspnetInstalled = true
            Exit Function
        End If
    Next

End Function

' Add a map only if it is not already there
Sub Add( IISObj, ext, map )
    ' Don't add if aspnet_isapi is not installed in the scriptmap
    If ( AspnetInstalled( IISObj ) = false ) Then
        If debug Then
            MsgBox "Aspnet not installed: " & IISObj.AdsPath
        End If
        Exit Sub
    End If

    ' Check is the map is already there?
    If ( ScriptMapExist( IISObj, ext ) = true ) Then
        If debug Then
            MsgBox "Map Exists: " & map & vbCrLf & IISObj.AdsPath
        End If
        Exit Sub
    End If

    ' Obtain the current set of Script Maps
    Dim NewScriptMaps : NewScriptMaps = IISObj.ScriptMaps
    ReDim Preserve NewScriptMaps( UBound( NewScriptMaps ) + 1 )
    ' Insert the new map
    NewScriptMaps( UBound( NewScriptMaps ) ) = map
    ' Save the new set of script maps
    IISObj.ScriptMaps = NewScriptMaps
    IISObj.SetInfo

End Sub

' Delete a map only if it is there
Sub Delete( IISObj, ext )

    Dim pos2, Items, found

    found = false
    ext = UCase( ext )
    Dim ScriptMaps : ScriptMaps = IISObj.Scriptmaps
    ReDim NewScriptMaps(UBound( ScriptMaps ))
    NewScriptMaps(UBound( ScriptMaps )) = "Null"
    ' Search for the ext in the map set and dont add it to the new set
    pos2 = LBound( ScriptMaps )
    For pos = LBound( ScriptMaps ) to UBound( ScriptMaps )
        Items = Split( Scriptmaps(pos), "," )
        If ( UCase( items(0) ) <> ext ) Then
            NewScriptMaps(pos2) = ScriptMaps(pos)
            pos2 = pos2 + 1
        Else
            found = true
        End If
    Next

    ' Don't set any scriptmap property if J# extension isn't found
    If (found = false) Then
        Exit Sub
    End If

    ' Remove the last element if it is still "Null"
    If ( NewScriptMaps(UBound( ScriptMaps )) = "Null" ) Then
        ReDim Preserve NewScriptMaps( UBound( NewScriptMaps ) - 1 )
    Else
        If debug Then
            MsgBox "Map doesnt exist for " & ext & vbCrLf & IISObj.AdsPath
        End If
    End If
    ' Save the new set of script maps
    IISObj.ScriptMaps = NewScriptMaps
    IISObj.SetInfo

End Sub

Sub RecursivelyGoMad( objectPath )

    On Error Resume Next

    Dim IISObject, IISObjectPath, childObject, childObjectName

    Call SanitizePath( objectPath )
    IISObjectPath = "IIS://" & "localhost"
    IISObjectPath = IISObjectPath & "/" & objectPath

    ' Instantiate this IIS object
    Set IISObject = GetObject(IISObjectPath)

    ' Do the job for this IIS Object: remove/add the script maps
    Dim ext, map, i
    'Do we have to do
    If regSM Then
        ' We have to add the maps
        For i = LBound( extns ) to UBound( extns )
            ext = extns(i)
            map = ext & trailer
            Call Add( IISObject, ext, map )
        Next

    Else
        ' We have to remove maps
        For i = LBound( extns ) to UBound( extns )
            ext = extns(i)
            Call Delete( IISObject, ext )
        Next

    End If

    ' Now, do it for each children..
    For Each childObject In IISObject

        'If (Err.Number <> 0) Then Exit For

        ' Obtain the name of the child
        childObjectName = Right( childObject.AdsPath, Len( childObject.AdsPath ) - 6 )
        childObjectName = Right( childObjectName, Len( childObjectName ) - InStr( childObjectName, "/" ) + 1 )
        Call RecursivelyGoMad( childObjectName )

    Next

End Sub

' The insane path...
Sub SanitizePath( objectPath )

    ' Remove WhiteSpace, left and right
    Trim( objectPath )

    ' Remove back-slash, left and right
    If Left( objectPath, 1 ) = "/" Then
            objectPath = Right( objectPath, Len( objectPath ) - 1 )
    End If
    If Right( objectPath, 1) = "/" Then
            objectPath = Left( objectPath, Len( objectPath ) - 1 )
    End If

End Sub