Skip to content

安全实践指南

简介

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

输入验证

参数校验中间件

vb
' cValidationMiddleware.cls
Option Explicit

Public Sub Entry(ctx As cHttpServerContext)
    Dim rules As Scripting.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 Scripting.Dictionary
    Set GetValidationRules = Nothing
    
    Dim rules As New Scripting.Dictionary
    
    Select Case path
        Case "/api/users/create"
            Dim userRules As New Scripting.Dictionary
            userRules("required") = True
            userRules("type") = "string"
            userRules("maxLength") = 50
            rules("username") = userRules
            
            Dim emailRules As New Scripting.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 Scripting.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 Scripting.Dictionary  ' IP -> 请求记录
Dim BlockList As Scripting.Dictionary   ' IP -> 解封时间

Private Sub Class_Initialize()
    Set RequestLog = New Scripting.Dictionary
    Set BlockList = New Scripting.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 Scripting.Dictionary
        record("count") = 0
        record("startTime") = Now
        record("urls") = New Scripting.Dictionary
        Set RequestLog(ip) = record
    End If
    
    Dim rec As Scripting.Dictionary
    Set rec = RequestLog(ip)
    
    ' 超过1分钟重置
    If DateDiff("n", rec("startTime"), Now) >= 1 Then
        rec("count") = 0
        rec("startTime") = Now
        Set rec("urls") = New Scripting.Dictionary
    End If
    
    ' 统计
    rec("count") = rec("count") + 1
    
    Dim urls As Scripting.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

安全配置检查清单

检查项状态说明
HTTPS 强制生产环境必须使用 HTTPS
参数化查询所有数据库操作使用参数化
XSS 过滤输出内容进行 HTML 编码
CSRF Token修改操作验证 CSRF Token
HttpOnly CookieSession Cookie 设置 HttpOnly
Secure CookieHTTPS 环境下设置 Secure
密码哈希使用 bcrypt 等安全算法
频率限制限制接口请求频率
安全头部添加 X-Frame-Options 等
日志记录记录敏感操作和安全事件

最后更新: 2026-05-17

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