Need help with sqlite3.dll

[Norm]

Hi,

I am trying to open and manipulate a sqlite database, containing cookie
information in FireFox browser.

I have an application that I use which removes all the cookies I don't want
to save and worked just fine until FireFox changed to a sqlite type
database. :-)

I am trying a wrapper which I can get to open the database and list all the
items contained in a listview control. But I cannot figure out how to delete
the ones I don't want.

If anyone knows of a better way to do this please let me know.

Thanks,
Norm

Code:
Option Explicit

'// SQL Lite dll declarations:

Private Declare Sub sqlite3_open Lib "SQLite3VB.dll" (ByVal FileName As
String, ByRef handle As Long)
Private Declare Sub sqlite3_close Lib "SQLite3VB.dll" (ByVal DB_Handle As
Long)
Private Declare Function sqlite3_last_insert_rowid Lib "SQLite3VB.dll"
(ByVal DB_Handle As Long) As Long
Private Declare Function sqlite3_changes Lib "SQLite3VB.dll" (ByVal
DB_Handle As Long) As Long
Private Declare Function sqlite_get_table Lib "SQLite3VB.dll" (ByVal
DB_Handle As Long, ByVal SQLString As String, ByRef ErrStr As String) As
Variant()
Private Declare Function sqlite_libversion Lib "SQLite3VB.dll" () As String
' Now returns a BSTR

'// This function returns the number of rows from the last sql statement.
Use this to ensure you have a valid array
Private Declare Function number_of_rows_from_last_call Lib "SQLite3VB.dll"
() As Long
Dim DB As Long

Private Sub Form_Load()
' Display the SQLite3VB version
Caption = "Cookies Listed In FireFox V.3 Profiles File"
StartQueary
End Sub
Private Sub StartQueary()
Dim mRetErr As String ' Will hold an error string if one is
encountered
Dim mResultCnt As Long
Dim mDBFile As String
Dim mQuery As String
Dim i As Long
mQuery = "SELECT * FROM moz_cookies" 'Text2.Text
mDBFile = App.Path & "\" & "cookies.sqlite" 'mDBFile
lvResults.ListItems.Clear
lvResults.ColumnHeaders.Clear
SB1.SimpleText = "Querying database"

mResultCnt = DBQuery(mDBFile, mQuery, mRetErr)
If mRetErr <> "" Then
MsgBox mRetErr, vbCritical, "SQLite Database Error"
End If
SB1.SimpleText = mResultCnt & " Cookies Listed In File!"
For i = 1 To lvResults.ColumnHeaders.Count
If lvResults.ColumnHeaders.Item(i).Text = "host" Or
lvResults.ColumnHeaders.Item(i).Text = "name" _
Or lvResults.ColumnHeaders.Item(i).Text = "expiry" Then
Else
lvResults.ColumnHeaders.Item(i).Width = 0
End If
Next i
DoEvents
Sleep 100
Set lvResults.SelectedItem = lvResults.ListItems.Item(1)
End Sub
Private Function DBQuery(ByVal DBFile As String, ByVal QueryStr As String,
ByRef ErrStr As String) As Long
On Error GoTo ERR_TRAP
Dim i As Long
Dim mVar As Variant ' Will hold our results
Dim mV1 As Variant ' Will be used to get each individual result
Dim mErrStr As String
Dim mStr As String
Dim mRowCnt As Long
Dim mCurColumn As String
Dim LI As ListItem
If QueryStr = "" Or DBFile = "" Then Exit Function
sqlite3_open DBFile, DB
If DB > 0 Then
mVar = sqlite_get_table(DB, QueryStr, mErrStr)
If mErrStr <> "" Then
ErrStr = mErrStr
sqlite3_close DB
Exit Function
Else
mRowCnt = number_of_rows_from_last_call
If mRowCnt > 0 Then
For Each mV1 In mVar
mStr = mV1
If i = 0 Then
mCurColumn = mStr
lvResults.ColumnHeaders.Add , mCurColumn, mCurColumn
Else
If lvResults.ColumnHeaders.Count = 1 Then
lvResults.ListItems.Add , , mStr
ElseIf lvResults.ColumnHeaders.Count > 1 Then
Set LI = lvResults.ListItems(i)
LI.SubItems(lvResults.ColumnHeaders.Count - 1) =
mStr
End If
End If
i = i + 1
If i > mRowCnt Then
i = 0
End If
Next
End If
End If
'sqlite3_close DB
End If
DBQuery = lvResults.ListItems.Count
Exit Function
ERR_TRAP:
ErrStr = Err.Description
End Function

