Gava ku me li ser mijara ka hilberên 1C di hawîrdora Linux-ê de çawa dixebitin, kêmasiyek hate kifş kirin - nebûna amûrek pir-platformê ya grafîkî ya hêsan a ji bo birêvebirina komek serverên 1C. Û biryar hat dayîn ku vê kêmasiyê bi nivîsandina GUI-yek ji bo kargêriya konsolê rac rast bike. Tcl/tk ji bo vî karî wekî zimanê pêşkeftinê hate hilbijartin, li gorî min zimanê herî guncaw e. Ji ber vê yekê, ez dixwazim di vê materyalê de hin aliyên balkêş ên çareseriyê pêşkêşî bikim.
Ji bo xebatê hûn ê hewceyê belavkirina tcl/tk û 1C bibin. Û ji ber ku min biryar da ku ez herî zêde ji kapasîteyên radestkirina tcl/tk-ya bingehîn bêyî karanîna pakêtên sêyemîn bikar bînim, ez ê hewceyê guhertoya 8.6.7, ku tê de ttk heye - pakêtek bi hêmanên grafîkî yên din, ya ku bi giranî hewcedariya me bi ttk heye. ::TreeView, hem di şeklê avahiyek darê de hem jî di şeklê tabloyê (lîsteyê) de dide nîşandan. Di heman demê de, di guhertoya nû de, xebata bi îstîsnayan ji nû ve hatî xebitandin (fermana ceribandinê, ku di projeyê de dema ku emrên derveyî dimeşîne tê bikar anîn).
Proje ji çend pelan pêk tê (tevî ku tiştek nahêle hûn her tiştî di yek de bikin):
rac_gui.cfg - veavakirina xwerû
rac_gui.tcl - skrîpta destpêkirina sereke
Peldanka lib pelên ku di destpêkê de bixweber têne barkirin hene:
function.tcl - pelê bi proseduran
gui.tcl - pêwendiya grafîkî ya sereke
images.tcl - pirtûkxaneya wêneyê base64
Pelê rac_gui.tcl, bi rastî, wergêr dest pê dike, guherbaran dest pê dike, modulan bar dike, mîhengan, û hwd. Naveroka pelê bi şîroveyan:
rac_gui.tcl
#!/bin/sh
exec wish "$0" -- "$@"
# Устанавливаем текущий каталог
set dir(root) [pwd]
# Устанавливаем рабочий каталог, если его нет то создаём
set dir(work) [file join $env(HOME) .rac_gui]
if {[file exists $dir(work)] == 0 } {
file mkdir $dir(work)
}
# каталог с модулями
set dir(lib) "[file join $dir(root) lib]"
# загружаем пользовательский конфиг, если он отсутствует, то копируем дефолтный
if {[file exists [file join $dir(work) rac_gui.cfg]] ==0} {
file copy [file join [pwd] rac_gui.cfg] [file join $dir(work) rac_gui.cfg]
}
source [file join $dir(work) rac_gui.cfg]
# Код проверки наличия rac и правильности указания пути в конфиге
# если программа не найдена то будет выведен диалог для указания корректного пути
# и этот путь будет записан в пользовательский конфиг
if {[file exists $rac_cmd] == 0} {
set rac_cmd [tk_getOpenFile -initialdir $env(HOME) -parent . -title "Укажите путь до rac" -initialfile rac]
file copy [file join $dir(work) rac_gui.cfg] [file join $dir(work) rac_gui.cfg.bak]
set orig_file [open [file join $dir(work) rac_gui.cfg.bak] "r"]
set file [open [file join $dir(work) rac_gui.cfg] "w"]
while {[gets $orig_file line] >=0 } {
if {[string match "set rac_cmd*" $line]} {
puts $file "set rac_cmd $rac_cmd"
} else {
puts $file $line
}
}
close $file
close $orig_file
#return "$host:$port"
file delete [file join $dir(work) 1c_srv.cfg.bak]
} else {
puts "Found $rac_cmd"
}
set cluster_user ""
set cluster_pwd ""
set agent_user ""
set agent_pwd ""
## LOAD FILE ##
# Загружаем модули кроме gui.tcl так как его надо загрузить последним
foreach modFile [lsort [glob -nocomplain [file join $dir(lib) *.tcl]]] {
if {[file tail $modFile] ne "gui.tcl"} {
source $modFile
puts "Loaded module $modFile"
}
}
source [file join $dir(lib) gui.tcl]
source [file join $dir(work) rac_gui.cfg]
# Читаем файл со списком серверов 1С
# и добавляем в дерево
if [file exists [file join $dir(work) 1c_srv.cfg]] {
set f [open [file join $dir(work) 1c_srv.cfg] "RDONLY"]
while {[gets $f line] >=0} {
.frm_tree.tree insert {} end -id "server::$line" -text "$line" -values "$line"
}
}Piştî dakêşana her tiştê ku pêdivî ye û kontrolkirina hebûna kargêriya rac, dê pencereyek grafîkî were destpêkirin. Navbera bernameyê ji sê hêmanan pêk tê:
Toolbar, dar û navnîş
Min naveroka "darê" bi qasî ku mimkun e wekî amûrên standard Windows-ê ji 1C çêkir.
Koda sereke ya ku vê pencereyê pêk tîne di pelê de heye
lib/gui.tcl
# установка размера и положения основного окна
# можно установить в переменную topLevelGeometry в конфиг программы
if {[info exists topLevelGeometry]} {
wm geometry . $topLevelGeometry
} else {
wm geometry . 1024x768
}
# Заголовок окна
wm title . "1C Rac GUI"
wm iconname . "1C Rac Gui"
# иконка окна (берется из файла lib/imges.tcl)
wm iconphoto . tcl
wm protocol . WM_DELETE_WINDOW Quit
wm overrideredirect . 0
wm positionfrom . user
ttk::style theme use clam
# Панель инсрументов
set frm_tool [frame .frm_tool]
pack $frm_tool -side left -fill y
ttk::panedwindow .panel -orient horizontal -style TPanedwindow
pack .panel -expand true -fill both
pack propagate .panel false
ttk::button $frm_tool.btn_add -command Add -image add_grey_32
ttk::button $frm_tool.btn_del -command Del -image del_grey_32
ttk::button $frm_tool.btn_edit -command Edit -image edit_grey_32
ttk::button $frm_tool.btn_quit -command Quit -image quit_grey_32
pack $frm_tool.btn_add $frm_tool.btn_del $frm_tool.btn_edit -side top -padx 5 -pady 5
pack $frm_tool.btn_quit -side bottom -padx 5 -pady 5
# Дерево с полосами прокрутки
set frm_tree [frame .frm_tree]
ttk::scrollbar $frm_tree.hsb1 -orient horizontal -command [list $frm_tree.tree xview]
ttk::scrollbar $frm_tree.vsb1 -orient vertical -command [list $frm_tree.tree yview]
set tree [ttk::treeview $frm_tree.tree -show tree
-xscrollcommand [list $frm_tree.hsb1 set] -yscrollcommand [list $frm_tree.vsb1 set]]
grid $tree -row 0 -column 0 -sticky nsew
grid $frm_tree.vsb1 -row 0 -column 1 -sticky nsew
grid $frm_tree.hsb1 -row 1 -column 0 -sticky nsew
grid columnconfigure $frm_tree 0 -weight 1
grid rowconfigure $frm_tree 0 -weight 1
# назначение обработчика нажатия кнопкой мыши
bind $frm_tree.tree <ButtonRelease> "TreePress $frm_tree.tree"
# Список для данных (таблица)
set frm_work [frame .frm_work]
ttk::scrollbar $frm_work.hsb -orient horizontal -command [list $frm_work.tree_work xview]
ttk::scrollbar $frm_work.vsb -orient vertical -command [list $frm_work.tree_work yview]
set tree_work [
ttk::treeview $frm_work.tree_work
-show headings -columns "par val" -displaycolumns "par val"
-xscrollcommand [list $frm_work.hsb set]
-yscrollcommand [list $frm_work.vsb set]
]
# Установка цветов для чередования в таблице
$tree_work tag configure dark -background $color(dark_table_bg)
$tree_work tag configure light -background $color(light_table_bg)
# Размещение элементов на форме
grid $tree_work -row 0 -column 0 -sticky nsew
grid $frm_work.vsb -row 0 -column 1 -sticky nsew
grid $frm_work.hsb -row 1 -column 0 -sticky nsew
grid columnconfigure $frm_work 0 -weight 1
grid rowconfigure $frm_work 0 -weight 1
pack $frm_tree $frm_work -side left -expand true -fill both
#.panel add $frm_tool -weight 1
.panel add $frm_tree -weight 1
.panel add $frm_work -weight 1
Algorîtmaya xebata bi bernameyê re wiha ye:
1. Pêşî, hûn hewce ne ku servera komê ya sereke lê zêde bikin (ango servera rêveberiya komê (di Linux de, rêvebirin bi fermana "/opt/1C/v8.3/x86_64/ras cluster —daemon") tê destpêkirin).
Ji bo vê yekê, li ser bişkoja "+" bikirtînin û di pencereya ku vedibe de, navnîşana server û portê têkevin:
Dûv re, servera me dê bi tikandina wê di darê de xuya bibe, navnîşek koman dê vebe an xeletiyek pêwendiyê dê were xuyang kirin.
2. Bi tikandina li ser navê komê dê navnîşek fonksiyonên ku jê re hene veke.
3…
Û hwd, yanî. ji bo ku komek nû lê zêde bike, yeka ku di navnîşê de heye hilbijêrin û bişkoja "+" ya li darikê amûran bikirtînin û diyaloga nû lê zêde bike dê were xuyang kirin:
Bişkokên di darikê amûran de li gorî çarçoweyê fonksiyonan pêk tînin, ango. Bi ve girêdayî ye ku kîjan hêmanek darê an navnîşê hatî hilbijartin, dê prosedurek an din were kirin.
Ka em li mînaka bişkoka lê zêde bike ("+") binêrin:
Koda hilberîna bişkokê:
ttk::button $frm_tool.btn_add -command Add -image add_grey_32Li vir em dibînin ku gava ku bişkojk tê pêl kirin, dê prosedûra "lê zêde bike", koda wê were darve kirin:
proc Add {} {
global active_cluster host
# Определяем идентификатор выделенного элемента
set id [.frm_tree.tree selection]
# Определяем значение этого элемента
set values [.frm_tree.tree item [.frm_tree.tree selection] -values]
set key [lindex [split $id "::"] 0]
# в зависимости от того что выделили будет запущена нужная процедура
if {$key eq "" || $key eq "server"} {
set host [ Add::server ]
return
}
Add::$key .frm_tree.tree $host $values
}Li vir yek ji avantajên tickle heye: hûn dikarin nirxa guhêrbar wekî navek prosedurê derbas bikin:
Add::$key .frm_tree.tree $host $valuesAngo, wek nimûne, heke em nîşan bidin servera sereke û pêl "+" bikin, wê hingê prosedûra Add::server dê were destpêkirin, heke li komê - Add::cluster û hwd (ez ê li ku derê binivîsim "bişkojkên" hewce ji piçek jêrîn têne), prosedurên navnîşkirî hêmanên grafîkî yên li gorî çarçoweyê xêz dikin.
Wekî ku we berê jî dîtiye, form bi şêwazê mîna hev in - ev ne ecêb e, ji ber ku ew bi yek prosedurê têne xuyang kirin, bi rastî jî çarçoweya sereke ya formê (pencere, bişkok, wêne, etîket), navê pêvajoyê. AddTopLevel
proc AddToplevel {lbl img {win_name .add}} {
set cmd "destroy $win_name"
if [winfo exists $win_name] {destroy $win_name}
toplevel $win_name
wm title $win_name $lbl
wm iconphoto $win_name tcl
# метка с иконкой
ttk::label $win_name.lbl -image $img
# фрейм с полями ввода
set frm [ttk::labelframe $win_name.frm -text $lbl -labelanchor nw]
grid columnconfigure $frm 0 -weight 1
grid rowconfigure $frm 0 -weight 1
# фрейм и кнопки
set frm_btn [frame $win_name.frm_btn -border 0]
ttk::button $frm_btn.btn_ok -image ok_grey_24 -command { }
ttk::button $frm_btn.btn_cancel -command $cmd -image quit_grey_24
grid $win_name.lbl -row 0 -column 0 -sticky nw -padx 5 -pady 10
grid $frm -row 0 -column 1 -sticky nw -padx 5 -pady 5
grid $frm_btn -row 1 -column 1 -sticky se -padx 5 -pady 5
pack $frm_btn.btn_cancel -side right
pack $frm_btn.btn_ok -side right -padx 10
return $frm
}
Parametreyên bangê: sernav, navê wêneyê ji bo îkonê ji pirtûkxaneyê (lib/images.tcl) û parametreyek navê pencereyê ya vebijarkî (default .add). Bi vî rengî, heke em mînakên jorîn ji bo lêzêdekirina server û komê ya sereke bigirin, dê bang li gorî vê yekê be:
AddToplevel "Добавление основного сервера" server_grey_64an
AddToplevel "Добавление кластера" cluster_grey_64Welê, bi van mînakan re bidome, ez ê prosedurên ku ji bo serverek an komê dîyalogên lê zêde dikin nîşan bidim.
Zêde bike :: server
proc Add::server {} {
global default
# выводим основную форму
set frm [AddToplevel "Добавление основного сервера" server_grey_64]
# добавляем етки и поля ввода на эту форму
label $frm.lbl_host -text "Адрес сервера"
entry $frm.ent_host
label $frm.lbl_port -text "Порт"
entry $frm.ent_port
$frm.ent_port insert end $default(port)
grid $frm.lbl_host -row 0 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_host -row 0 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_port -row 1 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_port -row 1 -column 1 -sticky nsew -padx 5 -pady 5
grid columnconfigure $frm 0 -weight 1
grid rowconfigure $frm 0 -weight 1
#set frm_btn [frame .add.frm_btn -border 0]
# переопределяем обработчик нажатия кнопки
.add.frm_btn.btn_ok configure -command {
set host [SaveMainServer [.add.frm.ent_host get] [.add.frm.ent_port get]]
.frm_tree.tree insert {} end -id "server::$host" -text "$host" -values "$host"
destroy .add
return $host
}
return $frm
}Zêde kirin :: kom
proc Add::cluster {tree host values} {
global default lifetime_limit expiration_timeout session_fault_tolerance_level
global max_memory_size max_memory_time_limit errors_count_threshold security_level
global load_balancing_mode kill_problem_processes
agent_user agent_pwd cluster_user cluster_pwd auth_agent
if {$agent_user ne "" && $agent_pwd ne ""} {
set auth_agent "--agent-user=$agent_user --agent-pwd=$agent_pwd"
} else {
set auth_agent ""
}
# устанавливаем глобальные переменные ()
set lifetime_limit $default(lifetime_limit)
set expiration_timeout $default(expiration_timeout)
set session_fault_tolerance_level $default(session_fault_tolerance_level)
set max_memory_size $default(max_memory_size)
set max_memory_time_limit $default(max_memory_time_limit)
set errors_count_threshold $default(errors_count_threshold)
set security_level [lindex $default(security_level) 0]
set load_balancing_mode [lindex $default(load_balancing_mode) 0]
set frm [AddToplevel "Добавление кластера" cluster_grey_64]
label $frm.lbl_host -text "Адрес основного сервера"
entry $frm.ent_host
label $frm.lbl_port -text "Порт"
entry $frm.ent_port
$frm.ent_port insert end $default(port)
label $frm.lbl_name -text "Название кластера"
entry $frm.ent_name
label $frm.lbl_secure_connect -text "Защищённое соединение"
ttk::combobox $frm.cb_security_level -textvariable security_level -values $default(security_level)
label $frm.lbl_expiration_timeout -text "Останавливать выключенные процессы через:"
entry $frm.ent_expiration_timeout -textvariable expiration_timeout
label $frm.lbl_session_fault_tolerance_level -text "Уровень отказоустойчивости"
entry $frm.ent_session_fault_tolerance_level -textvariable session_fault_tolerance_level
label $frm.lbl_load_balancing_mode -text "Режим распределения нагрузки"
ttk::combobox $frm.cb_load_balancing_mode -textvariable load_balancing_mode
-values $default(load_balancing_mode)
label $frm.lbl_errors_count_threshold -text "Допустимое отклонение количества ошибок сервера, %"
entry $frm.ent_errors_count_threshold -textvariable errors_count_threshold
label $frm.lbl_processes -text "Рабочие процессы:"
label $frm.lbl_lifetime_limit -text "Период перезапуска, сек."
entry $frm.ent_lifetime_limit -textvariable lifetime_limit
label $frm.lbl_max_memory_size -text "Допустимый объём памяти, КБ"
entry $frm.ent_max_memory_size -textvariable max_memory_size
label $frm.lbl_max_memory_time_limit -text "Интервал превышения допустимого объёма памяти, сек."
entry $frm.ent_max_memory_time_limit -textvariable max_memory_time_limit
label $frm.lbl_kill_problem_processes -justify left -anchor nw -text "Принудительно завершать проблемные процессы"
checkbutton $frm.check_kill_problem_processes -variable kill_problem_processes -onvalue yes -offvalue no
grid $frm.lbl_host -row 0 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_host -row 0 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_port -row 1 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_port -row 1 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_name -row 2 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_name -row 2 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_secure_connect -row 3 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.cb_security_level -row 3 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_expiration_timeout -row 4 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_expiration_timeout -row 4 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_session_fault_tolerance_level -row 5 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_session_fault_tolerance_level -row 5 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_load_balancing_mode -row 6 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.cb_load_balancing_mode -row 6 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_errors_count_threshold -row 7 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_errors_count_threshold -row 7 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_processes -row 8 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.lbl_lifetime_limit -row 9 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_lifetime_limit -row 9 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_max_memory_size -row 10 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_max_memory_size -row 10 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_max_memory_time_limit -row 11 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.ent_max_memory_time_limit -row 11 -column 1 -sticky nsew -padx 5 -pady 5
grid $frm.lbl_kill_problem_processes -row 12 -column 0 -sticky nw -padx 5 -pady 5
grid $frm.check_kill_problem_processes -row 12 -column 1 -sticky nw -padx 5 -pady 5
# переопределяем обработчик
.add.frm_btn.btn_ok configure -command {
RunCommand "" "cluster insert
--host=[.add.frm.ent_host get]
--port=[.add.frm.ent_port get]
--name=[.add.frm.ent_name get]
--expiration-timeout=$expiration_timeout
--lifetime-limit=$lifetime_limit
--max-memory-size=$max_memory_size
--max-memory-time-limit=$max_memory_time_limit
--security-level=$security_level
--session-fault-tolerance-level=$session_fault_tolerance_level
--load-balancing-mode=$load_balancing_mode
--errors-count-threshold=$errors_count_threshold
--kill-problem-processes=$kill_problem_processes
$auth_agent $host"
Run::server $tree $host ""
destroy .add
}
return $frm
}Dema ku koda van proseduran berhev bikin, cûdahî bi çavê rût xuya ye, ez ê balê bikişînim ser bişkojka "Ok". Di Tk de, taybetmendiyên hêmanên grafîkî dikarin di dema darvekirina bernameyê de bi karanîna vebijarkê werin paşguh kirin configures. Mînakî, fermana destpêkê ya nîşankirina bişkojê:
ttk::button $frm_btn.btn_ok -image ok_grey_24 -command { }Lê di formên me de, ferman bi fonksiyona pêwîst ve girêdayî ye:
.add.frm_btn.btn_ok configure -command {
RunCommand "" "cluster insert
--host=[.add.frm.ent_host get]
--port=[.add.frm.ent_port get]
--name=[.add.frm.ent_name get]
--expiration-timeout=$expiration_timeout
--lifetime-limit=$lifetime_limit
--max-memory-size=$max_memory_size
--max-memory-time-limit=$max_memory_time_limit
--security-level=$security_level
--session-fault-tolerance-level=$session_fault_tolerance_level
--load-balancing-mode=$load_balancing_mode
--errors-count-threshold=$errors_count_threshold
--kill-problem-processes=$kill_problem_processes
$auth_agent $host"
Run::server $tree $host ""
destroy .add
}
Di mînaka li jor de, bişkoka "xitimî" prosedûra zêdekirina komekê dest pê dike.
Li vir hêja ye ku meriv li ser xebata bi hêmanên grafîkî yên di Tk-yê de hûrguliyek were çêkirin - ji bo hêmanên cûda yên têketina daneyê (têketin, combobox, bişkojka kontrolê, hwd.) parameterek wekî guhêrbarek nivîsê hatî destnîşan kirin:
entry $frm.ent_lifetime_limit -textvariable lifetime_limitEv guhêrbar di nav cîhê navên gerdûnî de tê pênase kirin û nirxa ku niha hatî nivîsandin dihewîne. Ewan. ji bo ku hûn nivîsa têketinê ji zeviyê bistînin, hûn tenê hewce ne ku nirxa ku bi guhêrbar re têkildar bixwînin (bê guman, bi şertê ku ew di dema afirandina hêmanê de were destnîşankirin).
Rêbaza duyemîn ji bo wergirtina nivîsa têketinê (ji bo hêmanên celebê têketinê) karanîna fermana wergirtinê ye:
.add.frm.ent_name getVan her du rêbazan di koda jorîn de têne dîtin.
Bi tikandina vê bişkojê, di vê rewşê de, prosedûra RunCommand bi rêzika fermanê ya çêkirî re ji bo lê zêdekirina komek di warê rac de dest pê dike:
/opt/1C/v8.3/x86_64/rac cluster insert --host=localhost --port=1540 --name=dsdsds --expiration-timeout=0 --lifetime-limit=0 --max-memory-size=0 --max-memory-time-limit=0 --security-level=0 --session-fault-tolerance-level=0 --load-balancing-mode=performance --errors-count-threshold=0 --kill-problem-processes=no localhost:1545Naha em têne ser fermana sereke, ku destpêkirina rac-ê bi pîvanên ku em hewce ne kontrol dike, di heman demê de derketina fermanan di navnîşan de par dike û heke hewce bike vedigere:
RunCommand
proc RunCommand {root par} {
global dir rac_cmd cluster work_list_row_count agent_user agent_pwd cluster_user cluster_pwd
puts "$rac_cmd $par"
set work_list_row_count 0
# открываем канал в неблокирующем режиме
# $rac - команда с полным путём
# $par - сформированные ключи запуска и опции
set pipe [open "|$rac_cmd $par" "r"]
try {
set lst ""
set l ""
# вывод команды добавляем в список списков
while {[gets $pipe line]>=0} {
#puts $line
if {$line eq ""} {
lappend l $lst
set lst ""
} else {
lappend lst [string trim $line]
}
}
close $pipe
return $l
} on error {result options} {
# Запуск обработчика ошибок
ErrorParcing $result $options
return ""
}
}Piştî têketina daneya servera sereke, ew ê li darê were zêdekirin, ji bo vê yekê, di prosedûra jorîn Add: server, koda jêrîn berpirsiyar e:
.frm_tree.tree insert {} end -id "server::$host" -text "$host" -values "$host"Naha, bi tikandina li ser navê serverê ya di darê de, em navnîşek komên ku ji hêla wê serverê ve têne rêve kirin digirin, û bi tikandina li ser komekê, em navnîşek hêmanên komê (pêşkêşker, infobases, hwd.) digirin. Ev di prosedûra TreePress (pelê lib/function.tcl) de tête bicîh kirin:
proc TreePress {tree} {
global host server active_cluster infobase
# определяем выделенный элемент
set id [$tree selection]
# устанавливаем нужные глобальные переменные
SetGlobalVarFromTreeItems $tree $id
# Определяем ключ и значение, т.е. именно тип выбранного элемента
set values [$tree item $id -values]
set key [lindex [split $id "::"] 0]
# и в зависимости от того что выбрали будет запущена соответствующая процедура
# в пространстве имён Run
Run::$key $tree $host $values
}Li gorî vê yekê, Run::server dê ji bo servera sereke were destpêkirin (ji bo komikek - Run::cluster, ji bo serverek kar - Run::work_server, hwd.). Ewan. nirxa guhêrbara $key beşek ji navê hêmana darê ye ku ji hêla vebijarkê ve hatî destnîşan kirin -id.
Ka em bala xwe bidin pêvajoyê
Bixebitîne:: server
proc Run::server {tree host values} {
# получаем список кластеров требуемого сервера
set lst [RunCommand server::$host "cluster list $host"]
if {$lst eq ""} {return}
set l [lindex $lst 0]
#puts $lst
# удаляем лишнее из списка
.frm_work.tree_work delete [ .frm_work.tree_work children {}]
# читаем список
foreach cluster_list $lst {
# Заполняем список полученными значениями
InsertItemsWorkList $cluster_list
# обрабатываем вывод (список) для добавления данных в дерево
foreach i $cluster_list {
#puts $i
set cluster_list [split $i ":"]
if {[string trim [lindex $cluster_list 0]] eq "cluster"} {
set cluster_id [string trim [lindex $cluster_list 1]]
lappend cluster($cluster_id) $cluster_id
}
if {[string trim [lindex $cluster_list 0]] eq "name"} {
lappend cluster($cluster_id) [string trim [lindex $cluster_list 1]]
}
}
}
# добавляем кластеры в дерево
foreach x [array names cluster] {
set id [lindex $cluster($x) 0]
if { [$tree exists "cluster::$id"] == 0 } {
$tree insert "server::$host" end -id "cluster::$id" -text "[lindex $cluster($x) 1]" -values "$id"
# добавляем элементы в кластер
InsertClusterItems $tree $id
}
}
if { [$tree exists "agent_admins::$id"] == 0 } {
$tree insert "server::$host" end -id "agent_admins::$id" -text "Администраторы" -values "$id"
#InsertClusterItems $tree $id
}
}Ev pêvajo tiştê ku ji serverê bi navgîniya fermana RunCommand hatî wergirtin pêvajoyê dike û her cûre tiştan li darê zêde dike - kom, hêmanên cihêreng ên root (bingeh, serverên xebatê, danişîn û hwd.). Ger hûn ji nêz ve lê mêze bikin, hûn ê li hundurê prosedûra InsertItemsWorkList-ê bangek bibînin. Ew ji bo lê zêdekirina hêmanan li navnîşek grafîkî tête bikar anîn bi hilanîna hilbera kargêriya konsolê rac, ku berê wekî navnîşek li guhêrbara $lst hatibû vegerandin. Ev navnîşek navnîşan e ku cotên hêmanan hene ku bi kolonek veqetandî ne.
Mînakî, navnîşek girêdanên komê:
svk@svk ~]$ /opt/1C/v8.3/x86_64/rac connection list --cluster=783d2170-56c3-11e8-c586-fc75165efbb2 localhost:1545
connection : dcf5991c-7d24-11e8-1690-fc75165efbb2
conn-id : 0
host : svk.home
process : 79de2e16-56c3-11e8-c586-fc75165efbb2
infobase : 00000000-0000-0000-0000-000000000000
application : "JobScheduler"
connected-at : 2018-07-01T14:49:51
session-number : 0
blocked-by-ls : 0
connection : b993293a-7d24-11e8-1690-fc75165efbb2
conn-id : 0
host : svk.home
process : 79de2e16-56c3-11e8-c586-fc75165efbb2
infobase : 00000000-0000-0000-0000-000000000000
application : "JobScheduler"
connected-at : 2018-07-01T14:48:52
session-number : 0
blocked-by-ls : 0
Di forma grafîkî de ew ê tiştek weha xuya bike:
Pêvajoya jorîn ji bo dagirtina tabloyê navên hêmanan ji bo sernav û daneyan hildibijêre:
InsertItemsWorkList
proc InsertItemsWorkList {lst} {
global work_list_row_count
# установка чередования цвета для строки
if [expr $work_list_row_count % 2] {
set tag dark
} else {
set tag light
}
# разбор строк на пары ключ - значение
foreach i $lst {
if [regexp -nocase -all -- {(D+)(s*?|)(:)(s*?|)(.*)} $i match param v2 v3 v4 value] {
lappend column_list [string trim $param]
lappend value_list [string trim $value]
}
}
# заполнение таблицы
.frm_work.tree_work configure -columns $column_list -displaycolumns $column_list
.frm_work.tree_work insert {} end -values $value_list -tags $tag
.frm_work.tree_work column #0 -stretch
# установка заголовков
foreach j $column_list {
.frm_work.tree_work heading $j -text $j
}
incr work_list_row_count
}Li vir, li şûna fermanek hêsan [split $str ":"], ku rêzê li hêmanên ku bi ":" veqetandî ne veqetîne û lîsteyek vegerîne, bêjeyek birêkûpêk tê bikar anîn, ji ber ku hin hêman jî kolonek dihewîne.
Pêvajoya InsertClusterItems (yek ji çendên mîna hev) bi tenê navnîşek hêmanên zarokan ên bi nasnameyên têkildar li dara hêmana komê ya pêwîst zêde dike.
InsertClusterItems
proc InsertClusterItems {tree id} {
set parent "cluster::$id"
$tree insert $parent end -id "infobases::$id" -text "Информационные базы" -values "$id"
$tree insert $parent end -id "servers::$id" -text "Рабочие серверы" -values "$id"
$tree insert $parent end -id "admins::$id" -text "Администраторы" -values "$id"
$tree insert $parent end -id "managers::$id" -text "Менеджеры кластера" -values $id
$tree insert $parent end -id "processes::$id" -text "Рабочие процессы" -values "workprocess-all"
$tree insert $parent end -id "sessions::$id" -text "Сеансы" -values "sessions-all"
$tree insert $parent end -id "locks::$id" -text "Блокировки" -values "blocks-all"
$tree insert $parent end -id "connections::$id" -text "Соединения" -values "connections-all"
$tree insert $parent end -id "profiles::$id" -text "Профили безопасности" -values $id
}
Hûn dikarin du vebijarkên din ji bo pêkanîna pêvajoyek wekhev bihesibînin, li ku derê dê bi zelalî xuya bibe ka hûn çawa dikarin xweşbîn bikin û ji fermanên dubare xilas bibin:
Di vê pêvajoyê de, lê zêdekirin û kontrolkirin bi serê xwe têne çareser kirin:
InsertBaseItems
proc InsertBaseItems {tree id} {
set parent "infobase::$id"
if { [$tree exists "sessions::$id"] == 0 } {
$tree insert $parent end -id "sessions::$id" -text "Сеансы" -values "$id"
}
if { [$tree exists "locks::$id"] == 0 } {
$tree insert $parent end -id "locks::$id" -text "Блокировки" -values "$id"
}
if { [$tree exists "connections::$id"] == 0 } {
$tree insert $parent end -id "connections::$id" -text "Соединения" -values "$id"
}
}
Li vir nêzîkatiyek rasttir heye:
InsertProfileItems
proc InsertProfileItems {tree id} {
set parent "profile::$id"
set lst {
{dir "Виртуальные каталоги"}
{com "Разрешённые COM-классы"}
{addin "Внешние компоненты"}
{module "Внешние отчёты и обработки"}
{app "Разрешённые приложения"}
{inet "Ресурсы интернет"}
}
foreach i $lst {
append item [lindex $i 0] "::$id"
if { [$tree exists $item] == 0 } {
$tree insert $parent end -id $item -text [lindex $i 1] -values "$id"
}
unset item
}
}Cûdahiya di navbera wan de karanîna lûkê ye, ku tê de ferman(ên) dubare têne kirin. Kîjan nêzîkatiya ku bikar bîne li gorî biryara pêşdebiran e.
Me zêdekirina hêmanan û vegerandina daneyan vegirtiye, niha dem hatiye ku em bala xwe bidin ser guherandinê. Ji ber ku, di bingeh de, heman pîvan ji bo guherandin û zêdekirinê têne bikar anîn (ji bilî bingeha agahdariyan), heman formên diyalogê têne bikar anîn. Algorîtmaya bangkirina prosedurên ji bo lêzêdekirinê wiha xuya dike:
Zêde bike::$key->AddToplevel
Û ji bo verastkirina bi vî rengî:
Biguherîne::$key-> Zêde bike::$key->AddTopLevel
Mînakî, em werin sererastkirina komekê, yanî. Piştî ku li ser navê komê ya di darê de bikirtînin, bişkojka guherandinê ya li darikê amûrê (pênûsê) bikirtînin û forma têkildar dê li ser ekranê were xuyang kirin:
Biguherîne:: kom
proc Edit::cluster {tree host values} {
global default lifetime_limit expiration_timeout session_fault_tolerance_level
global max_memory_size max_memory_time_limit errors_count_threshold security_level
global load_balancing_mode kill_problem_processes active_cluster
agent_user agent_pwd cluster_user cluster_pwd auth
if {$cluster_user ne "" && $cluster_pwd ne ""} {
set auth "--cluster-user=$cluster_user --cluster-pwd=$cluster_pwd"
} else {
set auth ""
}
# рисуем форму для кластера
set frm [Add::cluster $tree $host $values]
# меняем текст на метке
$frm configure -text "Редактирование кластера"
set active_cluster $values
# получаем данные по выделенному кластеру
set lst [RunCommand cluster::$values "cluster info --cluster=$active_cluster $host"]
# заполняем поля
FormFieldsDataInsert $frm $lst
# выключаем поля, редактирование которых запрещено
$frm.ent_host configure -state disable
$frm.ent_port configure -state disable
# переназначаем обработчик
.add.frm_btn.btn_ok configure -command {
RunCommand "" "cluster update
--cluster=$active_cluster $auth
--name=[.add.frm.ent_name get]
--expiration-timeout=$expiration_timeout
--lifetime-limit=$lifetime_limit
--max-memory-size=$max_memory_size
--max-memory-time-limit=$max_memory_time_limit
--security-level=$security_level
--session-fault-tolerance-level=$session_fault_tolerance_level
--load-balancing-mode=$load_balancing_mode
--errors-count-threshold=$errors_count_threshold
--kill-problem-processes=$kill_problem_processes
$auth $host"
$tree delete "cluster::$active_cluster"
Run::server $tree $host ""
destroy .add
}
}Li ser bingeha şîroveyên di kodê de, di prensîbê de, her tişt zelal e, ji bilî ku koda hilgirê bişkojkê tê guheztin û pêvajoyek FormFieldsDataInsert heye ku zeviyan bi daneyan tije dike û guhêrbaran dest pê dike:
FormFieldsDataInsert
proc FormFieldsDataInsert {frm lst} {
foreach i [lindex $lst 0] {
# получаем список параметров и значений
if [regexp -nocase -all -- {(D+)(s*?|)(:)(s*?|)(.*)} $i match param v2 v3 v4 value] {
# меняем символы
regsub -all -- "-" [string trim $param] "_" entry_name
# заполняем данными
if [winfo exists $frm.ent_$entry_name] {
$frm.ent_$entry_name delete 0 end
$frm.ent_$entry_name insert end [string trim $value """]
}
if [winfo exists $frm.cb_$entry_name] {
global $entry_name
set $entry_name [string trim $value """]
}
# для чекбоксов меняем значения
if [winfo exists $frm.check_$entry_name] {
global $entry_name
if {$value eq "0"} {
set $entry_name no
} elseif {$value eq "1"} {
set $entry_name yes
} else {
set $entry_name $value
}
}
}
}
}
Di vê pêvajoyê de, avantajek din a tcl derket holê - nirxên guhêrbarên din wekî navên guhêrbar têne cîh kirin. Ewan. ji bo otomatîzekirina dagirtina form û destpêkirina guhêrbaran, navên zevî û guherbaran bi guhêrbarên rêza fermanê yên kargêriya rac re û navên pîvanên derana fermanê bi hin îstîsnayan re têkildar in - tîrêj bi xêzek jêrîn tê guheztin. Mînak plansaz kirin-kar-inkarkirin meydanê li hev dike ent_scheduled_jobs_deny û guherbar scheduled_jobs_deny.
Dibe ku formên lê zêdekirin û guherandinê di pêkhatina qadan de cûda bin, mînakî, bi bingehek agahdarî re xebitîn:
Zêdekirina ewlehiya agahdariyê
Guhertina ewlehiya agahdariyê
Di pêvajoya guherandinê de Biguherîne::infobase, qadên pêwîst li formê têne zêdekirin, ji ber vê yekê ez li vir pêşkêşî nakim.
Bi analogî, prosedurên lê zêdekirin, sererastkirin, jêbirin ji bo hêmanên din têne bicîh kirin.
Ji ber ku karûbarê karûbar tê wateya hejmareke bêsînor server, kom, bingehên agahdarî, hwd., Ji bo destnîşankirina kîjan komê girêdayî kîjan server an pergala ewlehiya agahdariyê ye, gelek guhêrbarên gerdûnî hatine destnîşan kirin, ku nirxên wan her yek têne danîn. dema ku hûn li ser hêmanên darê bitikînin. Ewan. prosedur bi paşverû di nav hemî hêmanên dêûbav re derbas dibe û guhêrbaran destnîşan dike:
SetGlobalVarFromTreeItems
proc SetGlobalVarFromTreeItems {tree id} {
global host server active_cluster infobase
set parent [$tree parent $id]
set values [$tree item $id -values]
set key [lindex [split $id "::"] 0]
switch -- $key {
server {set host $values}
work_server {set server $values}
cluster {set active_cluster $values}
infobase {set infobase $values}
}
if {$parent eq ""} {
return
} else {
SetGlobalVarFromTreeItems $tree $parent
}
}
Koma 1C dihêle hûn bi destûr an bê destûr bixebitin. Du celeb rêveber hene - rêveberê nûnerê komê û rêveberê komê. Li gorî vê yekê, ji bo xebitandina rast, 4 guhêrbarên gerdûnî yên din ku têketin û şîfreya rêveberê tê de hene, hatin destnîşan kirin. Ewan. heke di komê de hesabek rêveberî hebe, dê diyalogek were xuyang kirin ku têketin û şîfreya we têkevin, dane dê di bîranînê de werin hilanîn û di her fermanê de ji bo koma têkildar têkevin.
Ev berpirsiyariya prosedûra hilgirtina xeletiyan e.
ErrorParcing
proc ErrorParcing {err opt} {
global cluster_user cluster_pwd agent_user agent_pwd
switch -regexp -- $err {
"Cluster administrator is not authenticated" {
AuthorisationDialog "Администратор кластера"
.auth_win.frm_btn.btn_ok configure -command {
set cluster_user [.auth_win.frm.ent_name get]
set cluster_pwd [.auth_win.frm.ent_pwd get]
destroy .auth_win
}
#RunCommand $root $par
}
"Central server administrator is not authenticated" {
AuthorisationDialog "Администратор агента кластера"
.auth_win.frm_btn.btn_ok configure -command {
set agent_user [.auth_win.frm.ent_name get]
set agent_pwd [.auth_win.frm.ent_pwd get]
destroy .auth_win
}
}
"Администратор кластера не аутентифицирован" {
AuthorisationDialog "Администратор кластера"
.auth_win.frm_btn.btn_ok configure -command {
set cluster_user [.auth_win.frm.ent_name get]
set cluster_pwd [.auth_win.frm.ent_pwd get]
destroy .auth_win
}
#RunCommand $root $par
}
"Администратор центрального сервера не аутентифицирован" {
AuthorisationDialog "Администратор агента кластера"
.auth_win.frm_btn.btn_ok configure -command {
set agent_user [.auth_win.frm.ent_name get]
set agent_pwd [.auth_win.frm.ent_pwd get]
destroy .auth_win
}
}
(.+) {
tk_messageBox -type ok -icon error -message "$err"
}
}
}Ewan. li gorî çi ferman vedigere, dê bertek jî li gorî wê be.
Heya nuha, ji sedî 95-ê fonksiyonê hatî bicîh kirin, ya ku dimîne ev e ku meriv bi profîlên ewlehiyê re xebatê bicîh bîne û wê ceribandin =). Navê pêger. Ez lêborîna xwe dixwazim ji bo çîroka qirçîn.
Kod bi kevneşopî heye .
Nûvekirin: Min bi profîlên ewlehiyê re xebata xwe qedand. Naha fonksiyon 100% pêk tê.
Nûvekirin 2: herêmîkirina bi Englishngilîzî û Rûsî hate zêdekirin, xebata di win7 de hate ceribandin
Source: www.habr.com