输出数组格式
<%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%>
<%
'通义千问
' 定义连接数据库的函数（假设使用的是Access或SQL Server数据库）
Function OpenDB()
Dim conn
Set conn = Server.CreateObject("ADODB.Connection")
' 替换为你的数据库连接字符串
conn.Open "Provider=SQLOLEDB;Data Source=(local);Initial Catalog=db;User ID=sa;Password=123456;"
Set OpenDB = conn
End Function
' 关闭数据库连接的函数
Sub CloseDB(conn)
If IsObject(conn) Then
conn.Close
Set conn = Nothing
End If
End Sub
' 主程序开始
Dim conn, rsParent, rsChild, parentId, parentName, childId, childTitle
Dim resultArray, parentIndex
' 初始化结果数组
parentIndex = 0
ReDim resultArray(0)
' 打开数据库连接
Set conn = OpenDB()
' 查询父类数据
sqlParent = "select id, MingCheng from BDClass where ParentID='1' order by orders"
Set rsParent = conn.Execute(sqlParent)
If Not rsParent.EOF Then
Do While Not rsParent.EOF
parentId = rsParent("id")
parentName = rsParent("MingCheng")
' 创建一个空的子类数组
Dim childArray
ReDim childArray(0)
' 查询子类产品数据
sqlChild = "select C.Comid, C.Title, C.OutUrl, C.TJtitle, C.Logo, C.ZSstar " & _
"from BDcompany T, Company C " & _
"where T.Comid=C.Comid and C.IsPass=1 and T.classid='" & parentId & "' " & _
"order by Orders, T.AddTime desc, T.ID desc"
Set rsChild = conn.Execute(sqlChild)
If Not rsChild.EOF Then
Dim childIndex
childIndex = 0
Do While Not rsChild.EOF
childId = rsChild("Comid")
childTitle = rsChild("Title")
' 将子类信息存储到子类数组中
ReDim Preserve childArray(childIndex)
childArray(childIndex) = Array(childId, childTitle, rsChild("OutUrl"), rsChild("TJtitle"), rsChild("Logo"), rsChild("ZSstar"))
childIndex = childIndex + 1
rsChild.MoveNext
Loop
End If
' 关闭子类记录集
If IsObject(rsChild) Then rsChild.Close
' 将父类和子类数据合并到结果数组中
ReDim Preserve resultArray(parentIndex)
resultArray(parentIndex) = Array(parentId, parentName, childArray)
parentIndex = parentIndex + 1
rsParent.MoveNext
Loop
End If
' 关闭父类记录集和数据库连接
If IsObject(rsParent) Then rsParent.Close
Call CloseDB(conn)
' 输出结果数组（仅用于调试）
For i = 0 To UBound(resultArray)
Response.Write "Parent ID: " & resultArray(i)(0) & ", Name: " & resultArray(i)(1) & "<br>"
For j = 0 To UBound(resultArray(i)(2))
Response.Write " Child ID: " & resultArray(i)(2)(j)(0) & ", Title: " & resultArray(i)(2)(j)(1) & "<br>"
Next
Next
%>
输出JSON格式
<%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%>
<%
'通义千问，以JSON格式输出
' 定义连接数据库的函数（假设使用的是Access或SQL Server数据库）
Function OpenDB()
Dim conn
Set conn = Server.CreateObject("ADODB.Connection")
' 替换为你的数据库连接字符串
conn.Open "Provider=SQLOLEDB;Data Source=(local);Initial Catalog=db;User ID=sa;Password=123456;"
Set OpenDB = conn
End Function
' 关闭数据库连接的函数
Sub CloseDB(conn)
If IsObject(conn) Then
conn.Close
Set conn = Nothing
End If
End Sub
' 自定义 Nz 函数：处理 Null 值
Function Nz(value, defaultValue)
If IsNull(value) Or value = "" Then
Nz = defaultValue
Else
Nz = value
End If
End Function
' 主程序开始
Dim conn, rsParent, rsChild, parentId, parentName, childId, childTitle
Dim resultArray, parentIndex
' 初始化结果数组
parentIndex = 0
ReDim resultArray(0)
' 打开数据库连接
Set conn = OpenDB()
' 查询父类数据
sqlParent = "select id, MingCheng from BDClass where ParentID='1' order by orders"
Set rsParent = conn.Execute(sqlParent)
If Not rsParent.EOF Then
Do While Not rsParent.EOF
parentId = Nz(rsParent("id"), "")
parentName = Nz(rsParent("MingCheng"), "")
' 创建一个空的子类数组
Dim childArray
ReDim childArray(0)
' 查询子类产品数据
sqlChild = "select C.Comid, C.Title, C.OutUrl, C.TJtitle, C.Logo, C.ZSstar " & _
"from BDcompany T, Company C " & _
"where T.Comid=C.Comid and C.IsPass=1 and T.classid='" & parentId & "' " & _
"order by Orders, T.AddTime desc, T.ID desc"
Set rsChild = conn.Execute(sqlChild)
If Not rsChild.EOF Then
Dim childIndex
childIndex = 0
Do While Not rsChild.EOF
childId = Nz(rsChild("Comid"), "")
childTitle = Nz(rsChild("Title"), "")
' 将子类信息存储到子类数组中
ReDim Preserve childArray(childIndex)
childArray(childIndex) = Array(childId, childTitle, Nz(rsChild("OutUrl"), ""), Nz(rsChild("TJtitle"), ""), Nz(rsChild("Logo"), ""), Nz(rsChild("ZSstar"), ""))
childIndex = childIndex + 1
rsChild.MoveNext
Loop
End If
' 关闭子类记录集
If IsObject(rsChild) Then rsChild.Close
' 将父类和子类数据合并到结果数组中
ReDim Preserve resultArray(parentIndex)
resultArray(parentIndex) = Array(parentId, parentName, childArray)
parentIndex = parentIndex + 1
rsParent.MoveNext
Loop
End If
' 关闭父类记录集和数据库连接
If IsObject(rsParent) Then rsParent.Close
Call CloseDB(conn)
' 构建 JSON 输出
Response.ContentType = "application/json"
Response.Charset = "UTF-8"
Dim jsonOutput
jsonOutput = "{""data"":" & GetJson(resultArray) & "}"
Response.Write jsonOutput
' 辅助函数：将数组转换为 JSON 字符串
Function GetJson(dataArray)
Dim i, j
Dim jsonArray, childJsonArray
jsonArray = "["
For i = 0 To UBound(dataArray)
jsonArray = jsonArray & "{"
jsonArray = jsonArray & """id"":""" & EscapeJson(dataArray(i)(0)) & ""","
jsonArray = jsonArray & """name"":""" & EscapeJson(dataArray(i)(1)) & ""","
jsonArray = jsonArray & """children"":" & GetChildJson(dataArray(i)(2)) & "}"
If i < UBound(dataArray) Then
jsonArray = jsonArray & ","
End If
Next
jsonArray = jsonArray & "]"
GetJson = jsonArray
End Function
' 辅助函数：将子类数组转换为 JSON 字符串
Function GetChildJson(childArray)
Dim j
Dim childJsonArray
If IsEmpty(childArray) Or UBound(childArray) = -1 Then
GetChildJson = "[]"
Exit Function
End If
childJsonArray = "["
For j = 0 To UBound(childArray)
childJsonArray = childJsonArray & "{"
childJsonArray = childJsonArray & """id"":""" & EscapeJson(childArray(j)(0)) & ""","
childJsonArray = childJsonArray & """title"":""" & EscapeJson(childArray(j)(1)) & ""","
childJsonArray = childJsonArray & """outUrl"":""" & EscapeJson(childArray(j)(2)) & ""","
childJsonArray = childJsonArray & """tjTitle"":""" & EscapeJson(childArray(j)(3)) & ""","
childJsonArray = childJsonArray & """logo"":""" & EscapeJson(childArray(j)(4)) & ""","
childJsonArray = childJsonArray & """zsStar"":""" & EscapeJson(childArray(j)(5)) & """}"
If j < UBound(childArray) Then
childJsonArray = childJsonArray & ","
End If
Next
childJsonArray = childJsonArray & "]"
GetChildJson = childJsonArray
End Function
' 辅助函数：转义 JSON 字符串中的特殊字符
Function EscapeJson(strValue)
If IsNull(strValue) Or strValue = "" Then
EscapeJson = ""
Else
strValue = Replace(strValue, "\", "\\") ' 转义反斜杠
strValue = Replace(strValue, """", "\""") ' 转义双引号
strValue = Replace(strValue, vbCr, "\r") ' 转义回车符
strValue = Replace(strValue, vbLf, "\n") ' 转义换行符
EscapeJson = strValue
End If
End Function
%>