VBScript: Clean Up Imported SIM Card Contacts in Outlook

Filed under: VBScript — Written by Chrissy on Friday, April 11th, 2008 @ 2:11 pm

The other day, I was texting a friend and some guy looked at me and said "Oh hey, 2002 called, it wants its T9 back." Haha, slightly cliche but I laughed anyway. Then I went and bought myself a Blackberry.

I totally love it, I won't lie. So I imported my contacts into Outlook from a Sony Ericsson mobile phone and they came out kinda chu-chu. All the contacts came in as "Work" numbers and were all prefixed by ";\M". I cleaned the M's out manually but then wrote a script to list all the numbers as Mobile numbers. For consistency's sake, I also cleaned up all of the numbers themselves to just be, for instance, 2345551212. Here's the script in case you would like to do a mass cleanse as well.

Set objOutlook = CreateObject("Outlook.Application")
Set objNamespace = objOutlook.GetNamespace("MAPI")
 
Set colContacts = objNamespace.GetDefaultFolder(10).Items ' 10 = olFolderContacts
 
For Each objContact In colContacts
  if len(objContact.MobileTelephoneNumber) = 0 then
    objContact.MobileTelephoneNumber = objContact.BusinessTelephoneNumber
    objContact.BusinessTelephoneNumber = ""
    'Wscript.Echo objContact.FullName, objContact.BusinessTelephoneNumber, objContact.MobileTelephoneNumber
    objContact.Save
  end if
  
  if len(objContact.MobileTelephoneNumber) > 0 then
    mobileNumber = objContact.MobileTelephoneNumber
    mobileNumber = replace(mobileNumber," ","")
    mobileNumber = replace(mobileNumber,"-","")
    mobileNumber = replace(mobileNumber,"(","")
    mobileNumber = replace(mobileNumber,")","")
    mobileNumber = replace(mobileNumber,"+1","")
    
    if left(mobileNumber,1) = "1" then mobileNumber = right(mobileNumber,len(mobileNumber)-1)
    objContact.MobileTelephoneNumber = mobileNumber
    objContact.Save
  End if
  
Next

Ouu my grammar has gone downhill since I spent a weekend in Louisiana.

T-SQL Equivalent of VBScript's FormatDateTime Function

Filed under: Quick Code, SQL Server, VBScript — Written by Chrissy on Tuesday, July 3rd, 2007 @ 8:17 am

Looking for the T-SQL (somewhat) equivalent to VBScript's FormatDateTime function? I've been too, for years. I finally found it within the CONVERT() function. As stated in SQL Server Books Online:

In CONVERT ( data_type [ ( length ) ] , expression [ , style ] ), style is the style of the date format used to convert datetime or smalldatetime data to character data (nchar, nvarchar, char, varchar, nchar, or nvarchar data types); or the string format used to convert float, real, money, or smallmoney data to character data (nchar, nvarchar, char, varchar, nchar, or nvarchar data types). When style is NULL, the result returned is also NULL.

Manuj Bahl wrote a nice article covering date and time manipulation in SQL Server 2000 and it in, he summarized BOL's table that lists the different style types. It went something like this:

Style ID Style Type
0 or 100 mon dd yyyy hh:miam (or pm)
101 mm/dd/yy
102 yy.mm.dd
103 dd/mm/yy
104 dd.mm.yy
105 dd-mm-yy
106 dd mon yy
107 mon dd, yy
108 hh:mm:ss
9 or 109 mon dd yyyy hh:mi:ss:mmmam (or pm)
110 mm-dd-yy
111 yy/mm/dd
112 yymmdd
13 or 113 dd mon yyyy hh:mm:ss:mmm(24h)
114 hh:mi:ss:mmm(24h)
20 or 120 yyyy-mm-dd hh:mi:ss(24h)
21 or 121 yyyy-mm-dd hh:mi:ss.mmm(24h)
126 yyyy-mm-dd thh:mm:ss.mmm(no spaces)
130 dd mon yyyy hh:mi:ss:mmmam
131 dd/mm/yy hh:mi:ss:mmmam

Try this out with GETDATE() by running the following statement:
SELECT CONVERT(VARCHAR,GETDATE(),7) AS currentdate

