Access交流网
  • 设为首页|收藏本站|繁体中文|手机版
  •     
  • Access培训-Access开发平台-Access行业开发

  • 首页
  • 资讯
  • 技巧
  • 源码
  • 行业
  • 资源
  • 活动
  • 关于

技巧

ACCESS数据库

启动/设置/选项/背景

修复/压缩

安全/加密/解密

快捷键

版本升级/其它等

数据表

命名方式/设计规范

表设计

查询

Sql语言基础

选择查询

更新查询

删除查询

追加查询

生成表查询

交叉表查询

SQL特定查询

查询参数

查询综合应用

界面/窗体/控件

标签

文本框

命令按钮

组合框/列表框

选项组/复选框/选项按钮

选项卡

子窗体

窗体本身/综合应用

其它

报表打印

报表设计

高级报表

模块/函数/VBA/API/系统

VBA基础

内置函数

调试/跟踪/Debug

模块/类模块

API/COM/系统相关

字符数字日期

网络通信游戏

加密解密安全

文件处理

经典算法

宏/菜单/工具栏/功能区

宏/脚本

菜单/工具栏

功能区/Ribbon

图表/图形/图像/多媒体

图表

图形/图像

音频

视频/动画

DAO/链接表/ADO/ADP

DAO/链接表/ODBC

ADO/RDO

ADP

ActiveX/第三方控件/插件

Treeview树控件

ListView列表控件

Toolbar工具栏控件

微软其它控件

Dbi-Tech

CodeJock

Grid++Report

FastReport

ComponentOne

加载项/插件/Addin

OFFICE集成/导入导出/交互

Excel导入导出/交互

Word导入导出/交互

PPT交互

Outlook控制/邮件

Text文本文件/INI/CSV

PDF/SWF/XML格式

CAD格式

Sharepoint/其它Office

SqlServer/其它数据库

表

视图

存储过程/触发器

函数

用户/权限/安全

调试/维护

SqlServer其它/综合

发布/打包/文档/帮助

开发版/运行时

打包/发布/部署

开发文档/帮助制作

Access完整行业系统

采购管理系统

销售管理系统

仓库管理系统

人力资源管理HRM

CRM管理系统

MRP/ERP管理系统

BRP/流程优化

其它管理系统

心得/经验/绝招
其它/杂项
Excel技巧

Excel应用与操作

Excel开发编程

Word技巧

Word应用与操作

Word开发编程

Outlook技巧

Outlook应用与操作

Outlook开发编程

热门文章

  • MySQL replace..
  • access数据库升迁导入..
  • VB Access VBA..
  • Sql Server 数据..
  • 把ACCESS转成SQL数..
  • ACCESS(mdb)数据..