Private Sub Form_Unload(Cancel As Integer)
Dim mDBFile As String
mDBFile = App.Path & "\" & "cookies.sqlite" 'mDBFile

sqlite3_close DB
End Sub

[Steven Cheng]

Hi Norm,

From your description, you're dealing with some VB6 program which maniplate
some SQLite database, correct?

I haven't used SQLite database much, based on my research, here are some
reference about manipulating SQLite database via VB6 code:

http://www.kirupa.com/net/sqllite_vb_pg2.htm

http://www.sqlite.org/cvstrac/wiki?p=SqliteWrappers&1057833364

Sincerely,

Steven Cheng

Microsoft MSDN Online Support Lead

Delighting our customers is our #1 priority. We welcome your comments and
suggestions about how we can improve the support we provide to you. Please
feel free to let my manager know what you think of the level of service
provided. You can send feedback directly to my manager at:
msd...@microsoft.com.

==================================================
Get notification to my posts through email? Please refer to
http://msdn.microsoft.com/en-us/subscriptions/aa948868.aspx#notifications.
==================================================
This posting is provided "AS IS" with no warranties, and confers no rights.
--------------------
>From: "Norm" <Nor...@newsgroups.nospam>
>Subject: Need help with sqlite3.dll
>Date: Mon, 6 Oct 2008 16:09:02 -0700

[Schmidt]

"Norm" <Nor...@newsgroups.nospam> schrieb im Newsbeitrag
news:eIfvFiAK...@TK2MSFTNGP05.phx.gbl...

[Listing and removing cookie-records from cookies.sqlite]

If you want to stay with the plain sqlite-api-calls, you
should also include a declare for the sqlit3_execute

Then you can call the appropriate SQL-Statements to
delete from your 'cookies.sqlite' DB-File.
e.g.
"Delete From moz_cookies Where name = 'nametodelete'"
But maybe in this table is also an ID-Column, which
would work better with the above statement (in a unique
way).
e.g.
"Delete From moz_cookies Where ID = 1234"

Not sure if you already found my VB6-Wrapper per
Web-Search...
It allows you, to work in a more objectoriented way
with SQLite (ADO-like):
www.datenhaus.de/Downloads/dhRichClientDemo.zip

Then you could fill your ListView within a Recordset-
Loop:

Dim Cnn as cConnection
Set Cnn = New cConnection
Cnn.OpenDB PathToCookieDB

Dim Rs as cRecordset
Set Rs = Cnn.OpenRecordset("SELECT * FROM moz_cookies")
'clear ListView first
Do Until Rs.EOF
'Fill ListView-Line from Record-Fields
Rs.MoveNext
Loop

If you click on a Row in your ListView, then
you can make the Rs follow this ListRow-Index
by setting:
Rs.AbsolutePosition = RowIndex + 1 'AbsPos is onebased

If you (or the user) wants to delete this current line
you can simply call:
Rs.Delete 'assumes you've set the AbsPosition before
and then also remove this line from your ListView.

You can do this multiple times if you want and
at any point in time (as soon as you want to write
these Rs-Changes back to the DB) - simply call:
Rs.UpdateBatch
maybe followed by a new calling-sequence to
read-back the actual table-content after this
update-operation:
Rs.Requery
'clear ListView first
Do Until Rs.EOF
'Fill ListView-Line from Record-Fields
Rs.MoveNext
Loop

