读写sqlite3数据库程序.tcl

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

            eval $command
            .topframe.leftframe.list insert end $newTableName
            destroy .newTable
        } else {
            tk_dialog .error Error "You already have a table by that name. Please select another." error 0 OK
        }
    }

    pack .newTable.create
 }

 proc dropTable {table} {
    global table_names
    toplevel .are_you_sure
    label .are_you_sure.label -text "Are you sure you want to delte table $table ?"
    pack .are_you_sure.label
    button .are_you_sure.yes -text "Yes, I AM sure" -command "
    destroy .are_you_sure
    set sure_variable true
    db eval {[subst {DROP TABLE $table ;}]}
    .topframe.leftframe.list delete [.topframe.leftframe.list index active]
    for \{set x 0\} \{\$x < \[llength \$table_names\]\} \{incr x\} \{
    if \{\[string compare $table  \[lindex \$table_names \$x\]\] == \"0\"\} \{
    set table_names \[lreplace \$table_names \$x \$x\]
    puts \"they match\"
    \}
    \}
    "
    pack .are_you_sure.yes
    button .are_you_sure.no -text "No, I am NOT sure" -command {
        destroy .are_you_sure
        set sure_variable false
    }
    pack .are_you_sure.no
    tkwait variable sure_variable

 }

 proc createtablelist {table_name} {
    global sock primary_key primary_key_name column_names
    set column_names {}
    set primary_key_name {}
    set primary_key {}
    # 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;}]]
    #set column_names [Eval_Remote $sock db eval [subst {SELECT sql FROM (SELECT * FROM  sqlite_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 ","] {
            if {[regexp "PRIMARY KEY" $name]} {
                set primary_key $key_index_counter
                set primary_key_name [lindex $name 0]
            }
            if {[lindex $name 0] != "" && [lindex $name 0] != "CREATE"} {
                lappend column_names [lindex $name 0]
            }
            incr key_index_counter
        }
    }

    # in this case you do not want all the column names
    if {[regexp "CREATE VIEW" $initial_column_names] && ![regexp "\\*" $initial_column_names]} {
        # we need to get the names of the columns you want from between the SELECT and the FROM statements
        regexp "SELECT .+ FROM" $initial_column_names match
        puts "match == $match"
        regsub "SELECT " $match {} match
        regsub " FROM" $match {} match
        regsub -all {, } $match { } match
        puts "match == $match"

        # in this case, the initial_column_names is actually the table names - I know that is confusing - just too lazy to change the code
        regsub "CREATE VIEW $table_name AS SELECT .+ FROM " $initial_column_names {} initial_column_names
        regsub { WHERE.+$} $initial_column_names {} initial_column_names
        set initial_column_names [split $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
        regsub -all {\\} $initial_column_names {} initial_column_names
        #puts $initial_column_names
        # now loop through the selected tables and get the column names
        #foreach view_table $initial_column_names {
        #    set initial_column_names2 [db eval [subst {SELECT sql FROM (SELECT * FROM sqlite_master UNION ALL SELECT * FROM sqlite_temp_master) WHERE tbl_name LIKE '$view_table' AND type!='meta' ORDER BY type DESC, name;}]]
        #    regsub "CREATE TABLE $view_table" $initial_column_names2 {} initial_column_names2
        #    regsub -all {\(} $initial_column_names2 {} initial_column_names2
        #    regsub -all {\)} $initial_column_names2 {} initial_column_names2
        #    regsub -all {\{} $initial_column_names2 {} initial_column_names2
        #    regsub -all {\}} $initial_column_names2 {} initial_column_names2

        # 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_names2 ","] {
        #        if {[regexp "PRIMARY KEY" $name]} {
        #            set primary_key $key_index_counter
        #            set primary_key_name [lindex $name 0]
        #        }
        #        lappend column_names [lindex $name 0]
        #        incr key_index_counter
        #    }
        #in this case the column names comes from the SELECT columnname1, columnname2 FROM
        # so we just set columnames equal to that
        set column_names $match

        #}

    }
    # this is the case where you use a wildcard for selecting the columnames when creating a view. So you will get all the column names in the tablelist widget.
    if {[regexp "CREATE VIEW" $initial_column_names] && [regexp "\\*" $initial_column_names]} {
        regsub "CREATE VIEW $table_name AS SELECT \\* FROM " $initial_column_names {} initial_column_names
        regsub { WHERE.+$} $initial_column_names {} initial_column_names
        set initial_column_names [split $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
        regsub -all {\\} $initial_column_names {} initial_column_names
        puts $initial_column_names

        foreach view_table $initial_column_names {
            set initial_column_names2 [db eval [subst {SELECT sql FROM (SELECT * FROM sqlite_master UNION ALL SELECT * FROM sqlite_temp_master) WHERE tbl_name LIKE '$view_table' AND type!='meta' ORDER BY type DESC, name;}]]
            regsub "CREATE TABLE $view_table" $initial_column_names2 {} initial_column_names2
            regsub -all {\(} $initial_column_names2 {} initial_column_names2
            regsub -all {\)} $initial_column_names2 {} initial_column_names2
            regsub -all {\{} $initial_column_names2 {} initial_column_names2
            regsub -all {\}} $initial_column_names2 {} initial_column_names2

            # 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_names2 ","] {
                if {[regexp "PRIMARY KEY" $name]} {
                    set primary_key $key_index_counter
                    set primary_key_name [lindex $name 0]
                }

                lappend column_names [lindex $name 0]

                incr key_index_counter
            }

        }

    }

    set top .configTop
    for {set n 2} {[winfo exists $top]} {incr n} {
        set top .configTop$n
    }
    toplevel $top -class DemoTop
    wm title $top $table_name

    set tf $top.tf
    frame $tf

    set tbl $tf.tbl
    set vsb $tf.vsb
    set hsb $tf.hsb
    set new_column_names [list "0 [join $column_names "\n0 "]"]
    #puts $new_column_names
    regsub -all {\{} $new_column_names {} new_column_names
    regsub -all {\}} $new_column_names {} new_column_names

    tablelist::tablelist $tbl -columns $new_column_names -selectmode multiple \
            -labelcommand tablelist::sortByColumn -sortcommand demo::compareAsSet \
            -editendcommand applyValue -height 15 -width 100 -stretch all \
            -xscrollcommand [list $hsb set] -yscrollcommand [list $vsb set] \
            -stripebackground           #e0e8f0
    # -editstartcommand enableDelete
    #$tbl columnconfigure 3 -maxwidth 30 -editable yes
    #$tbl columnconfigure 4 -maxwidth 30 -editable yes

    for {set x 0} {$x < [llength $column_names]} {incr x} {
        $tbl columnconfigure $x -maxwidth 30 -editable yes
        if {$x == $primary_key} {
            $tbl columnconfigure $x -foreground red -editable no
        }
    }

    scrollbar $vsb -orient vertical   -command [list $tbl yview]
    scrollbar $hsb -orient horizontal -command [list $tbl xview]

    #
    # Create three buttons within a frame child of the top-level widget
    #
    set bf $top.bf
    frame $bf
    set b1 $bf.b1
    set b2 $bf.b2
    set b3 $bf.b3
    set b4 $bf.b4

    set b5 $bf.b5
    set b6 $bf.b6
    set b7 $bf.b7

    button $b1 -text "Refresh"     -command [list demo::putConfig \$w $tbl] -state disabled
    button $b4 -text "New Record"  -command [list newRecord $tbl $table_name]
    #    button $b2 -text "Sort as set" -command [list $tbl sort] -state disabled

    # row delete button initially disabled because tablelist widget will set inital active row to 0 and you don't want to delete
    # until user selects row by putting the mouse on it at least.
    button $b2 -text "Delete Seleted Row" -command [list deleteRecord $tbl $table_name "$tbl index active" $primary_key] -state disabled
    button $b3 -text "Close"       -command [list destroy $top]

    if {$table_name == "SpokanePhysicians"} {
        button $b5 -image fax -command "
        foreach row \[$tbl curselection\] \{
        toplevel .fax
        text .fax.t
        pack .fax.t
        .fax.t insert 1.0 \"                              Jerry Park D.O.
        101 Main St.
        Spokane WA 88845
        \[clock format \[clock seconds\] -format \"%m/%d/%Y %R\"\]\\n\\n\\n\"
        set this_row  \[$tbl get \$row\]
        .fax.t insert end  \"\[lindex \$this_row 2\] \[lindex \$this_row 1\] \[lindex \$this_row 4\]\\n\"
        .fax.t insert end  \"\[lindex \$this_row 5\]\\n\"
        .fax.t insert end \"\[lindex \$this_row 6\] \[lindex \$this_row 7\] \[lindex \$this_row 8\]\\n\\n\\n\"
        .fax.t insert end \"Hi \[lindex \$this_row 2\]!\\n\\\n\\n\"
        .fax.t insert end \"     I was just wanting to let you know that our new tkfp_tablelist2.tcl program seems to be working.\\n\\n\\n\\n\"
        .fax.t insert end \"                              Yours truly,\\n\\n\"
        .fax.t insert end \"                              Jerry Park D.O.\"

        button .fax.done -text {Send} -command {set done_variable true;destroy .fax}
        pack .fax.done -side left
        button .fax.cancel -text {Cancel} -command {set done_variable true;destroy .fax}
        pack .fax.cancel -side left -padx 5
        tkwait variable done_variable
        \}
        "

        button $b6 -image email
        button $b7 -image mail
    }

    set bodyTag [$tbl bodytag]
    bind $bodyTag <FocusIn>   [list $b2 configure -state normal]

    #
    # Manage the widgets
    #
    grid $tbl -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 $b1 $b2 $b4 $b3 -side left -expand yes -pady 10
    if {$table_name == "SpokanePhysicians"} {
        pack $b5 $b6 $b7 -side left -expand yes -pady 10
    }
    pack $bf -side bottom -fill x
    pack $tf -side top -expand yes -fill both

    #insert some data retrieved by sql from the database into the tablelist
    #the blank space at the end of each variable is because the tablelist seems
    #to ignor nulls and moves things over one unless you put a space in.
    set data [db eval [subst {Select * from $table_name;}]]

    #foreach {BusinessOrganizationType NameID Honorific FirstName LastName Degree ExtraDegrees Nickname SpecialtyID Specialty2ID BusinessOrganization Birthday Custom1_Name Custom2_Name Custom3_Name Custom4_Name Comments_Name DateLastUpdated_Name} $data {

    #    $tbl insert end " \"$BusinessOrganizationType \" \"$NameID\" \"$Honorific \" \"$FirstName \" \"$LastName \" \"$Degree \" \"$ExtraDegrees \" \"$Nickname \" \"$SpecialtyID \" \"$Specialty2ID \" \"$BusinessOrganization \" \"$Birthday \" \"$Custom1_Name \" \"$Custom2_Name \" \"$Custom3_Name \" \"$Custom4_Name \" \"$Comments_Name \" \"$DateLastUpdated_Name \""
    #}

    #set column_insert_command " \\\"\$"
    #set column_insert_list [join $column_names " \\\" \\\"\$"]
    #append column_insert_command $column_insert_list
    #append column_insert_command " \\\""

    append column_insert_command " \\\"\$\{"
    set key_counter 0
    foreach name $column_names {
        #if {[regexp {\.} $name]} {
        #    set name [lindex [split $name "."] 1]
        #}

        if {$key_counter != $primary_key && ![string compare $name " "] && ![string compare $name ""]} {
            append column_insert_command "$name\} \\\" \\\"\$\{"
        } else {
            append column_insert_command "$name\}\\\" \\\"\$\{"
        }
        incr key_counter
    }
    append column_insert_command "\} \\\""
    regsub {\$\{\}} $column_insert_command {} column_insert_command

    foreach $column_names $data {
        set command  "$tbl insert end \"$column_insert_command\""
        #puts $command
        eval $command
        #update idletasks
    }
 }