Attribute VB_Name = "GradeCard"
Option Explicit
'==============================================================================
'  GradeCard 选材函数（Excel / WPS 通用）
'
'  1. 到网站登录 →「我的」→ API Key → 新建，复制 gc_ 开头的 Key
'  2. 把 Key 粘到下面 GC_KEY 的引号里
'  3. 保存：VBA 编辑器 → 文件 → 导入文件（选本 .bas），或新建模块后整段粘贴
'
'  常用写法（A2 是一格需求文字，如「传动轴 200℃ 耐磨 成本别太高」）
'    =GC选材(A2)                  首选牌号
'    =GC选材(A2,"standard")       标准号
'    =GC选材(A2,"est_price")      估算价（元/吨）
'    =GC选材(A2,"process")        推荐热处理工艺
'    =GC选材(A2,"all")            牌号 + 类别 + 标准 + 价格 + 工艺
'    =GC选材(A2,"grade",1)        第二名候选（0 是第一名）
'    =GC牌号("40Cr","tensile_strength")    查牌号属性
'    =GC工艺("40Cr","传动轴 耐磨")          按工况推工艺
'    =GC额度()                    今日剩余调用次数
'    =GC诊断()                    连不上时先跑这个
'
'  返回以 ! 开头的短句 = 出错提示，不是牌号。
'  写完公式若显示 #NAME? ，说明函数名没被识别，检查模块是否已导入。
'==============================================================================

Public Const GC_BASE As String = "https://gradecard.online"
Public Const GC_KEY As String = "把 gc_ 开头的 API Key 粘到这里"
Private Const GC_TIMEOUT_MS As Long = 20000

' 选材：自然语言需求 → 取指定字段
Public Function GC选材(need As Variant, Optional field As String = "grade", _
                      Optional rank As Long = 0) As String
    Dim t As String
    t = Trim$(GC_Str(need))
    If Len(t) = 0 Then
        GC选材 = "!需求为空"
        Exit Function
    End If
    If Len(field) = 0 Then field = "grade"
    GC选材 = GC_Get("/api/v1/cell", "text=" & GC_Url(t) & "&field=" & GC_Url(field) _
                    & "&rank=" & CStr(rank))
End Function

' 牌号属性：=GC牌号("40Cr","tensile_strength")
Public Function GC牌号(grade As Variant, Optional field As String = "grade") As String
    GC牌号 = GC选材(grade, field, 0)
End Function

' 工艺推荐：=GC工艺("40Cr","传动轴 耐磨")
Public Function GC工艺(grade As Variant, Optional application As String = "") As String
    Dim g As String
    g = Trim$(GC_Str(grade))
    If Len(g) = 0 Then
        GC工艺 = "!牌号为空"
        Exit Function
    End If
    GC工艺 = GC_Get("/api/v1/cell", "text=" & GC_Url(Trim$(GC_Str(application) & " " & g)) _
                    & "&field=process")
End Function

' 多牌号对比：=GC对比("40Cr","45#")
Public Function GC对比(g1 As Variant, Optional g2 As String = "", _
                     Optional g3 As String = "", Optional g4 As String = "") As String
    Dim t As String
    t = Trim$(GC_Str(g1) & " vs " & GC_Str(g2) & " " & GC_Str(g3) & " " & GC_Str(g4))
    GC对比 = GC_Get("/api/v1/cell", "text=" & GC_Url(t) & "&field=all")
End Function

' 今日额度
Public Function GC额度() As String
    GC额度 = GC_Get("/api/v1/cell/quota", "verbose=1")
End Function

' 自检：看不到数据时先跑这个，它会告诉你卡在哪一步
Public Function GC诊断() As String
    Dim out As String
    out = "服务器：" & GC_BASE & vbLf
    out = out & "Key：" & IIf(Len(GC_KEY) > 8, Left$(GC_KEY, 6) & "****", "( 未填写 )") & vbLf
    out = out & "连通性：" & GC_Check() & vbLf
    out = out & "额度：" & GC额度()
    GC诊断 = out
End Function

'==============================================================================
'  以下为内部实现，不需要改
'==============================================================================

Private Function GC_Str(v As Variant) As String
    On Error Resume Next
    If IsObject(v) Then
        GC_Str = CStr(v.Value)
    Else
        GC_Str = CStr(v)
    End If
    If Err.Number <> 0 Then
        Err.Clear
        GC_Str = ""
    End If
End Function

Private Function GC_Http() As Object
    Dim h As Object
    On Error Resume Next
    Set h = CreateObject("MSXML2.ServerXMLHTTP.6.0")
    If h Is Nothing Then Set h = CreateObject("MSXML2.ServerXMLHTTP")
    If h Is Nothing Then Set h = CreateObject("WinHttp.WinHttpRequest.5.1")
    On Error GoTo 0
    Set GC_Http = h
End Function

Private Function GC_Check() As String
    Dim r As String
    r = GC_Get("/api/v1/cell/fields", "")
    If Left$(r, 1) = "!" Then
        GC_Check = r
    ElseIf InStr(r, "grade") > 0 Then
        GC_Check = "正常（接口有响应）"
    Else
        GC_Check = "返回异常：" & Left$(r, 60)
    End If
End Function

Private Function GC_Get(ByVal path As String, ByVal query As String) As String
    Dim url As String, http As Object, attempt As Long
    If GC_KEY = "" Then
        GC_Get = "!未填写 API Key"
        Exit Function
    End If
    url = GC_BASE & path & "?token=" & GC_Url(GC_KEY)
    If Len(query) > 0 Then url = url & "&" & query
    On Error GoTo Fail
    Set http = GC_Http()
    If http Is Nothing Then
        GC_Get = "!本机无法发起 HTTPS 请求"
        Exit Function
    End If
    On Error Resume Next
    http.setTimeouts 5000, 5000, GC_TIMEOUT_MS, GC_TIMEOUT_MS
    Err.Clear
    On Error GoTo Fail
    For attempt = 1 To 2
        http.Open "GET", url, False
        http.setRequestHeader "Accept", "text/plain"
        http.send
        If http.Status = 200 Then Exit For
        If attempt = 2 Then
            GC_Get = "!HTTP " & CStr(http.Status)
            Exit Function
        End If
    Next attempt
    GC_Get = GC_Decode(http)
    Exit Function
Fail:
    GC_Get = "!请求失败（网络或域名）"
End Function

Private Function GC_Decode(http As Object) As String
    Dim st As Object, body As Variant
    On Error GoTo Fallback
    body = http.responseBody
    Set st = CreateObject("ADODB.Stream")
    st.Type = 1
    st.Open
    st.Write body
    st.Position = 0
    st.Type = 2
    st.Charset = "utf-8"
    GC_Decode = st.ReadText
    st.Close
    Exit Function
Fallback:
    On Error GoTo GiveUp
    GC_Decode = http.responseText
    Exit Function
GiveUp:
    GC_Decode = "!响应解码失败"
End Function

' UTF-8 百分号编码：Excel 不会自动转中文，必须自己转
Private Function GC_Url(ByVal s As String) As String
    Dim i As Long, c As Long, out As String
    For i = 1 To Len(s)
        c = AscW(Mid$(s, i, 1))
        If c < 0 Then c = c + 65536
        If (c >= 48 And c <= 57) Or (c >= 65 And c <= 90) Or (c >= 97 And c <= 122) _
           Or c = 45 Or c = 46 Or c = 95 Or c = 126 Then
            out = out & Chr$(c)
        ElseIf c < 128 Then
            out = out & "%" & Right$("0" & Hex$(c), 2)
        ElseIf c < 2048 Then
            out = out & "%" & Right$("0" & Hex$(&HC0 Or (c \ 64)), 2) _
                      & "%" & Right$("0" & Hex$(&H80 Or (c And &H3F)), 2)
        Else
            out = out & "%" & Right$("0" & Hex$(&HE0 Or (c \ 4096)), 2) _
                      & "%" & Right$("0" & Hex$(&H80 Or ((c \ 64) And &H3F)), 2) _
                      & "%" & Right$("0" & Hex$(&H80 Or (c And &H3F)), 2)
        End If
    Next i
    GC_Url = out
End Function