netnerds.net

24Apr/068

PHP & Javascript & ASP: Format ATOM Date

I'm surprised this isn't built in.. I had the hardest time finding how to convert ATOM time (found in many RSS feeds) to something human-readable. The cleanest solution I have found thus far is this:

<?php
$atomdate = '2006-04-22T10:00:00.000Z';
$datetime = strtotime(substr($atomdate, 0, 10) . ' ' . substr($atomdate, 11, 8 ));
print date('m.d.y',$datetime);
?>

That outputs "04.22.06" but you can use any of the formats available from php date().

Here is basically the same routine, but this time in Javascript

var atomdate = items[n].getElementsByTagName('published').item(0).firstChild.data;
var itemPubDateDay = atomdate.substr(0, 10);
var itemPubDateTime = atomdate.substr(11, 8 );
print itemPubDateDay;

And this time in ASP

<%
atomdate = "2006-04-22T10:00:00.000Z"
dateandtime = mid(atomdate, 1, 10) & " " & mid(atomdate, 12, 8 )
response.write formatdatetime(dateandtime)
%>
Posted by: Chrissy   Filed under: General 8 Comments
24Apr/067

ASP: Easily Parse and Consume RSS in Classic ASP

This script should work right out of the box..

Dirty Code

<%
Call getNews(10)

Sub getNEWS(howManyResults)
myRSSfile = "http://rss.news.yahoo.com/rss/tech"

Set xmlHttp = Server.CreateObject("MSXML2.XMLHTTP.4.0")
xmlHttp.Open "Get", myRSSfile, false
xmlHttp.Send()
myXML = xmlHttp.ResponseText

Set xmlResponse = Server.CreateObject("MSXML2.DomDocument.4.0")
xmlResponse.async = false
xmlResponse.LoadXml(myXML)
Set xmlHttp = Nothing

Set objLst = xmlResponse.getElementsByTagName("item")
Set xmlResponse = Nothing

intNoOfHeadlines = objLst.length -1

For i = 0 To (intNoOfHeadlines)
Set     objHdl = objLst.item(i)

for each child in objHdl.childNodes
Select case lcase(child.nodeName)
    case "title"
          title = child.text
    case "link"
          link = child.text
    case "description"
          description = child.text
     'You can also use the following: author,category,comments,enclosure,guid,pubDate,source
