Logowanie do formularza web

Dziś zaprezentuję metodę logowani się do stron internetowych/intranetowych zabezpieczonych formularzem logowania. Jest to w zasadzie standardowy sposób zabezpieczania aplikacji przed nieautoryzowanym dostępem. O ile jest to dobre z punktu widzenia security, to z punktu widzenia usera który musi klikać w ileś tam formularzy dziennie jest to droga przez mękę.

Dlatego proponuję ułatwić sobie życie za pomocą poniższego zestawu:

Function httpSessionRequest(theStep, method, url, data, cookie, viewState)

    Dim HTTPReferrer As String
    Dim postVars As String
    Dim XMLHTTP As Object
    Dim strHeaders As String
    Dim hArr() As String
    Dim kk As Long
    Dim theCookie As String
    Dim mycookie As String


    If Len(cookie) = 0 Then cookie = "dummy=dummy;"
    HTTPReferrer = Trim(url)
    postVars = Trim(data)

    Set XMLHTTP = CreateObject("MSXML2.serverXMLHttp")
    XMLHTTP.Open method, Trim(url), False

    If UCase(method) = "POST" Then
        XMLHTTP.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    End If
    
    XMLHTTP.setRequestHeader "Referer", HTTPReferrer    'just in case the server cares
    XMLHTTP.setRequestHeader "Cookie", "excuse the Microsoft bug"
    XMLHTTP.setRequestHeader "Cookie", cookie

    XMLHTTP.send postVars

    'wait for response
    While XMLHTTP.readyState <> 4
        XMLHTTP.waitForResponse 1000
    Wend
    strHeaders = XMLHTTP.getAllResponseHeaders()

    hArr = Split(strHeaders, "Set-Cookie: ")
    For kk = 1 To UBound(hArr)
        theCookie = Left(hArr(kk), InStr(hArr(kk), "path=/") - 2)
        mycookie = mycookie & " " & theCookie
    Next

    If Len(mycookie) = 0 Then mycookie = cookie

    Select Case CInt(theStep)
        Case 1
            httpSessionRequest = mycookie
        Case 2
            httpSessionRequest = XMLHTTP.responsetext
        Case 3
            httpSessionRequest = XMLHTTP.responseStream
        Case 4
            httpSessionRequest = XMLHTTP.responseBody
        Case 5
            httpSessionRequest = XMLHTTP.responseXML
        Case 6
            httpSessionRequest = XMLHTTP
        Case Else
            httpSessionRequest = XMLHTTP.responsetext
    End Select

    Set XMLHTTP = Nothing
End Function

Public Function URLEncode( _
   StringVal As String, _
   Optional SpaceAsPlus As Boolean = False _
) As String

  Dim StringLen As Long: StringLen = Len(StringVal)

  If StringLen > 0 Then
    ReDim result(StringLen) As String
    Dim i As Long, CharCode As Integer
    Dim Char As String, Space As String

    If SpaceAsPlus Then Space = "+" Else Space = "%20"

    For i = 1 To StringLen
      Char = Mid$(StringVal, i, 1)
      CharCode = Asc(Char)
      Select Case CharCode
        Case 97 To 122, 65 To 90, 48 To 57, 45, 46, 95, 126
          result(i) = Char
        Case 32
          result(i) = Space
        Case 0 To 15
          result(i) = "%0" & Hex(CharCode)
        Case Else
          result(i) = "%" & Hex(CharCode)
      End Select
    Next i
    URLEncode = Join(result, "")
  End If
End Function

Function WriteStream(file As String, body)
    Dim oStream As Object
    Set oStream = CreateObject("ADODB.Stream")
    oStream.Open
    oStream.Type = 1
    oStream.Write body
    oStream.SaveToFile "D:\header_.gif"
    oStream.Close
    Set oStream = Nothing
End Function

Sub test()

    Dim Filename As String
    Dim baseURL As String, url1 As String, url2 As String, url3 As String
    Dim Data1 As String
    Dim nodata As String, noCookie As String, noViewState As String
    Dim theCookie As String
    Dim finalHTML As String
    Dim bytes() As Byte

    baseURL = "http://192.168.1.103/"    'This is to fix any broken images in the output.

    url1 = baseURL & "index.php" ' strona służąca do pobrania sesji
    url2 = baseURL & "?k=auth&a=auth&target=" ' strona logowania
    url3 = baseURL & "static/images/header.gif" ' strona

    Data1 = "login=rachwprz&password=thepass"

    theCookie = httpSessionRequest(1, "GET", baseURL, nodata, noCookie, noViewState)
    finalHTML = httpSessionRequest(2, "POST", url2, Data1, theCookie, noViewState)
    
    bytes = httpSessionRequest(4, "POST", url3, Data1, theCookie, noViewState)

    Filename = "D:\header_.gif"
    
    If Dir(Filename) <> "" Then Kill (Filename)

    WriteStream Filename, bytes

    
End Sub

Dla wyjaśnienia dodam tylko:
funkcja httpSessionRequest - jest uniwersalną metodą logowania i pobierania danych ze strony web za. W zależności od parametru theStep uzyskamy pożądany efekt. Przykładem może być pobranie wartości binarnej a następnie zapisanie jest za pomocą WriteStream
parametry przekazywane za pomocą metody POST nie muszą być traktowane funkcją URLEncode