
#include Once "sqlite3.bi"
Extern "C"
Declare Function sqlite3_key Lib "sqlite3" Alias "sqlite3_key"(ByVal db As Any Ptr, ByVal pKey As Const ZString Ptr, ByVal nKey As Integer) As Integer
Declare Function sqlite3_rekey Lib "sqlite3" Alias "sqlite3_rekey"(ByVal db As Any Ptr, ByVal pKey As Const ZString Ptr, ByVal nKey As Integer) As Integer
End Extern


Type Class_SQLite3
Private : 
   m_hWndForm As HWnd '控件句柄
   m_IDC As Long     '控件IDC
   ErrStr As String  '输出错误信息
   Transaction As Long '是否开启事务
   EventsEn As Long  '<>0 时 为内部查询，不产生查询事件
   m_FindRsProc As Any Ptr  '
   m_SqlStringProc As Any Ptr  '
   Declare Function GetFP() As FormControlsPro_TYPE ptr '返回控件保存数据的指针（一般是类自己用）
   Declare Function StrUtoA(Utf8str As String) As String     'Utf8编码转换为Ansi字符，但不支持宽字符的特殊字符，会变 ?
   Declare Function StrAtoU(Ansistr As String) As String  'Ansi字符转换为Utf8编码，不支持宽字符的特殊字符，会变 ?
   Declare Function StrUtoW(Utf8str As String) As CWSTR     'Utf8编码转换为WSTR字符，
   Declare Function StrWtoU(wText As CWSTR) As String  'WSTR字符转换为Utf8编码
   Declare Function strReplace(Expression As String, Find As String, Replacewith As String) As String
Public : 
   Declare Constructor
   Declare Destructor
   Declare Property hWndForm() As.hWnd         '返回/设置控件所在的窗口句柄，主要用于多开同一个窗口后，要使用控件前，必须先指定控件所在的窗口句柄，才能正常使用控件。
   Declare Property hWndForm(ByVal hWndParent As.hWnd) '获取控件所在的窗口句柄（父窗口）
   Declare Property IDC() As Long             '返回/设置控件IDC，控件标识符，1个窗口里每个控件IDC都是唯一的，包括控件数组。（不可随意修改，系统自动处理）
   Declare Property IDC(NewIDC As Long)
   Declare Property Tag() As CWSTR                       '存储程序所需的附加数据。
   Declare Property Tag(ByVal sText As CWSTR)
   
   Declare Function Open(sFileName As CWSTR, Password As CWSTR = "") As Boolean  '打开数据库，成功返回True 失败为False ，失败错误信息看 .ErrMsg {=.True.False}
   Declare Function MemOpen(sFileName As CWSTR, Password As CWSTR = "",Synchronization As Boolean =0) As Boolean  '打开数据库，并且全部加载到内存中，成为内存数据库，成功返回True 失败为False ，失败错误信息看 .ErrMsg {=.True.False}{3.True.False}
   Declare Function MemSave() As Boolean  '把内存数据库保存回文件中，成功返回True 失败为False ，失败错误信息看 .ErrMsg {=.True.False}
   Declare Function Find(Table As CWSTR, Cond As CWSTR, rs() As String, Orderby As CWSTR = "", Page As Long = 1, Pagesize As Long = 0, Col As CWSTR = "*") As Long   '查询数据库，成功返回二维数组（多条记录）行数，失败返回 0
   Declare Function FindByte(Table As CWSTR, Cond As CWSTR, rs() As String, Orderby As CWSTR = "", Page As Long = 1, Pagesize As Long = 0, Col As CWSTR = "*") As Long   '查询数据库(2进制)，成功返回二维数组（多条记录）行数，失败返回 0
   Declare Function FindOne(Table As CWSTR, Cond As CWSTR, rs() As String, Orderby As CWSTR = "", Col As CWSTR = "*") As Long   '查询数据库，成功返回一维数组（一条记录)的字段个数，失败返回 0
   Declare Function FindOneByte(Table As CWSTR, Cond As CWSTR, rs() As String, Orderby As CWSTR = "", Col As CWSTR = "*") As Long   '查询数据库(2进制)，成功返回一维数组（一条记录)的字段个数，失败返回 0
   Declare Function Insert(Table As CWSTR, nList As CWSTR) As Long   '插入一条记录，成功返回插入的 ID，失败返回 FALSE。
   Declare Function AddItem(Table As CWSTR, nList As CWSTR) As Long   '新增一条记录(与insert()相同)，成功返回插入的 ID，失败返回 FALSE。
   Declare Function Update(Table As CWSTR, Cond As CWSTR, upList As CWSTR) As Long   '更新记录，成功返回受影响的行数，失败返回 -1。
   Declare Function UpdateByte(Table As CWSTR, Cond As CWSTR, ColName As CWSTR, nByte As Any Ptr, nLen As Long) As Long   '写入2进制数据，成功返回受影响的行数，失败返回 -1。
   Declare Function DeleteItem(Table As CWSTR, Cond As CWSTR) As Long   '删除记录，成功返回受影响的行数，失败返回 -1。
   Declare Function Count(Table As CWSTR, Cond As CWSTR = "") As Long   '统计满足条件的行数，无条件返回全部行数，成功返回总行数，失败返回 0。
   Declare Function MaxID(Table As CWSTR, nField As CWSTR, Cond As CWSTR = "") As Long   '查找表中某列最大值，成功返回最大值，失败返回 0。
   
   Declare Function INIgetKey(lSection As String, lKeyName As String, lDefault As String = "") As String  '读取配置，用数据库保存软件配置，类似INI文件读取配置值。
   Declare Function INIgetKey(lSection As WString Ptr, lKeyName As WString Ptr, lDefault As WString Ptr = 0) As CWSTR  '读取配置，用数据库保存软件配置，类似INI文件读取配置值。
   Declare Function INIsetKey(lSection As String, lKeyName As String, nValue As String) As Boolean   '保存配置，用数据库保存软件配置，类似INI文件保存配置值，值为空时删除此记录，成功返回True ，失败返回 FALSE。
   Declare Function INIsetKey(lSection As WString Ptr, lKeyName As WString Ptr, nValue As WString Ptr) As Boolean   '保存配置，用数据库保存软件配置，类似INI文件保存配置值，值为空时删除此记录，成功返回True，失败返回 FALSE。
   
   Declare Function Exec(Sql_Utf8 As String,Synchronization As Boolean =0) As Long   '执行一条 SQL，成功返回受影响的行数，失败返回 -1。
   
   Declare Function SqlFind(Sql_Utf8 As String, rs() As String) As Long  '通过 SQL 的方式查询满足条件的记录，字符全是UTF8编码，成功返回rs()（包含多条记录二维数组）的行数，失败返回 0 。
   Declare Function SqlFindOne(Sql_Utf8 As String, rs() As String) As Long  '通过 SQL 的方式查询一行记录，字符全是UTF8编码，成功返回一维数组（一条记录)的字段个数，失败返回 0 。
   Declare Function CreateTable(Table As CWSTR) As Long '创建1张表（默认添加 ID 主键字段），失败返回 -1
   Declare Function CreateIndex(Table As CWSTR, nField As CWSTR, Unique As Boolean = 0) As Long '创建索引，索引提高查询速度非常明显，同时降低了更新与插入数据速度。 失败返回 -1  {3.True.False}
   Declare Function AddField(Table As CWSTR, nField As CWSTR, nType As CWSTR, default As CWSTR = "", nNull As Boolean = 0) As Long '新增字段，失败返回 -1 {3."INTEGER" 有符号整形，根据值的大小以1、2、3、4、6或8字节存放."REAL" 浮点型值，以8字节IEEE浮点数存放."TEXT" 字符串."BLOB" 二进制."NULL"}{5.True 允许值为空.False 必须有值}
   
     
   Declare Function Vacuum() As Long   '对数据库文件重新整理，减少文件尺寸，避免数据臃肿，影响效率。失败返回 -1
   Declare Function GetSQLitePtr(Index As Long =0) As SQLite3 Ptr   '获取数据库指针，可以自己自己操作数据库。失败返回 0 ,Index=0 现在操作数据库 Index=1 文件数据库（当启用内存数据库时，1 对应文件，0 对应内存） 
   
   
   Declare Sub TransactionBegin()       '开始事务（用于批量执行SQL，提高SQL效率）
   Declare Function TransactionEnd() As Long '执行并且结束事务，返回成功执行了多少条SQL（不包括事务SQL）
   Declare Function Version() As String                                             'SQLite3 版本号，ANSI编码
   Declare Function ErrMsg() As String                                             '输出错误信息，ANSI编码
   Declare Function SetKey(newkey As CWSTR) As Boolean                            '设置密码，无密码时清除密码 ，成功返回True 失败为False ，失败错误信息看 .ErrMsg {=.True.False}
   Declare Sub Close()                                                             '关闭数据库
   Declare Function SetEventProc(EventName As CWSTR , pProc As Any Ptr) As Any Ptr  '设置SQLite3事件函数的指针，返回前一个事件函数的指针（一般由VFB内部设置）
End Type
Constructor Class_SQLite3()
   