End Select
next

   kk = kk+1
     if kk < howManyresults+1 then
    Response.Write "<br /><a href=""" & link & """>" & title & "</a> <br /> " & description

    end if

Next
End Sub
%>
Posted by: Chrissy   Filed under: IIS 7 Comments
22Apr/062

mod_rewrite: Forbid Unsavory Visitors

I have a another blog that mentions random words like "daughter","school", "dirty", "bad", "dog", "herself", "year", "nasty" and "old." Until I started revewing my HTTP referers, It never even occured to me that nasty perverts could end up on my site while looking for websites that contain the words "11 year old dirty asian daughter in school with dog." Even though my blog wouldn't come close to providing what they were looking for, I still didn't want these unwelcomed visitors seeing it so I enabed mod_rewrite on my Apache install and wrote the following script to detect people coming from search engines who are looking for unfavorable stuff.

.htaccess code

<ifModule mod_rewrite.c>
RewriteEngine On
RewriteBase /
RewriteCond %{HTTP_REFERER} !http://(www\.)?mywebsite.com/.*$ [NC]
RewriteCond %{HTTP_REFERER} !.*my*web*site.*$ [NC]
RewriteCond %{HTTP_REFERER} ^.*(google|yahoo|msn|search).*$ [NC]
RewriteCond %{HTTP_REFERER} ^.*(daughter|herself||asian|dog|little|school|girls.*nasty|taste.*self|year|girl.*old).*$ [NC]
RewriteRule .* - [F]
</ifModule>

Here is what the script performs, step by step.
1. If the module mod_rewrite is enabled do the following
2. Turn Rewrite Engine On
3. Apply it to the entire site
4. If referer is not www.mywebsite.com or a variation of my site's name
5. AND they come from a search engine
6. AND the URL includes the following combination of words/phrases: nasty AND (daughter or herself or asian or dog or little or school or girls) or taste AND self or old AND (year or girl)
7. Give them a 403 Forbidden
8. End of script

I placed this script in the root of my website and it worked perfectly. Of course, the person can easily get around this but I'd say over 99% just think the site is outdated/broken and won't even attempt it.

Posted by: Chrissy   Filed under: Security 2 Comments
20Apr/061

Quickcode WordPress Plugin

I released my first WordPress plugin last night! It's a script that hides/unhides and slightly formats blocks of code. I use it heavily on this site. Here's an example:

CSS is cool.

        <style type='text/css'>
                a.dirtycode {
                        padding-left: 20px;
                        background: url('/wp-includes/images/dirtycode.gif') no-repeat;
                        }
        </style>

You can read more abou the plugin here: QuickCode.

Posted by: Chrissy   Filed under: General 1 Comment
16Apr/0649

VBScript: Delete ALL E-mails from the Exchange 2003 Queue

Recently my Exchange server got pounded by spammers that were attacking my NDR (non delivery report) capabilities. Turning off NDRs helped 75% and I explored Exchange quite a bit along the way to figure out that last 25%.

It seems that I had 180 emails stuck in my queue. I was looking at my logs and ethereal and it seemed that my mail server would go to several other servers, say "Hello" and then "Goodbye". No message in the middle. It didn't even ask if a recipient was valid. Twenty-four hours later, my queue was still churning at 180 emails constant and Exchange was still being silly.

I took a closer look at the queue. Why was it 180 constant? Then I noticed the date they started their retry -- December 5th 2005. That was the day that installed Exchange (and presumably SP1) on my new server. I restored some PSTs and that's about it. Those emails had been stuck in the queue for well over 2 months! Why didn't they expire? I have no idea.

So I began to try to empty my queue. It was such a manual process. Click on the envelope, click "Find Messages", Delete with No NDR, confirm Yes. I'd have to do this 180 times? No way. So I wrote a script to do it for me: (NOTE! This script empties your ENTIRE queue! There are very few circumstances that you will need to use this script.)

Edit: As noted in the comments below, please close Exchange System Manager before running this script.

Dirty Code

' Author: Chrissy LeMaire
' Copyright 2003 NetNerds Consulting Group
' Script is provided AS IS with no warranties or guarantees and assumes no liabilities.
' Website: http://www.netnerds.net
' Description: This scripts empties out the entire Exchange queue. USE WITH CAUTION.

Set objWMIExch = GetObject("winmgmts://./root/MicrosoftExchangeV2")
Set objLinksList = objWMIExch.ExecQuery ("Select * from Exchange_SMTPLink")
For each objLinkInst in objLinksList

strSQL = "Select * from Exchange_SMTPQueue where "
strSQL = strSQL & "LinkID='" & objLinkInst.LinkID
strSQL = strSQL & "' and LinkName='" & objLinkInst.LinkName
strSQL = strSQL & "' and ProtocolName='" & objLinkInst.ProtocolName
strSQL = strSQL & "' and VirtualMachine='" & objLinkInst.VirtualMachine
strSQL = strSQL & "' and VirtualServerName='" & objLinkInst.VirtualServerName & "'"

Set objQueuesList = objWMIExch.ExecQuery (strsql)
For each objQueueInst in objQueuesList
        i = i +1
                If i > 7 And InStr(objQueueInst.QueueName,".") > 0 Then 'make sure its not the built in stuff

                                        strSQL = "Select * from Exchange_QueuedSMTPMessage where " '<-- This class requires that you pass ALL the variables below in the where clause
                                        strSQL = strSQL & "LinkID='" & objLinkInst.LinkID
                                        strSQL = strSQL & "' and LinkName='" & objLinkInst.LinkName
                                        strSQL = strSQL & "' and ProtocolName='" & objLinkInst.ProtocolName
                                        strSQL = strSQL & "' and QueueID='" & objQueueInst.QueueID
                                        strSQL = strSQL & "' and QueueName='" & objQueueInst.QueueName
                                        strSQL = strSQL & "' and VirtualMachine='" & objLinkInst.VirtualMachine
                                        strSQL = strSQL & "' and VirtualServerName='" & objLinkInst.VirtualServerName & "'"

                                          Set objQueuesList1 = objWMIExch.ExecQuery (strsql)
                                                 For each objQueueInst1 in objQueuesList1
                                                        If i > 7 And InStr(objQueueInst1.QueueName,".") > 0 Then
                                                                objQueueInst1.DeleteNoNDR
                                                        End If
                                                 Next
                End If
        Next
Next

MsgBox i

This script emptied my queue in about 25 seconds and Exchange is no longer going out and saying Hello & Goodbye. Traffic is back to normal. I'm assuming that was an Exchange bug.

Posted by: Chrissy   Filed under: Exchange, VBScript 49 Comments
12Apr/060

VBScript: Monitor Processes and Restart if Necessary

This may only be useful for wscript.exe so it may not have universal appeal but I'll list it anyway. The first script is to be inserted at the top of the wscript file you'd like to monitor. The second file is to be run as a scheduled task. SQL Server is used to keep track of the PIDs. SQL Server Express is free so you have no excuses! ;)

Download Code to find PID

' Author: Chrissy LeMaire
' Copyright 2003 NetNerds Consulting Group
' Script is provided AS IS with no warranties or guarantees and assumes no liabilities.
' Website: http://www.netnerds.net

'create table WscriptPID (PID int,timestamp smalldatetime default getdate())

'''''''''''''''''''''''''''''''''''''''''''''''''''''
'        GET PID FOR MONITORING
'''''''''''''''''''''''''''''''''''''''''''''''''''''

Set objWMIService = GetObject("winmgmts:\.\root\cimv2")
strWQL = "Select * from Win32_Process where name = 'wscript.exe'"
Set colProcesses = objWMIService.ExecQuery(strWQL)
    For Each objProcess in colProcesses
        If objProcess.ProcessID > MaxPID Then MaxPID = objProcess.ProcessID 'No MAX in WQL :(
    Next
Set colProcesses = Nothing
Set objWMIService = Nothing

Set Conn = CreateObject("adodb.connection")
    Conn.Open ConnString
        strSQL = "insert into WscriptPID (PID) values (" & MaxPID & ")"
        Conn.execute strSQL
    Conn.Close
Set Conn = Nothing

Download Code for monitoring

' Author: Chrissy LeMaire
' Copyright 2003 NetNerds Consulting Group
' Script is provided AS IS with no warranties or guarantees and assumes no liabilities.
' Website: http://www.netnerds.net

'create table WscriptPID (PID int,timestamp smalldatetime default getdate())
ConnString = "Provider=SQLOLEDB; Data Source=LELAND; Initial catalog=WindowsEvents; Trusted_Connection=yes;"

strComputer = "LELAND" 'Enter your monitoring server name

        Set rs = CreateObject("adodb.recordset")
                strSQL = "select top 1 PID from WscriptPID order by timestamp desc"
                rs.Open strSQL,ConnString,1,1
                    PID = rs("PID")
                rs.Close
            Set rs = Nothing

Set objWMIService = GetObject("winmgmts:\.\root\cimv2")
Set colProcesses = objWMIService.ExecQuery("Select * from Win32_Process where ProcessID = " & PID)
    If colProcesses.Count = 0 Then
        Set objWMIProcess = GetObject("winmgmts:" & strComputer & "\root\cimv2:Win32_Process")
            errReturn = objWMIProcess.Create ("wscript.exe C:\scripts\push2servers.vbs", Null, Null, intProcessID)
        Set objWMIProcess = Nothing
    End If
Set colProcesses = Nothing
Set objWMIService = Nothing
Posted by: Chrissy   Filed under: VBScript No Comments
12Apr/064

VBScript & SQL: Centralize Windows Events in SQL Server

This is a barebones script that gathers server events across a domain and stores them in SQL Server using asyncronous notifications as seen in this sample of the code:

strWQL = "Select * from __InstanceCreationEvent where TargetInstance isa 'Win32_NTLogEvent'"
objWMIService.ExecNotificationQueryAsync eventSink,strWQL

Only one instance of this script is required to monitor multiple servers across a domain.

Download SQL script for creating the necessary tables

/*
I chose to normalize this database just a tad.

Since event messages are large and often repeated, I created a table specifically for them.
Otherwise, the database would grow big fairly quickly.

Be sure to populate your computers table with the computers you'd like monitored. If you'd like
to automatically populate this table using ADSI, see barebonespopsql.vbs

The Event Types table is just for reference.

*/
create database WindowsEvents
go
use windowsevents
go

create table computers (
    ID int identity primary key,
    computer varchar(255)
)

insert into computers (computer) values ('ALPHONSE')
insert into computers (computer) values ('LELAND')

Create table eventViewerMessages (
    id int identity primary key,
    ComputerID int references computers(ID),
    SourceName varchar(255),
    eventcode int,
    Message  varchar(1024),
)

Create table eventTypes (
    ID int primary key,
    eventType varchar(25)
)

Insert into eventTypes (ID, eventType) values (1,'Error')
Insert into eventTypes (ID, eventType) values (2,'Warning')
Insert into eventTypes (ID, eventType) values (4,'Information')
Insert into eventTypes (ID, eventType) values (8,'Security audit success')
Insert into eventTypes (ID, eventType) values (16,'Security audit failure')

Create table eventViewer (
    ID int identity primary key,
    Category int,
    CategoryString  varchar(512),
    ComputerID int references computers(ID),
    EventCode int,
    EventIdentifier int,
    Logfile  varchar(32),
    MessageID int references eventViewerMessages(ID),
    RecordNumber int,
    SourceName varchar(255),
    TimeGenerated varchar(255),
    TimeWritten varchar(255),
    EventType varchar(512),
    NTUser varchar(104)
)
Go

Download VBS code for populating the database with domain computer names

strDomain = "HOME"
ConnString = "Provider=SQLOLEDB; Data Source=LELAND; Initial catalog=WindowsEvents; Trusted_Connection=yes;"
Set TheDomain = GetObject("WinNT://" & strDomain)
TheDomain.Filter = Array("Computer")

Set rs = CreateObject("adodb.recordset")
strSQL = "select computer from computers where id = 0"
rs.Open strSQL,ConnString,1,2
For Each Computer In TheDomain
rs.AddNew
strComputer = UCase(Computer.Name)
    Set objWMIService = GetObject("winmgmts:" & strComputer & "\root\cimv2")
Set colSettings = objWMIService.ExecQuery ("SELECT * FROM Win32_OperatingSystem")
For Each objOperatingSystem in colSettings
If InStr(UCase(objOperatingSystem.Name),"SERVER") > 0 Then rs("Computer") = strComputer
Next
Set colSettings = Nothing
Set objWMIService = Nothing
Next
rs.UpdateBatch
rs.close
Set rs = nothing
Set TheDomain = Nothing

Download the actual monitoring code

''''''''''''''''''''''''''''''''''''''''''''''''''''''
'    Set Your SQL String Here. Get tables from barebonesEVSQL.sql
''''''''''''''''''''''''''''''''''''''''''''''''''''''
ConnString = "Provider=SQLOLEDB; Data Source=LELAND; Initial catalog=WindowsEvents; Trusted_Connection=yes;"

'''''''''''''''''''''''''''''''''''''''''''''''''''''
'                        GET COMPUTERS TO MONITOR
'''''''''''''''''''''''''''''''''''''''''''''''''''''

Set rs = CreateObject("adodb.recordset")
    strSQL = "select computer from computers"
        rs.Open strSQL,ConnString,1,1
            Do until rs.eof
                Push2EVServer(rs("computer"))
                rs.movenext
            loop
        rs.close
Set rs = nothing

'''''''''''''''''''''''''''''''''''''''''''''''''''''
'                    KEEP THE SCRIPT GOING FOREVER
'''''''''''''''''''''''''''''''''''''''''''''''''''''

While (True)
    Wscript.Sleep(1000)
Wend

'''''''''''''''''''''''''''''''''''''''''''''''''''''
'                                    SET SINK SUB
'''''''''''''''''''''''''''''''''''''''''''''''''''''

Sub Push2EVServer(strComputer)
    Set objWMIService = GetObject("winmgmts:" & strComputer & "\root\cimv2")
    Set eventSink = wscript.CreateObject("WbemScripting.SWbemSink", "EVSINK_")
    strWQL = "Select * from __InstanceCreationEvent where TargetInstance isa  'Win32_NTLogEvent'"
    objWMIService.ExecNotificationQueryAsync eventSink,strWQL
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''
'        ADD EVENTS TO SEMI-NORMALIZED SQL DATABASE
'''''''''''''''''''''''''''''''''''''''''''''''''''''

Sub EVSINK_OnObjectReady(objObject, objAsyncContext)
'Set Variables and Objects
Set rs = CreateObject("adodb.recordset")
ConnString = "Provider=SQLOLEDB; Data Source=LELAND; Initial catalog=WindowsEvents; Trusted_Connection=yes;"

    'Event Stuff
    Category = objObject.TargetInstance.Category
    CategoryString = objObject.TargetInstance.CategoryString
    ComputerName = objObject.TargetInstance.ComputerName
    EventCode = objObject.TargetInstance.EventCode
    Logfile = objObject.TargetInstance.Logfile
    Message = objObject.TargetInstance.Message
    RecordNumber = objObject.TargetInstance.RecordNumber
    SourceName = objObject.TargetInstance.SourceName
    TimeGenerated = objObject.TargetInstance.TimeGenerated
    TimeWritten = objObject.TargetInstance.TimeWritten
    EventType = objObject.TargetInstance.Type 'Type, as opposed to EventType, is backwards compat.
    NTUser = objObject.TargetInstance.User

strSQL = "select ID from computers where computer = '" & ComputerName & "'"
rs.Open strSQL,ConnString,1,1
    If rs.eof And rs.bof Then
        Exit Sub 'big problems
    Else
            ComputerID = rs("ID")
    End If
rs.Close

strSQL = "select ID,ComputerID,SourceName,EventCode,Message from eventViewerMessages where ComputerID = " & ComputerID & " and sourcename = '" &  SourceName & "' and EventCode = '" & EventCode & "' and Message = '" & Message & "'"
rs.Open strSQL,ConnString,1,2
        If rs.eof And rs.bof Then ' Add it
            rs.AddNew
            rs("ComputerID") = ComputerID
            rs("SourceName") = SourceName
            rs("EventCode") = EventCode
            rs("Message") = Message
            rs.Update
                MessageID = rs("ID")
        Else
                MessageID = rs("ID")
        End If
    rs.Close

strSQL = "select * from eventViewer where id = 0"
    rs.Open strSQL,ConnString,1,2
        rs.AddNew
            rs("Category") = Category
            rs("CategoryString") = CategoryString
            rs("ComputerID") = ComputerID
            rs("EventCode") = EventCode
            rs("Logfile") = Logfile
            rs("MessageID") = MessageID
            rs("RecordNumber") = RecordNumber
            rs("SourceName") = SourceName
            rs("TimeGenerated") = TimeGenerated
            rs("TimeWritten") = TimeWritten
            rs("Eventtype") = Eventtype
            rs("NTUser") = User
            '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
            'InsertionStrings, Data and Eventtype are not queried. Eventtype
            'is win2k3/xp only and the other two are arrays
            '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        rs.Update
    rs.Close

Set rs = Nothing
End Sub

Front end code to view and manage Windows Events coming later....

Posted by: Chrissy   Filed under: SQL Server 4 Comments
11Apr/060

cmd: The "at" command

Windows, like Unix, has an "at" command. It's basically a command-line interface for Task Scheduler. I use it rather often but haven't memorized the syntax so I've decided to put it here in my blog. Here is example syntax for running a VBS script:

at 12:00 /every:m,t,w,th,f,s,su %SystemDirectory%\cscript.exe C:\scripts\fileFetch.vbs

Here are a few notes to remember about the at service

a. The script will run with the permissions of the user that is used to start the "Task Scheduler" or "at" service. Make sure the user has adequate permissions to Objects you are creating and the directory where you will save your file.
b. Make sure the account that is used to start the at service has "log on as a service" enabled.
c. To delete a schedule task, run the at command and look for its id. Next, run at id /delete. For example: at 1 /delete
Posted by: Chrissy   Filed under: Windows No Comments
10Apr/068

VBScript: Check for Low Disk Space and Report to Event Viewer

This code is part of a bigger project I'm working on. It checks the disk space for each logical drive and, if the space is below one gigabyte, reports it to Event Viewer at a max of once per day.

Dirty Code

'****************************************************************************
' This script created by Chrissy LeMaire (clemaire@gmail.com)
' Website: http://netnerds.net/
'
' NO WARRANTIES, etc.
'
' This script checks hard drives for less than 1GB of space.
'
' Requirements -- ability to read WinNT://, create events and read WMI
'
' This script has only been tested on Windows Server 2003.
'
' "What it does"
' 1. Gets a list of computers on a domain
' 2. Checks for disk space
' 3. If disk space < 1 GB, add to Event Viewer but not more than once a day.
'*****************************************************************************

On Error Resume Next 'Ignore errors

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
       Call GetDiskSpaceAddEvent(strServerName)
       objRS.movenext
       Set objServer = Nothing
    Loop
  objRS.close

Set objRS = Nothing
Set objAdRootDSE = Nothing

'-----------------------------------------------------------------------
'
'    Do the Dirty Work
'
'-----------------------------------------------------------------------

Sub GetDiskSpaceAddEvent(strComputer)
myDate = date2String(strComputer,"-24")

Set objWMIService = GetObject("winmgmts:"  & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery  ("Select DeviceID, FreeSpace from Win32_LogicalDisk where DriveType = 3") 'Grab the name and the free space for fixed drives

    For Each objItem in colItems
    MBFree = formatnumber((objItem.FreeSpace/1048576),2)
        If MBFree > 1000 Then 'Convert to MB then check for < 1GB
            theQuery = "SELECT * FROM Win32_NTLogEvent WHERE Eventcode = '1000' and Type = 'Error' and LogFile='System' and SourceName = 'Low Disk Space' and TimeWritten  >= '" & myDate & "' and Message like '%" & objItem.DeviceID & "%" & strComputer & "%'"

            Set colLoggedEvents = objWMIService.ExecQuery (theQuery)
                If colLoggedEvents.Count = 0 Then
                    runThis =  "%COMSPEC% /c eventcreate /s " & strComputer & " /so ""Low Disk Space"" /T Error /ID 1000 /L System /D ""The size of disk " & objItem.DeviceID & " on " & StrComputer & " has dropped below 1 Gigabyte (" & MBFree & " MB free)."""
                    WindowStyle = 0 'Do not pop up a dos box
                    Set WshShell = WScript.CreateObject("WScript.Shell") 'generate the object
                    Call WshShell.Run (runThis, WindowStyle, false) 'execute the dos command listed above (COMSPEC = cmd.exe)
                    Set WshShell = Nothing
                End If
            Set colLoggedEvents = Nothing
        End If
    Next