Your results should look something like this: Jul 03, 07 Nice! Have fun :)

VBScript: Forward SQL Server Alerts/Windows Events to (Cingular) SMS

Filed under: SQL Server, VBScript — Written by Chrissy on Friday, May 11th, 2007 @ 6:11 pm

Someone recently asked why I don't use SQL Mail on my SQL Servers (2000 and below). The answer is: I don't want to install Outlook on my SQL Servers. Sure, there are ways around it but I prefer just using "net send" to alert the Operator (moi) then forwarding those messages on to my inbox and phone.

Although my employer offered me a Blackberry, I never really cared for them. The battery life is just too short and I don't like talking into something the size of my hand. So.. I use a regular phone that doesn't receive e-mails easily. It does, however, love to receive texts. Cingular even gave me an email address to go with my phone and this is what I use to Alert me if any of my jobs (Backups, Optimizations, etc) fail.

First, I created a DNS CNAME record to my workstation called DBAWorkstation. Then I created an operator named DBA Workstation. I like to keep things generic in the event that I leave or my workstation name changes. In the event that happens, there's just one change at the DNS level. So next, I set the jobs to alert this operator via net send if any jobs fail. Finally, I set up a script that runs all the time on my workstation which has IIS's SMTP installed locally:

'****************************************************************************
' This script created by Chrissy LeMaire (clemaire@gmail.com)
' Website: http://netnerds.net/
'
' NO WARRANTIES, etc.
'
' This script monitors Windows Events and forwards any Application Popups
' to an email address
'*****************************************************************************
 
' Push Event Viewer Alert
    Set objWMIService = GetObject("winmgmts:{(security)}!root/cimv2")
    Set eventSink = wscript.CreateObject("WbemScripting.SWbemSink", "EVSINK_")
    strWQL = "Select * from __InstanceCreationEvent where TargetInstance isa  'Win32_NTLogEvent' and TargetInstance.SourceName = 'Application Popup' and TargetInstance.EventCode = 26"
    objWMIService.ExecNotificationQueryAsync eventSink,strWQL
 
' Keep it going forever
While (True)
    Wscript.Sleep(1000)
Wend
 
Sub EVSINK_OnObjectReady(objObject, objAsyncContext)
'Here's where I do a whole lot of cleaning. Edit to your liking.
   strCleanedMsg = replace(objObject.TargetInstance.Message,"Application popup: Messenger Service  : ","")
   strCleanedMsg = replace(strCleanedMsg,"Message from ","")
   strCleanedMsg = replace(strCleanedMsg," to " & objObject.TargetInstance.ComputerName,"")
   strCleanedMsg = replace(strCleanedMsg," for DB Maintenance Plan 'DB Maintenance for All DBs'","")
   strCleanedMsg = replace(strCleanedMsg,"JOB RUN:","")
   strCleanedMsg = replace(strCleanedMsg," was run on "," failed around ")
   strCleanedMsg = Left(strCleanedMsg,InStr(strCleanedMsg,"DURATI")-2)
   If Len(strCleanedMsg) > 159 Then strCleanedMsg = Left(strCleanedMsg,159) ' SMS allows max 160 characters. I picked 159 just in case.
 
    Set objCDO = CreateObject("CDO.Message")
    objCDO.From = "SQL Alert <me@myemployer.com>"
    objCDO.To = "0000000000@cingularme.com" ' Phone number goes there. Cingular does the SMS magic
    objCDO.CC = "me@myemployer.com"
    objCDO.TextBody = strCleanedMsg
    objCDO.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 1 'cdoSendUsingPort (1 = local, 2= remote, 3 = Exchange)
    objCDO.Configuration.Fields.Update
    objCDO.Send
    set objCDO = Nothing
End Sub

Run that script as a service and you're set with SMS/E-mail notifications in SQL Server 2000 and below. SQL Server 2005 can do the same thing..but e-mail is much more accessible within the service itself.

Active Directory: E-mail Notification for Newly Added Users and Computers

Filed under: Active Directory, Quick Code, VBScript — Written by Chrissy on Monday, February 12th, 2007 @ 8:26 am