End Constructor 
Destructor Class_SQLite3
   'pDB[0]  主 数据库，对于内存打开，这是内存数据库
   'pDB[1]  副 数据库，对于文件数据库时，这里为 NULL，对于内存数据库，这是对应文件的
   'pDB[2]  是不是同步，是对于内存打开数据时，同步，意为着修改数据库时，会自动修改对应文件数据库，
   Dim fp As FormControlsPro_TYPE ptr = GetFP()
   if fp then
      if Len(fp->nData) < 32 Then Return 
      This.Close 
      fp->nData=""
   End If    
End Destructor
Function Class_SQLite3.GetFP() As FormControlsPro_TYPE ptr '返回自己控件的指针
   Dim fp As FormControlsPro_TYPE ptr = GetPropW(m_hWndForm, "FCP_TYPE_PTR")
   While fp
      if fp->IDC = m_IDC Then Return fp      
      fp = fp->VrControls
   Wend

End Function
Property Class_SQLite3.hWndForm() As .hWnd         '返回/设置控件所在的窗口句柄
      Return m_hWndForm
End Property
Property Class_SQLite3.hWndForm(ByVal hWndParent As .hWnd)
   m_hWndForm = hWndParent
End Property
Property Class_SQLite3.IDC() As Long                  '返回/设置两次调用 Timer 控件的 Timer 事件间隔的毫秒数。
   Return m_IDC
End Property
Property Class_SQLite3.IDC(ByVal NewIDC As Long)
   m_IDC  =NewIDC
End Property
Property Class_SQLite3.Tag() As CWSTR 
   Dim fp As FormControlsPro_TYPE ptr = GetFP()
   if fp then
      Return fp->Tag
   End If
End Property
Property Class_SQLite3.Tag(ByVal sText As CWSTR )
   Dim fp As FormControlsPro_TYPE ptr = GetFP()
   if fp then
      fp->Tag = sText
   End If
End Property
Function Class_SQLite3.SetEventProc(EventName As CWSTR, pProc As Any Ptr) As Any Ptr
   Select Case ucase(StrWtoU(EventName))
      Case "FINDRS"
         Function = m_FindRsProc
         m_FindRsProc = pProc
'         if m_FindRsProc Then
'            Dim pp As Function(ByVal pi As Long, ByVal Columns As Long, ByVal Rows As Long ,ByRef decltype() as String , ByRef col() As ZString Ptr) As Long  = m_FindRsProc
'
'         End If
      Case "SQLSTRING"
         Function = m_SqlStringProc
         m_SqlStringProc = pProc
'         if m_SqlStringProc Then
'            Dim pp As FunctionSqlString(ByRef Sql_Utf8 as String) As Long = m_SqlStringProc
'
'         End If
   End Select
End Function
Function Class_SQLite3.Open(sFileName As CWSTR , Password As CWSTR = "") As Boolean
   Dim fp As FormControlsPro_TYPE ptr = GetFP()
   if fp = 0 then ErrStr = StrAtoU("无初始化") : Return False
   if Len(fp->nData) < 32 Then fp->nData = String(32, 0)
   Dim pDB As any Ptr Ptr = Cast(Any Ptr, StrPtr(fp->nData))
   If pDB[0] Then sqlite3_close(pDB[0])
   pDB[0] = Null
   If pDB[1] Then sqlite3_close(pDB[1])
   pDB[1] = Null
   pDB[2] = Null
   If Len( sFileName) = 0 Then
      ErrStr = StrAtoU("无文件")
      Return False
   End If
   Dim r As Long, sFileName_Utf8 As String = StrWtoU( sFileName)
   r = sqlite3_open(StrPtr(sFileName_Utf8), @pDB[0])
   If r Then '出错
      ErrStr = *sqlite3_errmsg(pDB[0])
      sqlite3_close(pDB[0])
      Return False
   End If
   If Len(Password) Then '有密码
      dim Password_Utf8 As String = StrWtoU( Password)
      If sqlite3_key(pDB[0], StrPtr(Password_Utf8), Len(Password_Utf8)) Then
         ErrStr = *sqlite3_errmsg(pDB[0])
         sqlite3_close(pDB[0])
         Return False
      End If
   End If
   '检查密码是不是正确
   Dim rs() as String
   EventsEn =1
   If SqlFind("PRAGMA database_list", rs()) Then
      if UBound(rs) = -1 or UBound(rs, 2) = -1 Then
         ErrStr = StrAtoU("密码出错或非数据库")
         sqlite3_close(pDB[0])
         Return False
      End if
   Else
      ErrStr = *sqlite3_errmsg(pDB[0])
      sqlite3_close(pDB[0])
      Return False
   End If
   EventsEn = 0
   ErrStr = "" ' 无错误
   
   Function = True
End Function
Function Class_SQLite3.MemOpen(sFileName As CWSTR, Password As CWSTR = "",Synchronization As Boolean =0) As Boolean
   Dim fp As FormControlsPro_TYPE ptr = GetFP()
   if fp = 0 then ErrStr = StrAtoU("无初始化") : Return False
   if Len(fp->nData) < 32 Then fp->nData = String(32, 0)
   Dim pDB As any Ptr Ptr = Cast(Any Ptr, StrPtr(fp->nData))
'   Dim m_DB As SQLite3 Ptr = pDB[0]
   If pDB[0] Then sqlite3_close(pDB[0])
   pDB[0] = Null
   If pDB[1] Then sqlite3_close(pDB[1])
   pDB[1] = Null
   pDB[2] = Null
   If Len( sFileName) = 0 Then
      ErrStr = StrAtoU("无文件")
      Return False
   End If
   Dim r As Long, sFileName_Utf8 As String = StrWtoU(sFileName)
   r = sqlite3_open(":memory:", @pDB[0])
   
   If r Then '出错
      ErrStr = *sqlite3_errmsg(pDB[0])
      sqlite3_close(pDB[0])
      Return False
   End If
   Dim pFile As SQLite3 Ptr
   r = sqlite3_open(StrPtr(sFileName_Utf8), @pDB[1])
   If r Then '出错
      ErrStr = *sqlite3_errmsg(pDB[1])
      sqlite3_close(pDB[0])
      sqlite3_close(pDB[1])
      Return False
   End If
   If Password Then '有密码
      dim Password_Utf8 As String = StrWtoU(Password)
      If sqlite3_key(pDB[1], StrPtr(Password_Utf8), Len(Password_Utf8)) Then
         ErrStr = *sqlite3_errmsg(pDB[1])
         sqlite3_close(pDB[0])
         sqlite3_close(pDB[1])
         Return False
      End If
   End If  
   '检查密码是不是正确
   Dim rs() as String
   EventsEn = 1
   If SqlFind("PRAGMA database_list", rs()) Then
      if UBound(rs) = -1 or UBound(rs, 2) = -1 Then
         ErrStr = StrAtoU("密码出错或非数据库")
         sqlite3_close(pDB[0])
         sqlite3_close(pDB[1])
         Return False
      End if
   Else
      ErrStr = *sqlite3_errmsg(pDB[0])
      sqlite3_close(pDB[0])
      sqlite3_close(pDB[1])
      Return False
   End If     
   EventsEn = 0
   Dim pBackup As sqlite3_backup Ptr = sqlite3_backup_init(pDB[0], "main", pDB[1], "main")
   If pBackup Then
      sqlite3_backup_step(pBackup, -1)
      sqlite3_backup_finish(pBackup)
   Else
      ErrStr = *sqlite3_errmsg(pDB[0])
      sqlite3_close(pDB[0])
      sqlite3_close(pDB[1])
      Return False      
   End If
   pDB[2] = Cast(Any Ptr, Cast(Integer , Synchronization))
 
   
   ErrStr = "" ' 无错误
   Function = True
End Function

Function Class_SQLite3.MemSave() As Boolean
   Dim fp As FormControlsPro_TYPE ptr = GetFP()
   if fp = 0 then ErrStr = StrAtoU("无初始化") : Return False
   if Len(fp->nData) < 32 Then ErrStr = StrAtoU("数据库未打开") : Return False
   Dim pDB As any Ptr Ptr = Cast(Any Ptr, StrPtr(fp->nData))
   If pDB[0] = Null Then ErrStr = StrAtoU("数据库未打开") : Return False
   If pDB[1] = Null Then ErrStr = StrAtoU("无内存数据库") : Return False
   
   Dim r As Long
   Dim pBackup As sqlite3_backup Ptr = sqlite3_backup_init(pDB[1], "main", pDB[0], "main")
   If pBackup Then
      sqlite3_backup_step(pBackup, -1)
      sqlite3_backup_finish(pBackup)
   Else
      ErrStr = *sqlite3_errmsg(pDB[1])
      Return False      
   End If
   ErrStr = "" ' 无错误
   Function = True
End Function
Sub Class_SQLite3.Close()
   Dim fp As FormControlsPro_TYPE ptr = GetFP()
   if fp = 0 then ErrStr = StrAtoU("无初始化") : Return
   ErrStr = "" ' 无错误"
   if Len(fp->nData) < 32 Then ErrStr = StrAtoU("数据库未打开") : Return 
   Dim pDB As any Ptr Ptr = Cast(Any Ptr, StrPtr(fp->nData))
   If pDB[0] Then
      sqlite3_close(pDB[0])
       pDB[0] = Null
   End If
   If pDB[1] Then
      sqlite3_close(pDB[1])
       pDB[1] = Null
   End If