End Sub

'-----------------------------------------------------------------------
'
'    Supporting Date Functions to convert WMI date to human readable dates
'
'-----------------------------------------------------------------------

'The function listed below only works in 2k3 and XP. So we use the manual ones below.
'Function date2WMI(theHourDiff)
'Set WMIDate = CreateObject("WbemScripting.SWbemDateTime")
'WMIDate.SetVarDate DateAdd("hh", theHourDiff, Now())
'Date2WMI = WMIDate.Value
'End Function

    Function string2Date(dtmInstallDate)
        WMIDateStringToDate = CDate(Mid(dtmInstallDate, 5, 2) & "/" & _
             Mid(dtmInstallDate, 7, 2) & "/" & Left(dtmInstallDate, 4) _
                 & " " & Mid (dtmInstallDate, 9, 2) & ":" & _
                     Mid(dtmInstallDate, 11, 2) & ":" & Mid(dtmInstallDate, _
                         13, 2))
          string2Date   = WMIDateStringToDate
    End Function

        Function date2String(strComputer,theOffset)
            Set objSWbemServices = GetObject("winmgmts:\.\root\cimv2")
            Set colTimeZone = objSWbemServices.ExecQuery ("SELECT * FROM Win32_TimeZone")
            For Each objTimeZone in colTimeZone
                strBias = objTimeZone.Bias
            Next

            dtmCurrentDate = date + theOffset
            'response.write dtmCurrentDate
            dtmTargetDate = Year(dtmCurrentDate)

            dtmMonth = Month(dtmCurrentDate)
            If Len(dtmMonth) = 1 Then
                dtmMonth = "0" & dtmMonth
            End If

            dtmTargetDate = dtmTargetDate & dtmMonth

            dtmDay = Day(dtmCurrentDate)
            If Len(dtmDay) = 1 Then
                dtmDay = "0" & dtmDay
            End If

            dtmTargetDate = dtmTargetDate & dtmDay & "000000.000000"
            dtmTargetDate = dtmTargetDate & Cstr(strBias)

            date2String = dtmTargetDate
        End Function

