ASP - Cheap Debug Input Dumper

I call it: Dave's Dastardly Diabolical Debugging Dumbass Dumper, or just Debug Dump for short.  It simply prints out any form inputs and querystring inputs and then stops the page rendering process dead.  That allows you to structure a processing page to capture inputs and then dump them before proceeding to process them; allowing you a chance to see what may be going in the wrong direction before you go further into the debug abyss.

[asp]

<%
Sub Show_InputParams ()
   Dim fn, qv, fc, qc
    fc = 0
    qc = 0
    Response.Write "

Form Inputs

"
    For each fn in Request.Form()
        Response.Write "" & fn & " = " & Request.Form(fn) & "
"
        fc = fc + 1
    Next
    Response.Write "

QueryString Inputs

"
    For each qv in Request.QueryString()
        Response.Write "" & qv & " = " & Request.QueryString(qv) & "
"
        qc = qc + 1
    Next
    Response.Write "

(processing halted)

"
    Response.End
End Sub
%>

[asp]

To try this out the quickest way, paste that mess above into a new file and save it as "dumbass.asp".  Then access it via your browser along with some test parameters (querystring inputs for now).  something like "/mysite/dumbass.asp?test1=123&a=def&x=4321"

It should print out something like the following...

Form Inputs

(no form inputs found)

QueryString Inputs

test1 = 123

a = def

x = 4321

3 querystring inputs found

(processing halted)

ASP - Function to Get Windows Logon UserName

This requires that you have some form of authentication enabled on the web site configuration.  I prefer Windows Authentication, but forms or basic might also suffice.  Basically, regardless of the web browser, as long as some form of authentication is required, and the user provides it (or the browser hands it over silently, like IE usually does, cough-cough), it will spew forth the "logon_user" or "remote_user" server variable.  Using that, you can parse out a NetBIOS domain prefix, such as "contoso\dumbass" to return just the "dumbass" part.

