KGF_dll - nouvelles versions

dim res%, s$
dll_on "KGF.dll"
s$ = string$(255," ")
res% = dll_call1("WhoLaunchedMe",adr(s$))
message s$
end

' test_SQLite3.bas

label init, open, close, reset, exit
label sample1
label start, exec, commit, rollback, fill, fillgrid, tables, columns
label clickgrid, maj

dim res%, base$, SQL%, xNbrRecords%, x%, sOtherID$, sName$, sNumber$
dim p%, sNotes$, sSQL$, RowCount%, TestTable$, i%, j%, s$, y%, id$, champ$
  TestTable$ = "TestTable"

full_space 0 : on_close 0,exit

main_menu 1
  sub_menu 11 : parent 11,1 : caption 11,"File"
    sub_menu 111 : parent 111,11 : caption 111,"Initialize SQLite3" : on_click 111,init
    sub_menu 112 : parent 112,11 : caption 112,"Open SQLite3" : on_click 112,open
    sub_menu 113 : parent 113,11 : caption 113,"Close SQLite3" : on_click 113,close
    sub_menu 114 : parent 114,11 : caption 114,"Reset SQLite3" : on_click 114,reset
    sub_menu 115 : parent 115,11 : caption 115,"-"
    sub_menu 116 : parent 116,11 : caption 116,"Exit" : on_click 116,exit
  sub_menu 12 : parent 12,1 : caption 12,"Sample scripts SQL"
    sub_menu 121 : parent 121,12 : caption 121,"Create sample table" : on_click 121,sample1
  sub_menu 13 : parent 13,1 : caption 13,"Execute scripts SQL"
    sub_menu 131 : parent 131,13 : caption 131,"Start transaction" : on_click 131,start
    sub_menu 132 : parent 132,13 : caption 132,"Execute script from memo" : on_click 132,exec
    sub_menu 133 : parent 133,13 : caption 133,"Commit transaction" : on_click 133,commit
    sub_menu 134 : parent 134,13 : caption 134,"Rollback transaction" : on_click 134,rollback
    sub_menu 135 : parent 135,13 : caption 135,"-"
    sub_menu 136 : parent 136,13 : caption 136,"Fill data base" : on_click 136,fill
    sub_menu 137 : parent 137,13 : caption 137,"Fill grid from data base" : on_click 137,fillgrid
    sub_menu 138 : parent 138,13 : caption 138,"Get table names in data base" : on_click 138,tables
    sub_menu 139 : parent 139,13 : caption 139,"Get column names in table 'Critère'" : on_click 139,columns
   

alpha 1000 : top 1000,10 : left 1000,10 : caption 1000,"Réponse de SQLite3:"
memo 1001 : top 1001,30 : left 1001,10 : width 1001,500 : height 1001,300 : bar_both 1001

alpha 1010 : top 1010,350 : left 1010,10 : caption 1010,"Script SQL:"
memo 1011 : top 1011,370 : left 1011,10 : width 1011,500 : height 1011,300 : bar_both 1011

progress_bar 1020 : top 1020,680 : left 1020,10 : width 1020,500

alpha 1030 : top 1030,10 : left 1030,540 : caption 1030,"Critère:"
edit 1031 : top 1031,10 : left 1031,600 : width 1031,300
  text 1031,"A%"
alpha 1032 : top 1032,40 : left 1032,540 : caption 1032,"Paramètre:"
edit 1033 : top 1033,40 : left 1033,600 : width 1033,300
  text 1033,"ORDER BY OtherID ASC"
grid 1034 : top 1034,70 : left 1034,540 : width 1034,500 : height 1034,300
  grid_column 1034,5 : grid_row 1034,500 : grid_column_fixed 1034,0
  grid_one_column_width 1034,1,40
  grid_one_column_width 1034,2,60
  grid_one_column_width 1034,3,80
  grid_one_column_width 1034,4,100
  grid_one_column_width 1034,5,200
  grid_write 1034,1,1,"ID"
  grid_write 1034,1,2,"OtherID"
  grid_write 1034,1,3,"Name"
  grid_write 1034,1,4,"Number"
  grid_write 1034,1,5,"Notes"
  on_click 1034,clickgrid