Recently, someone asked if there was a way to be notified when servers have been added to an Active Directory domain. I looked around the Internet and it seems there's not a direct way to do this without some large software package. So in lieu of having an instant notification, I created a script that tallies up newly added user and computer accounts and emails the admin with all the info. This script is initially setup to be run once a day, but you can modify to whatever frequency you want.

I really expected this to take at most a couple hours to write but parsing through all the data turned out to take a heckofa lot of time. From converting the desired comparison date to UTC to parsing the AD attribute memberOf, I spent a good day working on this. I learned a lot, though and found this page which details the AD schema to be very helpful.

If you need anything more than this, you may want to consider an enterprise-type administration package such as Microsoft's MOM.

ADAddedUsersNComputers.vbs

'****************************************************************************
' This script created by Chrissy LeMaire (clemaire@gmail.com)
' Website: http://netnerds.net/
'
' ADAddedUsersNComputers.vbs
'
' This script Checks AD for any additions made to Users or Computers
' in the past 24 hours. The time interval to check can be changed below.
'
' NO WARRANTIES, USE THIS AT YOUR OWN RISK, etc.
'*****************************************************************************
 
'Please modify these four settings
strSMTPServer = "myexchangeserver"
strEmailFrom = "Administrator  <me@mydomain.com>"
strEmailTo = "Administrator <me@mydomain.com>"
 
strTimeInUTC = CompareDateUTCConvert("h",-24) 'This is the same syntax as dateAdd(). The example will get new users/computers added in the past 24 hours.
 
'Unless you want to change the domain to check or the format of the emailed info, nothing below really needs to be modified.
On Error Resume Next
numPersonCount = 0
numComputerCount = 0
 
Set objAdRootDSE = GetObject("LDAP://RootDSE")
Set objRS = CreateObject("adodb.recordset")
  varConfigNC = objAdRootDSE.Get("defaultNamingContext")
  strConnstring = "Provider=ADsDSOObject"
  strWQL = "SELECT ADsPath FROM 'LDAP://" & varConfigNC & "' WHERE createTimeStamp > '" & strTimeInUTC & "' and (objectCategory = 'Person' or objectCategory = 'Computer')"
 
  objRS.Open strWQL, strConnstring
      Do until objRS.eof
        Set objADUserOrComputer = GetObject(objRS.Fields.Item(0))
        strObjectCategory = ParseDN(objADUserOrComputer.objectCategory)
 
        Select Case strObjectCategory
        Case "Person"
        numPersonCount = numPersonCount + 1
            If Len(objADUserOrComputer.displayName) > 0 Then strUserMsg = strUserMsg & vbCrLf & "displayName = " & objADUserOrComputer.displayName
            'strUserMsg = strUserMsg & vbCrLf & "distinguishedName = " & objADUserOrComputer.distinguishedName
            strUserMsg = strUserMsg & vbCrLf & "sAMAccountName = " & objADUserOrComputer.sAMAccountName
            strUserMsg = strUserMsg & vbCrLf & "sAMAccountType = " & SAMAccountTypetoName(objADUserOrComputer.sAMAccountType)
            strUserMsg = strUserMsg & vbCrLf & "whenChanged = " & objADUserOrComputer.whenChanged
            strUserMsg = strUserMsg & vbCrLf & "whenCreated = " & objADUserOrComputer.whenCreated
            strUserGroups = ParseMemberOf(objADUserOrComputer.memberOf,objADUserOrComputer.PrimaryGroupID)
            strUserMsg = strUserMsg & vbCrLf & "Member Of: " & strUserGroups
            If Len(objADUserOrComputer.userPrincipalName) > 0 Then strUserMsg = strUserMsg & vbCrLf & "userPrincipalName = " & objADUserOrComputer.userPrincipalName
            strUserMsg = strUserMsg & vbCrLf
         Case "Computer"
         numComputerCount = numComputerCount + 1
            strCompMsg = strCompMsg & vbCrLf & "dNSHostName = " & objADUserOrComputer.dNSHostName
            strCompMsg = strCompMsg & vbCrLf & "isCriticalSystemObject = " & objADUserOrComputer.isCriticalSystemObject
            strCompMsg = strCompMsg & vbCrLf & "operatingSystem = " & objADUserOrComputer.operatingSystem
            strCompMsg = strCompMsg & vbCrLf & "operatingSystemServicePack = " & objADUserOrComputer.operatingSystemServicePack
            strCompMsg = strCompMsg & vbCrLf & "operatingSystemVersion = " & objADUserOrComputer.operatingSystemVersion
            If InStr(objADUserOrComputer.rIDSetReferences,"Domain Controller") > 0 Then strCompMsg = strCompMsg & vbCrLf & "Domain Controller = Yes"
            If Len(objADUserOrComputer.description) > 0 Then strCompMsg = strCompMsg & vbCrLf & "description = " & objADUserOrComputer.description
             If Len(objADUserOrComputer.machineRole) > 0 Then strCompMsg = strCompMsg & vbCrLf & "machineRole = " & objADUserOrComputer.machineRole
            If Len(objADUserOrComputer.physicalLocationObject) > 0 Then strCompMsg = strCompMsg & vbCrLf & "physicalLocationObject = " & ParseDN(objADUserOrComputer.physicalLocationObject)
            strCompMsg = strCompMsg & vbCrLf
         End Select
        objRS.movenext
        Set objADUserOrComputer = Nothing
      Loop
    objRS.close
