code_junkie

SQLite UDF - VBA Callback

Nov 10th, 2011
180
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 1.63 KB | None | 0 0
  1. 'Create Function
  2. Public Declare Function sqlite3_create_function Lib "SQLiteVB.dll" (ByVal db As Long, ByVal zFunctionName As String, ByVal nArg As Long, ByVal eTextRep As Long, ByVal pApp As Long, ByVal xFunc As Long, ByVal xStep As Long, ByVal xFinal As Long) As Long
  3.  
  4. 'Gets a value
  5. Public Declare Function sqlite3_value_type Lib "SQLiteVB.dll" (ByVal arg As Long) As SQLiteDataTypes 'Gets the type
  6. Public Declare Function sqlite3_value_text_bstr Lib "SQLiteVB.dll" (ByVal arg As Long) As String 'Gets as String
  7. Public Declare Function sqlite3_value_int Lib "SQLiteVB.dll" (ByVal arg As Long) As Long 'Gets as Long
  8.  
  9. 'Sets the Function Result
  10. Public Declare Sub sqlite3_result_int Lib "SQLiteVB.dll" (ByVal context As Long, ByVal value As Long)
  11. Public Declare Sub sqlite3_result_error_code Lib "SQLiteVB.dll" (ByVal context As Long, ByVal value As Long)
  12.  
  13. Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, source As Any, ByVal bytes As Long)
  14.  
  15. Public Property Get ArgValue(ByVal argv As Long, ByVal index As Long) As Long
  16. CopyMemory ArgValue, ByVal (argv + index * 4), 4
  17. End Property
  18.  
  19. Public Sub FirstCharCallback(ByVal context As Long, ByVal argc As Long, ByVal argv As Long)
  20. Dim arg1 As String
  21. If argc >= 1 Then
  22. arg1 = sqlite3_value_text_bstr(ArgValue(argv, 0))
  23. sqlite3_result_int context, AscW(arg1)
  24. Else
  25. sqlite3_result_error_code context, 666
  26. End If
  27. End Sub
  28.  
  29. Public Sub RegisterFirstChar(ByVal db As Long)
  30. sqlite3_create_function db, "FirstChar", 1, 0, 0, AddressOf FirstCharCallback, 0, 0
  31. 'Example query: SELECT FirstChar(field) FROM Table
  32. End Sub
Add Comment
Please, Sign In to add comment