' libsqlv14 - Richard Peeters - jan 2003
' sqlite API calls from Colin McMurchie

[Initprog]
    ForegroundColor$ = "Black"
    BackgroundColor$ = "buttonface"
    TexteditorColor$ = "lightgray"
    dsteps           = 0
    Dim steps$(20)          'array to hold entry
    crlf$=Chr$(13)+Chr$(10) 'carriage return/line feed
    NoMainWin
    WindowWidth = DisplayWidth : WindowHeight = DisplayHeight
    UpperLeftX =0
    UpperLeftY =0

[ControlSup]
Menu        #1, "&File", "&Open sql", [open], "&Save sql", [save],_
                "E&xit", [quit]
Menu        #1, "Database","&New", [newdb], "&Open database", [opendb],"&Close database",_
                 [closedb]
Menu        #1, "Edit"
Menu        #1, "&Run", "R&un",[runit]
Menu        #1, "&Help", "&Instructions", [help],_
                 "&About",[about]

Button      #1.run, "Execute",[runit],UL,WindowWidth/2-60,105,100,24

Texteditor  #1.t, 1,1,WindowWidth-7,150    'entry
Texteditor  #1.g, 1,160,WindowWidth-7,WindowHeight-230 'result

Open "LibSQL  v1.4  -  Richard Peeters - 2003" For Window_nf As #1
    #1 "trapclose [quit]"
    #1.t "!font courier_new 10"
    #1.g "!font courier_new 9"
    Print #1.t, "!setfocus"
    GoSub [init]

[loop]
    Wait
'---------------------------------------------------------------------
[quit]
     If chdllopen=1 Then
         CallDLL #sql, "sqlite_close", dbhook As ulong, result As void
         Close #sql
     End If
     Close #1
     End
'---------------------------------------------------------------------
[open]  'extension is sql
    FileDialog "Open","*.sql",file$
    If file$="" Then Wait 'user cancelled
    Open file$ For Input As #f
    #1.t "!contents #f"
    Close #f
    Wait
'---------------------------------------------------------------------
[save]  'extension is sql
    FileDialog "Save As","*.sql",file$
    If file$="" Then Wait   'user cancelled
    #1.t "!contents? saveit$";
    Open file$ For Output As #f
    Print #f, saveit$
    Close #f
    Notice "File saved as ";file$
    Wait
'---------------------------------------------------------------------
[opendb]  'extension is dbs
If chdllopen=1 Then
    Print #1.g,"there is already a database open"
    Wait
End If
FileDialog "Open","*.dbs",file$
If file$="" Then Wait 'user cancelled
chdllopen=1
Open "sqlite.dll", For DLL As #sql
CallDLL #sql, "sqlite_open", file$ As ptr, 0 As long, _
e As struct, dbhook As ulong
If dbhook>0 Then
    Print #1.g," succesfully opened"
Else
    Print #1.g," NOT opened - error"
End If
Wait
'----------------------------------------------------------------------
[closedb]
If chdllopen=1 Then
        CallDLL #sql, "sqlite_close", dbhook As ulong, result As void
        Close #sql
        Print #1.g,"database closed"
        chdllopen=0
End If
Wait
'----------------------------------------------------------------------
[newdb]
If chdllopen=1 Then
    Print #1.g,"there is already a database open"
    Wait
End If
Prompt"database name (no extension)?";file$:file$=file$+".dbs"
chdllopen=1
Open "sqlite.dll", For DLL As #sql
CallDLL #sql, "sqlite_open", file$ As ptr, 0 As long, _
e As struct, dbhook As ulong
If dbhook>0 Then
    Print #1.g," succesfully opened"
Else
    Print #1.g," NOT opened - error"
End If
Wait
'----------------------------------------------------------------------
[runit] 'read and parse sql
    Print #1.g, "!cls"
    #1.t "!lines dsteps"    'get number of lines in texteditor
    ReDim steps$(dsteps)    'redim array to number of lines
    'fill array with commands
    For i = 1 to dsteps
        #1.t "!line ";i;" txt$"
        steps$(i)=txt$
    Next
    query$ = Parse$(dsteps)
    If Upper$(Word$(query$,1))=".INSERT" Then GoSub [inserting]:GoSub [callsq]:Wait
    If Left$(query$,1)="." Then
         GoSub [dotcomm]
         Wait
         End If
    For i=1 to nrstat
        If Upper$(Word$(query$,1))= validq$(i)Then
            valid=1:GoSub [callsq]:Exit For
        End If
    Next
    If valid <>1 Then
         Print #1.g,"instruction not recognized":Beep
    Else
        valid=0
    End If
    Wait
