Database Integration

Overview

HttpServer has built-in cDataBase integration, allowing direct database access in controllers.

Configure Database

Private Sub Form_Load()
    Set Server = New cHttpServer
    
    ' Method 1: Configure before starting
    If Server.Database.Connect(enumDbType.Mysql, "localhost,3306", "root", "password", "mydb") Then
        Debug.Print "Database connection successful"
    End If
    
    ' Method 2: Using connection string (advanced)
    ' Server.Database.ConnectionString = "..."
    
    Call Server.Start(8080, "C:\WebRoot")
End Sub

Using Database in Controllers

Basic Query

' cUserController.cls

' GET /api/users
Public Sub List(ctx As cHttpServerContext)
    Dim sql As String
    sql = "SELECT id, username, email FROM users LIMIT 100"
    
    If ctx.Db.Sql(sql).Fetch Then
        ctx.Response.Json ctx.Db.Rows, 0, "Success", ctx.Db.Rows.Count
    Else
        ctx.Response.State500 "Query failed: " & ctx.Db.LastErr
    End If
End Sub

' GET /api/user?id=123
Public Sub Detail(ctx As cHttpServerContext)
    Dim id As String
    id = ctx.Request.QueryString("id")
    
    ' Parameterized query to prevent SQL injection
    If ctx.Db.Sql("SELECT * FROM users WHERE id=?") _
        .Param("id", id, adVarChar) _
        .Fetch Then
        
        If ctx.Db.Rows.Count > 0 Then
            ctx.Response.Json ctx.Db.Rows(1)
        Else
            ctx.Response.State404 "User not found"
        End If
    Else
        ctx.Response.State500 "Query failed"
    End If
End Sub

Paginated Query

' GET /api/users?page=1&limit=20
Public Sub ListPaged(ctx As cHttpServerContext)
    Dim page As Long, limit As Long
    page = CLng(ctx.Request.QueryString("page"))
    limit = CLng(ctx.Request.QueryString("limit"))
    
    If page < 1 Then page = 1
    If limit < 1 Or limit > 100 Then limit = 20
    
    Dim offset As Long
    offset = (page - 1) * limit
    
    ' Get total count
    Dim total As Long
    total = ctx.Db.Count("users")
    
    ' Paginated query
    Dim sql As String
    sql = "SELECT id, username, email FROM users LIMIT " & limit & " OFFSET " & offset
    
    If ctx.Db.Sql(sql).Fetch Then
        Dim result As New Scripting.Dictionary
        result("items") = ctx.Db.Rows
        result("total") = total
        result("page") = page
        result("limit") = limit
        
        ctx.Response.Json result, 0, "Success", total
    Else
        ctx.Response.State500 "Query failed"
    End If
End Sub

Insert Data

' POST /api/users
Public Sub Create(ctx As cHttpServerContext)
    Dim username As String, email As String
    username = ctx.Request.Form("username")
    email = ctx.Request.Form("email")
    
    ' Parameterized insert
    Dim sql As String
    sql = "INSERT INTO users (username, email, created_at) VALUES (?, ?, NOW())"
    
    If ctx.Db.Sql(sql) _
        .Param("username", username, adVarChar) _
        .Param("email", email, adVarChar) _
        .ExecParam Then
        
        Dim newId As Long
        newId = ctx.Db.LastInsertId
        
        Dim result As New Scripting.Dictionary
        result("id") = newId
        result("username") = username
        
        ctx.Response.Json result, 0, "Created successfully"
    Else
        ctx.Response.State500 "Creation failed: " & ctx.Db.LastErr
    End If
End Sub

Transaction Processing

' POST /api/transfer
Public Sub Transfer(ctx As cHttpServerContext)
    Dim fromUser As String, toUser As String
    Dim amount As Currency
    
    fromUser = ctx.Request.Form("from")
    toUser = ctx.Request.Form("to")
    amount = CCur(ctx.Request.Form("amount"))
    
    ' Start transaction
    If Not ctx.Db.TransBegin Then
        ctx.Response.State500 "Failed to start transaction"
        Exit Sub
    End If
    
    On Error GoTo Rollback
    
    ' Deduct from sender
    If Not ctx.Db.Sql("UPDATE accounts SET balance = balance - ? WHERE user_id = ?") _
        .Param("amount", amount, adCurrency) _
        .Param("user_id", fromUser, adVarChar) _
        .ExecParam Then
        GoTo Rollback
    End If
    
    ' Add to receiver
    If Not ctx.Db.Sql("UPDATE accounts SET balance = balance + ? WHERE user_id = ?") _
        .Param("amount", amount, adCurrency) _
        .Param("user_id", toUser, adVarChar) _
        .ExecParam Then
        GoTo Rollback
    End If
    
    ' Log transaction
    If Not ctx.Db.Sql("INSERT INTO transactions (from_user, to_user, amount) VALUES (?, ?, ?)") _
        .Param("from", fromUser, adVarChar) _
        .Param("to", toUser, adVarChar) _
        .Param("amount", amount, adCurrency) _
        .ExecParam Then
        GoTo Rollback
    End If
    
    ' Commit transaction
    If ctx.Db.TransCommit Then
        ctx.Response.Json Nothing, 0, "Transfer successful"
    Else
        GoTo Rollback
    End If
    
    Exit Sub
    