最新文章

  • SQLite数据库可视化管..
  • access数据库升迁导入..
  • ACCESS(mdb)数据..
  • SSMA(Sql Serv..
  • ACCESS数据库迁移到S..
  • SSMA进行 mysql ..

联系方式

Access交流网(免费Access交流)

QQ:18449932 

网  址:www.access-cn.com

当前位置:首页 > 技巧 > SqlServer/其它数据库 > SqlServer其它/综合
SqlServer其它/综合

VB Access VBA如何使用Sqlite3数据库

VB Access VBA如何使用Sqlite3数据库

转自:谢厂节的博客


一、先建立一个类模块 

VERSION 1.0 CLASS

BEGIN

  MultiUse = -1  'True

  Persistable = 0  'NotPersistable

  DataBindingBehavior = 0  'vbNone

  DataSourceBehavior  = 0  'vbNone

  MTSTransactionMode  = 0  'NotAnMTSObject

END

Attribute VB_Name = "cCDECL"

Attribute VB_GlobalNameSpace = False

Attribute VB_Creatable = True

Attribute VB_PredeclaredId = False

Attribute VB_Exposed = False

'--------------------------------------------------------------------------

'

' cCDECL - Class that enables the user to call cdecl dynamic link libraries.

'          Supports cdecl style variable argument lists and bas module

'          callbacks.

'

'031029 First cut....................................................... v1.00

'071129 Uses virtual memory rather than string space to fix a DEP issue. v1.01

'


Option Explicit

Option Base 0


'API declarations

Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long

Private Declare Function GetLastError Lib "kernel32" () As Long

Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long

Private Declare Function LoadLibraryA Lib "kernel32" (ByVal lpLibFileName As String) As Long

Private Declare Function VirtualAlloc Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long

Private Declare Function VirtualFree Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long


Private Declare Sub GetMem4 Lib "msvbvm60" (ByVal Addr As Long, RetVal As Long)

Private Declare Sub PutMem1 Lib "msvbvm60" (ByVal Addr As Long, ByVal NewVal As Byte)

Private Declare Sub PutMem2 Lib "msvbvm60" (ByVal Addr As Long, ByVal NewVal As Integer)

Private Declare Sub PutMem4 Lib "msvbvm60" (ByVal Addr As Long, ByVal NewVal As Long)

Private Declare Sub PutMem8 Lib "msvbvm60" (ByVal Addr As Long, ByVal NewVal As Currency)

Private Declare Sub SetLastError Lib "kernel32" (ByVal dwErrCode As Long)


'Private constants

Private Const ERR_SRC       As String = "cCDECL"    'Error source name

Private Const ERR_NUM       As Long = vbObjectError 'cCDECL error number base

Private Const MAX_ARG       As Long = 16            'Maximum number of parameters, you can change this if required

Private Const PATCH_01      As Long = 15            'CDECL patch, CDECL function address

Private Const PATCH_02      As Long = 10            'Callback patch, bas mod function address patch

Private Const PATCH_03      As Long = 16            'Callback patch, stack adjustment patch


'Parameter block

Private Type tParamBlock

  ParamCount                As Long                 'Number of parameters to be forwarded to the cdecl function

  Params(0 To MAX_ARG - 1)  As Long                 'Array of parameters to be forwarded to the cdecl function

End Type


'Private member

Private m_LastError         As Long                 'Last error private member


'Private variables

Private bNewDLL             As Boolean              'Flag to indicate that the loaded DLL has changed

Private hMod                As Long                 'DLL module handle

Private nAddr               As Long                 'Cache the previous cdecl function's address

Private pCode               As Long                 'Pointer to the CDECL code

Private sLastFunc           As String               'Cache the previous cdecl function's name

Private pb                  As tParamBlock          'Parameter block instance


'Replace the stub proc (z_DO_NOT_CALL) with machine-code to handle the cdecl function

Private Sub Class_Initialize()

    Dim pMe As Long

  

    'Get the address of my vtable into pMe

    GetMem4 ObjPtr(Me), pMe


    'Allocate a page of executable memory

    pCode = VirtualAlloc(0, &H1000&, &H1000&, &H40&)

  

    'Copy the CDECL translation code to memory

    PutMem8 pCode + 0, -208642111809017.9757@

    PutMem8 pCode + 8, -605931634821031.5515@

    PutMem8 pCode + 16, 20765931315670.1386@

    PutMem8 pCode + 24, -857143604525899.4687@

    PutMem4 pCode + 32, &HC2C03102

    PutMem2 pCode + 36, &HC


    'Patch the first vtable entry (z_DO_NOT_CALL) to point to the CDECL code

    PutMem4 pMe + &H1C, pCode

  

    'Copy the callback thunk code to memory

    PutMem8 pCode + 40, 479615108421936.7656@

    PutMem8 pCode + 48, -140483859888551.3191@

    PutMem8 pCode + 56, 99649511.6971@

    PutMem8 pCode + 64, 21442817159.0144@

End Sub


Private Sub Class_Terminate()

    'Free virtual memory

    VirtualFree pCode, 0, &H8000&

End Sub


'This sub is replaced by machine code at pCode at class instance creation...

'IT MUST ONLY be called internally by CallFunc.

Public Function z_DO_NOT_CALL(ByVal nAddrParamBlock As Long) As Long

End Function


'Purpose:

' Call the named cdecl function with the passed parameters

'

'Arguments:

' sFunction - Name of the cdecl function to call

' ParmLongs - ParamArray of parameters to pass to the named cdecl function

'

'Return:

'  The return value of the named cdecl function

Public Function CallFunc(ByVal sFunction As String, ParamArray ParmLongs() As Variant) As Long

    Dim i As Long

    Dim j As Long

  

    'Check that the DLL is loaded

    If hMod = 0 Then

    

        'If in the IDE just stop, programmer may have On Error Resume Next protection and miss the problem.

        Debug.Assert False

        Call Err.Raise(ERR_NUM + 0, ERR_SRC, "DLL not loaded")

    End If


    'Check to see if we're calling the same cdecl function as the previous call to CallFunc

    If (StrComp(sLastFunc, sFunction) <> 0) Or bNewDLL Then

    

        'Get the address of the function

        nAddr = GetProcAddress(hMod, sFunction)

        If nAddr = 0 Then

      

            'If in the IDE just stop, programmer may have On Error Resume Next protection and miss the problem.

            Debug.Assert False

            Call Err.Raise(ERR_NUM + 1, ERR_SRC, "Failed to locate function: " & sFunction)

        End If


        'Patch the code buffer to call the relative address to the cdecl function

        PutMem4 pCode + PATCH_01, nAddr - pCode - (PATCH_01 + 4)

        bNewDLL = False

        sLastFunc = sFunction

    End If

  

    With pb

        j = UBound(ParmLongs)

        If j >= MAX_ARG Then

      

            'If in the IDE just stop, programmer may have On Error Resume Next protection and miss the problem.

            Debug.Assert False

            Call Err.Raise(ERR_NUM + 2, ERR_SRC, "Too many parameters")

        End If

    

        'Fill the parameter block

        For i = 0 To j

            .Params(i) = ParmLongs(i)

        Next i

    

        .ParamCount = i                                         '(j + 1)

    End With

  

    Call SetLastError(0)                                      'Clear the error code

    CallFunc = z_DO_NOT_CALL(VarPtr(pb))                      'Execute the code buffer passing the address of the parameter block

    m_LastError = GetLastError()                              'Get error code

End Function


'Load the DLL

Public Function DllLoad(ByVal sName As String) As Boolean

    hMod = LoadLibraryA(sName)


    If hMod <> 0 Then

        DllLoad = True

        'It's remotely possible that the programmer could change the dll and then call a function

        'in the new dll with exactly the same name as the previous CallFunc to the previous DLL. This would

        'defeat the caching scheme and result in the old function in the old dll being called. An unlikely

        'scenario, but stranger things have happened. Soooo, explicitly indicate that we're using a new dll

        bNewDLL = True

    End If

  

    'If in the IDE just stop on failure, programmer may not be checking the return value.

    Debug.Assert DllLoad

End Function


'It's not important to do this, but, if you've finished with a DLL there's no harm in releasing

'its memory. Don't bother at app end... it will be dealt with automatically when the process ends.

Public Function DllUnload() As Boolean

    If hMod <> 0 Then

        DllUnload = (FreeLibrary(hMod) <> 0)

        hMod = 0

    End If

  

    'If in the IDE, get the programmer's attention

    Debug.Assert DllUnload

End Function


'Return the cdecl function's error code

Public Property Get LastError() As Long

    LastError = m_LastError

End Property


'Purpose:

' Setup a wrapper so that a bas module function can act as a cdecl callback

'

'Arguments:

' nModFuncAddr - The address of the bas module function to act as a cdecl callback (use AddressOf)

' nParms       - The number of parameters that will be passed to the bas module function

'

'Return:

'  The address to pass to the cdecl function as the callback address

'

Public Function WrapCallback(ByVal nModFuncAddr As Long, ByVal nParms As Long) As Long

    Dim nStackAdjust As Long                                  'The number of bytes to adjust the stack

  

    WrapCallback = pCode + 40                                 'Address of the callback wrapper

    nStackAdjust = nParms * 4                                 'Four bytes per parameter


    'Patch the code buffer to call the vb bas module callback function

    PutMem4 WrapCallback + PATCH_02, nModFuncAddr - WrapCallback - (PATCH_02 + 4)

  

    'Patch the code buffer to apply the necessary stack adjustment

    PutMem4 WrapCallback + PATCH_03, nStackAdjust

End Function


国内现在用VB好像很少了,一个项目用到Sqlite3,发现相关资料比较凌乱,也有很多不同使用方法。需要注意的是,Vb调用Sqlite3可使用上面的类模块,官方网站下载的不好用(注册老是失败)。特把使用方法记录在这里。

1.添加附件的类模块 cCDECL.cls

2.添加附件的模块 mDeclarations.bas,mSqlite.bas

 

Private Sub checkHistory()  

    Dim sPath As String  

    sPath = App.path & "\..\data\"  

    If mSqlite.sqlite3_initialize(sPath) <> SQLITE_OK Then  

        Debug.Print "error"  

        Exit Sub  

    End If  

      

    If mSqlite.sqlite3_open(sPath & "data.sqlite", f_lSqlite) <> SQLITE_OK Then  

        Debug.Print "error"  

        Exit Sub  

    End If  

       

    If mSqlite.sqlite3_prepare_v2(f_lSqlite, "SELECT id,flag,send_username,send_cop,send_mail,send_phone,cmbType,cmbW,cmbC,cmbH FROM history WHERE flag=0", 0, f_lStatement, 0) = SQLITE_OK Then  

  

        Dim send_username As String, send_cop As String, send_mail As String, send_phone As String  

        Dim cmbType As String, cmbW As Integer, cmbC As Integer, cmbH As Integer  

        ' add lasttime  

          

        Do While mSqlite.sqlite3_step(f_lStatement) = SQLITE_ROW  

            Debug.Print mSqlite.sqlite3_column_int(f_lStatement, 0)  

            Debug.Print mSqlite.sqlite3_column_text(f_lStatement, 1)  

            send_username = mSqlite.sqlite3_column_text(f_lStatement, 2)  

            send_cop = mSqlite.sqlite3_column_text(f_lStatement, 3)  

            send_mail = mSqlite.sqlite3_column_text(f_lStatement, 4)  

            send_phone = mSqlite.sqlite3_column_text(f_lStatement, 5)  

            cmbType = mSqlite.sqlite3_column_text(f_lStatement, 6)  

            cmbW = mSqlite.sqlite3_column_int(f_lStatement, 7)  

            cmbC = mSqlite.sqlite3_column_int(f_lStatement, 8)  

            cmbH = mSqlite.sqlite3_column_int(f_lStatement, 9)  

            generate send_username, send_cop, send_mail, send_phone, cmbType, cmbW, cmbC, cmbH  

            mSqlite.sqlite3_exec f_lSqlite, "UPDATE history set flag=1 WHERE id=" & mSqlite.sqlite3_column_int(f_lStatement, 0)  

        Loop  

    Else  

        Debug.Print mSqlite.sqlite3_errmsg(f_lSqlite)  

    End If  

  

    Call mSqlite.sqlite3_finalize(f_lStatement)  

      

    '// Close DB handle  

    Call mSqlite.sqlite3_close(f_lSqlite)  

      

    '// Terminate wrapper  

    Call mSqlite.sqlite3_shutdown  

End Sub  


我的项目目录结构是:

data

       ---data.sqlite

vb

---

自己使用的时候要注意修改数据库路径。


发布人:zstmtony  
分享到:
点击次数:  更新时间:2017-04-22 12:43:44  【打印此页】  【关闭】
上一条:通用模块:读取图片文件并保存到OLE字段中  下一条:vb6或Access或VBA如何对sqlite数据库操作



相关文章

  • • SQLite数据库可视化管理工具汇总
  • • access数据库升迁导入sql server2005或Sql server 2008的方法及步骤
  • • ACCESS(mdb)数据库转成Sql Server(mdf)数据库的办法
  • • SSMA(Sql Server迁移助手)SSMA SQL Server Migration Assistant for MySQL使用方法
  • • ACCESS数据库迁移到SQLSERVER数据库两种方法(图文详解)
  • • SSMA进行 mysql 到 sqlserver 的数据库迁移
  • • 把ACCESS转成SQL数据库的方法
  • • 解决SQL Server服务器无法连接的问题

热门文章

  • [2018-02-03] SQLite数据库可视化管理工具汇总access数据库
  • [2016-12-10] SQL Server瞬间快速清除日志的代码access数据库
  • [2017-07-29] ACCESS(mdb)数据库转成Sql Server(mdf)数据库的办法access数据库
  • [2017-04-22] VB Access VBA如何使用Sqlite3数据库access数据库
  • [2016-10-10] Sql Server 数据库或表损坏如何修复access数据库
  • [2017-02-20] MySQL replace函数替换字符串语句的用法access数据库

热门产品

公司动态|在线留言|在线反馈|友情链接|会员中心|站内搜索|网站地图

Access交流网 版权所有 1999-2018 粤ICP备10043721号

QQ:18449932

Access应用 Access培训 Access开发 Access平台

access|数据库|access下载|access教程|access视频|access软件

Powered by MetInfo 5.3.12 ©2008-2023  www.metinfo.cn