基于Android平台标准的公共密钥密码工作站

 package require Tk package require tkpath 0.3.0 global mydir set mydir [file dirname [info script]] #  #  image create photo logo_product -file [file join $mydir "imageme" "validcertkey_51x24.png"] #  image create photo logo_orel -file [file join $mydir "imageme" "__425x200.png"] -format "png -alpha 1.0" #  tcl/tk image create photo logo_and -file [file join $mydir "imageme" "AndTk_inv_147x173.png"] -format "png -alpha 1.0" #  image create photo svitok -file [file join $mydir "imageme" "blue_svitok.png"] -format "png -alpha 1.0" # image create photo tileand -file [file join $mydir "imageme" "tile_green_and_32x32.png"] -format "png -alpha 1.0" #/ (  - ) proc scaleImage {im xfactor {yfactor 0}} { set mode -subsample if {$xfactor>=0 && $yfactor>=0} { set mode -zoom } else { set xfactor [expr $xfactor * -1] } if {$yfactor == 0} {set yfactor $xfactor} set t [image create photo] $t copy $im $im blank $im copy $t -shrink $mode $xfactor $yfactor image delete $t } proc createtile {w backg} { image create photo tiled tiled copy $backg -to 0 0 $::scrwidth $::scrheight -shrink $backg copy tiled image delete tiled #   $w create image 0 0 \ -image $backg \ -anchor nw } proc create_rectangle {canv img x1 y1 x2 y2 color alfa {wbd 0} {colorline black} } { image create photo $img -format "default -colorformat rgb" set rgb1 [winfo rgb $canv $color] set cr [lindex $rgb1 0] set cg [lindex $rgb1 1] set cb [lindex $rgb1 2] set fill [format "#%04x%04x%04x" $cr $cg $cb ] #   $img put $fill -to 0 0 [expr {$x2 - $x1}] [expr {$y2 -$y1}] #  set dimg [$img data -format png] # image   alpha  image create photo $img -data $dimg -format "png -alpha $alfa" # $img put [list $rgb1] -to 0 0 [expr {$x2 - $x1}] [expr {$y2 -$y1}] #   set imgr [$canv create image $x1 $y1 -image $img -anchor nw] set cc [subst {butImg $img}] $canv bind $imgr <ButtonPress-1> $cc #    if {$wbd > 0 } { set item [$canv create rect $x1 $y1 $x2 $y2 -outline $colorline -width $wbd ] $canv bind $item <ButtonPress-1> $cc } return $imgr } proc butImg {img} { tk_messageBox -title "" -icon info -message " =$img" -detail "::screenwidth=$::scrwidth\n::screenheight=$::scrheight" -parent . if {$img == "exit"} { set answer [tk_dialog .dialog2 " " " \n ?" question 0 "" "" ] if {$answer == 0} { exit } } } proc page_titul {fr logo_manufacturer} { global mydir #     tkp::canvas $fr.can -borderwidth 0 -height [winfo screenheight .] -width [winfo screenwidth .] -relief flat #   createtile "$fr.can" "tileand" pack $fr.can -anchor center -expand 1 -fill both -side top -padx 0 -pady 0 #     #update        update # set aa [winfo height $fr.labtitul] set aa $::padly #   set ha [image width $logo_manufacturer] set xman [expr {($::scrwidth - $ha) / 2 }] $fr.can create image $xman $aa -image $logo_manufacturer -anchor nw -tag tag_logo set blogo [$fr.can bbox tag_logo] set wexit [lindex $blogo 3] if {$::typetlf } { set dlx [expr {$::padlx / 1}] $fr.can create text [expr $dlx + 6] [expr {$wexit + $::padly + 6}] -anchor nw -text " " -fill black -font {{Roboto Condensed Medium} 15 } $fr.can create text $dlx [expr {$wexit + $::padly}] -anchor nw -text " " -fill white -font {{Roboto Condensed Medium} 15 } -tag id_text0 update set blogo [$fr.can bbox id_text0] set wexit [lindex $blogo 3] $fr.can create text [expr $dlx + 4] [expr {$wexit + $::padly + 4 - 80}] -anchor nw -text "  Android" -fill black -font {{Roboto Condensed Medium} 13} $fr.can create text $dlx [expr {$wexit + $::padly - 80}] -anchor nw -text "  Android" -fill white -font {{Roboto Condensed Medium} 13} -tag id_text1 set blogo [$fr.can bbox id_text1] set wexit [lindex $blogo 3] $fr.can create text [expr $dlx + 3] [expr {$wexit + $::padly + 3 - 50}] -anchor nw -text "№ 63  \" \n  6  2011 \"" -fill black -font {{Roboto} 10} $fr.can create text $dlx [expr {$wexit + $::padly - 50}] -anchor nw -text "№ 63  \" \n  6  2011 \"" -fill white -font {{Roboto} 10} -tag id_text2 set blogo [$fr.can bbox id_text2] set wexit [lindex $blogo 3] $fr.can create text [expr $dlx + 2] [expr {$wexit + $::padly + 2 - 40}] -text ": .. \nhttp://soft.lissi.ru, http://www.lissi.ru\n+7(495)589-99-53\ne-mail: support@lissi.ru\n\n" \ -anchor nw -fill black -font {{Roboto} 9} $fr.can create text $dlx [expr {$wexit + $::padly - 40}] -text ": .. \nhttp://soft.lissi.ru, http://www.lissi.ru\n+7(495)589-99-53\ne-mail: support@lissi.ru\n\n" \ -anchor nw -fill white -tag id_text3 -font {{Roboto} 9} } else { $fr.can create text [expr $::padlx + 2] [expr {$wexit + $::padly + 2}] -anchor nw -text " " -fill black -font {{Nimbus Sans Narrow} 20} $fr.can create text $::padlx [expr {$wexit + $::padly}] -anchor nw -text " " -fill white -font {{Nimbus Sans Narrow} 20} -tag id_text0 set blogo [$fr.can bbox id_text0] set wexit [lindex $blogo 3] $fr.can create text [expr $::padlx + 2] [expr {$wexit + $::padly + 2 - 20}] -anchor nw -text "  Android" -fill black -font {{Nimbus Sans Narrow} 18} $fr.can create text $::padlx [expr {$wexit + $::padly - 20}] -anchor nw -text "  Android" -fill white -font {{Nimbus Sans Narrow} 18} -tag id_text1 set blogo [$fr.can bbox id_text1] set wexit [lindex $blogo 3] $fr.can create text [expr $::padlx + 2] [expr {$wexit + $::padly + 2}] -anchor nw -text "№ 63  \" \n  6  2011 \"" -fill black -font {{Nimbus Sans Narrow} 14} $fr.can create text $::padlx [expr {$wexit + $::padly}] -anchor nw -text "№ 63  \" \n  6  2011 \"" -fill white -font {{Nimbus Sans Narrow} 14} -tag id_text2 set blogo [$fr.can bbox id_text2] set wexit [lindex $blogo 3] $fr.can create text [expr $::padlx + 1] [expr {$wexit + $::padly + 1}] -text ": .. \nhttp://soft.lissi.ru, http://www.lissi.ru\n+7(495)589-99-53\ne-mail: support@lissi.ru\n\n" \ -anchor nw -fill black -font {{Nimbus Sans Narrow} 12} $fr.can create text $::padlx [expr {$wexit + $::padly}] -text ": .. \nhttp://soft.lissi.ru, http://www.lissi.ru\n+7(495)589-99-53\ne-mail: support@lissi.ru\n\n" \ -anchor nw -fill white -tag id_text3 -font {{Nimbus Sans Narrow} 12} -tag id_text3 set blogo [$fr.can bbox id_text2] } set blogo [$fr.can bbox id_text3] set wland [lindex $blogo 3] $fr.can create image $::padlx $wland -image logo_and -anchor nw -tag tag_land set ha [image height logo_and] set wa [image width logo_and] set ha1 [expr {$ha - ($ha / 2 ) }] $fr.can create image [expr {$wa - 80 }] [expr {$wland + $ha1}] -image svitok -anchor nw -tag tag_land if {$::typetlf} { set x1 [expr {$::padlx / 2}] set y1 [expr {$wland + 120}] set x2 [expr {$::::scrwidth - $x1}] set y2 [expr {$y1 + 120}] set wd 8 set rr 18 } else { set x1 [expr {$::padlx / 2}] set y1 [expr {$wland + 40}] set x2 [expr {$::::scrwidth - $x1}] set y2 [expr {$y1 + 40}] set wd 4 set rr 6 } set g5 [$fr.can gradient create linear -stops {{0 lightgreen} {1 green}}] set S3 [$fr.can style create -stroke "skyblue" -fill $g5 -strokewidth $wd -fillopacity 0.6] set im1 [$fr.can create prect $x1 $y1 $x2 $y2 -rx $rr -style $S3] $fr.can bind $im1 <ButtonPress-1> {butImg "img1"} #  set blogo [$fr.can bbox $im1] set by2 [lindex $blogo 3] set by1 [lindex $blogo 1] set bb [expr {($by2 - $by1) / 2}] set bx2 [lindex $blogo 2] set bx1 [lindex $blogo 0] set bbx [expr {($bx2 - $bx1) / 2}] set txt1 [$fr.can create text [expr {$x1 + $::padlx * 2}] [expr {$y1 + 1 }] -anchor nw -text " " -fill black -font {{Arial} 10 normal}] #  set btxt1 [$fr.can bbox $txt1] #   Y set ty2 [lindex $btxt1 3] set ty1 [lindex $btxt1 1] set tt [expr {$ty2 - $ty1}] set tt [expr {$tt / 2}] set offsy [expr {($by1 + $bb) - ($ty1 + $tt)}] #   X set tx2 [lindex $btxt1 2] set tx1 [lindex $btxt1 0] set ttx [expr {$tx2 - $tx1}] set ttx [expr {$ttx / 2}] set offsx [expr {($bx1 + $bbx) - ($tx1 + $ttx)}] $fr.can move $txt1 $offsx $offsy $fr.can bind $txt1 <ButtonPress-1> {butImg "img1"} if {$::typetlf} { set y1 [expr $y2 + 40] set x2 [expr {$::::scrwidth - $x1}] set y2 [expr {$y1 + 120}] } else { set y1 [expr {$y1 + 60}] set x2 [expr {$::::scrwidth - $x1}] set y2 [expr {$y1 + 40}] } set im1 [create_rectangle $fr.can "but2" $x1 $y1 $x2 $y2 "#2b972d" 0.6 $wd "skyblue"] #  set blogo [$fr.can bbox $im1] set by2 [lindex $blogo 3] set by1 [lindex $blogo 1] set bb [expr {($by2 - $by1) / 2}] set bx2 [lindex $blogo 2] set bx1 [lindex $blogo 0] set bbx [expr {($bx2 - $bx1) / 2}] set txt1 [$fr.can create text [expr {$x1 + $::padlx * 2}] [expr {$y1 + 1 }] -anchor nw -text "   " -fill black -font {{Roboto Condensed Medium} 12}] #  set btxt1 [$fr.can bbox $txt1] #   Y set ty2 [lindex $btxt1 3] set ty1 [lindex $btxt1 1] set tt [expr {$ty2 - $ty1}] set tt [expr {$tt / 2}] set offsy [expr {($by1 + $bb) - ($ty1 + $tt)}] #   X set tx2 [lindex $btxt1 2] set tx1 [lindex $btxt1 0] set ttx [expr {$tx2 - $tx1}] set ttx [expr {$ttx / 2}] set offsx [expr {($bx1 + $bbx) - ($tx1 + $ttx)}] $fr.can move $txt1 $offsx $offsy $fr.can bind $txt1 <ButtonPress-1> {butImg "but2"} if {$::typetlf} { set x1 [expr {$::padlx / 2}] set y1 [expr $y2 + 40] set x2 [expr {$::::scrwidth - $x1}] set y2 [expr {$y1 + 120}] } else { set x1 [expr {$::padlx / 2}] set y1 [expr {$y1 + 60}] set x2 [expr {$::::scrwidth - $x1}] set y2 [expr {$y1 + 40}] } set S3 [$fr.can style create -stroke skyblue -fill $g5 -strokewidth $wd -fillopacity 0.6] set im1 [$fr.can create prect $x1 $y1 $x2 $y2 -rx $rr -style $S3] set blogo [$fr.can bbox $im1] $fr.can bind $im1 <ButtonPress-1> {butImg "exit"} set by2 [lindex $blogo 3] set by1 [lindex $blogo 1] set bb [expr {($by2 - $by1) / 2}] set bx2 [lindex $blogo 2] set bx1 [lindex $blogo 0] set bbx [expr {($bx2 - $bx1) / 2}] set txt1 [$fr.can create text [expr {$x1 + $::padlx * 2}] [expr {$y1 + 1 }] -anchor nw -text " " -fill black -font {Arial 10 normal}] $fr.can bind $txt1 <ButtonPress-1> {butImg "exit"} set btxt1 [$fr.can bbox $txt1] #   Y set ty2 [lindex $btxt1 3] set ty1 [lindex $btxt1 1] set tt [expr {$ty2 - $ty1}] set tt [expr {$tt / 2}] set offsy [expr {($by1 + $bb) - ($ty1 + $tt)}] #   X set tx2 [lindex $btxt1 2] set tx1 [lindex $btxt1 0] set ttx [expr {$tx2 - $tx1}] set ttx [expr {$ttx / 2}] set offsx [expr {($bx1 + $bbx) - ($tx1 + $ttx)}] $fr.can move $txt1 $offsx $offsy } #  #   set ::scrwidth [winfo screenwidth .] set ::scrheight [winfo screenheight .] set ::typetlf 0 #,    if {$::scrwidth < $::scrheight} { set ::typetlf 1 } set ::padls 20 set ::padlx 15 set ::padly 15 if {$::typetlf} { wm attributes . -fullscreen 1 scaleImage icon_openfile_18x16 3 scaleImage ::img::view_18x16 3 #  scaleImage logo_orel 2 #  scaleImage logo_product 2 # tcl/tk scaleImage logo_and 3 #  scaleImage svitok 4 set ::padls 50 set ::padlx 75 set ::padly 50 } else { #    scaleImage logo_orel -2 set ::scrwidth 370 set ::scrheight 700 wm minsize . $::scrwidth $::scrheight set geometr $::scrwidth append geometr "x" append geometr $::scrheight append geometr "+0+0" wm geometry . $geometr } #   set name_product "CryptoArmPKCS-A" label .labtitul -image logo_product -compound left -fg snow -text $name_product -font {Arial 10 bold} -anchor w -width [winfo screenwidth .] -pady $::padls -padx 10 -bg #222222 pack .labtitul -anchor nw -expand 0 -fill x -side top -padx 1 -pady 0 #   set i 0 ttk::frame .fr$i -pad 0 -padding 0 page_titul ".fr$i" "logo_orel" pack .fr$i -side top -anchor center -expand 1 -fill both -side top -padx 0 -pady 0 update 

 package require Tk package require tkpath 0.3.0 global mydir set mydir [file dirname [info script]] #/ (  - ) proc scaleImage {im xfactor {yfactor 0}} { set mode -subsample if {$xfactor>=0 && $yfactor>=0} { set mode -zoom } else { set xfactor [expr $xfactor * -1] } if {$yfactor == 0} {set yfactor $xfactor} set t [image create photo] $t copy $im $im blank $im copy $t -shrink $mode $xfactor $yfactor image delete $t } proc createtile {w backg} { image create photo tiled tiled copy $backg -to 0 0 $::scrwidth $::scrheight -shrink $backg copy tiled image delete tiled #   $w create image 0 0 \ -image $backg \ -anchor nw } proc butCliked {num fr} { pack forget .fr1 set ::tekFrfunc $fr pack $fr -side top -anchor center -expand 1 -fill both -side top -padx 0 -pady 0 tk_dialog .dialog1 "Dear user:" "Button $num was clicked\nFr=$fr" info 0 OK } proc butImg {img} { tk_messageBox -title "" -icon info -message " =$img" -detail "::screenwidth=$::scrwidth\n::screenheight=$::scrheight" -parent . if {$img == "exit"} { set answer [tk_dialog .dialog2 " " " \n ?" question 0 "" "" ] if {$answer == 0} { exit } } } proc butReturn {} { pack forget $::tekFrfunc pack .fr1 -side top -anchor center -expand 1 -fill both -side top -padx 0 -pady 0 # tk_dialog .dialog1 "Dear user:" "Button $num was clicked\nFr=$fr" info 0 OK } proc page_func {fr tile titul functions} { #  upvar $functions but #    if {$::typetlf} { set feFONT_button "-family {Roboto} -size 9 -weight bold -slant roman" set widl 10 } else { set feFONT_button "-family {Arial} -size 12 -weight bold -slant roman" set widl 5 } catch {font delete fontTEMP_drawer} eval font create fontTEMP_drawer $feFONT_button #    set drawerCNT 0 set strMaxWidthPx 15 set Ndrawers [expr {[array size but] - 1}] while { $drawerCNT <= $Ndrawers } { set strWidthPx [font measure fontTEMP_drawer "$but($drawerCNT)"] if { $strWidthPx > $strMaxWidthPx } { set strMaxWidthPx $strWidthPx } incr drawerCNT } set drawerWidthPx [expr $strMaxWidthPx + 10] set xxx [expr {($::::scrwidth - $drawerWidthPx) / 2}] if {$fr != ".fr1"} { set hret [expr $::scrheight / 4] } else { set hret $::scrheight } set hret [expr $::scrheight / 4] tkp::canvas $fr.can -borderwidth 0 -height $hret -width $::scrwidth -relief flat #   createtile "$fr.can" $tile pack $fr.can -anchor center -expand 1 -fill both -side top -padx 0 -pady 0 if {$titul != "" } { set allfunc $titul catch {font delete fontTEMP_titul} set font_titul "-family {Roboto Condensed Medium} -size 15" eval font create fontTEMP_titul $font_titul set funcWidthPx [font measure fontTEMP_titul "$allfunc"] set dlx [expr {($::::scrwidth - $funcWidthPx) / 2}] $fr.can create text [expr $dlx + 6] [expr {6 + 6}] -anchor nw -text "$allfunc" -fill black -font fontTEMP_titul $fr.can create text $dlx 6 -anchor nw -text "$allfunc" -fill white -font fontTEMP_titul -tag id_text0 set blogo [$fr.can bbox id_text0] set boxbut [expr ([lindex $blogo 3] + 6 + 6)] } else { set boxbut [expr 6 + 6] } #      #.  #  set BDwidth_canvas 0 set maxTextHeightPx [font metrics fontTEMP_drawer -linespace] set maxTextHeightPx [expr {$maxTextHeightPx + ( $maxTextHeightPx / 2)}] set drawerHeightPx $maxTextHeightPx set xLocTextPx [expr {($::::scrwidth - $drawerWidthPx) / 2}] set yLocTextPx [expr $BDwidth_canvas + ($drawerHeightPx / 2) + $boxbut] set canvasHeightPx [expr $Ndrawers * $drawerHeightPx] set drawerCNT 0 set Ndrawers [expr {[array size but] - 1}] while { $drawerCNT <= $Ndrawers } { set yLineLocPx [ expr (( $drawerCNT ) * $drawerHeightPx + $boxbut)] #   $fr.can create line \ $xLocTextPx $yLineLocPx \ [expr $drawerWidthPx + $xLocTextPx] $yLineLocPx \ -fill "#a0a0a0" -width $widl $fr.can create text [expr $xLocTextPx + 5] $yLocTextPx \ -anchor w \ -font fontTEMP_drawer \ -text "$but($drawerCNT)" \ -tag textlineTag($drawerCNT) if {$drawerCNT == 0} { if {$fr == ".fr1"} { $fr.can bind textlineTag($drawerCNT) <ButtonRelease-1> {butImg "but1"} } else { $fr.can bind textlineTag($drawerCNT) <ButtonRelease-1> {butReturn} } } else { frame .fn$drawerCNT -background white -relief flat -pady 0 -padx 0 set titul $but($drawerCNT) set cmd "$fr.can bind textlineTag($drawerCNT) <ButtonRelease-1> {butCliked $drawerCNT .fn$drawerCNT}" set cmd [subst "$cmd"] eval $cmd set but1(0) "   " page_func ".fn$drawerCNT" voda "$titul" "but1" } incr drawerCNT set yLocTextPx [ expr $yLocTextPx + $drawerHeightPx] #  if { $drawerCNT > $Ndrawers } { set yLineLocPx [ expr (( $drawerCNT ) * $drawerHeightPx + $boxbut)] $fr.can create line $xLocTextPx $yLineLocPx \ [expr $drawerWidthPx + $xLocTextPx] $yLineLocPx \ -fill "#a0a0a0" -width $widl } } } #  #   set ::scrwidth [winfo screenwidth .] set ::scrheight [winfo screenheight .] set ::typetlf 0 #,    if {$::scrwidth < $::scrheight} { set ::typetlf 1 } set ::padls 20 set ::padlx 15 set ::padly 15 if {$::typetlf} { wm attributes . -fullscreen 1 #  scaleImage logo_product 2 set ::padls 50 set ::padlx 75 set ::padly 50 } else { #    set ::scrwidth 370 set ::scrheight 700 wm minsize . $::scrwidth $::scrheight set geometr $::scrwidth append geometr "x" append geometr $::scrheight append geometr "+0+0" wm geometry . $geometr } #  image create photo voda -file [file join $mydir "imageme" "voda_400x800.png"] #  image create photo logo_product -file [file join $mydir "imageme" "validcertkey_51x24.png"] #   set name_product "CryptoArmPKCS-A" label .labtitul -image logo_product -compound left -fg snow -text $name_product -font {Arial 10 bold} -anchor w -width [winfo screenwidth .] -pady $::padls -padx 10 -bg #222222 pack .labtitul -anchor nw -expand 0 -fill x -side top -padx 1 -pady 0 #    set i 1 ttk::frame .fr$i -pad 0 -padding 0 #   set but(0) " " set but(1) " " set but(2) "   (PKCS7)" set but(3) "  " set but(4) " /" set but(5) " " set but(6) " ASN1-" set but(7) " " set but(8) "  PKCS12/PFX" set but(9) " " set but(10) " /" set but(11) " " set but(12) " " if {$::typetlf} { scaleImage voda 3 2 } #    page_func ".fr$i" voda "" "but" #    pack .fr$i -side top -anchor center -expand 1 -fill both -side top -padx 0 -pady 0