'---------------------------------------------------------------------
[help]
    msg$="LibSQL Instructions" + crlf$ 
    msg$=msg$ + "create table = creates a new table" + crlf$
    msg$=msg$ + "create index = creates an index" + crlf$
    msg$=msg$ + "drop table = removes a table" + crlf$
    msg$=msg$ + "drop index = removes an index" + crlf$
    msg$=msg$ + "delete (from) = deletes records" + crlf$
    msg$=msg$ + "insert into = inserts records" + crlf$
    msg$=msg$ + ".insert into = easier way to insert records" + crlf$
    msg$=msg$ + "update = make changes to a record" + crlf$
    msg$=msg$ + "select = SQL query statement" + crlf$
    msg$=msg$ + ".mode = determines what to do with result of 'select'" + crlf$
    Notice msg$
    Wait
'---------------------------------------------------------------------
[about]
    Notice "LibSQL v1.4 - R.Peeters, 2003."
    Wait
'---------------------------------------------------------------------
[init]
'maxrecords = 1000
maxfields = 100
howlistit=1
Dim fields$(maxfields)
Dim query$(20)
Dim validq$(20)


struct np, _
nullpointer As ptr
np.nullpointer.struct = "this is a null pointer"
 struct d, _
  tableresult As ptr
  d.tableresult.struct = Space$(200000)
struct nr, _
numrow As long
struct nc, _
numcol As long
nr.numrow.struct = 0
nc.numcol.struct = 0
struct e, _
error As long
nrstat=8
Data CREATE,DELETE,DROP,INSERT,"SELECT",UPDATE, PRAGMA,COPY
For i=1 to nrstat
    Read xx$
    validq$(i)=xx$
Next i
Return
'---------------------------------------------------------------------
[callsq]
If chdllopen=0 Then
    Print #1.g,"no database active"
    Return
End If
CallDLL #sql, "sqlite_get_table", dbhook As ulong, query$ As ptr, _
 d As struct, nr As struct, nc As struct, e As struct, result As long

If e.error.struct >0 Then
    Print #1.g,"error in sql statement"
    Return
End If

PointersReturned = (nc.numcol.struct * nr.numrow.struct + nc.numcol.struct)

If nr.numrow.struct <> 0 Then

    BaseAddressStart = d.tableresult.struct
    BaseAddress = BaseAddressStart
    For x = 0 to nr.numrow.struct
        For z = 1 to nc.numcol.struct
            fields$(z) = winstring(PointerPeek(BaseAddress ))
            BaseAddress = BaseAddress + 4
        Next z
    GoSub [listit]
    Next x
    CallDLL #sql, "sqlite_free_table", BaseAddressStart As long , result As void
Else
    If Upper$(Left$(query$,6))="INSERT" Then
        Print #1.g,"record added":Return
    End If
    If Upper$(Left$(query$,6))="DELETE" Then
        Print #1.g,"record(s) deleted":Return
    End If
    If Upper$(Left$(query$,6))="CREATE" Then
        Print #1.g,"created":Return
    End If
    If Upper$(Left$(query$,4))="DROP" Then
        Print #1.g,"dropped":Return
    End If
    If Upper$(Left$(query$,6))="UPDATE" Then
        Print #1.g,"record updated":Return
    End If

    Print #1.g,"this Call returns no table":Beep
End If
Return
'---------------------------------------------------------------------
[dotcomm]
    If Upper$(Word$(query$,2))="LIST" Then howlistit=1:Print #1.g,"mode adapted"
    If Upper$(Word$(query$,2))="LINE" Then howlistit=2:Print #1.g,"mode adapted"
    If Upper$(Word$(query$,2))="COL" Then howlistit=3:Print #1.g,"mode adapted"
    If Upper$(Word$(query$,2))="PRINT" Then howlistit=4:Print #1.g,"mode adapted"
    If Upper$(Word$(query$,2))="FILE" Then
        howlistit=5
        Print #1.g,"mode adapted"
        Prompt"filename?";filename$:filename$=filename$+".txt"
    End If