alpha 1035 : top 1035,390 : left 1035,540 : caption 1035,"Ligne:"
alpha 1036 : top 1036,390 : left 1036,570
alpha 1037 : top 1037,390 : left 1037,600 : caption 1037,"Colonne:"
alpha 1038 : top 1038,390 : left 1038,640
alpha 1039 : top 1039,390 : left 1039,680 : caption 1039,"Valeur:"
edit 1040 : top 1040,390 : left 1040,720 : width 1040,200
button 1041 : top 1041,390 : left 1041,950 : caption 1041,"Mise à jour" : on_click 1041,maj

dll_on "KGF.dll"

end

init:
  res% = dll_call0("InitializeSQLite3")
  item_add 1001,"init "+str$(res%)
  res% = dll_call1("GetSQLite3Version",handle(1011))
  item_add 1001,"  version "+str$(res%)
  return

open:
  base$ = "MonTestSQLite2.db"
  SQL% = dll_call2("OpenSQLite3",adr(base$),handle(1001))
  item_add 1001,"open "+str$(SQL%)
 
  ' récupérer le nombre de lignes de la réponse
  RowCount% = dll_call2("GetSQLite3RowCount",SQL%,adr(TestTable$))
  item_add 1001,"  "+str$(rowcount%)+" Lignes dans table "+TestTable$
  return

close:
  SQL% = dll_call1("CloseSQLite3",SQL%)
  item_add 1001,"close "+str$(SQL%)
  return
 
reset:
  res% = dll_call0("ResetSQLite3")
  clear 1001
  item_add 1001,"reset "+str$(res%)
  return
 
exit:
  SQL% = dll_call1("CloseSQLite3",SQL%)
  res% = dll_call0("ResetSQLite3")
  terminate
 
 
 
sample1:          : ' création d'une table de démo
  clear 1011
  item_add 1011,"CREATE TABLE "+TestTable$+" ([ID] INTEGER PRIMARY KEY,[OtherID] INTEGER NULL,"
  item_add 1011,"[Name] VARCHAR (255),[Number] FLOAT, [notes] BLOB);" 
  return 
 
 
 
start:
  res% = dll_call1("StartSQLite3Transaction",SQL%)
  item_add 1001,"start transaction "+str$(res%)
  return
 
exec:
  res% = dll_call2("ExecuteSQLite3Script",SQL%,handle(1011))
  item_add 1001,"Script execution "+str$(res%)
  return
 
commit:
  res% = dll_call1("CommitSQLite3Transaction",SQL%)
  item_add 1001,"commit transaction "+str$(res%)
  return
 
rollback:
  res% = dll_call1("RollbackSQLite3Transaction",SQL%)
  item_add 1001,"irollbacknvalidate transaction "+str$(res%)
  return
 
fill:
  if SQL%=0
    message "No database open"
    return
  end_if
  xNbrRecords% = 10 : ' 500
  min 1020,0 : max 1020,xNbrRecords%
  clear 1011
  for x%=1 to xNbrRecords%
    Position 1020,x% 
    ' construire la requête SQL
    sOtherID$ = str$(int(1 + Rnd(9)))
    sName$ = chr$(int(65+rnd(26)))+str$(x%)
    sNumber$ = rnd(1)
    p% = instr(sNumber$,",")
    if p%>0 then sNumber$ = left$(sNumber$,p%-1)+"."+mid$(sNumber$,p%+1,len(sNumber$))
    sNotes$ = "Possibilité de stocker des données BLOB"
    sSQL$ = "INSERT INTO "+TestTable$+"(Name,OtherID,Number,Notes) VALUES (²"+sName$+"²,"+sOtherID$+","+sNumber$+",²"+sNotes$+"²);"
    item_add 1011,sSQL$
    ' exécuter la requête SQL
    res% = dll_call2("ExecuteSQLite3Script",SQL%,adr(sSQL$))
    if res%<0
      item_add 1011,"Erreur dans requête SQL"
      return
    end_if     
  next x%
  item_add 1011,"Database filled with "+str$(xNbrRecords%)+" records"
  Position 1020,0
  return