Set objRS = Nothing
Set objAdRootDSE = Nothing
 
If Len(strUserMsg) > 0 Then strEmailMessage = strEmailMessage & "--------- USERS ---------" & vbCrLf & strUserMsg & vbCrLf
If Len(strCompMsg) > 0 Then strEmailMessage = strEmailMessage & "--------- COMPUTERS ---------" & vbCrLf & strCompMsg
If Len(strUserMsg) = 0 And Len(strCompMsg) = 0 Then strEmailMessage = "No users or computers have been added in the last 24 hours."
 
Set objCDO = CreateObject("CDO.Message")
    objCDO.Subject = "Users Added: " & numPersonCount & ". Computers Added: " & numComputerCount & "."
    objCDO.From = strEmailFrom
    objCDO.To = strEmailTo
    objCDO.TextBody = strEmailMessage
    objCDO.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 'cdoSendUsingPort (1 = local, 3 = Exchange)
    objCDO.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSMTPServer
    objCDO.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
    objCDO.Configuration.Fields.Update
    objCDO.Send
    set objCDO = Nothing
 
Function CompareDateUTCConvert(dateAddInterval,compareNumber)
'Wow, this is a lil complex. So createTimestamp is in UTC format.
'So first we grab your machine's time bias and then apply it.
'Next, we adjust the date to the one you specified above (now()-24hours by default)
'Finally, we parse the final date to UTC format ie. 20070207032200.0Z
 
Set objSWbemServices = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\.\root\cimv2")
  Set colTimeZone = objSWbemServices.ExecQuery("SELECT * FROM Win32_TimeZone")
    For Each objTimeZone in colTimeZone
     strBias = objTimeZone.Bias
    Next
  Set colTimeZone = Nothing
Set objSWbemServices = Nothing
  strCompareDate = dateAdd(dateAddInterval,compareNumber,now())
  strUTCCompare = DateAdd("n",strBias*(-1),strCompareDate)
  CurrentUTC = Year(strUTCCompare) & Right("0" & Month(strUTCCompare),2) & Right("0" & Day(strUTCCompare),2)
  CurrentUTC = CurrentUTC & Right("0" & Hour(strUTCCompare),2) & Right("0" & Minute(strUTCCompare),2) & Right("0" & Second(strUTCCompare),2) & ".0Z"
  CompareDateUTCConvert = CurrentUTC
End Function
 
Function ParseDN(strDN)
'Take a DN and extract what we want then make it pretty.
  arrDN = split(strDN,",") 'CN=Example-Thing,CN=Whatever,CN=Etc
  strDN = right(arrDN(0),len(arrDN(0))-3) 'CN=Example-Thing -> Example-Thing
  strDN = replace(strDN,"-"," ") 'Example Thing
  ParseDN = strDN
End Function
 
