Convert Atom-formatted DateTime

The following function converts ATOM (RFC4287) formatted Date/Time string into a VBScript Date variable. You’ll find it useful if you want to process Atom feeds with VBScript/ASP.

Function AtomDateTime(S)
  Dim CompArray,ValueArray,DateVal,TimeString,TimeVal,ZoneSign,ZoneString,I

  CompArray = Split(S,"T")
  If UBound(CompArray) <> 1 Then _
    Err.raise vbObjectError,"AtomDateTime","No 'T' in Atom date/time"
  ValueArray = Split(CompArray(0),"-")
  If UBound(ValueArray) <> 2 Then _
    Err.raise vbObjectError,"AtomDateTime","Atom date part is not a date"
  DateVal = DateSerial(CInt(ValueArray(0)),CInt(ValueArray(1)),CInt(ValueArray(2)))

  TimeString = CompArray(1) : I = InStr(TimeString,"Z") 
  If I > 0 Then
    TimeString = Left(TimeString,I-1)
    TimeVal = GetAtomTime(TimeString)
  Else
    I = InStr(TimeString,"-")
    If I > 0 Then 
      ZoneSign = 1 
    Else
      ZoneSign = -1 : I = InStr(TimeString,"+")
    End If
    If I = 0 Then _
      Err.raise vbObjectError,"AtomDateTime","cannot recognize timezone separator"
    ZoneString = Mid(TimeString,I+1,Len(TimeString))
    TimeString = Left(TimeString,I-1)
    TimeVal = GetAtomTime(TimeString) + ZoneSign * GetAtomTime(ZoneString)
  End If
  AtomDateTime = DateVal + TimeVal
End Function 

The DateTime is converted into GMT time value. You might need to add/subtract your local timezone offset if you want to get local time.

The GetAtomTime function converts the time portion of the DateTime field:

Function GetAtomTime(TS) 
  Dim I : I = InStr(TS,".") : If I > 0 Then TS = Left(TS,I-1)
  GetAtomTime = Timevalue(TS)
End Function

Login to Google Data API

Google Data API has numerous client-side libraries, but not an ASP/VBScript one. Here’s the first routine you need: it authenticates you with the Google API and returns a handle you can use in subsequent calls.

The HTTPCheck is a function that checks the status code before returning to the caller. You could replace if with XRQ.status < 300. You'll find the EncodeFormData function in a previous post.

Dim XRQ ' global XMLHttpRequest object

Function GoogleLogin(UN,Pwd,Svc)
  Dim RQData,I,RT

  GoogleLogin = Null
  RQData = EncodeFormData(Array("Email","Passwd","service","source"), _
    Array(UN,Pwd,Svc,"VBScript-BloggerLibrary-0.1"))

  If Not IsObject(XRQ) Then Set XRQ = CreateObject("Microsoft.XMLHTTP")
  XRQ.open "POST","https://www.google.com/accounts/ClientLogin",false
  XRQ.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
  XRQ.send RQData
  If HTTPCheck(XRQ,"Google login response", _
    "https://www.google.com/accounts/ClientLogin") Then
    RT = XRQ.responseText
    I = InStr(RT,"Auth=")
    If I = 0 Then wr "Google response has no AUTH data" : Exit Function
    RT = Mid(RT,I+5,Len(RT))
    I = InStr(RT,Chr(10)) : If I > 0 Then RT = Left(RT,I-1)
    GoogleLogin = RT
  End If
End Function

Generate HTML form data in VBscript

Sometimes you have to post form data in an AJAX call started from server-side ASP script (or WSH script). The following VBScript functions will return well-formed form data that you can use with the application/x-www-form-urlencoded MIME type:

Function URLEncoded(V) ' … private
  Dim CC,I,Enc
  Enc = ""

  For I = 1 To Len(V)
    CC = AscW(Mid(V,I,1))
    If (CC >= 48 And CC < 58) Or (CC >= 64 And CC < 90) Or (CC >= 97 And CC < 124) Or CC = 95 Or CC = 45 Or CC = 46 Then
      Enc = Enc & Mid(V,I,1)
    Else
      Enc = Enc & "%" & Hex(CC)
    End If
  Next
  URLEncoded = Enc
End Function

Function CreateFormField(F,V) ' … private
  CreateFormField = F & "=" & URLEncoded(CStr(V))
End Function  

'
' EncodeFormData: Return form data for a POST request
'
' Input: N – array of form field names
'        V – array of form field values
'
' Return: encoded form data
'
Function EncodeFormData(N,V)
  Dim I
  For I = LBound(N) To UBound(N)
    If I <> LBound(N) Then EncodeFormData = EncodeFormData & "&"
    EncodeFormData = EncodeFormData & CreateFormField(N(I),V(I))
  Next
End Function