Skip to content

安全实践指南 ​

简介 ​

本文介绍 HttpServer 开发中的安全最佳实践,包括输入验证、SQL 注入防护、XSS 防护、CSRF 防护等。

输入验证 ​

参数校验中间件 ​

vb
' cValidationMiddleware.cls
Option Explicit

Public Sub Entry(ctx As cHttpServerContext)
    Dim rules As Dictionary
    Set rules = GetValidationRules(ctx.Request.PathInfo)

    If Not rules Is Nothing Then
        Dim field As Variant
        Dim errors As String
        errors = ""

        For Each field In rules.Keys
            Dim value As String
            value = ctx.Request(field)

            ' 必填检查
            If rules(field)("required") And value = "" Then
                errors = errors & field & " 不能为空; "
            End If

            ' 类型检查
            If rules(field)("type") = "number" And value <> "" Then
                If Not IsNumeric(value) Then
                    errors = errors & field & " 必须是数字; "
                End If
            End If

            ' 长度检查
            If rules(field).Exists("maxLength") Then
                If Len(value) > rules(field)("maxLength") Then
                    errors = errors & field & " 长度不能超过 " & rules(field)("maxLength") & "; "
                End If
            End If
        Next

        If errors <> "" Then
            ctx.Response.State400 "参数错误: " & errors
            ctx.fIsAbort = True
        End If
    End If
End Sub

Private Function GetValidationRules(path As String) As Dictionary
    Set GetValidationRules = Nothing

    Dim rules As New Dictionary

    Select Case path
        Case "/api/users/create"
            Dim userRules As New Dictionary
            userRules("required") = True
            userRules("type") = "string"
            userRules("maxLength") = 50
            rules("username") = userRules

            Dim emailRules As New Dictionary
            emailRules("required") = True
            emailRules("type") = "email"
            rules("email") = emailRules

            Set GetValidationRules = rules
    End Select
End Function

SQL 注入防护 ​

❌ 错误示例 ​

vb
' 危险!直接拼接 SQL
Dim sql As String
sql = "SELECT * FROM users WHERE username='" & ctx.Request("username") & "'"

✅ 正确做法:参数化查询 ​

vb
' 安全:使用参数化查询
If ctx.Db.Sql("SELECT * FROM users WHERE username=?") _
    .Param("username", ctx.Request("username"), adVarChar) _
    .Fetch Then
    ' ...
End If

输入过滤辅助函数 ​

vb
' 过滤危险字符
Public Function SqlSafe(input As String) As String
    Dim result As String
    result = input
    result = Replace(result, "'", "''")  ' 转义单引号
    result = Replace(result, ";", "")   ' 移除分号
    result = Replace(result, "--", "")  ' 移除注释
    SqlSafe = result
End Function

XSS 防护 ​

HTML 转义输出 ​

vb
' cSecurityUtils.bas

