WINDOWS脚本实践:为SAP补丁制作的VBS脚本代码

'SAP设置脚本 
'编写:SCZ 2005.04.20 
'最后修改日期: 2005.04.22 
'必须存在目录: BW（补丁文件） 和 登入界面 
'======================================================================== 
'全局变量、处理过程 
'======================================================================== 
WScript.Echo "该脚本只能正常运行在WIN2000/XP/2003的操作系统管理员权限下，按'确定'继续" 
Set objFSO = CreateObject("Scripting.FileSystemObject") '文件系统对象 
strWindir = GetWindir()                    '获取WINDOWS目录 
strSystem = GetSystemPath()                '获取System目录 
strSapPath = GetSAPPath()                 'SAP FrontEnd目录 
strSapGuiPath = strSapPath  "SAPgui"            'SapGui目录 
strSapBWPath = strSapPath  "BW"            'BW目录 
strHostPath = GetHostFilePath()             'host 文件所在目录 
strServicesPath = GetServicesPath()             'services 文件所在目录 

Call CopyFiles()                    '复制文件 
Call ModifyHost(strHostPath)                '修改HOST文件 
Call ModifyServices(strServicesPath)            '修改SERVICES文件 
Call SetEvn(strSapGuiPath)                '设置环境变量 
Call SetTCPIP(strServicesPath)                '修改TCPIP参数 
WScript.Echo "BW设置处理完毕,请手动安装SAP系统补丁" 



'======================================================================== 
'通过注册获取SAP FrontEnd目录 
'======================================================================== 
Function GetSAPPath() 
    Const HKEY_LOCAL_MACHINE = H80000002 
    strComputer = "." 
    Set objReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\"  _ 
         strComputer  " ootdefault:StdRegProv") 

    strKeyPath = "SOFTWARESAPSAP Shared" 
    strEntryName = "SAPdestdir" 
    objReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath,strEntryName,strValue 
    GetSAPPath = strValue 
    If IsNull(strValue) Then  
        Wscript.Echo "SAP注册信息读取失败，SAP未安装或系统已损坏，安装终止" 
        Err.Raise(507) 
        Err.Clear 
    End If 
End Function 


'======================================================================== 
'获取WINDOWS目录 
'======================================================================== 
Function GetWindir() 
    Const WindowFolder = 0 
    Set GetWindir = objFSO.GetSpecialFolder(WindowFolder) 
End Function 


'======================================================================== 
'获取SYSTEM目录 
'======================================================================== 
Function GetSystemPath() 
    Const SystemFolder = 1 
    Set GetSystemPath = objFSO.GetSpecialFolder(SystemFolder) 
End Function 


'======================================================================== 
'获取HOST文件所在目录 
'======================================================================== 
Function GetHostFilePath() 
    GetHostFilePath = strSystem  "driversetc" 
End Function 


'======================================================================== 
'获取Services文件所在目录 
'======================================================================== 
Function GetServicesPath() 
    GetServicesPath = strSystem  "driversetc" 
End Function 

'======================================================================== 
'复制文件 
'======================================================================== 
Function CopyFiles() 
    If NOT objFSO.FolderExists(strSapBWPath) Then   
        WScript.Echo "BW组件未安装，请先安装SAP的BW组件，再运行该脚本" 
        Err.Raise(507) 
        Err.Clear 
    End If 

    Call ClearAttribs(strSapBWPath) 

    objFSO.CopyFile "登陆界面*.ini" , strWindir 
    objFSO.CopyFile "BWgssntlm.dll" , strSapGuiPath  "gssntlm.dll" 
    objFSO.CopyFile "BWsncgss32.dll" , strSystem   "sncgss32.dll" 

    strBakFolder =strSapBWPath  "ak" 
    IF NOT objFSO.FolderExists(strBakFolder) Then   
        objFSO.CreateFolder(strBakFolder) 
    Else  
        Call ClearAttribs(strBakFolder) 
    End If 

    objFSO.CopyFile strSapBWPath  "*.xla" , strBakFolder 
    objFSO.CopyFile "BW*.xla" , strSapBWPath 
End Function 