Olaf

[Norm]

Olaf,

Thanks very much for the information and I did already find your wrapper,
matter of fact I had emailed you yesterday.

I think I can get it closer to working with your information, if I get hung
up I will post back here.

Thanks again,
Norm
"Schmidt" <s...@online.de> wrote in message
news:exayUpGK...@TK2MSFTNGP06.phx.gbl...

[Norm]

Olaf,

I have everything working for inputing the database and deleting rows not
wanted, as well as comparing the database to a listview.

Now for the new part is there a way with your wrapper to create a new
database and then enter rows and fields into it?

Thanks,
Norm

[Schmidt]

"Norm" <Nor...@newsgroups.nospam> schrieb im Newsbeitrag

news:Op2shrYK...@TK2MSFTNGP04.phx.gbl...

> Now for the new part is there a way with your wrapper
> to create a new database and then enter rows and fields
> into it?

Dim i&, Cnn as cConnection, Rs as cRecordset

Set Cnn = New cConnection

'without FileName-Param would create an InMemory-DB
Cnn.CreateNewDB "c:\test.db"

'create a simple Table with two Fields
Cnn.Execute "Create Table Test(ID Integer Primary Key, F1 Text)"

'Open the Recordset-representation of that table
Set Rs = Cnn.OpenRecordset("Select * From Test")

'no Records in there currently, so we add a few...
For i = 1 to 10
Rs.AddNew
Rs.Fields("F1").Value = "DemoText_" & i
Next i

'and now we store all new records in the DB
Rs.UpdateBatch

'test, if the data is really in the DB
Rs.Requery 'force an update of the Rs from the DB
If Rs.Recordcount = 10 Then MsgBox "it worked" ';-)

Olaf

[Norm]

Olaf,

Thanks very much for the information and this is what I have come up with to
try and make this work for me.

I have two listview boxes on a form, one is showing the cookies in the
firefox sqlite file and the other is to show the cookies you want to save
and not be removed.

I am getting an error when trying to use Rs2.UpdateBatch telling me that the
id has to be unique, even though each id is a different number, as I am
using the id's from the firefox sqlite list.

I know I am probably missing something and maybe I am too close to the
forest to see the trees. :-)

Code:

Private Sub cmdSave_Click()
Dim sMsg As VbMsgBoxResult
Dim i As Long
Dim e As Long
Dim h As Long
Dim sField As String
Dim sField2 As String
Dim intTotCount As Integer
Dim intCount1 As Integer, intCount2 As Integer
Dim colNew As ColumnHeader, NewLine As ListItem
Me.Hide
i = DBList.SelectedItem.Index

If i = 0 Then