fillgrid:
  if SQL%=0
    message "No database open"
    return
  end_if
  ' récupérer le nombre de lignes de la réponse
  RowCount% = dll_call2("GetSQLite3RowCount",SQL%,adr(TestTable$))
  if RowCount%<1
    item_add 1011,"Table "+TestTable$+"manquante ou vide"
    return
  end_if
  grid_row 1034,RowCount%+1
 
  ' charger la table dans le gridRequête SQL
  sSQL$ =        "SELECT * "
  sSQL$ = sSQL$ + "FROM "+testTable$
  sSQL$ = sSQL$ + " WHERE (("+testTable$+".Name)"
  sSQL$ = sSQL$ + " Like ²"+text$(1031)+"²)"
  if text$(1033)<>""
    sSQL$ = sSQL$ + " "+text$(1033)+";"
  else
    sSQL$ = sSQL$ + ";"
  end_if

  ' préparation de la requête: sélection des enregistrements de la table selon les critères
  res% = dll_call2("CompileSQLite3Script",SQL%,adr(sSQL$))

  ' Vider grid
  for i%=2 to RowCount%+1
    for j%=1 to grid_column(1034)
      grid_write 1034,i%,j%,""
    next j%
  next i%
 
  ' boucle d'affichage du résultat
  min 1020,0 : max 1020,5 : position 1020,0
  for i%=1 to RowCount%
    position 1020,i%
    ' Remplissage grid par lecture de chacun des colonnes de chacun des enregistrements
    res% = dll_call1("GetSQLite3NextRow",SQL%)
    if res%<0 then exit_for
    for j%=1 to 5                                     
      res% = dll_call2("GetSQLite3CellText",SQL%,j%)
      grid_write 1034,i%+1,j%,text$(1001)    : ' Ecriture dans la cellule correspondante   
    next j%
  next i%
  res% = dll_call1("FinalizeSQLite3Request",SQL%)   
  return

tables:
  if SQL%=0
    message "No database open"
    return
  end_if
  res% = dll_call1("GetSQLite3TableNames",SQL%)
  item_add 1001,str$(res%)+" tables"
  return
 
columns:
  if SQL%=0
    message "No database open"
    return
  end_if
  s$ = trim$(text$(1031))
  if s$="" then s$ = TestTable$
  res% = dll_call2("GetSQLite3ColumnNames",SQL%,adr(s$))
  item_add 1001,str$(res%)+" colonnes dans table "+s$
  return

clickgrid:
  x% = mouse_x_left_down(1034)
  y% = mouse_y_left_down(1034)
  x% = grid_x_to_column(1034,x%)
  y% = grid_y_to_row(1034,y%) - 1
  s$ = grid_read$(1034,y%+1,x%)
  caption 1036,str$(y%)
  caption 1038,str$(x%)
  text 1040,s$
  id$ = grid_read$(1034,y%+1,1)
  champ$ = grid_read$(1034,1,x%)
  return

maj:
  if x%<2
    message "colonne interdite"
    return
  end_if
  s$ = trim$(text$(1040))
  sSQL$ = "UPDATE TestTable SET "+champ$+" = ²"+s$+"² WHERE ID= ²"+id$+"² ;"
  clear 1011
  item_add 1011,sSQL$
  res% = dll_call2("ExecuteSQLite3Script",SQL%,handle(1011))
  item_add 1001,"UPDATE execution "+str$(res%)
  gosub fillgrid
  item_add 1001,"FILLGRID execution "+str$(res%)
  return

' test_SQLite3.bas

label init, open, close, reset, exit
label sample1, sample2, sample3, sample4
label start, exec, commit, rollback, fill, fillgrid, tables, columns
label clickgrid, maj

dim res%, base$, SQL%, xNbrRecords%, x%, sOtherID$, sName$, sNumber$
dim p%, sNotes$, sSQL$, RowCount%, TestTable$, i%, j%, s$, y%, id$, champ$
  TestTable$ = "TestTable"