Function ParseMemberOf(memberof,primarygroupid)
'This shows what groups a person belongs to.
'The output of memberof changes depending on
'how many groups the user is a member of, etc.
  Select Case TypeName(memberof)
    Case "String" ParseMemberOf = ParseDN(memberof)
    Case "Empty" ParseMemberOf = PrimaryGroupIDtoName(primarygroupid,varConfigNC)
    Case "Variant()"
      For each groupDN in memberof
         strUserGroups = strUserGroups & vbCrLf & ParseDN(groupDN)
      Next
      ParseMemberOf = strUserGroups
    Case Else ParseMemberOf = "Unknown"
  End Select
End Function
 
Function SAMAccountTypetoName(theType)
'Just makin it more useful...
  Select Case theType
    Case 268435456 SAMAccountTypetoName = "Group Object"
    Case 268435457 SAMAccountTypetoName = "Non-Security Group Object"
    Case 536870912 SAMAccountTypetoName = "Alias Object"
    Case 536870913 SAMAccountTypetoName = "Non-Security Alias Object"
    Case 805306368 SAMAccountTypetoName = "Normal User Account"
    Case 805306369 SAMAccountTypetoName = "Machine Account"
    Case 805306370 SAMAccountTypetoName = "Trust Account"
    Case 1073741824 SAMAccountTypetoName = "App Basic Group"
    Case 1073741825 SAMAccountTypetoName = "App Query Group"
    Case 2147483647 SAMAccountTypetoName = "Account Type Max"
    Case Else SAMAccountTypetoName = "Unknown"
  End Select
End Function
 
Function PrimaryGroupIDtoName(PGID,varConfigNC)
'Ugh.. the alternative to this function can be found here:
'http://support.microsoft.com/kb/297951
'both are kinda nasty.
  Set objRSPGID = CreateObject("adodb.recordset")
    Connstring = "Provider=ADsDSOObject"
    strSQL = "<ldap://" & varConfigNC & ">;(objectCategory=group);distinguishedName,primaryGroupToken,name;subtree"
     objRSPGID.Open strSQL, Connstring
      If not objRSPGID.eof and not objRSPGID.bof Then
        Do until objRSPGID.eof Or Len(strGroupName) > 0
        If PGID = objRSPGID("primaryGroupToken") Then strGroupName = objRSPGID("name")
         objRSPGID.movenext
        Loop
      End If
     objRSPGID.close
  Set objRSPGID = Nothing
  If Len(strGroupName) = 0 Then strGroupName = "Unknown"
  PrimaryGroupIDtoName =   strGroupName
End Function

To schedule this, save the above code as ADAddedUsersNComputers.vbs in C:\scripts (for ex.) and use Scheduled Tasks to run the following command: %windir%\system32\wscript.exe C:\scripts\ADAddedUsersNComputers.vbs. I suggest running it daily at the end of each workday.

VBScript & SQL: Programatically Find the Location of an IP Address

Filed under: Networking, Quick Code, SQL Server, VBScript — Written by Chrissy on Tuesday, January 30th, 2007 @ 7:21 pm

This is more of a post for proper keywords. My previous entry titled "Import MaxMind City CSVs into SQL Server 2005" assumes the user has already conducted research to find that MaxMind's free GeoIP database provides the functionality to look up the location of an IP address. So, if you wish to quickly and easily find an IP address' location, do the following.

1. Ensure you have SQL Server installed somewhere. If you don't currently have it installed,
    you can download SQL Server 2005 Express for free.
2. Read this post about importing the necessary (and free) database for IP lookups.
    a. Download zip & unzip
    b. Read README.txt
    c. Copy the unzip.exe to your Windows directory
    d. Run the included SQL File
    e. Run the included VBS file
3. Create a VBS file to access the information.
4. Double-click the VBS file and enter the IP address

LookupIPAddress.vbs

  strSQLServer = "localhost"
  strDBName = "maxmindGeoIP"
 
  strIPaddr = InputBox("Enter the IP address:","IP To Location")
 
  If Len(strIPaddr) = 0 Then Wscript.Quit
 
  Set objRS = CreateObject("ADODB.recordset")
  strConnstring =  "Driver={SQL Server};Server=" & strSQLServer & ";Database=" & strDBName & ";Trusted_Connection=Yes;"
  strSQL = "EXEC usp_IPtoLocation '" & strIPaddr & "'"
  objRS.Open strSQL, strConnstring, 1, 1
 
  If objRS.eof And objRS.bof Then
    MsgBox "Something is ultra-broken. Is your database populated? " 'Everything should return at least something.
  Else
    strLocation = objRS("location")
      If InStr(strLocation,"Unknown") > 0 Then
      MsgBox "The IP address, " & strIPaddr & ", cannot be found in the database :(",64,"IP To Location"
      Else
      MsgBox  strIPaddr & " resolves to.." & vbCrLf & vbCrLf & objRS("location"),64,"IP To Location"
      End If
   End If
 
   Set objRS = Nothing