WScript.Quit
Posted by: Chrissy   Filed under: VBScript 8 Comments
10Apr/061

VBScript: IIS Discovery

Find IIS Servers on your domain (or with modifications, your subnet) using this script

Dirty Code

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Author: Chrissy LeMaire
' Copyright 2003 NetNerds Consulting Group
' Script is provided AS IS with no warranties or guarantees and assumes no liabilities.
' Website: http://www.netnerds.net
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
On Error Resume Next

theDomain = "mydomain" ' set this here if you are probing a different domain

Set objNet = CreateObject("WScript.Network")
myFullUsername = trim(objNet.Userdomain & "" & objNet.UserName)
myComputerName = trim(objNet.ComputerName)

if len(theDomain) = 0 then
theDomain = Trim(objNet.Userdomain)
end if
myUsername = Trim(objNet.UserName)
set objNet = nothing

'in case the groups below do not exist

ADMIN = FALSE
Set objGroup = GetObject("WinNT://" & theDomain & "/Domain Admins")
For Each objUser in objGroup.Members
If LCase(myusername) = LCase(objUser.Name) Then
ADMIN = TRUE
End If
Next
Set objGroup = Nothing

Set objGroup = GetObject("WinNT://" & theDomain & "/Enterprise Admins")
For Each objUser in objGroup.Members
If LCase(myusername) = LCase(objUser.Name) Then
ADMIN = TRUE
End If
Next
Set objGroup = Nothing