full_space 0 : on_close 0,exit

main_menu 1
  sub_menu 11 : parent 11,1 : caption 11,"File"
    sub_menu 111 : parent 111,11 : caption 111,"Initialize SQLite3" : on_click 111,init
    sub_menu 112 : parent 112,11 : caption 112,"Open SQLite3" : on_click 112,open
    sub_menu 113 : parent 113,11 : caption 113,"Close SQLite3" : on_click 113,close
    sub_menu 114 : parent 114,11 : caption 114,"Reset SQLite3" : on_click 114,reset
    sub_menu 115 : parent 115,11 : caption 115,"-"
    sub_menu 116 : parent 116,11 : caption 116,"Exit" : on_click 116,exit
  sub_menu 12 : parent 12,1 : caption 12,"Sample scripts SQL"
    sub_menu 121 : parent 121,12 : caption 121,"Create sample table" : on_click 121,sample1
    sub_menu 122 : parent 122,12 : caption 122,"Delete sample table" : on_click 122,sample2
    sub_menu 123 : parent 123,12 : caption 123,"Delete records with selection" : on_click 123,sample3
    sub_menu 124 : parent 124,12 : caption 124,"Empty sample table" : on_click 124,sample4
  sub_menu 13 : parent 13,1 : caption 13,"Execute scripts SQL"
    sub_menu 131 : parent 131,13 : caption 131,"Start transaction" : on_click 131,start
    sub_menu 132 : parent 132,13 : caption 132,"Execute script from memo" : on_click 132,exec
    sub_menu 133 : parent 133,13 : caption 133,"Commit transaction" : on_click 133,commit
    sub_menu 134 : parent 134,13 : caption 134,"Rollback transaction" : on_click 134,rollback
    sub_menu 135 : parent 135,13 : caption 135,"-"
    sub_menu 136 : parent 136,13 : caption 136,"Fill data base" : on_click 136,fill
    sub_menu 137 : parent 137,13 : caption 137,"Fill grid from data base" : on_click 137,fillgrid
    sub_menu 138 : parent 138,13 : caption 138,"Get table names in data base" : on_click 138,tables
    sub_menu 139 : parent 139,13 : caption 139,"Get column names in table 'Critère'" : on_click 139,columns
   

alpha 1000 : top 1000,10 : left 1000,10 : caption 1000,"Réponse de SQLite3:"
memo 1001 : top 1001,30 : left 1001,10 : width 1001,500 : height 1001,300 : bar_both 1001

alpha 1010 : top 1010,350 : left 1010,10 : caption 1010,"Script SQL:"
memo 1011 : top 1011,370 : left 1011,10 : width 1011,500 : height 1011,300 : bar_both 1011

progress_bar 1020 : top 1020,680 : left 1020,10 : width 1020,500

alpha 1030 : top 1030,10 : left 1030,540 : caption 1030,"Critère:"
edit 1031 : top 1031,10 : left 1031,600 : width 1031,300
  text 1031,"A%"
alpha 1032 : top 1032,40 : left 1032,540 : caption 1032,"Paramètre:"
edit 1033 : top 1033,40 : left 1033,600 : width 1033,300
  text 1033,"ORDER BY OtherID ASC"
grid 1034 : top 1034,70 : left 1034,540 : width 1034,500 : height 1034,300
  grid_column 1034,5 : grid_row 1034,500 : grid_column_fixed 1034,0
  grid_one_column_width 1034,1,40
  grid_one_column_width 1034,2,60
  grid_one_column_width 1034,3,80
  grid_one_column_width 1034,4,100
  grid_one_column_width 1034,5,200
  grid_write 1034,1,1,"ID"
  grid_write 1034,1,2,"OtherID"
  grid_write 1034,1,3,"Name"
  grid_write 1034,1,4,"Number"
  grid_write 1034,1,5,"Notes"
  on_click 1034,clickgrid