End Sub
Function Class_SQLite3.GetSQLitePtr(Index As Long =0) As SQLite3 Ptr
   Dim fp As FormControlsPro_TYPE ptr = GetFP()
   if fp = 0 then ErrStr = StrAtoU("无初始化") : Return 0
   ErrStr = "" ' 无错误"
   if Len(fp->nData) < 32 Then ErrStr = StrAtoU("数据库未打开") : Return 0
   if Index<0 Or Index>1 Then  ErrStr = StrAtoU("索引错误") : Return 0
   Dim pDB As any Ptr Ptr = Cast(Any Ptr, StrPtr(fp->nData))
   Function = pDB[Index] 
End Function
Function Class_SQLite3.ErrMsg() As String
        Function = StrUtoA(ErrStr)
End Function
Function Class_SQLite3.Version() As String                                             '版本号
  Function = *sqlite3_libversion()
End Function

Function Class_SQLite3.SetKey(newkey As CWSTR) As Boolean   '设置密码，如果为空，取消密码
   Dim fp As FormControlsPro_TYPE ptr = GetFP()
   if fp = 0 then ErrStr = StrAtoU("无初始化") : Return False
   if Len(fp->nData) < 32 Then ErrStr = StrAtoU("数据库未打开") : Return False
   Dim pDB As any Ptr Ptr = Cast(Any Ptr, StrPtr(fp->nData))
   Dim m_DB As SQLite3 Ptr = *pDB
   If m_DB = Null Then ErrStr = StrAtoU("数据库未打开") : Return False
   ErrStr = "" ' 无错误"
   If Len(newkey) = 0 Then
      If sqlite3_rekey(m_DB, Null, 0) Then
         ErrStr = *sqlite3_errmsg(m_DB)
         Return False
      Else
         if pDB[1] <> 0 And pDB[2] <> 0 Then sqlite3_rekey(pDB[1], Null, 0)
         Return True
      End If
   Else
      Dim snewkey  As String = StrWtoU(newkey)
      If sqlite3_rekey(m_DB, StrPtr(snewkey), Len(snewkey)) Then
         ErrStr = *sqlite3_errmsg(m_DB)
         Return False
      Else
         if pDB[1] <> 0 And pDB[2] <> 0 Then sqlite3_rekey(m_DB, StrPtr(snewkey), Len(snewkey))
         Return True
      End If
   End If
   
End Function

Function Class_SQLite3.SqlFind(Sql_Utf8 As String, rs() As String) As Long
   Dim fp As FormControlsPro_TYPE ptr = GetFP()
   if fp = 0 then ErrStr = StrAtoU("无初始化") : Return 0
   if Len(fp->nData) < 32 Then ErrStr = StrAtoU("数据库未打开") : Return 0
   Dim pDB As any Ptr Ptr = Cast(Any Ptr, StrPtr(fp->nData))
   Dim m_DB As SQLite3 Ptr = *pDB
   If m_DB = Null Then ErrStr = StrAtoU("数据库未打开") : Return 0
   if m_SqlStringProc Then
      Dim pp As Function(ByRef Sql_Utf8 as String) As Long = m_SqlStringProc
      Dim r As Long = pp(Sql_Utf8)
      if r <> 0 Then Return 0
   End If
   '获取字段类型---------------------------------------------------------------------------------
   Dim ppStmt As sqlite3_stmt Ptr, pzTail As ZString Ptr
   'Print "准备执行SQL=" & sSQL
   Dim rr As Long = Sqlite3_prepare(m_DB, StrPtr(Sql_Utf8), -1, @ppStmt, @pzTail) ' 准备执行SQL
   'Print "rr=" & rr, "ppStmt=" & ppStmt
   Dim As Long u,i
   If ppStmt = 0 Then
      ErrStr = *sqlite3_errmsg(m_DB)
      Return 0
   End If
   u = sqlite3_column_count(ppStmt) '根据select语句的对象，获取结果集中的字段数量，只有select才有，其它为0。
   If u = 0 Then ErrStr = StrAtoU("非查询语句") : Return 0
   'Print "字段数=" & u
   
   '查询内容----------------------------------------------------------------------------------------------
   Dim lpTable As ZString Ptr Ptr ' 返回给定表的数组指针（从列名称）
   Dim nRows As long         ' 返回的记录集的行数
   Dim nColumns As long         ' 返回的记录集的列数
   Dim iFields As Integer         ' 返回表返回的字段数
   Dim iRow As Integer
   Dim iCol As Integer
   Dim lpErrorSz As ZString Ptr         ' 错误信息
   Dim pp As Function(pi As Long, ci As Long, nData As ZString Ptr, siz As Long, Rows As Long, Columns As Long, ppStmt As sqlite3_stmt Ptr) As Long = m_FindRsProc
   If sqlite3_get_table(m_DB, StrPtr(Sql_Utf8), @lpTable, @nRows, @nColumns, @lpErrorSz) = 0 Then '成功
      'Print "nRows=" & nRows, "nColumns=" & nColumns, "lpTable=" & lpTable
      If nRows = 0 Then
         ErrStr = StrAtoU("无记录")
      Else
         iFields = ((nRows + 1) * nColumns) -1
         ReDim rs(nRows, nColumns -1)
         'Print UBound(rs_Utf8), UBound(rs_Utf8, 2)
         If UBound(rs) > 0 Then
            Dim r As Long
            For i = 0 To iFields
               if iCol = 0 Then
                  if m_FindRsProc<>0 and EventsEn = 0 Then
                     r = pp(iRow, iCol, lpTable[i], Len( *lpTable[i]), nRows, u, ppStmt)
                  Else
                     r = 0
                  End If
               End if
               if r = 2 Then Exit For
               if r <> 1 Then
                  rs(iRow, iCol) = *lpTable[i]  '因为文本是 UTF8 的
               End If
               iCol += 1 : If iCol = nColumns Then iCol = 0
               If (i + 1) Mod nColumns = 0 Then iRow += 1
            Next i
            ErrStr = ""
            If Transaction Then Transaction += 1
         Else
            nRows = 0
            ErrStr = StrAtoU("返回数组被锁，无法使用 ReDim") ' "
         End If
         
      End If
   Else
      nRows = 0
      ErrStr = *sqlite3_errmsg(m_DB)
   End If
   sqlite3_finalize(ppStmt) '释放
   'declare sub sqlite3_free_table(byval result as zstring ptr ptr)
   sqlite3_free_table lpTable  '不论数据库查询是否成功，都释放 char** 查询结果
   Function = nRows
End Function
Function Class_SQLite3.SqlFindOne(Sql_Utf8 As String, rs() As String) As Long
   Dim fp As FormControlsPro_TYPE ptr = GetFP()
   if fp = 0 then ErrStr = StrAtoU("无初始化") : Return 0
   if Len(fp->nData) < 32 Then ErrStr = StrAtoU("数据库未打开") : Return 0
   Dim pDB As any Ptr Ptr = Cast(Any Ptr, StrPtr(fp->nData))
   Dim m_DB As SQLite3 Ptr = *pDB
   If m_DB = Null Then ErrStr = StrAtoU("数据库未打开") : Return 0
   if m_SqlStringProc Then
      Dim pp As Function(ByRef Sql_Utf8 as String) As Long = m_SqlStringProc
      Dim r As Long = pp(Sql_Utf8)
      if r <> 0 Then Return 0
   End If
   '获取字段类型---------------------------------------------------------------------------------
   Dim ppStmt As sqlite3_stmt Ptr, pzTail As ZString Ptr
   Dim rr As Long = Sqlite3_prepare(m_DB, StrPtr(Sql_Utf8), -1, @ppStmt, @pzTail) ' 准备执行SQL
   Dim As Long i
   If ppStmt = 0 Then
      ErrStr = *sqlite3_errmsg(m_DB)
      Return 0
   End If
   
   '查询内容----------------------------------------------------------------------------------------------
   Dim lpTable As ZString Ptr Ptr ' 返回给定表的数组指针（从列名称）
   Dim nRows As Long         ' 返回的记录集的行数
   Dim nColumns As Long         ' 返回的记录集的列数
   Dim iFields As Integer         ' 返回表返回的字段数
   Dim iRow As Integer
   Dim iCol As Integer
   Dim lpErrorSz As ZString Ptr         ' 错误信息
   Dim pp As Function(pi As Long, ci As Long, nData As ZString Ptr, siz As Long, Rows As Long, Columns As Long, ppStmt As sqlite3_stmt Ptr) As Long = m_FindRsProc
   If sqlite3_get_table(m_DB, StrPtr(Sql_Utf8), @lpTable, @nRows, @nColumns, @lpErrorSz) = 0 Then '成功
      If nColumns = 0 Then
         ErrStr = StrAtoU("无记录")  ' "
      Else
         iFields = ((nRows + 1) * nColumns) -1
         ReDim rs(nColumns -1)
         If UBound(rs) > -1 Then
            Dim r As Long
            For i = nColumns To iFields
               if m_FindRsProc<>0 and EventsEn = 0  Then
                  r = pp(1, iCol, lpTable[i], Len( *lpTable[i]), 1, nColumns, ppStmt)
               Else
                  r = 0
               End If
               if r = 2 Then Exit For
               if r <> 1 Then
                  rs(iCol) = *lpTable[i]
               End If
               iCol += 1 : If iCol = nColumns Then iCol = 0
               If (i + 1) Mod nColumns = 0 Then iRow += 1
            Next i
            ErrStr = ""
            If Transaction Then Transaction += 1
         Else
            nColumns = 0
            ErrStr = StrAtoU("返回数组被锁，无法使用 ReDim")  '
         End If
      End If
   Else
      nColumns = 0
      ErrStr = *sqlite3_errmsg(m_DB)
   End If
   'declare sub sqlite3_free_table(byval result as zstring ptr ptr)
   sqlite3_finalize(ppStmt) '释放
   sqlite3_free_table lpTable  '不论数据库查询是否成功，都释放 char** 查询结果
   Function = nColumns
   