MsgBox "You Have Not Selected Any Cookies!", vbOKOnly +
vbInformation, "SecRep Software FileClean Program"
Exit Sub
End If
sMsg = MsgBox("This Will Enter The Selected Cookies To Be Saved,
Continue?", vbYesNo + vbQuestion, "SecRep Software FileClean Program")
If sMsg = vbNo Then
Me.Show
Exit Sub
End If
'Getting list of cookies from firefox cookie file
If Not FillList(DBName, DBList2, "moz_cookies") Then
MsgBox "Error Getting Information From FireFox SqLite File!",
vbOKOnly + vbCritical, "SecRep Software FileClean Program"
Me.Show
Exit Sub
End If
DoEvents
'setting up headers for saved cookie list
For i = 1 To frmMain.DBList2.ColumnHeaders.Count
If frmMain.DBList2.ColumnHeaders.item(i) = "name" Then
frmMain.DBList2.ColumnHeaders(i).Position = 4
ElseIf frmMain.DBList2.ColumnHeaders.item(i) = "host" Then
frmMain.DBList2.ColumnHeaders(i).Position = 2
ElseIf frmMain.DBList2.ColumnHeaders.item(i) = "expiry" Then
'frmMain.DBList2.ColumnHeaders(i).Position = 4

End If
Next i
DoEvents

frmMain.DBList2.AllowColumnReorder = False
DoEvents
Set frmMain.DBList2.SelectedItem = frmMain.DBList2.ListItems.item(1)
'Remove any items that do not match the selected items in first
'DBlist box as cookies to save
Cont:
For i = DBList2.ListItems.Count To 1 Step -1
For h = DBList.ListItems.Count To 1 Step -1
If DBList2.ListItems.item(i) = DBList.ListItems.item(h) Then
If DBList.ListItems.item(h).Selected Then

Else
DBList2.ListItems.Remove i
GoTo Cont
End If
End If
Next h
Next i
DBList.Refresh
DBList2.Refresh
'Rs contains the firefox sqlite db
Rs.MoveFirst
'set new connection and Rs2 for SavedCookies db
Set Cnn2 = New cConnection
If FileExists(App.Path & "\SavedCookies.db") Then Kill App.Path &
"\SavedCookies.db"
Cnn2.CreateNewDB App.Path & "\SavedCookies.db"
Cnn2.Execute "Create Table Saved(id2 INTEGER PRIMARY KEY, name TEXT,
value TEXT, host TEXT, path TEXT,expiry INTEGER, lastAccessed INTEGER,
isSecure INTEGER, isHttpOnly INTEGER)"
Set Rs2 = Cnn2.OpenRecordset("Select * From Saved")
For i = 1 To DBList2.ListItems.Count
h = 0
Do Until Rs.EOF
sField2 = CStr(DBList2.ListItems.item(i))
sField = CStr(Rs.Fields("id"))
If InStr(1, sField2, sField, vbBinaryCompare) <> 0 Then
Rs2.AddNew
Rs2.Fields("id2").Value = sField
Rs2.AddNew
Rs2.Fields("name").Value = Rs.Fields("name")
Rs2.AddNew
Rs2.Fields("value").Value = Rs.Fields("value")
Rs2.AddNew
Rs2.Fields("host").Value = Rs.Fields("host")
Rs2.AddNew
Rs2.Fields("path").Value = Rs.Fields("path")
Rs2.AddNew
Rs2.Fields("expiry").Value = Rs.Fields("expiry")
Rs2.AddNew
Rs2.Fields("lastAccessed").Value = Rs.Fields("lastAccessed")
Rs2.AddNew
Rs2.Fields("isSecure").Value = Rs.Fields("isSecure")
Rs2.AddNew
Rs2.Fields("isHttpOnly").Value = Rs.Fields("isHttpOnly")
End If
h = h + 1
Rs.MoveNext
Loop
Rs.MoveFirst
Next i
Rs2.UpdateBatch
DoEvents
Label14.Caption = "You Have Saved " & DBList2.ListItems.Count & "
Cookies"
Me.Show

Thanks Norm

"Schmidt" <s...@online.de> wrote in message

news:Owh3f0YK...@TK2MSFTNGP04.phx.gbl...

[Norm]

Olaf,

I did get that to work by changing the id2 type from Integer to Text. Not
sure why this worked, but it did.

The next strange problem is that when I read back the new file I get the
name value all being the same, even though all the other values are
different.

Norm

[Schmidt]

"Norm" <Nor...@newsgroups.nospam> schrieb im Newsbeitrag

news:euSzJsaK...@TK2MSFTNGP04.phx.gbl...

As I see it, you shouldn't use Rs2.AddNew for every new field
you want to store in that new record-placeholder, which the
AddNew-Method creates under the hood in the Recordset.

Change it this way:

Do Until Rs.EOF
sField2 = CStr(DBList2.ListItems.item(i))
sField = CStr(Rs.Fields("id"))
If InStr(1, sField2, sField, vbBinaryCompare) <> 0 Then