alpha 1035 : top 1035,390 : left 1035,540 : caption 1035,"Ligne:"
alpha 1036 : top 1036,390 : left 1036,570
alpha 1037 : top 1037,390 : left 1037,600 : caption 1037,"Colonne:"
alpha 1038 : top 1038,390 : left 1038,640
alpha 1039 : top 1039,390 : left 1039,680 : caption 1039,"Valeur:"
edit 1040 : top 1040,390 : left 1040,720 : width 1040,200
button 1041 : top 1041,390 : left 1041,950 : caption 1041,"Mise à jour" : on_click 1041,maj

dll_on "KGF.dll"

end

sub ClearGrid()
dim_local r11%,c1%
  grid_row 1034,1
end_sub

init:
  res% = dll_call0("InitializeSQLite3")
  item_add 1001,"init "+str$(res%)
  res% = dll_call1("GetSQLite3Version",handle(1011))
  item_add 1001,"  version "+str$(res%)
  return

open:
  base$ = "MonTestSQLite2.db"
  SQL% = dll_call2("OpenSQLite3",adr(base$),handle(1001))
  item_add 1001,"open "+str$(SQL%)
 
  ' récupérer le nombre de lignes de la réponse
  RowCount% = dll_call2("GetSQLite3RowCount",SQL%,adr(TestTable$))
  item_add 1001,"  "+str$(rowcount%)+" Lignes dans table "+TestTable$
  return

close:
  SQL% = dll_call1("CloseSQLite3",SQL%)
  item_add 1001,"close "+str$(SQL%)
  return
 
reset:
  res% = dll_call0("ResetSQLite3")
  clear 1001
  item_add 1001,"reset "+str$(res%)
  return
 
exit:
  SQL% = dll_call1("CloseSQLite3",SQL%)
  res% = dll_call0("ResetSQLite3")
  terminate
 
 
 
sample1:          : ' création d'une table de démo
  clear 1011
  item_add 1011,"CREATE TABLE "+TestTable$+" ([ID] INTEGER PRIMARY KEY,[OtherID] INTEGER NULL,"
  item_add 1011,"[Name] VARCHAR (255),[Number] FLOAT, [notes] BLOB);" 
  return 
 
sample2:          : ' supprimer une table de démo
  clear 1011
  item_add 1011,"DROP TABLE ²"+TestTable$+"²"
  return 
 
sample3:          : ' supprimer des enregistrements avec sélection
  clear 1011
  item_add 1011,"DELETE FROM ²"+TestTable$+"² WHERE "+text$(1031)
  return 
 
sample4:          : ' vider une table de démo
  clear 1011
  item_add 1011,"DELETE FROM ²"+TestTable$+"²"
  return 
 
 
 
start:
  res% = dll_call1("StartSQLite3Transaction",SQL%)
  item_add 1001,"start transaction "+str$(res%)
  return
 
exec:
  res% = dll_call2("ExecuteSQLite3Script",SQL%,handle(1011))
  item_add 1001,"Script execution "+str$(res%)
  clearGrid()
  return
 
commit:
  res% = dll_call1("CommitSQLite3Transaction",SQL%)
  item_add 1001,"commit transaction "+str$(res%)
  return
 
rollback:
  res% = dll_call1("RollbackSQLite3Transaction",SQL%)
  item_add 1001,"irollbacknvalidate transaction "+str$(res%)
  return
 
fill:
  if SQL%=0
    message "No database open"
    return
  end_if
  xNbrRecords% = 10 : ' 500
  min 1020,0 : max 1020,xNbrRecords%
  clear 1011
  for x%=1 to xNbrRecords%
    Position 1020,x% 
    ' construire la requête SQL
    sOtherID$ = str$(int(1 + Rnd(9)))
    sName$ = chr$(int(65+rnd(26)))+str$(x%)
    sNumber$ = rnd(1)
    p% = instr(sNumber$,",")
    if p%>0 then sNumber$ = left$(sNumber$,p%-1)+"."+mid$(sNumber$,p%+1,len(sNumber$))
    sNotes$ = "Possibilité de stocker des données BLOB"
    sSQL$ = "INSERT INTO "+TestTable$+"(Name,OtherID,Number,Notes) VALUES (²"+sName$+"²,"+sOtherID$+","+sNumber$+",²"+sNotes$+"²);"
    item_add 1011,sSQL$
    ' exécuter la requête SQL
    res% = dll_call2("ExecuteSQLite3Script",SQL%,adr(sSQL$))
    if res%<0
      item_add 1011,"Erreur dans requête SQL"
      return
    end_if     
  next x%
  item_add 1011,"Database filled with "+str$(xNbrRecords%)+" records"
  Position 1020,0
  return

