读写sqlite3数据库程序.tcl

TCL的数据库处理支撑库及一些示例

# by Alex Caldwell M.D
 # [e-mail]
 # with much help from
 # Dr. Jerry Park D.O.
 # [e-mail]

 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 ","] {