End Function
Function Class_SQLite3.Find(Table As CWSTR, Cond As CWSTR, rs() As String, Orderby As CWSTR = "", Page As Long = 1, Pagesize As Long = 0, Col As CWSTR = "*") As Long
   Dim fp As FormControlsPro_TYPE ptr = GetFP()
   if fp = 0 then ErrStr = StrAtoU("无初始化") : Return 0
   if Len(fp->nData) < 32 Then ErrStr = StrAtoU("数据库未打开") : Return 0
   Dim pDB As any Ptr Ptr = Cast(Any Ptr, StrPtr(fp->nData))
   Dim m_DB As SQLite3 Ptr = *pDB
   If m_DB = Null Then ErrStr = StrAtoU("数据库未打开") : Return 0
   If Len(Table) = 0 Then ErrStr = StrAtoU("无表名") : Return 0   ' 无表名"
   Dim Col_Utf8 As String =StrWtoU(Col)
   Dim Sql_Utf8 As String = "SELECT " & Col_Utf8 & " FROM " & StrWtoU(Table)
   If len(Cond) Then Sql_Utf8 &= " WHERE " & StrWtoU(Cond)
   If len(Orderby) Then Sql_Utf8 &= " ORDER BY " & StrWtoU(Orderby)
   If Pagesize > 0 Then
      Dim n As Long = (Page -1) * Pagesize
      Sql_Utf8 &= " LIMIT " & n & "," & Pagesize
   End If
   'Print "Find=" & Sql_Utf8
   Function = SqlFind(Sql_Utf8, rs())
End Function
Function Class_SQLite3.FindByte(Table As CWSTR, Cond As CWSTR, rs() As String, Orderby As CWSTR = "", Page As Long = 1, Pagesize As Long = 0, Col As CWSTR = "*") As Long
   Dim fp As FormControlsPro_TYPE ptr = GetFP()
   if fp = 0 then ErrStr = StrAtoU("无初始化") : Return 0
   if Len(fp->nData) < 32 Then ErrStr = StrAtoU("数据库未打开") : Return 0
   Dim pDB As any Ptr Ptr = Cast(Any Ptr, StrPtr(fp->nData))
   Dim m_DB As SQLite3 Ptr = *pDB
   If m_DB = Null Then ErrStr = StrAtoU("数据库未打开") : Return 0
   If Len(Table) = 0 Then ErrStr = StrAtoU("无表名") : Return 0   ' 无表名"
   Dim Col_Utf8 As String = StrWtoU(Col)
   Dim Sql_Utf8 As String = "SELECT " & Col_Utf8 & " FROM " & StrWtoU(Table)
   If Cond Then Sql_Utf8 &= " WHERE " & StrWtoU(Cond)
   If Orderby Then Sql_Utf8 &= " ORDER BY " & StrWtoU(Orderby)
   If Pagesize > 0 Then
      Dim n As Long = (Page -1) * Pagesize
      Sql_Utf8 &= " LIMIT " & n & "," & Pagesize
   End If
'   Print "Find=" & Sql_Utf8,m_DB
   Dim ppStmt As sqlite3_stmt Ptr, pzTail As ZString Ptr
   Dim rr As Long = Sqlite3_prepare(m_DB, StrPtr(Sql_Utf8), -1, @ppStmt, @pzTail) ' 准备执行SQL

   Dim As Long u,i,yu ,yi
   If ppStmt = 0 Then
      ErrStr = *sqlite3_errmsg(m_DB)
      Return 0
   End If
   
   u = sqlite3_column_count(ppStmt) '根据select语句的对象，获取结果集中的字段数量，只有select才有，其它为0。
   if u > 0 Then
      yu = This.Count(Table, Cond)
      ReDim rs(yu, u -1)
      For i = 0 To u -1
         '返回值说明数据类型
         '1：SQLITE_INTEGER
         '2：SQLITE_FLOAT
         '3：SQLITE_TEXT
         '4：SQLITE_BLOB
         '5：SQLITE_NULL
         rs(0, i) = *sqlite3_column_name(ppStmt, i)   '获取字段名称
         ''t=sqlite3_database_name( ppStmt, i )'获取数据库名称
         ''t=sqlite3_table_name( ppStmt, i )  '获取表的名称
      Next
      Dim value As Any Ptr
      Dim siz As Long
      Dim r As Long
      Dim pp As Function(pi As Long, ci As Long, nData As ZString Ptr, siz As Long, Rows As Long, Columns As Long, ppStmt As sqlite3_stmt Ptr) As Long = m_FindRsProc
      While (sqlite3_step(ppStmt) = SQLITE_ROW) '完成后退出
         yi += 1
         if yi > yu Then Exit While
         For i = 0 To u -1
            Select Case sqlite3_column_type(ppStmt, i) '获取其声明时的类型。
                  'Case 1 '：SQLITE_INTEGER
                  'rs(yi, i) = Str(sqlite3_column_int(ppStmt, i))
                  'if m_FindRsProc<>0 and EventsEn = 0 Then
                  'r = pp(yi, i, yu, StrPtr(rs(yi, i)),Len(rs(yi, i)),yu,u,ppStmt)
                  'Else
                  'r = 0
                  'End if
                  'if r = 2 Then Exit While
                  'Case 2 '：SQLITE_FLOAT
               Case 1, 2, 3 '：SQLITE_TEXT
                  value = Cast(Any Ptr, sqlite3_column_text(ppStmt, i)) '数据指针
                  siz = sqlite3_column_bytes(ppStmt, i) '数据长度
                  if m_FindRsProc<>0 and EventsEn = 0 Then
                     r = pp(yi, i, value, siz, yu, u, ppStmt)
                  Else
                     r = 0
                  End if
                  if r = 2 Then Exit While
                  if siz And r <> 1 Then
                     rs(yi, i) = String(siz, 0)
                     memcpy StrPtr(rs(yi, i)), value, siz
                  End if
               Case 4 '：SQLITE_BLOB
                  value = Cast(Any Ptr, sqlite3_column_blob(ppStmt, i)) '数据指针
                  siz = sqlite3_column_bytes(ppStmt, i) '数据长度
                  if m_FindRsProc<>0 and EventsEn = 0 Then
                     r = pp(yi, i, value, siz, yu, u, ppStmt)
                  Else
                     r = 0
                  End if
                  if r = 2 Then Exit While
                  if siz And r <> 1 Then
                     rs(yi, i) = String(siz, 0)
                     memcpy StrPtr(rs(yi, i)), value, siz
                  End if
                  
               Case 5 '：SQLITE_NULL
            End Select
            
         Next
      Wend
      If Transaction Then Transaction += 1
   End if
   ErrStr = ""
   sqlite3_finalize(ppStmt) '释放
   Function = yu
