''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright (c) Microsoft Corporation. All rights reserved.
' THIS CODE IS MADE AVAILABLE AS IS, WITHOUT WARRANTY OF ANY KIND. THE ENTIRE
' RISK OF THE USE OR THE RESULTS FROM THE USE OF THIS CODE REMAINS WITH THE
' USER. USE AND REDISTRIBUTION OF THIS CODE, WITH OR WITHOUT MODIFICATION, IS
' HEREBY PERMITTED.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This script detaches all ISA Server MSDE log databases older than 30 days.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Main
Sub Main
Dim shell ' A WshShell object
Dim serverName ' A String
Dim cn ' An ADODB Connection object
Dim rs ' An ADODB Recordset object
Dim cmd ' An ADODB Command object
Dim cmdText ' A String
Dim dbName ' A String
Dim oldDate ' A Variant
Dim oldDateText ' A String
Dim oldDay ' A String
Dim oldMonth ' A String
Dim datePart ' A String
Dim dbCounter ' An Integer
Dim dDbCounter ' An Integer
' If the script was not launched with Cscript, display the usage and quit.
On Error Resume Next
Set shell = CreateObject("WScript.Shell")
If Err.Number <> 0 Then
ReportError "creating the WshShell object."
WScript.Quit
End If
On Error GoTo 0
If LCase(Right(WScript.FullName, 11)) <> "cscript.exe" Then
WScript.Echo "Usage:" & VbCrLf _
& " This script can be run from a command prompt " & VbCrLf _
& " by entering the following command:" & VbCrLf _
& " Cscript " & WScript.ScriptName
WScript.Quit
End If
' Get the name of the local ISA Server computer.
On Error Resume Next
serverName = shell.ExpandEnvironmentStrings("%ComputerName%")
If Err.Number <> 0 Then
ReportError "reading the %ComputerName% environment variable."
WScript.Quit
End If
On Error GoTo 0
' Create and open an ADODB Connection object.
Set cn = CreateObject("ADODB.Connection")
cn.ConnectionTimeout = 25
cn.Provider = "SQLOLEDB"
cn.Properties("Data Source").Value = serverName & "\MSFW"
cn.Properties("Integrated Security").Value = "SSPI"
On Error Resume Next
cn.Open
If Err.Number <> 0 Then
ReportError "opening a database connection."
WScript.Quit
End If
On Error GoTo 0
' Create and open an ADODB Recordset object to get the collection
' of active databases.
Set rs = CreateObject("ADODB.Recordset")
cmdText = "SELECT name, size FROM sysaltfiles WHERE name like 'ISALOG_%'"
rs.Open cmdText, cn
' Create an ADODB Command object.
On Error Resume Next
Set cmd = CreateObject("ADODB.Command")
If Err.Number <> 0 Then
ReportError "creating a Command object."
WScript.Quit
End If
On Error GoTo 0
' Get the date that was 30 days ago and convert it to a string
' in the YYYYMMDD format.
oldDate = DateAdd("d", -30, Now)
oldMonth = Month(oldDate)
If Len(oldMonth) < 2 Then oldMonth = "0" & oldMonth
oldDay = Day(oldDate)
If Len(oldDay) < 2 Then oldDay = "0" & oldDay
oldDateText = Year(oldDate) & oldMonth & oldDay
WScript.Echo "Databases that were created before " _
& FormatDateTime(oldDate, vbShortDate) & " will be detached." & vbCrLf
' Iterate through the databases, find databases that are over 30 days old,
' and then detach them.
dbCounter = 0
dDbCounter = 0
rs.MoveFirst
Do While Not rs.EOF
dbName = rs("name")
If Mid(dbName, 24, 4) <> "_log" Then
dbCounter = dbCounter + 1
End If
If Left(dbName, 6) = "ISALOG" And Mid(dbName, 24, 4) <> "_log" Then
'Get the date part of the dbName
datePart = Mid(dbName, 8, 8)
' If the database is older than 30 days, call the DetachDB
' subprocedure to detach it.
If CLng(datePart) < CLng(oldDateText) Then
DetachDB cn, cmd, dbName
dDbCounter = dDbCounter + 1
End If
End If
rs.MoveNext
Loop
If dDbCounter > 0 Then
WScript.Echo "Detached " & dDbCounter & " of " & dbCounter _
& " databases."
Else
WScript.Echo "No active databases over 30 days old were found."
End If
End Sub
Sub DetachDB(cn, cmd, dbName)
WScript.Echo "Detaching " & dbName & " ..."
cmd.CommandText = "sp_detach_db " & dbName
Set cmd.ActiveConnection = cn
On Error Resume Next
cmd.Execute
If Err.Number <> 0 Then
ReportError "attempting to detach " & dbName & "."
WScript.Quit
End If
On Error GoTo 0
End Sub
Sub ReportError(message)
WScript.Echo "An error was encountered while " & message & vbCrLf _
& "Number : " & Hex(Err.Number) & vbCrLf _
& "Description : " & Err.Description
Err.Clear
End Sub