Return
'---------------------------------------------------------------------
[listit]
Select Case howlistit
Case 1  'list
        line$=""
        For z = 1 to nc.numcol.struct
            ins$=" | "+fields$(z)
            line$=line$+ins$ 
        Next z
        Print #1.g,line$ 
        If x=0 Then Print #1.g,string$("-",Len(line$)+5)

Case 2    'line
        For z = 1 to nc.numcol.struct
            Print #1.g,fields$(z)
        Next z
        Print #1.g," "

Case 3    ' col
        line$=Space$(2000)
        For z = 1 to nc.numcol.struct
            ins$="| "+Left$(fields$(z),15)
            line$=Replace$(line$,ins$,(z-1)*15)
        Next z
        Print #1.g,Trim$(line$)
        If x=0 Then Print #1.g,string$("-",(z-1)*15)

Case 4     'print

        line$=Space$(2000)
        For z = 1 to nc.numcol.struct
            ins$="| "+Left$(fields$(z),15)
            line$=Replace$(line$,ins$,(z-1)*15)
        Next z
        LPrint Trim$(line$)
        If x=0 Then LPrint string$("-",(z-1)*15)
        Dump

Case 5  'file
   Open filename$ For Append As #rm
        If x>0 Then
            line$=""
            For z = 1 to nc.numcol.struct
                ins$=fields$(z)+","
                If ins$="," Then ins$="NULL,"
                line$=line$+ins$ 
            Next z
            line$=Left$(line$,Len(line$)-1)
            Print #1.g,line$ 
            Print #rm, line$
         End If
    Close #rm
End Select
Return
'---------------------------------------------------------------------
[inserting]
query$=""
query$=Mid$(steps$(1),2)+ " values ( "
For i = 2 to dsteps
    If Trim$(steps$(i)) <> "" Then
        If Trim$(Upper$(steps$(i)))="NULL" Then
            query$=query$+" "+Trim$(steps$(i))+","
        Else
            query$=query$+"'"+Trim$(steps$(i))+"',"
        End If
    End If
Next
query$=Left$(query$,Len(query$)-1) +" ) "
'Print #1.g,query$   ' to check
Return
'---------------------------------------------------------------------
Function PointerPeek( aNumber )     ' get memory address of the first byte of a four byte pointer
 add1 = PseudoPeek( aNumber )        ' find its value and assign it to add1
 aNumber = aNumber + 1            ' move on to second byte
add2 = PseudoPeek( aNumber )        ' etc
 aNumber = aNumber + 1
add3 = PseudoPeek( aNumber )
 aNumber = aNumber + 1
 add4 = PseudoPeek( aNumber )        ' get value of last byte
                     ' then calculate the address pointed at
 addressval = add1 + add2*256 + add3*256*256 + add4*256*256*256
 If addressval = 0 Then
 addressval = np.nullpointer.struct
 End If
 PointerPeek = addressval        ' return this address to calling routine
End Function
'---------------------------------------------------------------------
Function PseudoPeek( aNumber )    ' gets the value of a single byte of memory
                      ' by treating it as the start of a string
  If Len(winstring(aNumber)) = 0 Then   ' if the string stored here is of zero length
  PseudoPeek = 0            ' the first byte itself must be zero
  Else
  PseudoPeek = Asc(winstring(aNumber))  ' else use asc() to obtain the byte's value
  End If
End Function
'----------------------------------------------------------------------
Function Parse$(num) 'parse commands, and debug!
        For i = 1 to num
        s$=Trim$(steps$(i))            'entire command line
        res$=res$+s$+" "
    Next
    Parse$=res$
End Function
'----------------------------------------------------------------------
Function filext(fname$)
filext=0
End Function
'----------------------------------------------------------------------
Function Replace$(string$,insert$,start)
'Replaces second string into first string at position *start*
    Replace$=Left$(string$,start-1)+insert$+Mid$(string$,start+Len(insert$))
End Function
'----------------------------------------------------------------------
Function string$(char$,total)
    For i=1 to total:string$=string$+char$:Next i
End Function
'----------------------------------------------------------------------