'**************************************
' Name: Complete working Basic Authentic
' ation
' Description:This code shows your visit
' ors the Basic Authentication dialog (or
' NT Login Dialog)
It also returns the password and the username
if you like it, please vote For this 16 year old programmer :o)
' By: Almar Joling
'
' Inputs:In the dialog the username and
' password (/and domain)
'
' Returns:The password and username give
' n by the visitors of your site
'
' Assumes:Paste it and run it. It does n
' ot verify any usernames or so.
'
' Side Effects:Protects your site :o))
'
'This code is copyrighted and has ' limited warranties.Please see
http://w
' ww.Planet-Source-Code.com/vb/scripts/Sho
' wCode.asp?txtCodeId=6300&lngWId=4 'for details. '**************************************
<%
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 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvw xyz0123456789+/"
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
%>