Complete working Basic Authentication

Complete working Basic Authentication

--------------------------------------------------------------------------------

Description : This code shows your visitors the Basic Authentication dialog (or NT Login Dialog) It also returns the password and the username

<%
Response.Buffer = True
Response.Clear
Dim Myname, MyPass
GetUser Myname, MyPass
Response.Write MyName & "->" & MyPass
If Len(Myname) = 0 Then
Response.Status = "401 Unauthorized"
Response.AddHeader "WWW-Authenticate","BASIC Realm=enter your realm here"
Response.End
End If
Sub GetUser(LOGON_USER, LOGON_PASSWORD)
Dim UP, Pos, Auth
Auth = Request.ServerVariables("HTTP_AUTHORIZATION")
LOGON_USER = ""
LOGON_PASSWORD = ""
If LCase(Left(Auth, 5)) = "basic" Then
UP = Base64Decode(Mid(Auth, 7))
Pos = InStr(UP, ":")
If Pos > 1 Then
LOGON_USER = Left(UP, Pos - 1)
LOGON_PASSWORD = Mid(UP, Pos + 1)
End If
End If
End Sub
' Decodes a base-64 encoded string.
Function Base64Decode(base64String)
Const Base64CodeBase = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Dim dataLength, Out, groupBegin
dataLength = Len(base64String)
Out = ""
If dataLength Mod 4 <> 0 Then
Err.Raise 1, "Base64Decode", "Bad Base64 string."
Exit Function
End If
' Now decode each group:
For groupBegin = 1 To dataLength Step 4
Dim numDataBytes, CharCounter, thisChar, thisData, groupData
' Each data group encodes up To 3 actual
' bytes.
numDataBytes = 3
groupData = 0
For CharCounter = 0 To 3
' <B>Convert</B> each charac
' ter into 6 bits of data, And add it To
' an integer For temporary storage. If a
' character is a '=', there
' is one fewer data byte. (There can onl
' y be a maximum of 2 '=' In
' the whole string.)
thisChar = Mid(base64String, groupBegin + CharCounter, 1)
If thisChar = "=" Then
numDataBytes = numDataBytes - 1
thisData = 0
Else
thisData = InStr(Base64CodeBase, thisChar) - 1
End If
If thisData=-1 Then
Err.Raise 2, "Base64Decode", "Bad character In Base64 string."
Exit Function
End If
groupData = 64 * groupData + thisData
Next
' Convert 3-byte integer into up To 3 ch
' aracters
Dim OneChar
For CharCounter = 1 To numDataBytes
Select Case CharCounter
Case 1: OneChar = groupData 65536
Case 2: OneChar = (groupData And 65535) 256
Case 3: OneChar = (groupData And 255)
End Select
Out = Out & Chr(OneChar)
Next
Next
Base64Decode = Out
End Function
%>