IIS = FALSE
err.Clear ' to clear any possible errors from above

Set objW3SVC = GetObject("IIS://" & myComputerName & "/W3SVC")
if err.Number = 0 Then
IIS = TRUE
end If

if ADMIN = FALSE Then
MsgBox "You are not a Domain administrator. This script will not work properly."
Wscript.Quit
End If

if IIS = FALSE Then
MsgBox "IIS is not installed. This script will not work properly."
Wscript.Quit
End If
set objW3SVC = Nothing

on error goto 0

startTime = Timer()

'Use the WinNT Directory Services
theDomain = "WinNT://" & theDomain
'Create the Domain object
Set objDomain = GetObject(theDomain)
'Search for Computers in the Domain
objDomain.Filter = Array("Computer")

On error resume next
serverCount = 0
IISServerCount = 0

For Each Computer In objDomain
theServer = Computer.Name
serverCount = ServerCount + 1
Set objW3SVC = GetObject("IIS://" & theServer & "/W3SVC")
Select Case Err.Number
' 70 = permission denied; Strong indication of IIS Server in a DMZ
' 462 = The remote server machine does not exist or is unavailable
' 429 = ActiveX component can't create object
' -2147023169 = CreateObject Failed
' -2147012889  = Name could not be resolved
case  462, 429
thehttpVersion = cint(httpVersion(theServer))
if thehttpVersion > 0 and thehttpVersion < 404 then
IISServerCount = IISServerCount + 1
IISTrue = IISTrue & "IIS Server: " & theServer & VbCrLf
else
IISFalse = IISFalse & "NOT: " & theServer & VbCrLf
end if
case 70,-2147023169,-2147012889
IISUnknown = IISUnknown & "Possibly: " & theServer & VbCrLf
case 0,-2146646000
IISServerCount = IISServerCount + 1
IISTrue = IISTrue & "IIS Server: " & theServer & VbCrLf
set objW3SVC = Nothing
case else
'wscript.echo theServer & ": " & errNumber & ", " & err.Description & "<p>" ' for debugging
end Select