End Function
Function Class_SQLite3.FindOneByte(Table As CWSTR, Cond As CWSTR, rs() As String, Orderby As CWSTR = "", Col As CWSTR = "*") As Long
   Dim fp As FormControlsPro_TYPE ptr = GetFP()
   if fp = 0 then ErrStr = StrAtoU("无初始化") : Return 0
   if Len(fp->nData) < 32 Then ErrStr = StrAtoU("数据库未打开") : Return 0
   Dim pDB As any Ptr Ptr = Cast(Any Ptr, StrPtr(fp->nData))
   Dim m_DB As SQLite3 Ptr = *pDB
   If m_DB = Null Then ErrStr = StrAtoU("数据库未打开") : Return 0
   If Len(Table) = 0 Then ErrStr = StrAtoU("无表名") : Return 0   ' 无表名"
   Dim Col_Utf8 As String = StrWtoU(Col)
   Dim Sql_Utf8 As String = "SELECT " & Col_Utf8 & " FROM " & StrWtoU(Table)
   If Cond Then Sql_Utf8 &= " WHERE " & StrWtoU(Cond)
   If Orderby Then Sql_Utf8 &= " ORDER BY " & StrWtoU(Orderby)
   Sql_Utf8 &= " LIMIT 1"
   
   Dim ppStmt As sqlite3_stmt Ptr, pzTail As ZString Ptr
   Dim rr As Long = Sqlite3_prepare(m_DB, StrPtr(Sql_Utf8), -1, @ppStmt, @pzTail) ' 准备执行SQL
   Dim As Long u,i
   If ppStmt = 0 Then
      ErrStr = *sqlite3_errmsg(m_DB)
      Return 0
   End If
   
   u = sqlite3_column_count(ppStmt) '根据select语句的对象，获取结果集中的字段数量，只有select才有，其它为0。
   if u > 0 Then
      ReDim rs(u -1)
      Dim value As Any Ptr
      Dim siz As Long
      Dim r As Long
      Dim pp As Function(pi As Long, ci As Long, nData As ZString Ptr, siz As Long, Rows As Long, Columns As Long, ppStmt As sqlite3_stmt Ptr) As Long = m_FindRsProc
      if (sqlite3_step(ppStmt) = SQLITE_ROW) Then  '完成后退出
         For i = 0 To u -1
            'Print "Type=" & sqlite3_column_type(ppStmt, i)  , *CPtr(LongInt Ptr,sqlite3_column_value(ppStmt, i) )
            Select Case sqlite3_column_type(ppStmt, i) '获取其声明时的类型。
                  'Case 1 '：SQLITE_INTEGER
                  'rs(i) = Str(sqlite3_column_int(ppStmt, i))
                  'if m_FindRsProc <> 0 and EventsEn = 0 Then
                  'r = pp(1, i,StrPtr(rs(i)), Len(rs(i)), 1, u, ppStmt)
                  'Else
                  'r = 0
                  'End if
                  'if r = 2 Then Exit While
                  'Case 2 '：SQLITE_FLOAT
                  'rs(i) = Str(sqlite3_column_double(ppStmt, i))
                  
               Case 1, 2, 3 '：SQLITE_TEXT
                  value = Cast(Any Ptr, sqlite3_column_text(ppStmt, i)) '数据指针
                  siz = sqlite3_column_bytes(ppStmt, i) '数据长度
                  if m_FindRsProc <> 0 and EventsEn = 0 Then
                     r = pp(1, i, value, siz, 1, u, ppStmt)
                  Else
                     r = 0
                  End if
                  if r = 2 Then Exit For 
                  if siz And r <> 1 Then
                     rs(i) = String(siz, 0)
                     memcpy StrPtr(rs(i)), value, siz
                  End if
               Case 4 '：SQLITE_BLOB
                  value = Cast(Any Ptr, sqlite3_column_blob(ppStmt, i)) '数据指针
                  siz = sqlite3_column_bytes(ppStmt, i) '数据长度
                  if m_FindRsProc <> 0 and EventsEn = 0 Then
                     r = pp(1, i, value, siz, 1, u, ppStmt)
                  Else
                     r = 0
                  End if
                  if r = 2 Then Exit For 
                  if siz And r <> 1 Then
                     rs(i) = String(siz, 0)
                     memcpy StrPtr(rs(i)), value, siz
                  End if
                  
               Case 5 '：SQLITE_NULL
            End Select
            
         Next
      Else
         u = 0
      end if
      If Transaction Then Transaction += 1
   End if
   ErrStr = ""
   sqlite3_finalize(ppStmt) '释放
   Function = u
End Function
Function Class_SQLite3.FindOne(Table As CWSTR, Cond As CWSTR, rs() As String, Orderby As CWSTR = "", Col As CWSTR = "*") As Long
   Dim fp As FormControlsPro_TYPE ptr = GetFP()
   if fp = 0 then ErrStr = StrAtoU("无初始化") : Return 0
   if Len(fp->nData) < 32 Then ErrStr = StrAtoU("数据库未打开") : Return 0
   Dim pDB As any Ptr Ptr = Cast(Any Ptr, StrPtr(fp->nData))
   Dim m_DB As SQLite3 Ptr = *pDB
   If m_DB = Null Then ErrStr = StrAtoU("数据库未打开") : Return 0
   
   If Len( Table) = 0 Then ErrStr = StrAtoU("无表名") : Return 0   ' 无表名"
   Dim Col_Utf8 As String = "*"
   if Col Then Col_Utf8 = StrWtoU( Col)   
   Dim Sql_Utf8 As String = "SELECT " & Col_Utf8 & " FROM " & StrWtoU(Table)
   If Len(Cond)>0 Then Sql_Utf8 &= " WHERE " & StrWtoU(Cond)
   If len(Orderby) Then Sql_Utf8 &= " ORDER BY " & StrWtoU(Orderby)
   Sql_Utf8 &= " LIMIT 1"
'   Print StrUtoA(Sql_Utf8)
   Function = SqlFindOne(Sql_Utf8, rs())
End Function
Function Class_SQLite3.Insert(Table As CWSTR, nList As CWSTR) As Long    '插入一条记录，成功返回插入的 ID，失败返回 FALSE。
   'nList   要新增的列表，字段名=值 ，如：  字段名1=1,字段名2= 'dd'  字符用单引号，2个单引号表示 1个单引号字符
   Dim fp As FormControlsPro_TYPE ptr = GetFP()
   if fp = 0 then ErrStr = StrAtoU("无初始化") : Return 0
   if Len(fp->nData) < 32 Then ErrStr = StrAtoU("数据库未打开") : Return 0
   Dim pDB As any Ptr Ptr = Cast(Any Ptr, StrPtr(fp->nData))
   Dim m_DB As SQLite3 Ptr = *pDB
   If m_DB = Null Then ErrStr = StrAtoU("数据库未打开") : Return 0
   If Len(Table) = 0 Then ErrStr = StrAtoU("无表名") : Return 0   ' 无表名"
   If Len(nList) = 0 Then ErrStr = StrAtoU("无内容") : Return 0
   dim Table_Utf8 As String = StrWtoU(Table)
   Dim nList_Utf8 As String = StrWtoU(nList)
   Dim zd As String = nList_Utf8, vl As String = ")VALUES(" & nList_Utf8
   Dim i As Long, zdi As Long = 1, vli As Long = 8, zv As Long
   zd[0] = 40 ' (
   Dim zz As Long '字符状态
   For i = 0 To Len(nList_Utf8) -1
      If zz <> 0 Then '字符状态
         If zv = 0 Then ErrStr = StrAtoU("数据出错") : Return 0 ' "
         If nList_Utf8[i] = 39 Then
            zz = 0 '退出字符状态
         End If
         vl[vli] = nList_Utf8[i]
         vli += 1
      Else
         Select Case nList_Utf8[i]
            Case 39 ' 单引号
               zz = 1 '进入字符状态
               If zv = 0 Then ErrStr = StrAtoU("数据出错") : Return 0   ' 数据出错"
               vl[vli] = nList_Utf8[i]
               vli += 1
            Case 44 ' ,
               zv = 0 '进入下一字段
               zd[zdi] = 44
               zdi += 1
               vl[vli] = 44
               vli += 1
            Case 61 ' =
               zv = 1 '进入值模式
            Case Else
               If zv = 0 Then
                  zd[zdi] = nList_Utf8[i]
                  zdi += 1
               Else
                  vl[vli] = nList_Utf8[i]
                  vli += 1
               End If
         End Select
      End If
   Next
   vl[vli] = 41 ' )
   vli += 1
   Dim Sql_Utf8 As String = "INSERT INTO " & Table_Utf8 & Left(zd, zdi) & Left(vl, vli)
   
   If This.Exec(Sql_Utf8,Cast(Integer ,pDB[2]) ) = -1 Then
      ErrStr = StrAtoU("数据出错") ' 数据出错"
      Return 0
   End If

'   Dim rs_Utf8() As String
'   EventsEn =1 
'   If SqlFindOne("SELECT LAST_INSERT_ROWID() As mid FROM " & Table_Utf8, rs_Utf8()) = 0 Then
'      EventsEn =0
'      ErrStr = *sqlite3_errmsg(m_DB)
'      ErrStr = This.StrUtoA(ErrStr)
'      Return 0
'   End If
'  EventsEn = 0 
   Function = sqlite3_last_insert_rowid(m_DB) ' 获取新插入数据自增长的ID值  ValInt(rs_Utf8(0))
   If Transaction Then Transaction += 1
End Function
Function Class_SQLite3.Exec(Sql_Utf8 As String,Synchronization As Boolean =0) As Long
   Dim fp As FormControlsPro_TYPE ptr = GetFP()
   if fp = 0 then ErrStr = StrAtoU("无初始化") : Return -1
   if Len(fp->nData) < 32 Then ErrStr = StrAtoU("数据库未打开") : Return -1
   Dim pDB As any Ptr Ptr = Cast(Any Ptr, StrPtr(fp->nData))
   Dim m_DB As SQLite3 Ptr = *pDB
   If m_DB = Null Then ErrStr = StrAtoU("数据库未打开") : Return -1
   If Len(Sql_Utf8) = 0 Then ErrStr = StrAtoU("无Sql") : Return -1   ' "
   if m_SqlStringProc Then
      Dim pp As Function(ByRef Sql_Utf8 as String) As Long = m_SqlStringProc
      Dim r As Long = pp(Sql_Utf8)
      if r <> 0 Then Return -1
   End If
   Dim r As Long = sqlite3_exec(m_DB, StrPtr(Sql_Utf8), 0, 0, 0)
   '对于更新、删除、插入等不需要回调函数的操作，sqlite3_exec的第三、第四个参数可以传入0或者Null。
   '通常情况下sqlite3_exec返回SQLITE_OK=0的结果，非0结果可以通过errmsg来获取对应的错误描述。
   If r <> 0 Then
      ErrStr = *sqlite3_errmsg(m_DB)
      Return -1
   End If
   if Synchronization <> 0 And pDB[1] <> 0 Then '当使用内存数据库时，修改文件进行同步修改。
      sqlite3_exec(pDB[1], StrPtr(Sql_Utf8), 0, 0, 0)
   End if     
   ErrStr = ""
   If Transaction = 0 Then
      Dim rr As Long = sqlite3_changes(m_DB)
      'Print "影响行数=" & rr
      Function = rr
   Else
      Transaction += 1
      Function = 0
   End If