Then, finding the location is as easy as double-clicking the file, entering an IP, and pressing "OK"....

In less than 1 millisecond, (after the initial stored procedure execution), your results will show up

VBScript: Download and Save a Binary File

Filed under: Quick Code, VBScript — Written by Chrissy on Wednesday, January 24th, 2007 @ 12:03 pm

Update: If you are an iTunes user that needs VBScript, this page won't help you. Please visit the following two sites for two different solutions: Apple Docs and KeathMilligan.net.

This is an old script I dug up which I call "fileFetch". It's a script that downloads a binary file using XMLHTTP and saves it using an ADO stream. This is handy for nightly downloads and will work within SQL Server DTS packages.

Quick Code

' Set your settings
    strFileURL = "http://www.domain.com/file.zip"
    strHDLocation = "D:\file.zip"
 
' Fetch the file
    Set objXMLHTTP = CreateObject("MSXML2.XMLHTTP")
 
    objXMLHTTP.open "GET", strFileURL, false
    objXMLHTTP.send()
 
    If objXMLHTTP.Status = 200 Then
      Set objADOStream = CreateObject("ADODB.Stream")
      objADOStream.Open
      objADOStream.Type = 1 'adTypeBinary
 
      objADOStream.Write objXMLHTTP.ResponseBody
      objADOStream.Position = 0    'Set the stream position to the start
 
      Set objFSO = Createobject("Scripting.FileSystemObject")
        If objFSO.Fileexists(strHDLocation) Then objFSO.DeleteFile strHDLocation
      Set objFSO = Nothing
 
      objADOStream.SaveToFile strHDLocation
      objADOStream.Close
      Set objADOStream = Nothing
    End if
 
    Set objXMLHTTP = Nothing

ASP/VBScript: Send E-Mail with CDO

Filed under: Quick Code, VBScript — Written by Chrissy on Monday, January 22nd, 2007 @ 4:15 am

I've used CDONTS for years, even though it hasn't been included in a Windows Server release since NT4. Anytime I needed to send mail, I'd copy over CDONTS.dll, register it then use my old CDONTS code. Not sure why I resisted it for so long.. I think the weird Configuration Fields were too odd to accept. But I've finally accepted them.. about 3 good years after ASP went out of style. Here's a less-than-timely code snippet:

This is the sound of settling.

    Set objCDO = CreateObject("CDO.Message")
    objCDO.Subject = "Update from Web App."
    objCDO.From = "Web App <webapps@me.com>"
    objCDO.To = "yomomma@gmail.com"
    objCDO.TextBody = "Hello," & vbCrLf & vbCrLf & "A new order has been placed by " & userName & "."
    objCDO.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 'cdoSendUsingPort (1 = local, 3 = Exchange)
    objCDO.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "mail.me.com"
    objCDO.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
    objCDO.Configuration.Fields.Update
    objCDO.Send
    set objCDO = Nothing

Classic ASP: "Push" File Downloads from A Directory Outside the Application Root

Filed under: IIS, Quick Code, VBScript — Written by Chrissy on Monday, January 22nd, 2007 @ 4:04 am

This is some super old code but I used it recently and figured I'd archive it on this site for my future reference. The sample code below aims to allow authenticated users to download files which are not available via direct download (ie. files within the web root). The script accomplishes this by doing the following:

1. Checks to see if the user is logged in (your method may vary)
2. Sets the root directory location
3. Checks to see if the file exists, if so...
4. Retrieves the filesize and adds the appropriate HTTP headers including content disposition, filename, content type and filesize.
5. Uses a binary stream to "push" the download