Err.Clear
Next
Set objDomain = Nothing

Function httpVersion(theHost)
On Error Resume Next
Set objxmlHTTP = createobject("MSXML2.ServerxmlHTTP")
theURL= "http://" & theHost
objxmlHTTP.open "GET", theURL, false
objxmlHTTP.send()
tempVersion = objxmlHTTP.getResponseHeader("Server")
If errNumber = -2147012867 Then
NOSERVER = TRUE
Else
NOSERVER = FALSE
End If
set objxmlHTTP = nothing

If instr(tempversion,"Microsoft-IIS/") > 0 then
tempVersion = replace(tempVersion,"Microsoft-IIS/","")
httpVersion = trim(tempVersion)
else
if NOSERVER = TRUE then
httpVersion = "404" ' webserver not found ;)
err.Clear
Else 'there was a webserver there, but probably not an IIS Server
httpVersion = "0"
End If
End If
End Function

finishtime = Timer()
totalTime = finishtime - startTime

myStr = myStr &  "Total Time Taken: " & totalTime & " seconds" &  vbCrLf & vbCrLf
myStr = myStr &  "Total Servers Scanned: " & serverCount & vbCrLf
myStr = myStr &  "Total Servers Found: " & IISServerCount &  vbCrLf & vbCrLf
myStr = myStr &  IISTrue & vbCrLf
myStr = myStr &  IISUnknown & vbCrLf
'myStr = myStr &  IISFalse & vbCrLf
myStr = myStr &  "Done" & vbCrLf

wscript.echo myStr

Requirements: A Windows Domain, local IIS install, domain administrator rights.

Posted by: Chrissy   Filed under: IIS 1 Comment