Public Function HtmlEncode(text As String) As String
    Dim result As String
    result = text
    result = Replace(result, "&", "&amp;")
    result = Replace(result, "<", "&lt;")
    result = Replace(result, ">", "&gt;")
    result = Replace(result, """, "&quot;")
    result = Replace(result, "'", "&#x27;")
    HtmlEncode = result
End Function

' 在控制器中使用
Public Sub Search(ctx As cHttpServerContext)
    Dim keyword As String
    keyword = ctx.Request.QueryString("q")

    ' 转义后输出
    ctx.Response.Html "<p>搜索结果: " & HtmlEncode(keyword) & "</p>"
End Sub
vb
' 设置安全的 Session Cookie
With ctx.Cookies.Cookie("SESSIONID")
    .Value = ctx.Session.SessionID
    .HttpOnly = True   ' 禁止 JavaScript 访问
    .Secure = True     ' 仅 HTTPS 传输
    .SameSite = "Strict"
End With

CSRF 防护 ​

Token 验证 ​

vb
' cCsrfMiddleware.cls
Option Explicit

Public Sub Entry(ctx As cHttpServerContext)
    ' 只验证修改数据的请求
    If ctx.Request.Method <> ReqGet And _
       ctx.Request.Method <> ReqOptions Then

        Dim token As String
        token = ctx.Request.Header("X-CSRF-Token")

        If token = "" Then
            token = ctx.Request.Form("_csrf")
        End If

        ' 验证 Token
        If token <> ctx.Session("csrf_token") Then
            ctx.Response.State403 "CSRF Token 无效"
            ctx.fIsAbort = True
        End If
    End If
End Sub

Token 生成 ​

vb
' 登录时生成 CSRF Token
Public Sub Login(ctx As cHttpServerContext)
    ' ... 验证账号密码 ...

    ' 生成随机 Token
    ctx.Session("csrf_token") = GenerateRandomToken()

    ' 返回给客户端
    Dim result As New Dictionary
    result("csrf_token") = ctx.Session("csrf_token")
    ctx.Response.Json result
End Sub

Private Function GenerateRandomToken() As String
    ' 使用 GUID 作为 Token
    GenerateRandomToken = Replace(ToolsStr.GetGUID(False), "-", "")
End Function

密码安全 ​

密码哈希 ​

vb
' 使用 bcrypt 或类似算法
Public Function HashPassword(password As String) As String
    ' 实际项目中使用 bcrypt
    ' 这里演示基础哈希 + 盐
    Dim salt As String
    salt = GenerateSalt()

    HashPassword = salt & "$" & SHA256(salt & password)
End Function

Public Function VerifyPassword(password As String, hashed As String) As Boolean
    Dim parts() As String
    parts = Split(hashed, "$")

    If UBound(parts) = 1 Then
        Dim salt As String
        salt = parts(0)

        VerifyPassword = (SHA256(salt & password) = parts(1))
    End If
End Function

请求频率限制 ​

vb
' cRateLimitMiddleware.cls (完整版)
Option Explicit

Dim RequestLog As Dictionary  ' IP -> 请求记录
Dim BlockList As Dictionary   ' IP -> 解封时间

Private Sub Class_Initialize()
    Set RequestLog = New Dictionary
    Set BlockList = New Dictionary
End Sub

Public Sub Entry(ctx As cHttpServerContext)
    Dim ip As String
    ip = ctx.ClientInfo.IP

    ' 检查是否在黑名单
    If BlockList.Exists(ip) Then
        If Now < BlockList(ip) Then
            ctx.Response.State403 "IP 已被封禁,请 " & DateDiff("n", Now, BlockList(ip)) & " 分钟后重试"
            ctx.fIsAbort = True
            Exit Sub
        Else
            BlockList.Remove ip
        End If
    End If

    ' 获取/创建请求记录
    If Not RequestLog.Exists(ip) Then
        Dim record As New Dictionary
        record("count") = 0
        record("startTime") = Now
        record("urls") = New Dictionary
        Set RequestLog(ip) = record
    End If

    Dim rec As Dictionary
    Set rec = RequestLog(ip)

    ' 超过1分钟重置
    If DateDiff("n", rec("startTime"), Now) >= 1 Then
        rec("count") = 0
        rec("startTime") = Now
        Set rec("urls") = New Dictionary
    End If

    ' 统计
    rec("count") = rec("count") + 1

    Dim urls As Dictionary
    Set urls = rec("urls")
    urls(ctx.Request.PathInfo) = urls.Exists(ctx.Request.PathInfo) + 1

    ' 检查限制
    If rec("count") > 100 Then  ' 每分钟100次
        BlockList(ip) = DateAdd("n", 10, Now)  ' 封禁10分钟
        ctx.Response.State429 "请求过于频繁,IP 已被封禁"
        ctx.fIsAbort = True
        Exit Sub
    End If

    ' 单 URL 频率检查
    If urls(ctx.Request.PathInfo) > 30 Then  ' 单 URL 每分钟30次
        BlockList(ip) = DateAdd("n", 5, Now)
        ctx.Response.State429 "该接口请求过于频繁"
        ctx.fIsAbort = True
    End If
End Sub

安全头部 ​

vb
' cSecurityHeadersMiddleware.cls
Option Explicit

Public Sub Entry(ctx As cHttpServerContext)
    ' HSTS (强制 HTTPS)
    ctx.Response.Header("Strict-Transport-Security") = "max-age=31536000; includeSubDomains"

    ' 防止点击劫持
    ctx.Response.Header("X-Frame-Options") = "DENY"

    ' XSS 防护
    ctx.Response.Header("X-Content-Type-Options") = "nosniff"
    ctx.Response.Header("X-XSS-Protection") = "1; mode=block"

    ' 内容安全策略
    ctx.Response.Header("Content-Security-Policy") = _
        "default-src 'self'; " & _
        "script-src 'self' 'unsafe-inline'; " & _
        "style-src 'self' 'unsafe-inline';"

    ' 引用策略
    ctx.Response.Header("Referrer-Policy") = "strict-origin-when-cross-origin"
End Sub

日志安全 ​

vb
' cSecurityLogMiddleware.cls
Option Explicit

Public Sub Entry(ctx As cHttpServerContext)
    ' 记录敏感操作
    If IsSensitiveOperation(ctx.Request.PathInfo) Then
        Dim log As String
        log = Now & " | " & _
              ctx.ClientInfo.IP & " | " & _
              ctx.Request.MethodName & " | " & _
              ctx.Request.PathInfo & " | " & _
              ctx.Session("user_id")

        Call WriteSecurityLog(log)
    End If
End Sub

Private Function IsSensitiveOperation(path As String) As Boolean
    IsSensitiveOperation = (InStr(path, "/login") > 0 Or _
                           InStr(path, "/password") > 0 Or _
                           InStr(path, "/delete") > 0 Or _
                           InStr(path, "/admin") > 0)
End Function

Private Sub WriteSecurityLog(msg As String)
    Dim f As Integer
    f = FreeFile
    Open "C:\Logs\security.log" For Append As #f
    Print #f, msg
    Close #f
End Sub

请求体大小限制 ​

MaxRequestSize 配置 ​

防止恶意客户端发送超大请求体导致服务器 OOM 崩溃。

vb
' 启动前配置
Server.MaxRequestSize = 5242880  ' 5MB

' 超限时自动断开连接并记录日志
' 客户端收到 413 Payload Too Large 响应

说明: 默认 10MB。建议根据业务需要调整:

  • 纯 API 服务:1-5MB
  • 支持文件上传:根据最大文件大小设置

最大连接数限制 ​

vb
Server.MaxConnections = 500  ' 最多同时 500 个连接

说明: 默认 1000。超限时新连接被拒绝,触发 OnLogs 事件记录 WARN 日志。


安全配置检查清单 ​

检查项状态说明
HTTPS 强制☐生产环境必须使用 HTTPS
参数化查询☐所有数据库操作使用参数化
XSS 过滤☐输出内容进行 HTML 编码
CSRF Token☐修改操作验证 CSRF Token
HttpOnly Cookie☐Session Cookie 设置 HttpOnly
Secure Cookie☐HTTPS 环境下设置 Secure
密码哈希☐使用 bcrypt 等安全算法
频率限制☐限制接口请求频率
安全头部☐添加 X-Frame-Options 等
日志记录☐记录敏感操作和安全事件
请求体大小限制☐配置 MaxRequestSize 防止 OOM
连接数限制☐配置 MaxConnections 防止资源耗尽
空闲连接超时☐配置 IdleTimeoutSeconds 清理僵尸连接
Session 自动清理☐内置定时器自动清理过期 Session,也可手动调用 CleanupExpiredSessions
SSE 客户端释放☐CloseClient 自动关闭 Socket 并清理所有引用,防止资源泄漏

最后更新: 2026-06-13

VB6及其LOGO版权为微软公司所有