Rollback:
    ctx.Db.TransRollback
    ctx.Response.State500 "Transfer failed: " & ctx.Db.LastErr
End Sub

Join Query

' GET /api/orders?user_id=123
Public Sub GetOrders(ctx As cHttpServerContext)
    Dim userId As String
    userId = ctx.Request.QueryString("user_id")
    
    Dim sql As String
    sql = "SELECT o.id, o.total, u.username, u.email " & _
          "FROM orders o " & _
          "JOIN users u ON o.user_id = u.id " & _
          "WHERE o.user_id = ? " & _
          "ORDER BY o.created_at DESC"
    
    If ctx.Db.Sql(sql) _
        .Param("user_id", userId, adVarChar) _
        .Fetch Then
        
        ctx.Response.Json ctx.Db.Rows, 0, "Success"
    Else
        ctx.Response.State500 "Query failed"
    End If
End Sub

Data Model Encapsulation

' cUserModel.cls
Option Explicit

Private Db As cDataBase

Public Sub Init(database As cDataBase)
    Set Db = database
End Sub

' Query by ID
Public Function FindById(id As String) As Scripting.Dictionary
    If Db.Sql("SELECT * FROM users WHERE id=?") _
        .Param("id", id, adVarChar) _
        .Fetch Then
        
        If Db.Rows.Count > 0 Then
            Set FindById = Db.Rows(1)
        End If
    End If
End Function

' Query by username
Public Function FindByUsername(username As String) As Scripting.Dictionary
    If Db.Sql("SELECT * FROM users WHERE username=?") _
        .Param("username", username, adVarChar) _
        .Fetch Then
        
        If Db.Rows.Count > 0 Then
            Set FindByUsername = Db.Rows(1)
        End If
    End If
End Function

' Create user
Public Function Create(data As Scripting.Dictionary) As Long
    If Db.Sql("INSERT INTO users (username, email, password) VALUES (?, ?, ?)") _
        .Param("username", data("username"), adVarChar) _
        .Param("email", data("email"), adVarChar) _
        .Param("password", data("password"), adVarChar) _
        .ExecParam Then
        
        Create = Db.LastInsertId
    End If
End Function

' Update user
Public Function Update(id As String, data As Scripting.Dictionary) As Boolean
    Dim fields As String
    Dim first As Boolean: first = True
    Dim key As Variant
    
    For Each key In data.Keys
        If Not first Then fields = fields & ", "
        fields = fields & key & "=?"
        first = False
    Next
    
    Dim sql As String
    sql = "UPDATE users SET " & fields & " WHERE id=?"
    
    Dim q As Object
    Set q = Db.Sql(sql)
    
    For Each key In data.Keys
        q.Param CStr(key), data(key), adVarChar
    Next
    q.Param "id", id, adVarChar
    
    Update = q.ExecParam
End Function

' Delete user
Public Function Delete(id As String) As Boolean
    Delete = Db.Sql("DELETE FROM users WHERE id=?") _
        .Param("id", id, adVarChar) _
        .ExecParam
End Function

Using Models in Controllers

' cUserController.cls

Dim UserModel As cUserModel

Private Sub Class_Initialize()
    Set UserModel = New cUserModel
End Sub

Public Sub Detail(ctx As cHttpServerContext)
    Call UserModel.Init(ctx.Db)
    
    Dim id As String
    id = ctx.Request.QueryString("id")
    
    Dim user As Scripting.Dictionary
    Set user = UserModel.FindById(id)
    
    If Not user Is Nothing Then
        ctx.Response.Json user
    Else
        ctx.Response.State404 "User not found"
    End If
End Sub

Public Sub Create(ctx As cHttpServerContext)
    Call UserModel.Init(ctx.Db)
    
    Dim data As New Scripting.Dictionary
    data("username") = ctx.Request.Form("username")
    data("email") = ctx.Request.Form("email")
    data("password") = HashPassword(ctx.Request.Form("password"))
    
    Dim newId As Long
    newId = UserModel.Create(data)
    
    If newId > 0 Then
        ctx.Response.Json CreateObject("Scripting.Dictionary")("id", newId), 0, "Created successfully"
    Else
        ctx.Response.State500 "Creation failed"
    End If
End Sub

---

Last Updated: 2026-05-17