End Function
Function Class_SQLite3.AddItem(Table As CWSTR, nList As CWSTR) As Long   '新增一条记录(与insert()相同)，成功返回插入的 ID
  Function = Insert(Table, nList)
End Function
Function Class_SQLite3.Update(Table As CWSTR, Cond As CWSTR, upList As CWSTR) As Long    '更新记录，成功返回受影响的行数，失败返回 -1。
   Dim fp As FormControlsPro_TYPE ptr = GetFP()
   if fp = 0 then ErrStr = StrAtoU("无初始化") : Return -1
   if Len(fp->nData) < 32 Then ErrStr = StrAtoU("数据库未打开") : Return -1
   Dim pDB As any Ptr Ptr = Cast(Any Ptr, StrPtr(fp->nData))
   Dim m_DB As SQLite3 Ptr = *pDB
   If m_DB = Null Then ErrStr = StrAtoU("数据库未打开") : Return -1
   If Len( Table) = 0  Then ErrStr = StrAtoU("无表名") : Return -1  ' 无表名"
   If Len(Cond) = 0  Then ErrStr = StrAtoU("无条件") : Return -1  ' "
   If Len(upList) = 0  Then ErrStr = StrAtoU("无内容") : Return -1   ' "
   Dim Sql_Utf8 As String = "UPDATE " & StrWtoU(Table) & " SET " & StrWtoU(upList) & " WHERE " & StrWtoU(Cond)
   Function = This.Exec(Sql_Utf8,Cast(Integer ,pDB[2]) )
End Function
Function Class_SQLite3.UpdateByte(Table As CWSTR, Cond As CWSTR, ColName As CWSTR, nByte As Any Ptr, nLen As Long) As Long    '写入2进制数据，成功返回受影响的行数，失败返回 -1。
   Dim fp As FormControlsPro_TYPE ptr = GetFP()
   if fp = 0 then ErrStr = StrAtoU("无初始化") : Return -1
   if Len(fp->nData) < 32 Then ErrStr = StrAtoU("数据库未打开") : Return -1
   Dim pDB As any Ptr Ptr = Cast(Any Ptr, StrPtr(fp->nData))
   Dim m_DB As SQLite3 Ptr = *pDB
   If m_DB = Null Then ErrStr = StrAtoU("数据库未打开") : Return -1
   If Len( Table) = 0  Then ErrStr = StrAtoU("无表名") : Return -1   ' 无表名"
   If Len(Cond) = 0 Then ErrStr = StrAtoU("无条件") : Return -1  ' "
   If Len(ColName) = 0 Then ErrStr = StrAtoU("无字段名") : Return -1 ' 无字段名"
   Dim Sql_Utf8 As String = "UPDATE " & StrWtoU(Table) & " SET " & StrWtoU(ColName) & "=? WHERE " & StrWtoU(Cond)
   Dim ppStmt As sqlite3_stmt Ptr, pzTail As ZString Ptr
   Dim rr As Long = Sqlite3_prepare(m_DB, StrPtr(Sql_Utf8), -1, @ppStmt, @pzTail) ' 准备执行SQL
   Dim As Long u,i
   If ppStmt = 0 Then
      ErrStr = *sqlite3_errmsg(m_DB)
      Return -1
   End If
   If sqlite3_bind_blob(ppStmt, 1, nByte, nLen, Null) = 0 Then
      sqlite3_step(ppStmt)  '执行
      ErrStr = ""
      if pDB[1] <> 0 And pDB[2]<> 0 Then
         sqlite3_finalize(ppStmt) '释放
         Sqlite3_prepare(pDB[1], StrPtr(Sql_Utf8), -1, @ppStmt, @pzTail)
         if ppStmt Then 
            If sqlite3_bind_blob(ppStmt, 1, nByte, nLen, Null) = 0 Then sqlite3_step(ppStmt)  '执行
         End if 
      End if 
      If Transaction = 0 Then
         Function = sqlite3_changes(m_DB)
      Else
         Transaction += 1
         Function = 0
      End If
   Else
      ErrStr = *sqlite3_errmsg(m_DB)
      Function = -1
   End If
   sqlite3_finalize(ppStmt) '释放
End Function
Function Class_SQLite3.DeleteItem(Table As CWSTR, Cond As CWSTR) As Long    '删除记录，成功返回受影响的行数，失败返回 -1。
   Dim fp As FormControlsPro_TYPE ptr = GetFP()
   if fp = 0 then ErrStr = StrAtoU("无初始化") : Return -1
   if Len(fp->nData) < 32 Then ErrStr = StrAtoU("数据库未打开") : Return -1
   Dim pDB As any Ptr Ptr = Cast(Any Ptr, StrPtr(fp->nData))
   Dim m_DB As SQLite3 Ptr = *pDB
   If m_DB = Null Then ErrStr = StrAtoU("数据库未打开") : Return -1
   If Len(Table) = 0  Then ErrStr = StrAtoU("无表名") : Return -1    ' 无表名"
   If Len(Cond) = 0  Then ErrStr =StrAtoU("无条件") : Return -1    ' "
   Dim Sql_Utf8 As String = "DELETE FROM  " & StrWtoU(Table) & " WHERE " & StrWtoU(Cond)
   Function = This.Exec(Sql_Utf8,Cast(Integer ,pDB[2]) )
   '("DELETE FROM test WHERE name='Jerry'")
   '("DELETE FROM test WHERE id IN('003','005'")
End Function
Function Class_SQLite3.Count(Table As CWSTR, Cond As CWSTR = "") As Long    '
   Dim fp As FormControlsPro_TYPE ptr = GetFP()
   if fp = 0 then ErrStr = StrAtoU("无初始化") : Return 0
   if Len(fp->nData) < 32 Then ErrStr = StrAtoU("数据库未打开") : Return 0
   Dim pDB As any Ptr Ptr = Cast(Any Ptr, StrPtr(fp->nData))
   Dim m_DB As SQLite3 Ptr = *pDB
   If m_DB = Null Then ErrStr = StrAtoU("数据库未打开") : Return 0
   If Len(Table) = 0  Then ErrStr = StrAtoU("无表名") : Return 0   ' 无表名"
   Dim Sql_Utf8 As String = "SELECT count(*) As mcount FROM " & StrWtoU(Table)
   If Len(Cond) >0   Then Sql_Utf8 &= " WHERE " & StrWtoU(Cond)
   Dim rs_Utf8() As String
   EventsEn = 1
   If This.SqlFindOne(Sql_Utf8, rs_Utf8()) = 0 Then
      Function = 0
   Else
      Function = ValInt(rs_Utf8(0))
   End If
   EventsEn = 0
End Function
Function Class_SQLite3.INIgetKey(lSection As String, lKeyName As String, lDefault As String = "") As String  '读取配置，用数据库保存软件配置，类似INI文件读取配置值。
   Dim fp As FormControlsPro_TYPE ptr = GetFP()
   if fp = 0 then ErrStr = StrAtoU("无初始化") : Return ""
   if Len(fp->nData) < 32 Then ErrStr = StrAtoU("数据库未打开") : Return ""
   Dim pDB As any Ptr Ptr = Cast(Any Ptr, StrPtr(fp->nData))
   Dim m_DB As SQLite3 Ptr = *pDB
   If m_DB = Null Then ErrStr = StrAtoU("数据库未打开") : Return ""
   Dim rs_Utf8() As String, ot As String, Sql_Utf8 As String
   If Len(lSection) = 0 Or Len(lKeyName) = 0 Then Return lDefault
   Dim tlKeyName As String =strReplace(lKeyName,"'","''")
   Sql_Utf8 = StrAtoU("SELECT [值] FROM [" & lSection & "] WHERE [项目]='" & tlKeyName & "' LIMIT 1")
   EventsEn = 1 
   If This.SqlFindOne(Sql_Utf8, rs_Utf8()) > 0 Then
      ot = rs_Utf8(0)
   End If
   If Len(ot) Then
      Function = ot
   Else
      Function = lDefault
   End If
   EventsEn = 0 