fillgrid:
  if SQL%=0
    message "No database open"
    return
  end_if
  ' récupérer le nombre de lignes de la réponse
  RowCount% = dll_call2("GetSQLite3RowCount",SQL%,adr(TestTable$))
  if RowCount%<1
    item_add 1011,"Table "+TestTable$+"manquante ou vide"
    return
  end_if
  grid_row 1034,RowCount%+1
 
  ' charger la table dans le gridRequête SQL
  sSQL$ =        "SELECT * "
  sSQL$ = sSQL$ + "FROM "+testTable$
  sSQL$ = sSQL$ + " WHERE (("+testTable$+".Name)"
  sSQL$ = sSQL$ + " Like ²"+text$(1031)+"²)"
  if text$(1033)<>""
    sSQL$ = sSQL$ + " "+text$(1033)+";"
  else
    sSQL$ = sSQL$ + ";"
  end_if

  ' préparation de la requête: sélection des enregistrements de la table selon les critères
  res% = dll_call2("CompileSQLite3Script",SQL%,adr(sSQL$))

  ' Vider grid
  for i%=2 to RowCount%+1
    for j%=1 to grid_column(1034)
      grid_write 1034,i%,j%,""
    next j%
  next i%
 
  ' boucle d'affichage du résultat
  min 1020,0 : max 1020,5 : position 1020,0
  for i%=1 to RowCount%
    position 1020,i%
    ' Remplissage grid par lecture de chacun des colonnes de chacun des enregistrements
    res% = dll_call1("GetSQLite3NextRow",SQL%)
    if res%<0 then exit_for
    for j%=1 to 5                                     
      res% = dll_call2("GetSQLite3CellText",SQL%,j%)
      grid_write 1034,i%+1,j%,text$(1001)    : ' Ecriture dans la cellule correspondante   
    next j%
  next i%
  res% = dll_call1("FinalizeSQLite3Request",SQL%)   
  return

tables:
  if SQL%=0
    message "No database open"
    return
  end_if
  res% = dll_call1("GetSQLite3TableNames",SQL%)
  item_add 1001,str$(res%)+" tables"
  return
 
columns:
  if SQL%=0
    message "No database open"
    return
  end_if
  s$ = trim$(text$(1031))
  if s$="" then s$ = TestTable$
  res% = dll_call2("GetSQLite3ColumnNames",SQL%,adr(s$))
  item_add 1001,str$(res%)+" colonnes dans table "+s$
  return

clickgrid:
  x% = mouse_x_left_down(1034)
  y% = mouse_y_left_down(1034)
  x% = grid_x_to_column(1034,x%)
  y% = grid_y_to_row(1034,y%) - 1
  s$ = grid_read$(1034,y%+1,x%)
  caption 1036,str$(y%)
  caption 1038,str$(x%)
  text 1040,s$
  id$ = grid_read$(1034,y%+1,1)
  champ$ = grid_read$(1034,1,x%)
  return

maj:
  if x%<2
    message "colonne interdite"
    return
  end_if
  s$ = trim$(text$(1040))
  sSQL$ = "UPDATE TestTable SET "+champ$+" = ²"+s$+"² WHERE ID= ²"+id$+"² ;"
  clear 1011
  item_add 1011,sSQL$
  res% = dll_call2("ExecuteSQLite3Script",SQL%,handle(1011))
  item_add 1001,"UPDATE execution "+str$(res%)
  gosub fillgrid
  item_add 1001,"FILLGRID execution "+str$(res%)
  return