Rs2.AddNew 'creates a new, empty record at the end of Rs2

'now fill in all the fields of this new record
Rs2.Fields("id2").Value = Rs.Fields("id").Value
Rs2.Fields("name").Value = Rs.Fields("name").Value
Rs2.Fields("value").Value = Rs.Fields("value").Value
Rs2.Fields("host").Value = Rs.Fields("host").Value
Rs2.Fields("path").Value = Rs.Fields("path").Value
Rs2.Fields("expiry").Value = Rs.Fields("expiry").Value
Rs2.Fields("lastAccessed").Value =
Rs.Fields("lastAccessed").Value
Rs2.Fields("isSecure").Value = Rs.Fields("isSecure").Value
Rs2.Fields("isHttpOnly").Value =
Rs.Fields("isHttpOnly").Value

End If
h = h + 1
Rs.MoveNext
Loop

No guarantee, that this is error free - maybe there are
other issues with your Loop- and Search-Code/Strategy
(e.g. your Instr-Check or other things).

Olaf

[Norm]

佬慦Ⰺ੉⁨慤⁦楧畲敤畴⁴桥⁁摤乥眠汩湥湬礠湥敤⁴漠扥⁵獥搠潮捥⁡湤⁴桥⁤慴慢慳攠੩猠扥楮朠捲敡瑥搠睩瑨⁴桥⁣潲牥捴畭扥爠潦⁥湴物敳Ⱐ扵琠睨慴⁩猠獴牡湧攠楳 瑨慴⁩渠瑨攠景汬潷楮朠捯摥⁉⁡洠捲敡瑩湧⁴桲敥⁦楥汤猠慮搠獴数灩湧⁴桲潵杨 瑨攠捯摥⁥慣栠癡汵攠景爠桯獴Ⱐ湡浥⁡湤⁥硰楲礠慲攠摩晦敲敮琠敡捨⁴業攬⁢畴 睨慴⁩猠来瑴楮朠睲楴瑥渠瑯⁴桥⁤慴慢慳攠楳⁴桡琠敡捨⁶慬略⁦潲⁨潳琠慮搠湡浥 慲攠慬氠瑨攠獡浥⁡猠瑨攠晩牳琠癡汵攬⁢畴⁥硰楲礠楳⁢敩湧⁷物瑴敮⁡猠牥慤⸊੄慴慢慳攠捯灹㨊ਚฅ”ἄ剐協䅵瑨⹬楶攮捯浿뜚ਅ”ἄ剐協䅵瑨⹬楶攮捯浿匚అ”ἄ剐協䅵瑨⹬楶攮捯浿帚ଅ ᴟђ偓呁畴栮汩癥⹣潭翦啓ᨊԠᴟђ偓呁畴栮汩癥⹣潭翦啓ᨠԠᴟђ偓呁畴栮汩癥⹣潭翦喷ᨈԠਝἄ剐協䅵瑨⹬楶攮捯浟ਚ܅”ἄ剐協䅵瑨⹬楶攮捯浿帚؅”ἄ剐協䅵瑨⹬楶攮捯浉倚ԅ ᴟђ偓呁畴栮汩癥⹣潭䥰湠ᨄԠᴟђ偓呁畴栮汩癥⹣潭翦啞ᨃԠਝἄ剐協䅵瑨⹬楶攮捯浿帚ȅ”ἄ剐協䅵瑨⹬楶攮捯浿匚ą ᴟђ偓呁畴栮汩癥⹣潭翦啞ਠ†ฟ먠Ώῶ῱Ῥῧῢ῝Ῐΐ῎Έῄ᾿Ὰਊ乯牭 �

[Norm]

Ooops, forgot to include the code I was using now.

Cnn2.CreateNewDB App.Path & "\SavedCookies.db"
Cnn2.Execute "Create Table Saved(id Text PRIMARY KEY, name TEXT, host
TEXT,expiry INTEGER)"