[asp]
<%
Function Get_UserName()
    Dim tmp, result
    result = ""
    tmp = Trim(Request.ServerVariables("LOGON_USER"))
    If tmp = "" Then
        tmp = Trim(Request.ServerVariables("REMOTE_USER"))
    End If
    If tmp <> "" Then
        If InStr(tmp, "\") > 0 Then
            arrtmp = Split(tmp,"\")
            result = Lcase(arrtmp(1)
        Else
            result = Lcase(tmp)
        End If
    End If
    Get_UserName = result
End Function

' test it out...

If Get_UserName() = "dave" Then
    Response.Write "yay!  it's dave!"
Else
    Response.Write "boo.  it's not dave. bummer."
End If
%>
[/asp]

Function: Get Maintenance Window Status (VBScript, ASP and PowerShell flavors)

A little function you can use to determine if a date/time window is active, pending or expired.  I've provided both PowerShell, VBScript and ASP examples (almost the same thing).

Note that PowerShell requires defining the function before invoking it, with regards to single-file, sequential ("top-down") processing order.

[powershell]
function Get-TimeWindowStatus {
    Param(
        [parameter(Mandatory=$true)]$Start,
        [parameter(Mandatory=$true)]$End
    )
    $now = Get-Date
    $dif1 = $(New-TimeSpan -Start $Start -End $now).Minutes
    $dif2 = $(New-TimeSpan -Start $End -End $now).Minutes
    if ($dif1 -lt 0) {
        return -1
    }
    elseif ($dif2 -gt 0) {
        return 1
    }
    else {
        return 0
    }
}

$d1 = "8/27/2014 9:30:00"
$d2 = "8/27/2014 10:00:00"

switch (Get-TimeWindowStatus -Start $d1 -End $d2) {
    -1 {write-host "Maintenance window has not begun."}
    1  {write-hsot "Maintenance window has expired."}
    default {Write-Host "Maintenance window is active."}
}
[/powershell]

ASP and VBScript on the other hand pre-process script code, so you can define functions anywhere within a given script file, and the location for invoking the function doesn't matter as long as it's in the same file (or loaded in advance using "#include" if using ASP).

[asp]
d1 = "8/26/2014 16:00"
d2 = "8/27/2014 9:00"

Select Case TIME_WINDOW_STATUS (d1, d2)
    Case 0:  Response.Write "Maintenance window is in effect."
    Case 1:  Response.Write "Maintenance window has expired."
    Case -1: Response.Write "Maintenance window has not begun."
End Select

Function TIME_WINDOW_STATUS (startDT, endDT)
    Dim dd1, dd2, result
    dd1 = DateDiff("n", d1, NOW)
    dd2 = DateDiff("n", d2, NOW)
    If dd1 > 0 And dd2 < 0 Then 
        result = 0
    ElseIf dd1 < 0 Then
        result = -1
    ElseIf dd2 > 0 Then
        result = 1
    End If
    TIME_WINDOW_STATUS = result
    End Function

[/asp]

[vbscript]
d1 = "8/26/2014 16:00"
d2 = "8/27/2014 9:00"

Select Case TIME_WINDOW_STATUS (d1, d2)
    Case 0:  wscript.echo "Maintenance window is in effect."
    Case 1:  wscript.echo "Maintenance window has expired."
    Case -1: wscript.echo "Maintenance window has not begun."
End Select

Function TIME_WINDOW_STATUS (startDT, endDT)
    Dim dd1, dd2, result
    dd1 = DateDiff("n", d1, NOW)
    dd2 = DateDiff("n", d2, NOW)
    If dd1 > 0 And dd2 < 0 Then 
        result = True
    ElseIf dd1 < 0 Then
        result = False
    ElseIf dd2 > 0 Then
        result = False
    End If
    TIME_WINDOW_STATUS = result
End Function

[/vbscript]

Poor Mans Nested Array Splitting

Some will laugh.  Some will scoff.  Some will snort and then realize they accidentally blew a booger on their shirt and say “oh damn”.  Oh well, here goes…

<%
Const myList = "1=RED,2=YELLOW,3=GREEN,4=CYAN,5=BLUE,6=MAGENTA"

Sub ColorNumList(default)
    For each pair in Split(myList, ",")
        x = Split(pair, "=")
        If Cstr(default) = x(0) Then
            Response.Write "<option value=" & x(0) & _
            " selected>" & x(1) & "</option>"
        Else
            Response.Write "<option value=" & x(0) & _
            ">" & x(1) & "</option>"
        End If
    Next
End Sub
%>

To use this, you simply insert it within a matching set of ASP code tags inside of a <select></select> form object tag set:

...
<select name="colornum" size="1">
    <% ColorNumList 3 %>
</select>
...

VBScript / ASP Secure LDAP Query of User Group Membership

Check if a user is a member of a specified domain security group using a secure LDAP query with ADsDSoObject provider. Works for ASP and VBScript using a specified domain service/proxy user account (when anonymous LDAP is disabled).

Example:
If IsMemberOf("SalesManagers", "JohnDoe") Then
    Response.Write "is a member"
End If

Const ldap_user = "domain\useraccount"
Const ldap_pwd  = "P@ssW0rd$"
Const ou = "OU=Sales,OU=North America,OU=Corp,DC=contoso,DC=com"
Const ADS_SCOPE_SUBTREE = 2

Function IsMemberOf(groupName, uid)
    Dim objConnection, objCommand, objRecordSet
    Dim retval : retval = False
    Dim i, gplen : gplen = Len(groupName)+3
 
    On Error Resume Next
    Set objConnection = CreateObject("ADODB.Connection")
    Set objCommand =   CreateObject("ADODB.Command")
 
    objConnection.Provider = "ADsDSOObject"
    objConnection.Properties("User ID")  = ldap_user
    objConnection.Properties("Password") = ldap_pwd
    objConnection.Properties("Encrypt Password") = TRUE
    objConnection.Properties("ADSI Flag") = 1
    objConnection.Open "Active Directory Provider"

    Set objCommand.ActiveConnection = objConnection

    objCommand.Properties("Page Size") = 1000
    objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
    objCommand.CommandText = "SELECT memberof FROM 'LDAP://" & ou & "' " & _
        "WHERE objectCategory='user' AND sAMAccountName='" & uid & "'"

    Set objRecordSet = objCommand.Execute

    objRecordSet.MoveFirst
    Do Until objRecordSet.EOF
        For i = 0 to objRecordSet.Fields.Count -1
            For each m in objRecordSet.Fields("memberof").value
                If Left(Ucase(m),gplen) = Ucase("CN=" & groupname) Then
                    retval = True
                End If
            Next
        Next
        objRecordSet.MoveNext
    Loop
    objRecordSet.Close
    Set objRecordSet = Nothing
    Set objCommand = Nothing
    Set objConnection = Nothing
    IsMemberOf = retval
End Function

VBScript / ASP Secure LDAP User Query

Query Active Directory using a service/proxy user account from within VBScript or an ASP web page. Returns results as a tab-delimited string, where each token is sub-delimited using a pipe character "|".

example:
x = GetUserData("JohnDoe", "ADsPath, mail, department, givenName, sn")
 
For each v in Split(x, vbTab)
    response.write Replace(v, "|", " = ") & "<br/>"
Next

Const ldap_user = "domain\useraccount"
Const ldap_pwd  = "P@ssW0rd$"
Const ou = "OU=Sales,OU=North America,OU=Corp,DC=contoso,DC=com"

Function GetUserData(uid, fields)
    Const ADS_SCOPE_SUBTREE = 2
    Dim objConnection, objComment, objRecordSet
    Dim retval : retval = ""
    Dim i, fieldname, strvalue
 
    On Error Resume Next
    Set objConnection = CreateObject("ADODB.Connection")
    Set objCommand    = CreateObject("ADODB.Command")
 
    objConnection.Provider = "ADsDSOObject"
    objConnection.Properties("User ID")  = ldap_user
    objConnection.Properties("Password") = ldap_pwd
    objConnection.Properties("Encrypt Password") = TRUE
    objConnection.Properties("ADSI Flag") = 1
    objConnection.Open "Active Directory Provider"
 
    Set objCommand.ActiveConnection = objConnection

    objCommand.Properties("Page Size") = 1000
    objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
    objCommand.CommandText = "SELECT " & fields & _
        " FROM 'LDAP://" & ou & "' " & _
        "WHERE objectCategory='user' AND sAMAccountName='" & uid & "'"

    Set objRecordSet = objCommand.Execute

    objRecordSet.MoveFirst
    Do Until objRecordSet.EOF
        For i = 0 to objRecordSet.Fields.Count -1
            fieldname = objRecordSet.Fields(i).Name
            strvalue = objRecordSet.Fields(i).Value
            If retval <> "" Then
                retval = retval & vbTab & fieldname & "|" & strValue
            Else
                retval = fieldname & "|" & strValue
            End If
        Next
        objRecordSet.MoveNext
    Loop
    GetUserData = retval
End Function

ASP Get Page Input (Form or QueryString)

Function GetParam(strLabel)
    Dim retval : retval = ""
    retval = Trim(Request.Form(strLabel))
    If retval = "" Then
        retval = Trim(Request.QueryString(strLabel))
    End If
    GetParam = retval
End Function

VBScript / ASP Function to Convert Dates to/from MySQL

' MySqlDate(Now, 1) --> "2008-02-20"
' MySqlDate(Now, 2) --> "2/20/2008"

Function MySqlDate( d, dir )
    If Not isDate( d ) Then d = Date()
    Dim strNewDate
    Select Case dir
        Case 1:
            '=== store in db
            strNewDate = Year( d ) & "-" & Month( d ) & "-" & Day( d )
        Case 2: 
            '=== use with asp
            strNewDate = Month( d )& "/"  & Day( d ) & "/" & Year( d )
            strNewDate = cDate( strNewDate )
    End Select
    mysqlDate = strNewDate
End Function

ASP - Generate Alphabet List

<select name="letter" size="1">
<%
For i = Asc("A") to Asc("Z")
    Response.Write "<option>" & Chr(i) & "</option>"
Next
%>
</select>

VBScript / ASP Determine Next Pay Date

Function NextPayDate()
    Dim wd, base : base = CDate("6/12/2009")
    Dim today : today = Now
    If IsPayDate(today) Then
        NextPayDate = today
    Else
    wd = WeekDay(today)
    Select Case wd
        Case 6:
            ' if today is a friday
            If IsPayDate(DateAdd("d", 14, today)) Then
                NextPayDate = DateAdd("d", 14, today)
            End If
        Case 7:
            ' if today is a saturday
            If IsPayDate(DateAdd("d", 6, today)) Then
                NextPayDate = DateAdd("d", 6, today)
            Else
                NextPayDate = DateAdd("d", 13, today)
            End If
        Case Else:
            If IsPayDate(DateAdd("d", 6-wd, today)) Then
                NextPayDate = DateAdd("d", 6-wd, today)
            Else
                NextPayDate = DateAdd("d", 13-wd, today)
            End If
        End Select
    End If
End Function

VBScript / ASP Is-PayDate (Crude Version)

Returns True if [dateval] is a multiple of 14 days (two weeks) from a known base pay date in the past (I picked June 12, 2009).

Function IsPayDate(dateval)
    Dim days
    Dim base : base = CDate("6/12/2009")
    If WeekDay(dateval) = 6 Then
        days = DateDiff("d", base, dateval)
        If (days Mod 14) = 0 Then
            IsPayDate = True
        End If
    End If
End Function

Example...

For each d in Split("7/2/2009,7/3/2009,7/10/2009,7/24/2009", ",")
    If IsPayDate(d) Then
        wscript.echo d & " is a pay date"
    Else
        wscript.echo d & " is not a pay date"
    End If
Next

VBScript / ASP String Validate

Check if string contains a value (not Null and not empty)

Function StringVal(strval)
    If Not(IsNull(strval)) And Trim(strval) <> "" Then
        StringVal = True
    End If
End Function

VBScript / ASP Function Days-In-Month

Function DaysInMonth(dateval)
    Dim nxt
    Dim tmp : tmp = DateAdd("d", -(Day(dateval)-1), dateval) ' get first day of month
    nxt = DateAdd("m", 1, tmp) ' get first day of next month
    DaysInMonth = Day(DateAdd("d", -1, nxt))
End Function

VBScript / ASP Array_Slice Function

Almost as good as the PHP function Array_Slice()

Function Array_Slice(arr, start, newArray)
 Dim x : x = 0
 For i = start-1 to Ubound(arr)-1
  ReDim Preserve newArray(x)
  newArray(x) = arr(i)
  x = x + 1
 Next
 Array_Slice = Ubound(newArray)
End Function

ASP MailTo Link Generator

Function LinkMail(strval)
 If StringVal(strval) Then
  If InStr(1, strval, "@") <> 0 Then
   LinkMail = "<a href='mailto:" & strval & "'>" & strval & "</a>"
  Else
   LinkMail = strval
  End If
 Else
  LinkMail = strval
 End If
End Function

ASP Google-Map Link Function

Spock: "Crude, but effective"

Function MapLink(strAddress, strCity, strStateZip)
 Dim url
 If StringVal(strAddress) And StringVal(strCity) And StringVal(strStateZip) Then
  url = "http://maps.google.com/maps?hl=en&q=" & _
   Replace(strAddress, " ", "+") & ",+" & _
   Replace(strCity, " ", "+") & ",+" & strStateZip & _
   "&ie=UTF8&split=0&gl=us&ei=OWlNStjaNo-Ztgfi5p2oBA&t=h&z=16&iwloc=A"
  MapLink = "
<a href="http://www.blogger.com/%22%20&%20url%20&%20%22" target="_blank">View Map</a>" & vbCRLF
 Else
  MapLink = ""
 End If
End Function

ASP ListBox for U.S. State Abbreviations

Sub StatesList(default)
 Dim lst, x
 lst = "AL,AK,AZ,AR,CA,CO,CT,DE,DC,FL," & _
  "GA,HI,ID,IL,IN,IA,KS,KY,LA,ME," & _
  "MD,MA,MI,MN,MS,MO,MT,NE,NV,NH," & _
  "NJ,NM,NY,NC,ND,OH,OK,OR,PA,RI," & _
  "SC,SD,TN,TX,UT,VT,VA,WA,WV,WI,WY"

 If default = "" Then
  Response.Write "" & vbCRLF
 End If

 For each x in Split(lst, ",")
  If Ucase(x) = Ucase(default) Then
   Response.Write "" & x & "" & vbCRLF
  Else
   Response.Write "" & x & "" & vbCRLF
  End If
 Next
End Sub

Example:

<select name="state" size="1">
    <% StatesList "VA" %>
</select>

VBScript / ASP String Padding

Function PadString(strval, delim, length, side)
 Dim tmp : tmp = Trim(strval)
 Select Case Ucase(Left(side,1))
  Case "L":
   Do While Len(tmp) < length
    tmp = delim & tmp
   Loop
  Case "R":
   Do While Len(tmp) < length
    tmp = tmp & delim
   Loop
 End Select
 PadString = tmp
End Function

VBScript / ASP Date Formatter Function

Function FDate(dateval, mode)
 Select Case mode
  Case "MM/DD/YYYY": 
   FDate = FormatDateTime(dateval, vbShortDate)
  Case "YYYY-MM-DD": 
   FDate = Year(dateval) & "-" & _
    PadString(Month(dateval), "0", 2, "Left") & "-" & _
    PadString(Day(dateval), "0", 2, "Left")
  Case "Mmm D, YYYY":
   FDate = FormatDateTime(dateval, vbLongDate)
  Case "Mmm D, YYYY HH:MM:SS":
   FDate = FormatDateTime(dateval, vbLongDate) & " " & FormatDateTime(dateval, vbLongTime)
  Case "MM/DD":
   FDate = Month(dateval) & "/" & Day(dateval)
  Case "Mmm DD":
   FDate = MonthName(Month(dateval), True) & " " & Day(dateval)
  Case "MMM DD":
   FDate = MonthName(Month(dateval), False) & " " & Day(dateval)
  Case Else:
   FDate = "[FDate] invalid option parameter specified"
 End Select
End Function