ASP处理JSON数据与API接口调用实战指南：从基础语法到高级应用，解决数据格式转换与网络请求难题，提升Web开发效率

引言：ASP中JSON处理与API调用的重要性

在现代Web开发中，JSON（JavaScript Object Notation）已成为数据交换的标准格式，而API接口调用则是连接不同系统和服务的核心机制。对于ASP（Active Server Pages）开发者而言，掌握JSON数据的处理和API调用技术至关重要。尽管ASP技术相对较老，但许多遗留系统和企业应用仍在使用它，因此提升这些系统的现代化水平具有重要的现实意义。

本文将从基础语法讲起，逐步深入到高级应用，全面介绍ASP中处理JSON数据和调用API接口的各种方法。我们将涵盖以下关键内容：

JSON基础与ASP环境准备：了解JSON格式特点，配置ASP开发环境
ASP内置JSON处理功能：使用Scripting.Dictionary和自定义函数处理简单JSON
使用第三方组件处理JSON：介绍MSXML2.DOMDocument和自定义JSON解析器
ASP发送HTTP请求调用API：使用Msxml2.ServerXMLHTTP和WinHttp.WinHttpRequest
高级应用：完整API调用示例：从认证到数据处理的完整流程
性能优化与错误处理：提升系统稳定性和响应速度
实战案例：构建RESTful服务端：在ASP中创建JSON API接口

通过本文的学习，您将能够熟练地在ASP应用中处理JSON数据，高效地调用外部API，并构建现代化的Web服务接口，从而显著提升开发效率和系统集成能力。

JSON基础与ASP环境准备

JSON格式简介

JSON是一种轻量级的数据交换格式，易于人阅读和编写，同时也易于机器解析和生成。它基于JavaScript的一个子集，但已被广泛应用于各种编程语言中。

JSON有两种基本结构：

对象：键值对的集合，用花括号{}表示
数组：值的有序集合，用方括号[]表示

示例：

{ "name": "张三", "age": 30, "skills": ["ASP", "VBScript", "SQL"], "address": { "city": "北京", "street": "朝阳路123号" } }

ASP环境配置要求

要在ASP中处理JSON，需要确保以下环境配置：

IIS服务器：Windows Server或Windows 10/11的IIS功能已启用
ASP支持：在IIS中启用ASP功能
可选组件：
- MSXML2.DOMDocument（用于XML转换）
- 自定义JSON解析组件（可下载或自行实现）

检查ASP环境的简单代码：

<% Response.Write "服务器软件: " & Request.ServerVariables("SERVER_SOFTWARE") & "<br>" Response.Write "ASP版本: " & ScriptEngine & "." & ScriptEngineMajorVersion & "." & ScriptEngineMinorVersion & "." & ScriptEngineBuildVersion & "<br>" Response.Write "JSON支持: " On Error Resume Next Dim testObj Set testObj = Server.CreateObject("Scripting.Dictionary") If Err.Number = 0 Then Response.Write "可用" Else Response.Write "不可用" End If On Error GoTo 0 %>

基础数据类型映射

在ASP（VBScript）与JSON之间，数据类型需要正确映射：

VBScript类型	JSON类型	示例
String	string	`"Hello"`
Number	number	`123` 或 `123.45`
Boolean	boolean	`true` 或 `false`
Null	null	`null`
Array	array	`["a", "b", "c"]`
Object/Dictiona	object	`{"key": "value"}`

ASP内置JSON处理功能

使用Scripting.Dictionary处理简单JSON

虽然ASP没有内置的JSON解析器，但我们可以使用Scripting.Dictionary对象来构建简单的JSON字符串。

生成JSON字符串的示例：