End Function
Function Class_SQLite3.INIgetKey(lSection As WString Ptr, lKeyName As WString Ptr, lDefault As WString Ptr = 0) As CWSTR  '读取配置，用数据库保存软件配置，类似INI文件读取配置值。
   Dim fp As FormControlsPro_TYPE ptr = GetFP()
   if fp = 0 then ErrStr = StrAtoU("无初始化") : Return ""
   if Len(fp->nData) < 32 Then ErrStr = StrAtoU("数据库未打开") : Return ""
   Dim pDB As any Ptr Ptr = Cast(Any Ptr, StrPtr(fp->nData))
   Dim m_DB As SQLite3 Ptr = *pDB
   If m_DB = Null Then ErrStr = StrAtoU("数据库未打开") : Return ""
   Dim rs_Utf8() As String, ot As CWSTR, Sql_Utf8 As String
   Dim clDefault As CWSTR 
   if lDefault Then clDefault=*lDefault
   If lSection = 0 OrElse Len( *lSection) = 0  Then Return clDefault
   If lKeyName = 0 OrElse Len( *lKeyName) = 0 Then Return lKeyName
   Dim tlKeyName As String =strReplace(StrWtoU(*lKeyName),"'","''")
   Sql_Utf8 = StrAtoU("SELECT [值] FROM [") & StrWtoU( *lSection) & StrAtoU("] WHERE [项目]='") & tlKeyName & "' LIMIT 1"
   EventsEn = 1
   If This.SqlFindOne(Sql_Utf8, rs_Utf8()) > 0 Then
      ot = StrUtoW(rs_Utf8(0))
   End If
   EventsEn = 0
   If Len(ot) Then
      Return ot
   Else
      Return  clDefault
   End If

End Function
Function Class_SQLite3.INIsetKey(lSection As String, lKeyName As String, nValue As String) As Boolean   '写配置，用数据库保存软件配置，类似INI文件保存配置值 成功返回非0 ，失败返回 FALSE。
   Dim fp As FormControlsPro_TYPE ptr = GetFP()
   if fp = 0 then ErrStr = StrAtoU("无初始化") : Return FALSE
   if Len(fp->nData) < 32 Then ErrStr = StrAtoU("数据库未打开") : Return FALSE
   Dim pDB As any Ptr Ptr = Cast(Any Ptr, StrPtr(fp->nData))
   Dim m_DB As SQLite3 Ptr = *pDB
   If m_DB = Null Then ErrStr = StrAtoU("数据库未打开") : Return FALSE
   Dim rs_Utf8() As String, Sql_Utf8 As String
   If Len(lSection) = 0 Or Len(lKeyName) = 0 Then Return FALSE
   Dim tlKeyName As String =strReplace(lKeyName,"'","''") 
   Dim tnValue As String =strReplace(nValue,"'","''") 
   
   '判断的表名是不是存在 ---------
   'select * from sqlite_master where name='参数'
   Sql_Utf8 = "select * from sqlite_master where name='" & StrAtoU(lSection) & "'"
   EventsEn = 1
   If This.SqlFindOne(Sql_Utf8, rs_Utf8()) <= 0 Then '表不存在，创造个表
      'CREATE TABLE [参数] (ID INTEGER PRIMARY KEY AUTOINCREMENT ,[项目] TEXT NOT NULL,[值] TEXT NOT NULL)
      Sql_Utf8 =StrAtoU( "CREATE TABLE [" & lSection & "] (ID INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL ,[项目] TEXT NOT NULL,[值] TEXT NOT NULL) " )
      This.Exec(Sql_Utf8,Cast(Integer ,pDB[2]) )
   End If
   '判断的项目是不是存在 ---------
   Sql_Utf8 = StrAtoU( "SELECT [ID] FROM [" & lSection & "] WHERE [项目]='" & tlKeyName & "' LIMIT 1")
   If This.SqlFindOne(Sql_Utf8, rs_Utf8()) <= 0 Then '不存在，
      'INSERT INTO [参数]([项目],[值]) VALUES('单位','为而人')
      Sql_Utf8 = StrAtoU( "INSERT INTO [" & lSection & "]([项目],[值]) VALUES('" & tlKeyName & "','" & tnValue & "')" )
   Else
      If nValue = "" Then
         Sql_Utf8 = "DELETE FROM [" & StrAtoU(lSection) & "] WHERE ID=" & rs_Utf8(0)
      Else
         'UPDATE [参数] SET [值]='"的物品' WHERE ID=1
         Sql_Utf8 = StrAtoU("UPDATE [" & lSection & "] SET [值]='" & tnValue & "' WHERE ID=" & rs_Utf8(0) )
      End If
   End If
   EventsEn = 0
   Function = This.Exec(Sql_Utf8,Cast(Integer ,pDB[2]) )
   
End Function
Function Class_SQLite3.INIsetKey(lSection As WString Ptr, lKeyName As WString Ptr, nValue As WString Ptr) As Boolean   '写配置，用数据库保存软件配置，类似INI文件保存配置值 成功返回非0 ，失败返回 FALSE。
   Dim fp As FormControlsPro_TYPE ptr = GetFP()
   if fp = 0 then ErrStr = StrAtoU("无初始化") : Return FALSE
   if Len(fp->nData) < 32 Then ErrStr = StrAtoU("数据库未打开") : Return FALSE
   Dim pDB As any Ptr Ptr = Cast(Any Ptr, StrPtr(fp->nData))
   Dim m_DB As SQLite3 Ptr = *pDB
   If m_DB = Null Then ErrStr = StrAtoU("数据库未打开") : Return FALSE
   Dim rs_Utf8() As String, Sql_Utf8 As String
   If lSection = 0 OrElse Len( *lSection) = 0 Then Return FALSE
   If lKeyName = 0 OrElse Len( *lKeyName) = 0 Then Return FALSE
   Dim lSection_utf8 As String = StrWtoU( *lSection)
   Dim tlKeyName As String = strReplace(StrWtoU( *lKeyName), "'", "''")
   Dim tnValue As String
   if nValue Then tnValue=strReplace(StrWtoU( *nValue), "'", "''")
   
   '判断的表名是不是存在 ---------
   'select * from sqlite_master where name='参数'
   Sql_Utf8 = "select * from sqlite_master where name='" & lSection_utf8 & "'"
   EventsEn = 1
   If This.SqlFindOne(Sql_Utf8, rs_Utf8()) <= 0 Then '表不存在，创造个表
      'CREATE TABLE [参数] (ID INTEGER PRIMARY KEY AUTOINCREMENT ,[项目] TEXT NOT NULL,[值] TEXT NOT NULL)
      Sql_Utf8 = "CREATE TABLE [" & lSection_utf8 & StrAtoU("] (ID INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL ,[项目] TEXT NOT NULL,[值] TEXT NOT NULL) ")
      This.Exec(Sql_Utf8,Cast(Integer ,pDB[2]) )
   End If
   '判断的项目是不是存在 ---------
   Sql_Utf8 = "SELECT [ID] FROM [" & lSection_utf8 & StrAtoU("] WHERE [项目]='") & tlKeyName & "' LIMIT 1"
   If This.SqlFindOne(Sql_Utf8, rs_Utf8()) <= 0 Then '不存在，
      'INSERT INTO [参数]([项目],[值]) VALUES('单位','为而人')
      Sql_Utf8 = "INSERT INTO [" & lSection_utf8 & StrAtoU("]([项目],[值]) VALUES('") & tlKeyName & "','" & tnValue & "')"
   Else
      If tnValue = "" Then
         Sql_Utf8 = "DELETE FROM [" & lSection_utf8 & "] WHERE ID=" & rs_Utf8(0)
      Else
         'UPDATE [参数] SET [值]='"的物品' WHERE ID=1
         Sql_Utf8 = "UPDATE [" & lSection_utf8 & StrAtoU("] SET [值]='") & tnValue & "' WHERE ID=" & rs_Utf8(0)
      End If
   End If
   EventsEn = 0
   Function = This.Exec(Sql_Utf8,Cast(Integer ,pDB[2]) )
   
End Function
Function Class_SQLite3.MaxID(Table As CWSTR, nField As CWSTR, Cond As CWSTR = "") As Long    '查找表中某列最大值，成功返回最大值，失败返回 FALSE。
   Dim fp As FormControlsPro_TYPE ptr = GetFP()
   if fp = 0 then ErrStr = StrAtoU("无初始化") : Return False
   if Len(fp->nData) < 32 Then ErrStr = StrAtoU("数据库未打开") : Return False
   Dim pDB As any Ptr Ptr = Cast(Any Ptr, StrPtr(fp->nData))
   Dim m_DB As SQLite3 Ptr = *pDB
   If m_DB = Null Then ErrStr = StrAtoU("数据库未打开") : Return False
   Dim rs_Utf8() As String
   If Len(Table) = 0  Then ErrStr = StrAtoU("无表名") : Return 0   ' 无表名"
   If Len(nField) = 0  Then ErrStr = StrAtoU("无字段")  : Return 0 ' "
   Dim Sql_Utf8 As String = "SELECT MAX(" & StrWtoU(nField) & ") As mid FROM " & StrWtoU(Table)
   If Len(Cond) > 0 Then Sql_Utf8 &= " WHERE " & StrWtoU(Cond)
   EventsEn = 1
   If This.SqlFindOne(Sql_Utf8, rs_Utf8()) = 0 Then Return 0
   EventsEn = 0
   Function = ValInt(rs_Utf8(0))
End Function