Save this file as download.asp and call it with the filename in the querystring. Example: http://domain.com/downloads/download.asp?filename=myfile.pdf. Also, be sure to give read permissions to IUSR_SvrName to the root directory. Change the authentication requirements as needed:

download.asp

<%
If session("loggedIn") = True Then
 
  strFilePath = "D:\webfiles\downloads"  & request.querystring("filename")
 
  Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
    If objFSO.FileExists(strFilePath) Then
      Set objFile = objFSO.GetFile(strFilePath)
      intFileSize = objFile.Size
      Set objFile = Nothing
 
      strFileName = request.querystring("filename")
      strFileName = replace(request.querystring("filename")," ","-")
      Response.AddHeader "Content-Disposition","attachment; filename=" & strFileName
 
      Response.ContentType = "application/x-msdownload"
      Response.AddHeader "Content-Length", intFileSize
 
      Set objStream = Server.CreateObject("ADODB.Stream")
        objStream.Open
        objStream.Type = 1 'adTypeBinary
        objStream.LoadFromFile strFilePath
        Do While Not objStream.EOS And Response.IsClientConnected
        Response.BinaryWrite objStream.Read(1024)
        Response.Flush()
        Loop
        objStream.Close
      Set objStream = Nothing
    Else
      Response.write "Error finding file."
    End if
  Set objFSO = Nothing
End If
%>

Note: Even if the file is a PDF and a third-party application such as Adobe Reader is set to open the file within the browser, the code below will override that and force a download (by using the "application/x-msdownload" content type).

[The UPDATE below is no longer accurate as an alternative solution has been given below in the comments and subsequently, was added to the code (Thanks a bunch, David!). I wanted to leave it for Googlers looking for a solution, however]

UPDATE: Someone wrote to let me know that they were encountering the error "Response Buffer Limit Exceeded". As it turns out, IIS 6's ASPBufferingLimit is set to a measly 4MB (4194304 bits) so any file over 4MB would produce this error. To fix this issue, you will have to have access to IIS either via the command line or the MMC. Here's how to change the buffering limit via the command line:

************ NOTE: An easier solution is to use the updated Do While/Flush procedure given in the code *****************

cd C:\inetpub\adminscripts
cscript adsutil.vbs set /w3svc/aspbufferinglimit 4294967295

That's a buffering limit of more than 4 Gigabytes. Personally, I'd lop off the last digit and make that number closer to 430MB. Running that script worked immediately on my test machine, even though I do not have "Enable Direct Metabase Edit" checked in IIS' Properties. If it doesn't work for you, restart IIS and see if it works.

VBScript: Enumerate All SQL Servers on a Domain

Filed under: Active Directory, Quick Code, VBScript — Written by Chrissy on Tuesday, January 9th, 2007 @ 11:14 pm

So if you have SQL Server installed locally, you're lucky enough to have access to SQLDeeMO. You can then easily enumerate SQL Servers with the following code. Note: If you do decide to use VBScript and SQLDeeMO, you will need to remove the "ee" in the script below. I didn't want to put in the actual object name so that people searching Google for sites that do not contain the phrase SQLDeeMO will still find my site.

SQLDeeMO VBScript Action

    Set objSQLDMOApp = CreateObject("SQLDeeMO.Application")
 
    Set objSQLList = objSQLDeeMOApp.ListAvailableSQLServers()
    For i = 1 To objSQLList.Count
       MsgBox objSQLList.Item(i)
    Next
 
    Set objSQLList = Nothing
    Set objSQLDeeMOApp = Nothing

But if you don't have SQL Server installed locally.. here's a hack that grabs the name of all Windows Servers in AD and then checks their registry for instances of SQL Server.

Enumerate All SQL Servers and Instance Names on a Domain

