asp实现WWW-Authenticate basic认证示例
- http://blog.gufang.org/
- 2019/11/8 11:35:14
- 来源：Gufang
- 点击：
访问asp网站，使用WWW-Authenticate basic认证机制示例代码。WWW-Authenticate basic认证采用base64编码用户输入的信息，所以需要一个base64解码类，具体看下面贴出的base64.asp文件。
注意事项，需要设置iis，网站目录安全，身份验证和访问控制，取消“集成 Windows身份验证”，如下图所示，记得要配置匿名访问用户。
<%@LANGUAGE="VBSCRIPT"%>
<!--#include file="base64.asp" -->
<%
Sub Unauth()'realm不要设置为中文，会乱码
Call Response.AddHeader("WWW-Authenticate", "Basic realm=""Please input username and password""")
Response.Status = "401 Unauthorized"
Call Response.End()
End Sub
Dim strAuth
strAuth = Request.ServerVariables("HTTP_AUTHORIZATION")
If IsNull(strAuth) Or IsEmpty(strAuth) Or strAuth = "" Then
Call Unauth
Else
%>
<html>
<body>
<%
Dim aParts, aCredentials, strType, strBase64, strPlain, strUser, strPassword
aParts = Split(strAuth, " ")
If aParts(0) <> "Basic" Then
Call Unauth
End If
strPlain = Base64Decode(aParts(1))
aCredentials = Split(strPlain, ":")
if aCredentials(0)="showbo" and aCredentials(1)="123456" then'用户名和密码正确则显示用户名和密码，这里也可以改为数据库验证之类的
response.Write Server.HTMLEncode(aCredentials(0) & " - " & aCredentials(1))
else'不正确，重新调用
Call Unauth
end if
%>
</body>
</html>
<%
End If
%>
<%
' Decodes a base-64 encoded string (BSTR type).
' 1999 - 2004 Antonin Foller, http://www.motobit.com
' 1.01 - solves problem with Access And 'Compare Database' (InStr)
Function Base64Decode(ByVal base64String)
'rfc1521
'1999 Antonin Foller, Motobit Software, http://Motobit.cz
Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Dim dataLength, sOut, groupBegin
'remove white spaces, If any
base64String = Replace(base64String, vbCrLf, "")
base64String = Replace(base64String, vbTab, "")
base64String = Replace(base64String, " ", "")
'The source must consists from groups with Len of 4 chars
dataLength = Len(base64String)
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, nGroup, pOut
' Each data group encodes up To 3 actual bytes.
numDataBytes = 3
nGroup = 0
For CharCounter = 0 To 3
' Convert each character 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 only 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(1, Base64, thisChar, vbBinaryCompare) - 1
End If
If thisData = -1 Then
Err.Raise 2, "Base64Decode", "Bad character In Base64 string."
Exit Function
End If
nGroup = 64 * nGroup + thisData
Next
'Hex splits the long To 6 groups with 4 bits
nGroup = Hex(nGroup)
'Add leading zeros
nGroup = String(6 - Len(nGroup), "0") & nGroup
pOut = Chr(CByte("&H" & Mid(nGroup, 1, 2))) + _
Chr(CByte("&H" & Mid(nGroup, 3, 2))) + _
Chr(CByte("&H" & Mid(nGroup, 5, 2)))
'add numDataBytes characters To out string
sOut = sOut & Left(pOut, numDataBytes)
Next
Base64Decode = sOut
End Function
Function Base64Encode(inData)
'rfc1521
'2001 Antonin Foller, Motobit Software, http://Motobit.cz
Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Dim cOut, sOut, I
'For each group of 3 bytes
For I = 1 To Len(inData) Step 3
Dim nGroup, pOut, sGroup
'Create one long from this 3 bytes.
nGroup = &H10000 * Asc(Mid(inData, I, 1)) + _
&H100 * MyASC(Mid(inData, I + 1, 1)) + MyASC(Mid(inData, I + 2, 1))
'Oct splits the long To 8 groups with 3 bits
nGroup = Oct(nGroup)
'Add leading zeros
nGroup = String(8 - Len(nGroup), "0") & nGroup
'Convert To base64
pOut = Mid(Base64, CLng("&o" & Mid(nGroup, 1, 2)) + 1, 1) + _
Mid(Base64, CLng("&o" & Mid(nGroup, 3, 2)) + 1, 1) + _
Mid(Base64, CLng("&o" & Mid(nGroup, 5, 2)) + 1, 1) + _
Mid(Base64, CLng("&o" & Mid(nGroup, 7, 2)) + 1, 1)
'Add the part To OutPut string
sOut = sOut + pOut
'Add a new line For Each 76 chars In dest (76*3/4 = 57)
'If (I + 2) Mod 57 = 0 Then sOut = sOut + vbCrLf
Next
Select Case Len(inData) Mod 3
Case 1: '8 bit final
sOut = Left(sOut, Len(sOut) - 2) + "=="
Case 2: '16 bit final
sOut = Left(sOut, Len(sOut) - 1) + "="
End Select
Base64Encode = sOut
End Function
Function MyASC(OneChar)
If OneChar = "" Then MyASC = 0 Else MyASC = Asc(OneChar)
End Function
%>
效果如下
- 上一篇：如何用小概率赚大钱？
- 下一篇：ASP中使用JSON的简单例子
发表评论(0)