Sub Class_SQLite3.TransactionBegin()       '事务开始（用于批量执行SQL，提高SQL效率）
   Dim fp As FormControlsPro_TYPE ptr = GetFP()
   if fp = 0 then ErrStr = StrAtoU("无初始化") : Return 
   if Len(fp->nData) < 32 Then ErrStr = StrAtoU("数据库未打开") : Return 
   Dim pDB As any Ptr Ptr = Cast(Any Ptr, StrPtr(fp->nData))   
  Transaction = 1
  This.Exec("BEGIN TRANSACTION",Cast(Integer ,pDB[2]) )
End Sub
Function Class_SQLite3.TransactionEnd() As Long         '事务执行并且结束
   Dim fp As FormControlsPro_TYPE ptr = GetFP()
   if fp = 0 then ErrStr = StrAtoU("无初始化") : Return 0
   if Len(fp->nData) < 32 Then ErrStr = StrAtoU("数据库未打开") : Return 0
   Dim pDB As any Ptr Ptr = Cast(Any Ptr, StrPtr(fp->nData))   
  This.Exec("COMMIT TRANSACTION",Cast(Integer ,pDB[2]) )   ' 执行事务
  This.Exec("END TRANSACTION",Cast(Integer ,pDB[2]) )       ' 结束事务
  Function = Transaction -3
  Transaction = 0
End Function
Function Class_SQLite3.CreateTable(Table As CWSTR) As Long '创建1张表（默认添加 ID 主键字段）
   Dim fp As FormControlsPro_TYPE ptr = GetFP()
   if fp = 0 then ErrStr = StrAtoU("无初始化") : Return -1
   if Len(fp->nData) < 32 Then ErrStr = StrAtoU("数据库未打开") : Return -1
   Dim pDB As any Ptr Ptr = Cast(Any Ptr, StrPtr(fp->nData))
   Dim m_DB As SQLite3 Ptr = *pDB
   If m_DB = Null Then ErrStr = StrAtoU("数据库未打开") : Return -1
   If Len(Table) = 0   Then ErrStr = StrAtoU("无表名") : Return -1   ' 无表名"
   Dim Sql_Utf8 As String = "CREATE TABLE " & StrWtoU(Table) & " (ID INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL )"
   Function = This.Exec(Sql_Utf8,Cast(Integer ,pDB[2]))
End Function
Function Class_SQLite3.AddField(Table As CWSTR, nField As CWSTR, nType As CWSTR, default As CWSTR = "", nNull As Boolean = 0) As Long  '新增字段
   Dim fp As FormControlsPro_TYPE ptr = GetFP()
   if fp = 0 then ErrStr = StrAtoU("无初始化") : Return -1
   if Len(fp->nData) < 32 Then ErrStr = StrAtoU("数据库未打开") : Return -1
   Dim pDB As any Ptr Ptr = Cast(Any Ptr, StrPtr(fp->nData))
   Dim m_DB As SQLite3 Ptr = *pDB
   If m_DB = Null Then ErrStr = StrAtoU("数据库未打开") : Return -1
   If Len(Table) = 0 Then ErrStr = StrAtoU("无表名") : Return -1   ' 无表名"
   If Len(nField) = 0 Then ErrStr = StrAtoU("无字段名") : Return -1  ' 无字段名"
   If Len(nType) = 0 Then ErrStr = StrAtoU("无类型名")  : Return -1 ' "
   Dim Sql_Utf8 As String = "ALTER TABLE " & StrWtoU(Table) & " ADD " & StrWtoU(nField) & " " & StrWtoU(nType)
   Dim tdefault As String 
   if len(default) >0 AndAlso Len(nType) > 0 Then  tdefault =strReplace(StrWtoU(default),"'","''")
   If Len(tdefault) > 0 Then Sql_Utf8 &= " DEFAULT " & tdefault
   If nNull = 0 Then Sql_Utf8 &= " NOT NULL "
   'Print Sql_Utf8
   Function = This.Exec(Sql_Utf8,Cast(Integer ,pDB[2]))
End Function
Function Class_SQLite3.Vacuum() As Long   '对数据库文件重新整理，减少文件尺寸，避免数据臃肿，影响效率。失败返回 -1
   Function = This.Exec("VACUUM")
End Function
Function Class_SQLite3.CreateIndex(Table As CWSTR, nField As CWSTR, Unique As Boolean = 0) As Long '创建索引，索引提高查询速度非常明显，同时降低了更新与插入数据速度。 失败返回 -1
   Dim fp As FormControlsPro_TYPE ptr = GetFP()
   if fp = 0 then ErrStr = StrAtoU("无初始化") : Return -1
   if Len(fp->nData) < 32 Then ErrStr = StrAtoU("数据库未打开") : Return -1
   Dim pDB As any Ptr Ptr = Cast(Any Ptr, StrPtr(fp->nData))
   Dim m_DB As SQLite3 Ptr = *pDB
   If m_DB = Null Then ErrStr = StrAtoU("数据库未打开") : Return -1
   If Len(Table) = 0 Then ErrStr = StrAtoU("无表名") : Return -1 ' 无表名"
   If Len(nField) = 0 Then ErrStr = StrAtoU("无字段名") : Return -1  ' 无字段名"
   Dim Sql_Utf8 As String
   If Unique Then
      Sql_Utf8 = "CREATE UNIQUE INDEX "
   Else
      Sql_Utf8 = "CREATE INDEX "
   End If
   Sql_Utf8 &= StrWtoU(nField) & " ON " & StrWtoU(Table) & " (" & StrWtoU(nField) & ")"
   Function = This.Exec(Sql_Utf8,Cast(Integer ,pDB[2]))
End Function
Function Class_SQLite3.StrAtoU(sStr As String) As String
  Dim LenStr As Integer = Len(sStr)
  If LenStr = 0 Then Return ""
  Dim dst As String = String(LenStr * 2, 0)  '为输出Utf8预留空间
  Dim eLen As Integer, r As Any Ptr
  Dim wsStr As WString Ptr = CAllocate(LenStr * 2 + 2)  '必须转换为宽字符，不可以用CharToUTF转换，那不一样的编码。
  eLen = MultiByteToWideChar(CP_ACP, 0, StrPtr(sStr), LenStr, wsStr, LenStr * 2)
  r = WCharToUTF(UTF_ENCOD_UTF8, wsStr, eLen, StrPtr(dst), @eLen)
  Deallocate wsStr
  Function = Left(dst, eLen)
End Function
Function Class_SQLite3.StrUtoA(Utf8str As String) As String
   Dim eLen As Integer = Len(Utf8str)
   If eLen = 0 Then Return ""
   Dim wsStr As WString Ptr = CAllocate(eLen * 2 + 2)  '+2 是为了最后空出2个00 为宽字符结尾
   UTFToWChar(UTF_ENCOD_UTF8, StrPtr(Utf8str), wsStr, @eLen)
   Dim ZStr as String
   ZStr = String(eLen * 2 + 2, 0)
   Dim ZStrLen as Integer = WideCharToMultiByte(CP_ACP, 0, wsStr, eLen, StrPtr(ZStr), eLen * 2 + 2, Null, Null)
   If ZStrLen Then Function = Left(ZStr, ZStrLen)
   Deallocate wsStr
End Function
Function Class_SQLite3.StrWtoU(wText As CWSTR) As String
    Function = wText.UTF8 
End Function
Function Class_SQLite3.StrUtoW(Utf8str As String) As CWSTR  'Utf8编码转换为WSTR字符
   Dim c As CWSTR
   c.UTF8 = Utf8str
   Return c
End Function                            
Function Class_SQLite3.strReplace(Expression As String, nFind As String, Replacewith As String) As String
   Dim As  Long  FF(),ff1,i,u,Lf,Le,Lr,Lu,t
   Dim outstr As String
   Dim As UByte Ptr pE,pF
   Dim As Any Ptr pU,pR
   Le = Len(Expression)
   Lf = Len(nFind)
   Lr = Len(Replacewith)
   If Le = 0 Or Lf = 0 Then
      Return Expression
   Else
      '先找出替换数与位置----------------------------------
      u = -1
      ReDim ff(100)
      pE = StrPtr(Expression)
      pR = StrPtr(Replacewith)
      pF = StrPtr(nFind)
      For i = 0 To Le - Lf
         If pe[i] = pf[0] Then
            If MemCmp(@pe[i], pf, lf) = 0 Then
               u += 1
               If u > UBound(ff) Then ReDim Preserve ff(u + 100)
               ff(u) = i
               i += lf -1
            End If
         End If
      Next
      If u = -1 Then
         Return Expression
      Else
         Lu = Le + (Lr - Lf) * (u + 1)  'Lu=Le - Lf * (u+1) + Lr * (u+1)
         outstr = String(Lu, 0)
         pU = StrPtr(outstr)
         t = 0
         For i = 0 To u
            Lu = FF(i) - t
            If Lu > 0 Then '复制原字符
               MemCpy(pU, pE, Lu)
               pU += Lu
            End If
            If Lr > 0 Then '复制替换字符
               MemCpy(pU, pR, Lr)
               pU += Lr
            End If
            pE += Lu + Lf
            t += Lu + Lf
         Next
         If t < le Then
            lu = le - t
            MemCpy(pU, pE, Lu)
         End If
         Return outstr
      End If
   End If
   
   
End Function