<% Function BuildJsonFromDictionary(dict) Dim json, key, value, first json = "{" first = True For Each key In dict.Keys If Not first Then json = json & "," first = False json = json & """" & key & """:" value = dict(key) ' 判断值的类型 If IsArray(value) Then json = json & BuildJsonArray(value) ElseIf IsObject(value) Then If TypeName(value) = "Dictionary" Then json = json & BuildJsonFromDictionary(value) Else json = json & "null" End If ElseIf VarType(value) = vbString Then json = json & """" & EscapeJsonString(value) & """" ElseIf VarType(value) = vbBoolean Then If value Then json = json & "true" Else json = json & "false" End If ElseIf IsNull(value) Then json = json & "null" Else json = json & value End If Next json = json & "}" BuildJsonFromDictionary = json End Function Function BuildJsonArray(arr) Dim json, i, first json = "[" first = True For i = 0 To UBound(arr) If Not first Then json = json & "," first = False If VarType(arr(i)) = vbString Then json = json & """" & EscapeJsonString(arr(i)) & """" ElseIf IsArray(arr(i)) Then json = json & BuildJsonArray(arr(i)) ElseIf IsObject(arr(i)) Then If TypeName(arr(i)) = "Dictionary" Then json = json & BuildJsonFromDictionary(arr(i)) Else json = json & "null" End If ElseIf VarType(arr(i)) = vbBoolean Then If arr(i) Then json = json & "true" Else json = json & "false" End If ElseIf IsNull(arr(i)) Then json = json & "null" Else json = json & arr(i) End If Next json = json & "]" BuildJsonArray = json End Function Function EscapeJsonString(str) Dim result result = Replace(str, "", "\") result = Replace(result, """", """") result = Replace(result, "/", "/") result = Replace(result, vbCr, "r") result = Replace(result, vbLf, "n") result = Replace(result, vbTab, "t") EscapeJsonString = result End Function ' 使用示例 Dim userDict, addressDict, skillsArray Set userDict = Server.CreateObject("Scripting.Dictionary") Set addressDict = Server.CreateObject("Scripting.Dictionary") addressDict.Add "city", "上海" addressDict.Add "street", "南京路456号" skillsArray = Array("ASP", "VBScript", "SQL Server") userDict.Add "name", "李四" userDict.Add "age", 28 userDict.Add "isDeveloper", True userDict.Add "skills", skillsArray userDict.Add "address", addressDict userDict.Add "description", Null Response.ContentType = "application/json" Response.Write BuildJsonFromDictionary(userDict) %>

解析简单JSON字符串

对于简单的JSON字符串，我们可以编写自定义函数进行解析：

<% Function ParseSimpleJson(jsonString) Dim dict, pos, lenStr, char, inString, key, value, currentKey Set dict = Server.CreateObject("Scripting.Dictionary") jsonString = Trim(jsonString) lenStr = Len(jsonString) pos = 1 inString = False key = "" value = "" currentKey = "" ' 移除外层的{} If Left(jsonString, 1) = "{" And Right(jsonString, 1) = "}" Then jsonString = Mid(jsonString, 2, lenStr - 2) lenStr = lenStr - 2 End If While pos <= lenStr char = Mid(jsonString, pos, 1) If char = """" And (pos = 1 Or Mid(jsonString, pos - 1, 1) <> "") Then inString = Not inString If inString Then key = "" Else ' 结束一个键或值 If currentKey = "" Then currentKey = key Else value = key dict.Add currentKey, value currentKey = "" value = "" End If key = "" End If ElseIf inString Then key = key & char ElseIf char = ":" Then ' 键结束，开始值 If key <> "" Then currentKey = key key = "" End If ElseIf char = "," Then ' 如果有值，添加到字典 If currentKey <> "" And key <> "" Then dict.Add currentKey, key currentKey = "" key = "" End If Else If char <> " " And char <> vbTab And char <> vbCr And char <> vbLf Then key = key & char End If End If pos = pos + 1 Wend ' 处理最后一个键值对 If currentKey <> "" And key <> "" Then dict.Add currentKey, key End If Set ParseSimpleJson = dict End Function ' 使用示例 Dim jsonStr, parsedDict jsonStr = "{""name"":""王五"",""age"":35,""city"":""深圳""}" Set parsedDict = ParseSimpleJson(jsonStr) Response.Write "姓名: " & parsedDict("name") & "<br>" Response.Write "年龄: " & parsedDict("age") & "<br>" Response.Write "城市: " & parsedDict("city") & "<br>" %>

处理嵌套JSON的挑战

上述简单解析器无法处理嵌套对象和数组。对于复杂的JSON，我们需要更强大的解决方案。在实际项目中，建议使用第三方组件或自行实现完整的JSON解析器。

使用第三方组件处理JSON

使用MSXML2.DOMDocument进行XML-JSON转换

虽然这不是最佳方案，但在某些场景下，可以通过将JSON转换为XML，利用MSXML2.DOMDocument处理，再转回JSON。

<% ' JSON转XML辅助函数 Function JsonToXml(jsonString) ' 这是一个简化的转换，实际应用中需要更复杂的处理 Dim xml, dict, key, value Set dict = ParseSimpleJson(jsonString) xml = "<root>" For Each key In dict.Keys value = dict(key) xml = xml & "<" & key & ">" & Server.HTMLEncode(value) & "</" & key & ">" Next xml = xml & "</root>" JsonToXml = xml End Function ' 使用MSXML2.DOMDocument Dim xmlDoc, xmlStr, jsonStr jsonStr = "{""name"":""测试用户"",""age"":25}" ' 转换为XML xmlStr = JsonToXml(jsonStr) Set xmlDoc = Server.CreateObject("MSXML2.DOMDocument") xmlDoc.async = False xmlDoc.loadXML xmlStr ' 处理XML If xmlDoc.parseError.errorCode = 0 Then Dim nameNode, ageNode Set nameNode = xmlDoc.selectSingleNode("//name") Set ageNode = xmlDoc.selectSingleNode("//age") Response.Write "从XML解析 - 姓名: " & nameNode.text & "<br>" Response.Write "从XML解析 - 年龄: " & ageNode.text & "<br>" Else Response.Write "XML解析错误: " & xmlDoc.parseError.reason End If %>