'======================================================================== 
'去除文件只读属性 
'======================================================================== 
Function ClearAttribs(strFolder) 
    Call ClearFileAttrib(strFolder  "sapbex.xla") 
    Call ClearFileAttrib(strFolder  "sapbexc.xla") 
    Call ClearFileAttrib(strFolder  "sapbexs.xla") 
    Call ClearFileAttrib(strFolder  "sapbex0.xla") 
    Call ClearFileAttrib(strSystem   "sncgss32.dll") 
End Function 

'======================================================================== 
'去除文件只读属性 
'======================================================================== 
Function ClearFileAttrib(strFile) 
    If objFSO.FileExists(strFile) Then  
        Set f = objFSO.GetFile(strFile) 
        f.Attributes = 0 
    End If  
End Function 

'======================================================================== 
'修改HOST文件 
'======================================================================== 
Function ModifyHost(strHostPath) 
    strHostFile = strHostPath  "hosts" 
    strHostBak = strHostPath  "hosts.bak" 
    Const ForReading = 1, ForWriting = 2, ForAppending = 8 
    objFSO.CopyFile strHostFile , strHostBak 
    Set objFile = objFSO.OpenTextFile(strHostFile, ForReading, False) 
    strContents = objFile.ReadAll 
    objFile.Close 

    Set objFile = objFSO.OpenTextFile(strHostFile, ForAppending, False) 
    objFile.WriteBlankLines 1 
    compResult = Instr(strContents,"192.168.0.136") 
    If compResult = 0 Then objFile.WriteLine("192.168.0.136"  Chr(9)  "bwprd") 
    compResult = Instr(strContents,"192.168.0.135") 
    If compResult = 0 Then objFile.WriteLine("192.168.0.135"  Chr(9)  "bwdev") 
    compResult = Instr(strContents,"192.168.0.171") 
    If compResult = 0 Then objFile.WriteLine("192.168.0.171"  Chr(9)  "bwqas") 
    objFile.close 
End Function  

'======================================================================== 
'修改SERVICES文件 
'======================================================================== 
Function ModifyServices(strServicesPath) 
    strServicesFile = strServicesPath  "services" 
    strServicesbak = strServicesPath  "services.bak" 
    Const ForReading = 1, ForWriting = 2, ForAppending = 8 
    objFSO.CopyFile strServicesFile , strServicesbak 
    Set objFile = objFSO.OpenTextFile(strServicesFile, ForReading, False) 
    strContents = objFile.ReadAll 
    objFile.Close 

    Set objFile = objFSO.OpenTextFile(strServicesFile, ForAppending, False) 
    objFile.WriteBlankLines 1 
    compResult = Instr(strContents, "sapmsP01") 
    If compResult = 0 Then objFile.WriteLine("sapmsP01"  Chr(9)  "3600/tcp") 
    objFile.Close 
End Function  

'======================================================================== 
'设置环境变量 
'------------------------------------------------------------------------ 
Function SetEvn(strSapGuiPath) 
    strComputer = "." 
    Set objWMIService = GetObject("winmgmts:\"  strComputer  " ootcimv2") 
    Set colItems = objWMIService.ExecQuery( "Select * from Win32_Environment where name = 'SNC_LIB'") 
    Found = False 

    For Each objItem in colItems 
        If UCase(objItem.Name) = "SNC_LIB" Then 
                Found = True 
                objItem.VariableValue = strSapGuiPath  "gssntlm.dll" 
                objItem.Put_ 
           End If 
    Next 

    If (Found = False) Then   
            Set oEvn = objWMIService.Get("Win32_Environment").Spawninstance_ 
            oEvn.Name = "SNC_LIB" 
            oEvn.VariableValue = strSapGuiPath  "gssntlm.dll" 
            oEvn.SystemVariable = True 
            oEvn.UserName = "SYSTEM>" 
            oEvn.Status = "OK" 
            Set oPath = oEvn.Put_ 
     End If 

End Function 

'======================================================================== 

'======================================================================== 
'设置TCP/IP参数 
'------------------------------------------------------------------------ 
Function SetTCPIP(strServicesPath) 
    Const HKEY_LOCAL_MACHINE = H80000002 
    strComputer = "." 
    Set objReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\"  _ 
         strComputer  " ootdefault:StdRegProv") 

    strKeyPath = "SYSTEMCurrentControlSetServicesTcpipParameters" 
    strEntryName = "DataBasePath" 
    objReg.SetStringValue HKEY_LOCAL_MACHINE,strKeyPath,strEntryName,strServicesPath 
End Function 
'========================================================================