?? 讀寫sqlite3數據庫程序.tcl
字號:
# by Alex Caldwell M.D
# alcald2000@yahoo.com
# with much help from
# Dr. Jerry Park D.O.
# park.jerry@gmail.com
package require Tk
package require Tablelist
package require Iwidgets
package require sqlite3
#create some bitmaps for the fax and mail merge buttons
#bitmaps were borrowed from addressbook-0.7 a Tcl/Tk program by Klemens Durka
image create bitmap fax -data {
#define fax_width 31
#define fax_height 21
static unsigned char fax_bits[] = {
0xf0, 0xff, 0xff, 0x1f, 0x18, 0x00, 0x00, 0x10, 0x08, 0x00, 0x00, 0x18,
0xe8, 0x39, 0x21, 0x0b, 0x28, 0x44, 0x12, 0x0b, 0x28, 0x44, 0x0c, 0x0b,
0xe8, 0x7c, 0x0c, 0x0b, 0x2e, 0x44, 0x12, 0x38, 0x2a, 0x44, 0x21, 0x2b,
0x0a, 0x00, 0x00, 0x28, 0x0a, 0x00, 0x00, 0x28, 0xfa, 0xff, 0xff, 0x2f,
0x02, 0x00, 0x00, 0x20, 0xfa, 0xff, 0xff, 0x27, 0x0a, 0x30, 0xf2, 0x24,
0xfa, 0xff, 0xff, 0x2f, 0x02, 0x30, 0x92, 0x2c, 0x02, 0xf0, 0xff, 0x2f,
0x02, 0x00, 0x00, 0x20, 0x02, 0x00, 0x00, 0x20, 0xfe, 0xff, 0xff, 0x3f};
}
image create bitmap mail -data {
#define brief_width 31
#define brief_height 21
static unsigned char brief_bits[] = {
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfe, 0xff, 0xff, 0x3f,
0x02, 0x00, 0x00, 0x20, 0x02, 0x00, 0x00, 0x20, 0x3a, 0x00, 0x00, 0x27,
0x02, 0x00, 0x00, 0x25, 0xba, 0x01, 0x00, 0x25, 0x02, 0x00, 0x00, 0x27,
0x02, 0x00, 0x00, 0x20, 0x02, 0xfc, 0x07, 0x20, 0x02, 0x00, 0x00, 0x20,
0x02, 0x7c, 0x00, 0x20, 0x02, 0x00, 0x00, 0x20, 0x02, 0xfc, 0x79, 0x20,
0x02, 0x00, 0x00, 0x20, 0x02, 0x00, 0x00, 0x20, 0x02, 0x00, 0x00, 0x20,
0xfe, 0xff, 0xff, 0x3f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
}
image create bitmap email -data {
#define email_width 31
#define email_height 21
static unsigned char email_bits[] = {
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfe, 0xff, 0xff, 0x3f,
0x02, 0x00, 0x00, 0x20, 0x02, 0x00, 0x00, 0x20, 0x02, 0x00, 0x00, 0x24,
0x02, 0x00, 0x40, 0x24, 0x02, 0x00, 0x00, 0x24, 0x72, 0x2a, 0x43, 0x24,
0x8a, 0xbe, 0x44, 0x24, 0x7a, 0xaa, 0x44, 0x24, 0x0a, 0xaa, 0x44, 0x24,
0x72, 0x2a, 0xeb, 0x2e, 0x02, 0x00, 0x00, 0x20, 0x02, 0x00, 0x00, 0x20,
0x02, 0x00, 0x00, 0x20, 0x02, 0x00, 0x00, 0x20, 0x02, 0x00, 0x00, 0x20,
0xfe, 0xff, 0xff, 0x3f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
}
set types {
{{SQLite} {.db}}
{{SQLiteExplorer} {.db3}}
{{All Files} {*.*}}
}
sqlite3 db [set database_name [tk_getOpenFile -initialdir "./" -title \
"Choose Sqlite Database File" -filetypes $types]]
wm title . "[file tail $database_name] - Tables"
#Eval_Remote $sock {sqlite3 db ./medrolodex.db}
# get the names of all the tables
set table_names [db eval {SELECT name FROM sqlite_master WHERE type='table' UNION ALL SELECT name FROM sqlite_temp_master WHERE type='table' ORDER BY name;}]
# check the no. of tables - used later to configure views in a green foreground color
set no_tables [llength $table_names]
append table_names " [db eval {SELECT name FROM sqlite_master WHERE type='view' UNION ALL SELECT name FROM sqlite_temp_master WHERE type='view' ORDER BY name;}]"
# create a button for each table which when clicked will create a tablelist widget and populate it with data from the table
#foreach table $table_names {
# button ._$table -text $table -command "createtablelist $table"
# pack ._$table -side left
#}
# try a listbox instead to see what works best
frame .topframe
pack .topframe -expand true -fill both
frame .topframe.leftframe
frame .topframe.rightframe
pack .topframe.leftframe -side left -expand true -fill both
pack .topframe.rightframe -side right -expand true -fill y
listbox .topframe.leftframe.list -width 115 -yscrollcommand {.topframe.rightframe.scroll set}
pack .topframe.leftframe.list -expand true -fill both
scrollbar .topframe.rightframe.scroll -command {.topframe.leftframe.list yview}
pack .topframe.rightframe.scroll -expand true -fill y
foreach table $table_names {
.topframe.leftframe.list insert end $table
}
# configure the foreground color of the views in green to distinguish from tables in black
for {set x $no_tables} {$x < [.topframe.leftframe.list index end]} {incr x} {
.topframe.leftframe.list itemconfigure $x -foreground green
}
bind .topframe.leftframe.list <Double-Button-1> {
#createtablelist [selection get]
foreach i [selection get] {createtablelist $i}
}
set report_type text
frame .bottomframe
pack .bottomframe -side top -expand true -fill x
button .bottomframe.button1 -text "New Table" -command newTable
pack .bottomframe.button1 -side left -padx 2 -pady 4
button .bottomframe.button2 -text "Delete Selected Table" -command {
dropTable [selection get]
}
pack .bottomframe.button2 -side left -padx 2 -pady 4
frame .sqlframe
pack .sqlframe -side top -expand true -fill x
#label .sqlframe.label -text "SQL Query"
#pack .sqlframe.label -side left
#entry .sqlframe.entry -width 80 -textvariable sqlquery
iwidgets::combobox .sqlframe.entry -width 75 -editable true -unique true -labeltext "SQL Query" -labelpos w -textvariable sqlquery -selectioncommand {
#puts "selected: [.sqlframe.entry getcurselection]"
set sqlquery [.sqlframe.entry getcurselection]
#.sqlframe.entry insert list end $sqlquery
set f [open ${database_name}_queries.tcl w]
for {set x 0} {$x < [.sqlframe.entry index end]} {incr x} {
puts $f [.sqlframe.entry get $x]
}
close $f
}
lappend query_list ""
if {[file isfile ${database_name}_queries.tcl]} {
set f [open ${database_name}_queries.tcl r]
while {![eof $f]} {
gets $f line
if {$line != {}} {
lappend query_list "$line"
}
}
close $f
}
#.sqlframe.entry insert list end {SELECT * FROM SpokanePhysicians;}
foreach query $query_list {
.sqlframe.entry insert list end $query
}
#.sqlframe.entry selection set {}
pack .sqlframe.entry -side left -expand true -fill both
button .sqlframe.go_button -text "Go" -command {
catch {
destroy .result_text
destroy .result_scroll
destroy .result_scroll2
destroy .query_results
destroy .hsb
destroy .vsb
destroy .pw
}
iwidgets::panedwindow .pw -width 6i -height 2.5i -orient vertical
pack .pw -expand true -fill both
.pw add "left" -margin 2
.pw add "right" -margin 2
set left [.pw childsite "left"]
set right [.pw childsite "right"]
set no_columns 1
set column_names ""
set result [db eval "$sqlquery"]
regexp {SELECT.+FROM} $sqlquery no_columns
if {![regexp {\*} $no_columns]} {
regsub -all {SELECT } $no_columns {} no_columns
regsub -all { FROM} $no_columns {} no_columns
#set no_columns [split $no_columns ", "]
regsub -all {, } $no_columns { } no_columns
set column_names [split $no_columns " "]
set no_columns [llength [split $no_columns " "]]
#puts $result
if {$report_type == "text" || $report_type == "both"} {
if {$report_type == "text"} {
.pw fraction 100 0
} else {
.pw fraction 50 50
}
scrollbar .result_scroll2 -orient horizontal -command {.result_text xview}
pack .result_scroll2 -in $left -expand true -fill x
scrollbar .result_scroll -command {.result_text yview}
pack .result_scroll -in $left -side left -anchor w -padx 0 -expand true -fill y
text .result_text -width 125 -yscrollcommand {.result_scroll set} -wrap none
pack .result_text -in $left -side left -anchor w -padx 0 -expand true -fill both
}
set initial_result_length [llength $result]
for {set x $no_columns} {$x <= [llength $result]} {incr x [expr $no_columns + 1]} {
set result [linsert $result $x \n]
}
#for {set x 1} {$x <= [llength $result]} {incr x 1} {
# if {[expr $x % ($no_columns + 1)] eq 0} {
# set result [linsert $result $x \n]
# } else {
# set result [linsert $result $x "\t"]
# }
#}
regsub -all {\{\n\}} $result "\n" result
if {$report_type == "text" || $report_type == "both"} {
.result_text insert end "$column_names \n"
.result_text insert end $result
}
set new_column_names [list "0 [join $column_names "\n0 "]"]
regsub -all {\{} $new_column_names {} new_column_names
regsub -all {\}} $new_column_names {} new_column_names
if {$report_type == "tablelist" || $report_type == "both"} {
if {$report_type == "tablelist"} {
.pw fraction 0 100
} else {
.pw fraction 50 50
}
tablelist::tablelist .query_results -columns $new_column_names \
-labelcommand tablelist::sortByColumn -sortcommand demo::compareAsSet \
-editendcommand applyValue -height 15 -width 120 -stretch all \
-xscrollcommand [list .hsb set] -yscrollcommand [list .vsb set] \
-stripebackground #e0e8f0
for {set x 0} {$x < [llength $column_names]} {incr x} {
.query_results columnconfigure $x -maxwidth 30 -editable no
}
scrollbar .vsb -orient vertical -command [list .query_results yview]
scrollbar .hsb -orient horizontal -command [list .query_results xview]
#grid .query_results -row 0 -column 0 -sticky news
#grid .vsb -row 0 -column 1 -sticky ns
#grid .hsb -row 1 -column 0 -sticky ew
#grid rowconfigure $tf 0 -weight 1
#grid columnconfigure $tf 0 -weight 1
pack .hsb -in $right -expand true -fill x
pack .vsb -in $right -side left -fill y
pack .query_results -in $right -side left
foreach line [split $result "\n"] {
regsub -all {'} $line {\\u0027} line
regsub -all {"} $line {\\u0022} line
#.query_results insert end [string map {' \'} $line]
.query_results insert end $line
}
}
} else {
#toplevel .message
#label .message.label -text "Sorry, cannot process the wildcard yet"
#pack .message.label
#label .message.label2 -text "column names"
#pack .message.label2
if {$report_type == "text" || $report_type == "both"} {
if {$report_type == "text"} {
.pw fraction 100 0
} else {
.pw fraction 50 50
}
scrollbar .result_scroll2 -orient horizontal -command {.result_text xview}
pack .result_scroll2 -in $left -expand true -fill x
scrollbar .result_scroll -command {.result_text yview}
pack .result_scroll -in $left -side left -anchor w -padx 0 -expand true -fill y
text .result_text -width 125 -xscrollcommand {.result_scroll2 set} -yscrollcommand {.result_scroll set} -wrap none
pack .result_text -in $left -side left -anchor w -padx 0 -expand true -fill both
}
#need to get the table_name in order to find the column names when using a wildcard
if {[regexp "WHERE" $sqlquery]} {
regexp {FROM .+ WHERE} $sqlquery table_name
regsub {FROM } $table_name {} table_name
regsub { WHERE} $table_name {} table_name
} else {
regexp {FROM [^ ;]+[ ;]} $sqlquery table_name
regsub {FROM } $table_name {} table_name
set table_name [string trimright $table_name]
set table_name [string trimright $table_name ";"]
}
#.message.label configure -text "$table_name"
# need to get the names of all the columns in the selected table using SQL command on the sqlite_master table
set initial_column_names [db eval [subst {SELECT sql FROM (SELECT * FROM sqlite_master UNION ALL SELECT * FROM sqlite_temp_master) WHERE tbl_name LIKE '$table_name' AND type!='meta' ORDER BY type DESC, name;}]]
puts "initial_column_names ==\n$initial_column_names"
if {[regexp "CREATE TABLE" $initial_column_names]} {
# get rid of some junk in the reply that we don't want
regsub "CREATE TABLE $table_name" $initial_column_names {} initial_column_names
#regsub {((version\)|\(name),|(KE|PRIMAR)Y)|(version\)|\(name,|(KE|PRIMAR)Y)|(\(signature\)|UNIQUE)|(\(signature\),|UNIQUE)} $initial_column_names {} initial_column_names
regsub {PRIMARY KEY \((.+, .+)+\),} $initial_column_names {} initial_column_names
regsub {UNIQUE \(.+\)} $initial_column_names {} initial_column_names
regsub {PRIMARY KEY \((.+, .+)+\)} $initial_column_names {} initial_column_names
puts "initial_column_names ==\n$initial_column_names"
regsub -all {\(} $initial_column_names {} initial_column_names
regsub -all {\)} $initial_column_names {} initial_column_names
regsub -all {\{} $initial_column_names {} initial_column_names
regsub -all {\}} $initial_column_names {} initial_column_names
puts "initial_column_names ==\n$initial_column_names"
# the reply still contains the column name followed by a comma and the type description
# so we need to make a new list with only the first element - the name without the type description
set key_index_counter 0
foreach name [split $initial_column_names ","] {
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -