wechat_login.asp

<%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%>
<%
Response.CodePage = 65001
Response.Charset = "UTF-8"
Response.ContentType = "text/html"
%>
<%
Dim appId, redirectUri, scope, state, authUrl
appId = "你的AppID"
redirectUri = Server.URLEncode("http://你的域名/callback.asp") ' 回调地址
scope = "snsapi_login" ' 授权范围
state = "STATE" ' 自定义参数，用于防止CSRF攻击

authUrl = "https://open.weixin.qq.com/connect/qrconnect?appid=" & appId & "&redirect_uri=" & redirectUri & "&response_type=code&scope=" & scope & "&state=" & state & "#wechat_redirect"

Response.Redirect(authUrl)
%>

callback.asp

<%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%>
<%
Response.CodePage = 65001
Response.Charset = "UTF-8"
Response.ContentType = "text/html"
%>
<%
Dim code, state, appId, appSecret, accessTokenUrl, accessToken, userInfoUrl, userInfo

code = Request.QueryString("code")
state = Request.QueryString("state")

If code <> "" And state = "STATE" Then
    appId = "你的AppID"
    appSecret = "你的AppSecret"

    ' 通过code获取access_token
    accessTokenUrl = "https://api.weixin.qq.com/sns/oauth2/access_token?appid=" & appId & "&secret=" & appSecret & "&code=" & code & "&grant_type=authorization_code"

    Set xmlHttp = Server.CreateObject("MSXML2.ServerXMLHTTP")
    xmlHttp.Open "GET", accessTokenUrl, False
    xmlHttp.Send

    If xmlHttp.Status = 200 Then
        Dim json, openId
        Set json = ParseJson(xmlHttp.ResponseText)

        accessToken = json("access_token")
        openId = json("openid")

        ' 获取用户信息
        userInfoUrl = "https://api.weixin.qq.com/sns/userinfo?access_token=" & accessToken & "&openid=" & openId & "&lang=zh_CN"

        xmlHttp.Open "GET", userInfoUrl, False
        xmlHttp.Send

        If xmlHttp.Status = 200 Then
            Set userInfo = ParseJson(xmlHttp.ResponseText)

            ' 输出用户信息
            Response.Write "昵称: " & userInfo("nickname") & "<br>"
            Response.Write "openid: " & openId & "<br>"
        Else
            Response.Write "获取用户信息失败"
        End If
    Else
        Response.Write "获取access_token失败"
    End If
Else
    Response.Write "授权失败"
End If

' 解析JSON的函数
Function ParseJson(jsonText)
    Dim json, key
    Set json = Server.CreateObject("Scripting.Dictionary")

    ' 这里假设jsonText是一个简单的JSON对象，实际应用中可能需要更复杂的解析
    jsonText = Replace(jsonText, "{", "")
    jsonText = Replace(jsonText, "}", "")
    jsonText = Replace(jsonText, """", "")

    Dim pairs, pair
    pairs = Split(jsonText, ",")

    For Each pair In pairs
        Dim keyValue
        keyValue = Split(pair, ":")
        key = Trim(keyValue(0))
        json(key) = Trim(keyValue(1))
    Next

    Set ParseJson = json
End Function
%>