'****************************************************************************
' This script created by Chrissy LeMaire (clemaire@gmail.com)
' Website: http://netnerds.net/
'
' This script finds all SQL Servers and their instances that are members of an AD domain
' and running any Windows Server version
'
' Run this script with admin privs on any computer within a domain
'
' This script has only been tested on Windows Server 2003
'
' "What it does"
' 1. Gathers all machines in a domain that are running a Windows Server OS (NT, 2000, 2003)
' 2. Pings them to see if they are available
' 3. If they do respond to pings, it checks their registry to see if they have the proper SQL keys
' 4. If the key does exist, it then enumerates the instances (including default)
'
' NO WARRANTIES, USE THIS AT YOUR OWN RISK, etc.
'*****************************************************************************
Set objAdRootDSE = GetObject("LDAP://RootDSE")
Set objWMIService = GetObject("winmgmts:\.\root\cimv2")
Set objRS = CreateObject("adodb.recordset")
Const HKEY_LOCAL_MACHINE = &H80000002
 
  varConfigNC = objAdRootDSE.Get("defaultNamingContext")
  strConnstring = "Provider=ADsDSOObject"
  strWQL = "SELECT * FROM 'LDAP://" & varConfigNC & "' WHERE objectCategory= 'Computer' and OperatingSystem = 'Windows*Server*'"
  objRS.Open strWQL, strConnstring
      Do until objRS.eof
         Set objServer = GetObject(objRS.Fields.Item(0))
          strServerName = objServer.CN
 
          Set colItems = objWMIService.ExecQuery("Select * from Win32_PingStatus Where Address = '" & objServer.DNSHostName & "'")
          For Each objItem in colItems
              If objItem.StatusCode = 0 Then 'The Computer is Pingable
                    Set objRegistry = GetObject("winmgmts:{impersonationLevel=impersonate}!" & strServerName & "\root\default:StdRegProv")
                      strKeyPath = "SOFTWARE\Microsoft\Microsoft SQL Server"
                      strValueName = "InstalledInstances"
                      objRegistry.GetMultiStringValue HKEY_LOCAL_MACHINE,strKeyPath, strValueName,arrValues
                        If IsNull(arrValues) = 0 Then 'It's a SQL Server! Enumerate it's instances
                          strMsg = strServerName & " is running the following SQL Instance(s): "
                          For Each strValue In arrValues
                              If strValue = "MSSQLSERVER" Then strValue = "Default Instance"
                                strMsg = strMsg & vbCrLf & strValue
                          Next
                          MsgBox strMsg
                        End If
                     Set objRegistry = Nothing
              End If
          Set objServer = Nothing
      Next
    objRS.movenext
    Loop
  objRS.close
 
Set objWMIService = Nothing
Set objRS = Nothing
Set objAdRootDSE = Nothing

If you are looking for the version of each SQL Server.. you can either query it with SELECT @@VERSION or it may be easily found in the registry. It's 10:47pm and I'm still at work so I'm heading out ;)

VBScript: Use an LDAP Query to Find All Windows Servers on a Domain

Filed under: Active Directory, Networking, Quick Code, VBScript — Written by Chrissy on Tuesday, January 9th, 2007 @ 9:02 pm

Damn, the ADsDSOObject rocks! This script, which weighs in at less than 20 lines, finds all machines running any form of Windows Server on a given domain. Note that this script isn't useful in finding domain controllers, but rather any machine running Windows Server.

Awesome

'****************************************************************************
' This script created by Chrissy LeMaire (clemaire@gmail.com)
' Website: http://netnerds.net/
'
' This script finds all machines running Windows Server (NT, 2000, 2003) in AD
'
'Msgbox output provides server name and OS version.
'
' NO WARRANTIES, USE THIS AT YOUR OWN RISK, etc.
'*****************************************************************************
 
Set objAdRootDSE = GetObject("LDAP://RootDSE")
Set objRS = CreateObject("adodb.recordset")
 
  varConfigNC = objAdRootDSE.Get("defaultNamingContext")
  strConnstring = "Provider=ADsDSOObject"
  strWQL = "SELECT * FROM 'LDAP://" & varConfigNC & "' WHERE objectCategory= 'Computer' and OperatingSystem = 'Windows*Server*'"
  objRS.Open strWQL, strConnstring
    Do until objRS.eof
       Set objServer = GetObject(objRS.Fields.Item(0))
      strServerName = objServer.CN
      strOperatingSystem = objServer.OperatingSystem
      MsgBox strServerName & " is running " & strOperatingSystem
       objRS.movenext
       Set objServer = Nothing
    Loop
  objRS.close
 
Set objRS = Nothing
Set objAdRootDSE = Nothing

Also, I found this nice reference of Command One Liners while searching the web. Totally handy!