Set Rs2 = Cnn2.OpenRecordset("Select * From Saved")
For i = 1 To DBList2.ListItems.Count
h = 0

Do Until Rs.EOF
sField2 = DBList2.ListItems.item(i)

sField = CStr(Rs.Fields("id"))
If InStr(1, sField2, sField, vbBinaryCompare) <> 0 Then
Rs2.AddNew

Rs2.Fields("host").Value = Rs.Fields("host")

Rs2.Fields("name").Value = Rs.Fields("name")

Rs2.Fields("expiry").Value = Rs.Fields("expiry")

End If
h = h + 1
Rs.MoveNext
Loop

Rs.MoveFirst
Next i
Rs2.UpdateBatch
Me.Show

[Norm]

Olaf,

I think I have it worked out, by moving the Rs2.UpdateBatch into the loop I
now get all the items stored in the new database, with the exception of the
first one and that is left out, but the next one is added. But I assume this
is a problem with my comparing and looping. :-)

Thanks very much for all the help.

Norm

[Schmidt]

"Norm" <Nor...@newsgroups.nospam> schrieb im Newsbeitrag

news:umlBgabK...@TK2MSFTNGP04.phx.gbl...

> Cnn2.CreateNewDB App.Path & "\SavedCookies.db"
> Cnn2.Execute "Create Table Saved(id Text PRIMARY KEY,
> name TEXT, host TEXT,expiry INTEGER)"

If you want to have an AutoIncrement id-Field, then
you shouldn't define it as Text, but as Integer:

Cnn2.Execute "Create Table Saved(id INTEGER PRIMARY KEY, ...

> If InStr(1, sField2, sField, vbBinaryCompare) <> 0 Then
> Rs2.AddNew
> Rs2.Fields("host").Value = Rs.Fields("host")
> Rs2.Fields("name").Value = Rs.Fields("name")
> Rs2.Fields("expiry").Value = Rs.Fields("expiry")
> End If

Try to enhance the right side of these expression also
with the .Value-Property explicitely to avoid confusion
(although it is the Default-Property).

Regarding your other problems - try to debug
step by step through your loop (using a small
Demo-List) and look, what concrete Values
you are copying, if your field-types match, etc.

Your "brute-force-looping" inside another loop
is also not all that elegant - you can use the Findfirst-
Method for example on Rs, to find a matching ID
and to position the Record-Pointer on the appropriate
Record inside your Source-Recordset 'Rs'.

Dim idToFind as String

For i = 1 To DBList2.ListItems.Count

idToFind = ParseOutIdFromListViewLineOrWhereEver

If Rs.FindFirst("id = " & idToFind) Then 'we have a match
'the Rs is automatically moved to the matching record

'now copy over
Rs2.AddNew
Rs2.Fields("id").Value = Rs.Fields("id").Value
Rs2.Fields("host").Value = Rs.Fields("host").Value
'etc...
End If

Next i
Rs2.UpdateBatch

Olaf

[Norm]

Olaf,

Thanks for the information, I will try searching that way. It does seem a
lot simpler. :-)

Norm
"Schmidt" <s...@online.de> wrote in message

news:uPOvJNcK...@TK2MSFTNGP03.phx.gbl...

[Schmidt]

"Norm" <Nor...@newsgroups.spoof> schrieb im Newsbeitrag
news:OWn6pbjK...@TK2MSFTNGP03.phx.gbl...

> Thanks for the information, I will try searching that way.
> It does seem a lot simpler. :-)

Yep, and if name your columns exactly like in the
original-table, then you can also shorten your Field-
copying in a For Each Loop this way:

Dim Fld as cField
'now add a new record and copy fields over
Rs2.AddNew
For Each Fld in Rs2.Fields
Fld.Value = Rs.Fields(Fld.Name).Value
Next Fld

Olaf

[Norm]

Olaf,

Thanks very much for all the information and time. I have it working now and
your way is quite a bit simpler.

Norm