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 CookieSession Cookie 设置 HttpOnly
Secure CookieHTTPS 环境下设置 Secure
密码哈希使用 bcrypt 等安全算法
频率限制限制接口请求频率
安全头部添加 X-Frame-Options 等
日志记录记录敏感操作和安全事件
请求体大小限制配置 MaxRequestSize 防止 OOM
连接数限制配置 MaxConnections 防止资源耗尽
空闲连接超时配置 IdleTimeoutSeconds 清理僵尸连接
Session 自动清理内置定时器自动清理过期 Session,也可手动调用 CleanupExpiredSessions
SSE 客户端释放CloseClient 自动关闭 Socket 并清理所有引用,防止资源泄漏

最后更新: 2026-06-13

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