使用自定义JSON解析器

由于ASP没有官方JSON库，许多开发者选择使用自定义的JSON解析器。以下是一个功能更完整的JSON解析器实现：

<% ' JSON解析器类 Class JsonParser Private jsonString Private currentIndex Private totalLength Public Function Parse(jsonStr) jsonString = jsonStr currentIndex = 1 totalLength = Len(jsonStr) Set Parse = ParseValue() End Function Private Function ParseValue() SkipWhitespace() Dim char char = Mid(jsonString, currentIndex, 1) Select Case char Case "{" Set ParseValue = ParseObject() Case "[" Set ParseValue = ParseArray() Case """" ParseValue = ParseString() Case "t", "f", "n" ParseValue = ParseLiteral() Case Else If IsNumeric(char) Or char = "-" Then ParseValue = ParseNumber() Else Err.Raise 1, "JsonParser", "Unexpected character at position " & currentIndex End If End Select End Function Private Function ParseObject() Dim dict, key, value Set dict = Server.CreateObject("Scripting.Dictionary") currentIndex = currentIndex + 1 ' Skip { SkipWhitespace() ' 空对象 If Mid(jsonString, currentIndex, 1) = "}" Then currentIndex = currentIndex + 1 Set ParseObject = dict Exit Function End If Do While currentIndex <= totalLength key = ParseString() SkipWhitespace() ' 检查冒号 If Mid(jsonString, currentIndex, 1) <> ":" Then Err.Raise 2, "JsonParser", "Expected : at position " & currentIndex End If currentIndex = currentIndex + 1 value = ParseValue() dict.Add key, value SkipWhitespace() Dim nextChar nextChar = Mid(jsonString, currentIndex, 1) If nextChar = "}" Then currentIndex = currentIndex + 1 Exit Do ElseIf nextChar = "," Then currentIndex = currentIndex + 1 SkipWhitespace() Else Err.Raise 3, "JsonParser", "Expected , or } at position " & currentIndex End If Loop Set ParseObject = dict End Function Private Function ParseArray() Dim arr, values, value Set values = Server.CreateObject("Scripting.Dictionary") currentIndex = currentIndex + 1 ' Skip [ SkipWhitespace() ' 空数组 If Mid(jsonString, currentIndex, 1) = "]" Then currentIndex = currentIndex + 1 ParseArray = Array() Exit Function End If Do While currentIndex <= totalLength value = ParseValue() values.Add values.Count, value SkipWhitespace() Dim nextChar nextChar = Mid(jsonString, currentIndex, 1) If nextChar = "]" Then currentIndex = currentIndex + 1 Exit Do ElseIf nextChar = "," Then currentIndex = currentIndex + 1 SkipWhitespace() Else Err.Raise 4, "JsonParser", "Expected , or ] at position " & currentIndex End If Loop ' 转换为数组 ReDim arr(values.Count - 1) Dim i For i = 0 To values.Count - 1 arr(i) = values(i) Next ParseArray = arr End Function Private Function ParseString() Dim result, char, escaped currentIndex = currentIndex + 1 ' Skip " result = "" Do While currentIndex <= totalLength char = Mid(jsonString, currentIndex, 1) If char = "" Then currentIndex = currentIndex + 1 If currentIndex > totalLength Then Exit Do escaped = Mid(jsonString, currentIndex, 1) Select Case escaped Case """": result = result & """" Case "": result = result & "" Case "/": result = result & "/" Case "b": result = result & vbBack Case "f": result = result & vbFormFeed Case "n": result = result & vbLf Case "r": result = result & vbCr Case "t": result = result & vbTab Case "u" ' Unicode转义（简化处理） currentIndex = currentIndex + 1 Dim hexCode hexCode = Mid(jsonString, currentIndex, 4) result = result & ChrW("&H" & hexCode) currentIndex = currentIndex + 3 Case Else result = result & escaped End Select ElseIf char = """" Then currentIndex = currentIndex + 1 ParseString = result Exit Function Else result = result & char End If currentIndex = currentIndex + 1 Loop Err.Raise 5, "JsonParser", "Unterminated string" End Function Private Function ParseNumber() Dim start, char, numStr start = currentIndex Do While currentIndex <= totalLength char = Mid(jsonString, currentIndex, 1) If Not (IsNumeric(char) Or char = "." Or char = "e" Or char = "E" Or char = "-" Or char = "+") Then Exit Do End If currentIndex = currentIndex + 1 Loop numStr = Mid(jsonString, start, currentIndex - start) ParseNumber = CDbl(numStr) End Function Private Function ParseLiteral() Dim start, literal start = currentIndex Do While currentIndex <= totalLength Dim char char = Mid(jsonString, currentIndex, 1) If Not (char >= "a" And char <= "z") Then Exit Do currentIndex = currentIndex + 1 Loop literal = LCase(Mid(jsonString, start, currentIndex - start)) Select Case literal Case "true": ParseLiteral = True Case "false": ParseLiteral = False Case "null": ParseLiteral = Null Case Else: Err.Raise 6, "JsonParser", "Unknown literal: " & literal End Select End Function Private Sub SkipWhitespace() Do While currentIndex <= totalLength Dim char char = Mid(jsonString, currentIndex, 1) If char <> " " And char <> vbTab And char <> vbCr And char <> vbLf Then Exit Do currentIndex = currentIndex + 1 Loop End Sub End Class ' 使用示例 Dim parser, jsonStr, result Set parser = New JsonParser jsonStr = "{""user"":{""name"":""赵六"",""age"":40,""skills"":[""C#"",""ASP.NET"",""SQL""],""active"":true}}" Set result = parser.Parse(jsonStr) Response.Write "解析结果:<br>" Response.Write "用户姓名: " & result("user")("name") & "<br>" Response.Write "用户年龄: " & result("user")("age") & "<br>" Response.Write "技能: " & Join(result("user")("skills"), ", ") & "<br>" Response.Write "是否激活: " & result("user")("active") & "<br>" %>

使用开源组件JSON.asp

在实际项目中，推荐使用成熟的开源JSON组件，如JSON.asp（由Randy Forbing开发）或类似的库。这些组件通常提供完整的JSON解析和生成功能。

使用JSON.asp的示例：

<% ' 假设已包含JSON.asp文件 ' #include file="JSON.asp" Dim json, parsed, obj Set json = New JSON ' 解析JSON parsed = json.parse("{""name"":""测试"",""value"":123}") ' 生成JSON Set obj = Server.CreateObject("Scripting.Dictionary") obj.Add "name", "生成测试" obj.Add "value", 456 obj.Add "items", Array("A", "B", "C") Response.Write json.stringify(obj) %>

ASP发送HTTP请求调用API

使用Msxml2.ServerXMLHTTP

这是ASP中最常用的HTTP请求组件，支持同步和异步请求。

<% ' 基本GET请求示例 Function HttpGet(url) Dim http, response Set http = Server.CreateObject("Msxml2.ServerXMLHTTP") On Error Resume Next http.open "GET", url, False http.send If Err.Number <> 0 Then HttpGet = "Error: " & Err.Description Exit Function End If If http.status = 200 Then HttpGet = http.responseText Else HttpGet = "HTTP Error " & http.status & ": " & http.statusText End If Set http = Nothing End Function ' 带请求头的GET请求 Function HttpGetWithHeaders(url, headers) Dim http, header, parts Set http = Server.CreateObject("Msxml2.ServerXMLHTTP") http.open "GET", url, False ' 添加请求头 If IsArray(headers) Then For Each header In headers parts = Split(header, ":", 2) If UBound(parts) = 1 Then http.setRequestHeader Trim(parts(0)), Trim(parts(1)) End If Next End If http.send If http.status = 200 Then HttpGetWithHeaders = http.responseText Else HttpGetWithHeaders = "Error " & http.status & ": " & http.statusText End If Set http = Nothing End Function ' POST请求示例 Function HttpPost(url, data, contentType) Dim http Set http = Server.CreateObject("Msxml2.ServerXMLHTTP") http.open "POST", url, False http.setRequestHeader "Content-Type", contentType http.send data If http.status = 200 Then HttpPost = http.responseText Else HttpPost = "Error " & http.status & ": " & http.statusText End If Set http = Nothing End Function ' 使用示例 Dim apiUrl, result, headers ' GET请求 apiUrl = "https://api.example.com/users/123" result = HttpGet(apiUrl) Response.Write "GET结果: " & Server.HTMLEncode(result) & "<br><br>" ' POST请求（JSON数据） Dim postData postData = "{""name"":""新用户"",""email"":""user@example.com""}" result = HttpPost("https://api.example.com/users", postData, "application/json") Response.Write "POST结果: " & Server.HTMLEncode(result) & "<br><br>" ' 带认证的请求 headers = Array("Authorization: Bearer your-token-here", "X-Custom-Header: value") result = HttpGetWithHeaders("https://api.example.com/protected", headers) Response.Write "认证请求结果: " & Server.HTMLEncode(result) %>

使用WinHttp.WinHttpRequest

WinHttp是比ServerXMLHTTP更现代的组件，支持更多HTTP特性。

<% ' 使用WinHttp的POST请求 Function WinHttpPost(url, data, headers) Dim http Set http = Server.CreateObject("WinHttp.WinHttpRequest.5.1") http.open "POST", url, False ' 设置请求头 If IsArray(headers) Then Dim header, parts For Each header In headers parts = Split(header, ":", 2) If UBound(parts) = 1 Then http.setRequestHeader Trim(parts(0)), Trim(parts(1)) End If Next End If http.send data If http.status = 200 Then WinHttpPost = http.responseText Else WinHttpPost = "Error " & http.status & ": " & http.statusText End If Set http = Nothing End Function ' 处理HTTPS和SSL/TLS Function HttpsRequest(url, method, data, headers) Dim http Set http = Server.CreateObject("WinHttp.WinHttpRequest.5.1") ' 自动处理SSL证书 http.Option(4) = 13056 ' 忽略所有证书错误 http.open method, url, False If IsArray(headers) Then Dim header, parts For Each header In headers parts = Split(header, ":", 2) If UBound(parts) = 1 Then http.setRequestHeader Trim(parts(0)), Trim(parts(1)) End If Next End If If method = "POST" Or method = "PUT" Then http.send data Else http.send End If HttpsRequest = http.responseText Set http = Nothing End Function ' 使用示例 Dim winResult, winHeaders winHeaders = Array("Content-Type: application/json", "Authorization: Basic dXNlcjpwYXNz") winResult = WinHttpPost("https://secure-api.example.com/data", _ "{""action"":""create""}", winHeaders) Response.Write "WinHttp结果: " & Server.HTMLEncode(winResult) %>

异步请求处理

虽然ASP主要是同步处理，但可以通过一些技巧实现异步请求：

<% ' 异步请求示例（需要配合Session或数据库） Sub StartAsyncRequest(url, callbackUrl) Dim http Set http = Server.CreateObject("Msxml2.ServerXMLHTTP.6.0") ' 设置异步模式 http.open "GET", url, True ' 设置回调函数（通过事件） Set http.onreadystatechange = GetRef("AsyncCallback") http.send ' 保存http对象到Session以便回调使用 Set Session("AsyncHttp") = http Session("CallbackUrl") = callbackUrl End Sub Sub AsyncCallback() Dim http Set http = Session("AsyncHttp") If http.readyState = 4 Then ' 请求完成 If http.status = 200 Then ' 处理响应 Dim result result = http.responseText ' 可以保存到数据库或文件 ' 然后重定向到回调页面 If Session("CallbackUrl") <> "" Then Response.Redirect Session("CallbackUrl") & "?result=" & Server.URLEncode(result) End If End If Set Session("AsyncHttp") = Nothing End If End Sub %>

高级应用：完整API调用示例

认证处理（API Key, OAuth）

<% ' API Key认证 Function CallApiWithApiKey(url, apiKey, method, data) Dim headers headers = Array("X-API-Key: " & apiKey, "Content-Type: application/json") If method = "GET" Then CallApiWithApiKey = HttpGetWithHeaders(url, headers) Else CallApiWithApiKey = HttpPost(url, data, "application/json") ' 或者使用带headers的POST Dim http Set http = Server.CreateObject("Msxml2.ServerXMLHTTP") http.open method, url, False Dim header, parts For Each header In headers parts = Split(header, ":", 2) http.setRequestHeader Trim(parts(0)), Trim(parts(1)) Next http.send data CallApiWithApiKey = http.responseText Set http = Nothing End If End Function ' Basic认证 Function CallApiWithBasicAuth(url, username, password, method, data) Dim http, authHeader Set http = Server.CreateObject("Msxml2.ServerXMLHTTP") authHeader = "Basic " & Base64Encode(username & ":" & password) http.open method, url, False http.setRequestHeader "Authorization", authHeader http.setRequestHeader "Content-Type", "application/json" If method = "POST" Or method = "PUT" Then http.send data Else http.send End If CallApiWithBasicAuth = http.responseText Set http = Nothing End Function ' OAuth 2.0 Bearer Token Function CallApiWithOAuth(url, token, method, data) Dim headers headers = Array("Authorization: Bearer " & token, "Content-Type: application/json") If method = "GET" Then CallApiWithOAuth = HttpGetWithHeaders(url, headers) Else ' 使用带headers的POST Dim http Set http = Server.CreateObject("Msxml2.ServerXMLHTTP") http.open method, url, False Dim header, parts For Each header In headers parts = Split(header, ":", 2) http.setRequestHeader Trim(parts(0)), Trim(parts(1)) Next http.send data CallApiWithOAuth = http.responseText Set http = Nothing End If End Function ' Base64编码辅助函数 Function Base64Encode(sText) Dim oXML, oNode Set oXML = CreateObject("MSXML2.DOMDocument") Set oNode = oXML.createElement("b64") oNode.dataType = "bin.base64" oNode.nodeTypedValue = Stream_StringToBinary(sText) Base64Encode = oNode.text End Function Function Stream_StringToBinary(Text) Dim Stream, RS Set RS = CreateObject("ADODB.Recordset") With RS .Fields.Append "mBinary", 201, LenB(Text) ' adLongVarChar .Open .AddNew .Fields("mBinary").Value = Text .Update Stream_StringToBinary = .Fields("mBinary").GetChunk(LenB(Text)) .Close End With Set RS = Nothing End Function ' 使用示例 Dim apiResult ' API Key方式 apiResult = CallApiWithApiKey("https://api.example.com/data", "your-api-key", "GET", "") Response.Write "API Key结果: " & Server.HTMLEncode(apiResult) & "<br><br>" ' Basic认证方式 apiResult = CallApiWithBasicAuth("https://api.example.com/secure", "user", "pass", "POST", "{""data"":""test""}") Response.Write "Basic认证结果: " & Server.HTMLEncode(apiResult) & "<br><br>" ' OAuth方式 apiResult = CallApiWithOAuth("https://api.example.com/oauth", "your-access-token", "GET", "") Response.Write "OAuth结果: " & Server.HTMLEncode(apiResult) %>

分页和批量处理

<% ' 分页获取数据 Function GetPagedData(baseUrl, pageSize, maxPages) Dim allData, page, url, data, parser Set parser = New JsonParser Set allData = Server.CreateObject("Scripting.Dictionary") allData.Add "items", Array() For page = 1 To maxPages url = baseUrl & "?page=" & page & "&pageSize=" & pageSize data = HttpGet(url) If Left(data, 1) = "{" Then Dim pageData Set pageData = parser.Parse(data) If pageData.Exists("items") Then Dim items, currentItems items = pageData("items") ' 合并数组 currentItems = allData("items") allData("items") = MergeArrays(currentItems, items) End If ' 检查是否有下一页 If Not pageData.Exists("hasMore") Or Not pageData("hasMore") Then Exit For End If Else Exit For End If Next Set GetPagedData = allData End Function ' 数组合并辅助函数 Function MergeArrays(arr1, arr2) Dim result, i, totalSize totalSize = UBound(arr1) + UBound(arr2) + 2 ReDim result(totalSize - 1) For i = 0 To UBound(arr1) result(i) = arr1(i) Next For i = 0 To UBound(arr2) result(UBound(arr1) + 1 + i) = arr2(i) Next MergeArrays = result End Function ' 批量处理API调用 Sub BatchProcessApi(apiUrlTemplate, ids) Dim i, url, result, parser Set parser = New JsonParser For i = 0 To UBound(ids) url = Replace(apiUrlTemplate, "{id}", ids(i)) result = HttpGet(url) ' 处理结果 If Left(result, 1) = "{" Then Dim data Set data = parser.Parse(result) ' 保存到数据库或文件 SaveApiResult ids(i), data End If Next End Sub ' 保存API结果到数据库 Sub SaveApiResult(id, data) Dim conn, cmd Set conn = Server.CreateObject("ADODB.Connection") conn.Open "your-connection-string" Set cmd = Server.CreateObject("ADODB.Command") cmd.ActiveConnection = conn cmd.CommandText = "INSERT INTO api_results (api_id, json_data, created_at) VALUES (?, ?, GETDATE())" cmd.Parameters.Append cmd.CreateParameter("@id", adInteger, adParamInput, , id) cmd.Parameters.Append cmd.CreateParameter("@data", adLongVarChar, adParamInput, 8000, data("name")) cmd.Execute conn.Close Set cmd = Nothing Set conn = Nothing End Sub %>

性能优化与错误处理

连接池和超时设置

<% ' 优化的HTTP请求函数（带超时和重试） Function HttpGetOptimized(url, timeoutSeconds, maxRetries) Dim http, attempt, responseText attempt = 0 Do While attempt < maxRetries Set http = Server.CreateObject("Msxml2.ServerXMLHTTP") ' 设置超时（毫秒） http.setTimeouts 10000, 10000, 30000, timeoutSeconds * 1000 On Error Resume Next http.open "GET", url, False http.send If Err.Number = 0 And http.status = 200 Then responseText = http.responseText Set http = Nothing HttpGetOptimized = responseText Exit Function End If attempt = attempt + 1 If attempt < maxRetries Then ' 指数退避 WScript.Sleep 1000 * attempt End If Set http = Nothing Loop HttpGetOptimized = "Error: Failed after " & maxRetries & " attempts" End Function ' 使用连接复用（模拟连接池） Dim globalHttp Set globalHttp = Server.CreateObject("Msxml2.ServerXMLHTTP") Function HttpGetReusable(url) globalHttp.open "GET", url, False globalHttp.send HttpGetReusable = globalHttp.responseText End Function ' 在应用结束时清理 Sub CleanupGlobalHttp() If Not globalHttp Is Nothing Then Set globalHttp = Nothing End If End Sub %>

错误处理和日志记录

<% ' 带详细错误处理的API调用 Function SafeApiCall(url, method, data, headers) Dim http, startTime, endTime, errorOccurred startTime = Timer() errorOccurred = False On Error Resume Next Set http = Server.CreateObject("Msxml2.ServerXMLHTTP") If Err.Number <> 0 Then LogError "创建HTTP对象失败", Err.Number, Err.Description, url SafeApiCall = "Error: Cannot create HTTP object" Exit Function End If http.open method, url, False ' 设置请求头 If IsArray(headers) Then Dim header, parts For Each header In headers parts = Split(header, ":", 2) If UBound(parts) = 1 Then http.setRequestHeader Trim(parts(0)), Trim(parts(1)) End If Next End If If method = "POST" Or method = "PUT" Then http.send data Else http.send End If If Err.Number <> 0 Then LogError "HTTP请求失败", Err.Number, Err.Description, url SafeApiCall = "Error: Request failed" errorOccurred = True Else endTime = Timer() If http.status >= 400 Then LogError "API返回错误", http.status, http.statusText & " - " & http.responseText, url SafeApiCall = "Error " & http.status & ": " & http.statusText Else ' 记录成功调用（可选） LogSuccess url, http.status, endTime - startTime SafeApiCall = http.responseText End If End If Set http = Nothing On Error GoTo 0 End Function ' 日志记录函数 Sub LogError(errorType, errorCode, errorDesc, url) Dim conn, cmd On Error Resume Next Set conn = Server.CreateObject("ADODB.Connection") conn.Open "your-connection-string" Set cmd = Server.CreateObject("ADODB.Command") cmd.ActiveConnection = conn cmd.CommandText = "INSERT INTO error_log (error_type, error_code, error_desc, url, created_at) VALUES (?, ?, ?, ?, GETDATE())" cmd.Parameters.Append cmd.CreateParameter("@type", adVarChar, adParamInput, 50, errorType) cmd.Parameters.Append cmd.CreateParameter("@code", adInteger, adParamInput, , errorCode) cmd.Parameters.Append cmd.CreateParameter("@desc", adLongVarChar, adParamInput, 8000, errorDesc) cmd.Parameters.Append cmd.CreateParameter("@url", adVarChar, adParamInput, 500, url) cmd.Execute conn.Close Set cmd = Nothing Set conn = Nothing ' 同时输出到响应（调试用） Response.Write "<div style='color:red; background:#ffeeee; padding:10px; margin:10px 0;'>" Response.Write "<strong>API Error:</strong> " & Server.HTMLEncode(errorDesc) & "</div>" End Sub Sub LogSuccess(url, status, duration) ' 可选：记录成功调用到日志表 ' 实现类似LogError，但记录成功信息 End Sub ' 使用示例 Dim result result = SafeApiCall("https://api.example.com/data", "GET", "", Array("Authorization: Bearer token")) Response.Write "结果: " & Server.HTMLEncode(result) %>

实战案例：构建RESTful服务端

创建JSON API接口

<% ' API路由处理 Sub HandleApiRequest() Dim method, path, queryString, requestBody method = Request.ServerVariables("REQUEST_METHOD") path = Request.ServerVariables("PATH_INFO") queryString = Request.ServerVariables("QUERY_STRING") ' 读取请求体（POST/PUT） If method = "POST" Or method = "PUT" Then Dim contentLength, body contentLength = Request.ServerVariables("CONTENT_LENGTH") If contentLength > 0 Then body = Request.Form End If End If ' 路由分发 Select Case path Case "/api/users" HandleUsersApi method, queryString, body Case "/api/products" HandleProductsApi method, queryString, body Case Else SendJsonResponse 404, "Not Found", "Unknown endpoint" End Select End Sub ' 用户API处理 Sub HandleUsersApi(method, queryString, body) Dim parser, data, userId Select Case method Case "GET" ' 获取用户列表或单个用户 If queryString <> "" Then userId = GetQueryParam(queryString, "id") If userId <> "" Then GetUserById userId Else GetUsersList queryString End If Else GetUsersList "" End If Case "POST" ' 创建用户 Set parser = New JsonParser On Error Resume Next Set data = parser.Parse(body) If Err.Number = 0 Then CreateUser data Else SendJsonResponse 400, "Bad Request", "Invalid JSON" End If On Error GoTo 0 Case "PUT" ' 更新用户 Set parser = New JsonParser On Error Resume Next Set data = parser.Parse(body) If Err.Number = 0 Then userId = GetQueryParam(queryString, "id") If userId <> "" Then UpdateUser userId, data Else SendJsonResponse 400, "Bad Request", "Missing user ID" End If Else SendJsonResponse 400, "Bad Request", "Invalid JSON" End If On Error GoTo 0 Case "DELETE" ' 删除用户 userId = GetQueryParam(queryString, "id") If userId <> "" Then DeleteUser userId Else SendJsonResponse 400, "Bad Request", "Missing user ID" End If Case Else SendJsonResponse 405, "Method Not Allowed", "Method not supported" End Select End Sub ' 获取查询参数 Function GetQueryParam(queryString, param) Dim pairs, i, pair, parts pairs = Split(queryString, "&") For i = 0 To UBound(pairs) pair = pairs(i) parts = Split(pair, "=", 2) If parts(0) = param And UBound(parts) = 1 Then GetQueryParam = Server.URLDecode(parts(1)) Exit Function End If Next GetQueryParam = "" End Function ' 发送JSON响应 Sub SendJsonResponse(statusCode, statusText, message) Response.Status = statusCode & " " & statusText Response.ContentType = "application/json" Dim responseDict Set responseDict = Server.CreateObject("Scripting.Dictionary") responseDict.Add "status", statusCode responseDict.Add "message", message Response.Write BuildJsonFromDictionary(responseDict) Response.End End Sub ' 具体的API操作 Sub GetUserById(id) Dim conn, rs, userData Set conn = Server.CreateObject("ADODB.Connection") conn.Open "your-connection-string" Set rs = Server.CreateObject("ADODB.Recordset") rs.Open "SELECT * FROM users WHERE id=" & id, conn If Not rs.EOF Then Set userData = Server.CreateObject("Scripting.Dictionary") userData.Add "id", rs("id") userData.Add "name", rs("name") userData.Add "email", rs("email") Response.ContentType = "application/json" Response.Write BuildJsonFromDictionary(userData) Else SendJsonResponse 404, "Not Found", "User not found" End If rs.Close conn.Close Set rs = Nothing Set conn = Nothing End Sub Sub CreateUser(data) ' 验证数据 If Not data.Exists("name") Or Not data.Exists("email") Then SendJsonResponse 400, "Bad Request", "Missing required fields" Exit Sub End If ' 保存到数据库 Dim conn, cmd Set conn = Server.CreateObject("ADODB.Connection") conn.Open "your-connection-string" Set cmd = Server.CreateObject("ADODB.Command") cmd.ActiveConnection = conn cmd.CommandText = "INSERT INTO users (name, email) VALUES (?, ?)" cmd.Parameters.Append cmd.CreateParameter("@name", adVarChar, adParamInput, 100, data("name")) cmd.Parameters.Append cmd.CreateParameter("@email", adVarChar, adParamInput, 255, data("email")) cmd.Execute ' 获取新ID Dim newId newId = conn.Execute("SELECT SCOPE_IDENTITY()")(0) conn.Close Set cmd = Nothing Set conn = Nothing ' 返回成功响应 Dim responseDict Set responseDict = Server.CreateObject("Scripting.Dictionary") responseDict.Add "status", 201 responseDict.Add "message", "User created successfully" responseDict.Add "id", newId Response.Status = "201 Created" Response.ContentType = "application/json" Response.Write BuildJsonFromDictionary(responseDict) End Sub ' 主入口 If Request.ServerVariables("PATH_INFO") Like "/api/*" Then HandleApiRequest End If %>

处理CORS（跨域请求）

<% ' 在API页面顶部添加CORS支持 Sub EnableCORS() Dim origin origin = Request.ServerVariables("HTTP_ORIGIN") ' 允许的域名（可配置） Dim allowedOrigins allowedOrigins = Array("https://yourdomain.com", "https://app.yourdomain.com") If origin <> "" Then Dim allowed allowed = False For Each allowedOrigin In allowedOrigins If origin = allowedOrigin Then allowed = True Exit For End If Next If allowed Then Response.AddHeader "Access-Control-Allow-Origin", origin Response.AddHeader "Access-Control-Allow-Methods", "GET, POST, PUT, DELETE, OPTIONS" Response.AddHeader "Access-Control-Allow-Headers", "Content-Type, Authorization, X-API-Key" Response.AddHeader "Access-Control-Max-Age", "86400" End If End If ' 处理预检请求 If Request.ServerVariables("REQUEST_METHOD") = "OPTIONS" Then Response.Status = "200 OK" Response.End End If End Sub ' 在API处理前调用 EnableCORS() %>