#!/usr/bin/wish

# Copyright (c) 2002-2014, Botik Technologies, Ltd.
# See license.txt for more information.

# BotikTester - программа для тестирования качества связи.
# Дата начала разработки: 4 ноября 2002 года.

# ===========================================================================================
proc mkErrorCode { rc {delim "\n"}} {
   global errorCode
   set x $errorCode
   set t [lindex $x 0]
   switch $t {
      ARITH       -
      CHILDKILLED -
      CHILDSUSP   - 
      POSIX       { return "[lindex $x end]$delim$rc" }
      default     { return $rc }
   }
}

proc loadModule { fname } {
   global myModules
   if [info exists myModules($fname)] {
      tk_messageBox -icon warning -type ok -message "Модуль \"$fname\" уже загружен"
      return
   }
   set ok 0
   catch {
      source $fname
      set ok 1
      set myModules($fname) 1
   } rc
   if { ! $ok } {
      set msg "Не удалось загрузить модуль программы:\n\"$fname\"\nError: [mkErrorCode $rc]\n\
            Выполнение программы сейчас будет завершено.\
            Советуем попробовать переустановить программу."
      tk_messageBox -icon error -type ok -message $msg
      asksendmail $msg
      exit
   }
   return
}

proc loadImage { name fname } {
   global myImages
   if [info exists myImages($name)] {
      return
   }
   set ok 0
   catch {
      set myImages($name) [image create photo -file $fname]
      set ok 1
   } rc
   if { ! $ok } {
      set msg "Не удалось загрузить графический файл для программы:\n\"$fname\"\nError: [mkErrorCode $rc]\n\
            Выполнение программы сейчас будет завершено.\
            Советуем попробовать переустановить программу."
      tk_messageBox -icon error -type ok -message $msg
      asksendmail $msg
      exit
   }
   return
}

proc debug_ {str} {
   message info "DEBUG $str"
}
proc debug {str} {
    catch {
        set file [appFile btdebug.txt]
        set f [open $file a]
        puts $f $str
        close $f
    }
}

# ================= 0 Константы и настройки =================================================
proc initValues {} {
   global ping goon env wReport speed iface

   # Версия, дата текущей версии и начало разработки :
   set ping(ver)        1.71
   set ping(ver_date)   "21 октября 2014 года"
   set ping(name)       "Botik Tester"
   set ping(version)    "$ping(name) v.$ping(ver)"
   set ping(start_date) "4 ноября 2002 года"

   # ========================================================================================
   # Done: Данные параметры не меняются, но их надо согласовать с Ю.В.Шевчуком...
   #
   # параметры ping-a: размер пакета в байтах, ожидание пакета в мс 
   # (1 сек = 1000 мс), число пакетов за одно нажатие кнопки "тест"

   set ping(size)     1450
   set ping(timeout)  250
   set ping(npings)   100
   set ping(httpto)   15000

   # границы для отлично, хорошо, удовлетворительно и плохо:
   set ping(lat,exel)        30
   set ping(lat,good)        50
   set ping(lat,not_so_bad)  100

   # Modem: минимальная задержка 3 секунды (при 9,600 1.5 КБ
   # уходит и приходит за 1.5+1.5 секунды)
   #
   # элементы ping с индексами:   timeout   lat,exel   lat,good   lat,not_so_bad
   # переопределяются из таблицы (после установки типа подключения) -- см. resetupLanDialupConstants
   #
   #                                     LAN DIALUP
   set ping(lan_modem,timeout)        {  250   3000 }
   set ping(lan_modem,lat,exel)       {   30    600 }
   set ping(lan_modem,lat,good)       {   50   2000 }
   set ping(lan_modem,lat,not_so_bad) {  100   5000 }

   set ping(loss,exel)         1
   set ping(loss,good)         2
   set ping(loss,not_so_bad)   5

   # границы для очень тщательной, тщательной, удовлетворительной и слабой проверки:
   set ping(out,exel)        -999
   set ping(out,good)         -99
   set ping(out,not_so_bad)   -29

   set ping(psize,exel)       -1449
   set ping(psize,good)       -1449
   set ping(psize,not_so_bad)   -64 

   # цвета: RosyBrown2
   
   set ping(c_init)     snow2
   set ping(rgb_init)   { 238 233 233 }
   set ping(c_r)        tomato1
   set ping(rgb_r)      { 225  99 71 }
   set ping(c_y)        yellow1
   set ping(rgb_y)      { 255 255 0 }
   set ping(c_g)        PaleGreen2
   set ping(rgb_g)      { 144 238 144 }
   
   set ping(c_b)        SkyBlue1
   set ping(c_text)     black

   # отметки времени:
   set ping(t_start)    "n/a"
   set ping(t_start2)   "n/a"
   set ping(t_end)      "n/a"

   set ping(repair)      "repair@$::net(domain)"
   set ping(chk_noreason) 1; # проверять, есть ли причины посылать письмо

   # другие инициализации:
   # счетчик трассировок и его предел, счетчик пакетов и его предел
   set ping(traceN)     0
   set ping(MAXtraceN)  15
   set ping(pingsN)     0
   set ping(MAXpingsN)  2000
   set ping(minpacsize) 32
   set ping(maxpacsize) 1450
   set ping(maxto)      3000

   # предел длины списка хостов в окне [1] Параметры ping-теста:
   set ping(MAXN)       300

   # предел длины списка хостов в окне [2] Выполнение ping-теста:
   set ping(MAXNN)       50

   # Что такое приемлемый (good) и слишком большой (bad) уровни потерь ping-a (%%):
   set ping(good)       $ping(loss,good)
   set ping(bad)        $ping(loss,not_so_bad)

   # иное
   set ping(showtrace)  0
   set ping(bad_traces) 0
   set ping(raw_trrt,N) 0
   set ping(regAbName) {^[A-Za-z0-9-]+$}
   set goon 1

   set ping(bad_pings,K) 0
   set ping(bad_pings,N) 0
   set ping(bad_pings,MAXK) 10

   set ping(init_ver)         99999.99 ; # init-файл, что мы считали, построен для Botik Tester-a этой версии
   set ping(cancel_request)   0
   set ping(current_request)  ""
   set ::botiktools(progname) $ping(name)

   # Имена файлов:
   #
   # Внимание! в analyzeDataFromUrl --> switch -regexp  кусочки имен файлов записаны явно.
   # Правите имена файлов -- не забудьте поправить и там...

   set ping(init_file)            [appFile tester.init]
   set ping(url)                  http://www.botik.ru/~botik/tester
   set ping(url_tools)            http://www.botik.ru/~botik/tools
   set ping(url_dload)            "http://www.$::net(domain)/~botik/tools/download.ru.html#sWin"
   set ping(ab_page)              http://nadmin.$::net(domain)
   set ping(url_versions)         http://www.$::net(domain)/~botik/download/versions.txt
   set ping(url_whoami)           https://nadmin.$::net(domain)/~nadmin/whoami.cgi
   set ping(url_config)           https://nadmin.$::net(domain)/~nadmin/botiktester-config.cgi
   set ping(url_counter)          http://www.$::net(domain)/cgi-bin/Count.cgi?df=
   set ping(term_page)            http://www.$::net(domain)/2/abonents/paypoint/paiment.html
   set ping(office_page)          http://www.$::net(domain)/2/botik-office/index.html

   set ping(whoami,UserName)    ""
   set ping(whoami,HostName)    ""
   set ping(whoami,IP)          ""
   set ping(whoami,Connection)  "" ; # LAN | DIALUP
   set ping(whoami,Email)       ""
   set ping(whoami,Time)        ""
   set ping(whoami,LTime)       ""
   set ping(whoami,speedLimit)  ""; # 0 or 10 (MBps)
   set ping(whoami,pingBlocked) ""; # 0 or 1
   set ping(whoami,connBlocked) ""; # 0 or 1 or some text
   set ping(whoami,flowSpeed)   ""
   set ping(whoami,TARIFF)      ""
   set ping(whoami,TARIFF_SPEED) 0; # минимальная гарантированная скорость по тарифу
   set ping(whoami,BotikKey) ""
   set ping(speedresult) ""
   set ping(speedresult2) ""
   set ping(speed_ip) ""
   set ping(abonent) ""
   set ping(myhost)  ""
   set ping(isModem) 0
   set ping(diag)    ""
   set ping(diag_errors) ""
   set ping(minlocspeed) 7168; # мин. локальная скорость в Кбит/с
   set wReport(From)     ""
   set ::bgtraf(res) ""
   for {set i 0} {$i < 9} {incr i} {set wReport(Body$i) ""}
   set ping(by_whoami,UserName)   0
   set ping(by_whoami,Connection) 0
   set ping(by_whoami,HostNameIP) 0
   set ping(own,UserName)      "n/a"
   set ping(own,HostName)      "n/a"
   set ping(own,IP)            "n/a"
   set ping(own,Connection)    "n/a" ; # LAN | DIALUP
   set ping(sysnodes)          [list]
   setPingImage
   if {[windowsPlatform]} {
      set iface(font1) {Arial 10 bold}
      set iface(font2) {Helvetica 11 bold}
      set iface(font3) {Courier 9 bold}
      set iface(font4) {Courier 9}
      set iface(font5) {Helvetica 10 bold}
      set iface(font6) {Arial 8}
   } else {
      set iface(font1) {Courier 13 bold}
      set iface(font2) {Courier 13 bold}
      set iface(font3) {Courier 11 bold}
      set iface(font4) {Courier 11}
      set iface(font5) {Courier 10 bold}
      set iface(font6) {Courier 8}
   }
   set ping(trrt_f)   {}
   set ping(pids)     {}
   set ping(loc_lat_lvl) 0
   set ping(loc_loss_lvl) 0
   set ping(out_lat_lvl) 0
   set ping(out_loss_lvl) 0
   return
}
proc bt_exe {} {
    return [expr {[info exists ::bt_exe] && $::bt_exe}]
}
proc setPingImage {} {
    set ::ping(pingimg) ping
    if {[windowsPlatform]} {
        set exe [lindex [auto_execok $::ping(pingimg)] 0]
        if {[llength $exe]} {
            set ::ping(pingimg) $exe
        } else {
            append ::ping(pingimg) .exe
        }
    }
    set ::ping(pingpath) $::ping(pingimg)
}
proc analyzeDataFromUrl { url data } {
   global ping versions_http
   set data [encoding convertfrom koi8-r $data]
   switch -regexp $url {
      versions.txt {
         # -------------------------------------------------- versions.txt
         set tokens [scolSplit $data]
         foreach {pgm ver} $tokens {
            if [string is double -strict $ver] {
               set versions_http($pgm) $ver
            }
         }
         if {![info exists versions_http(BotikTools)]} {set versions_http(BotikTools) 0}
         catch {
            if { double($versions_http(BotikTester)) > double($ping(ver)) } {
              #showHelp HelpDownload
              set answer [selfUpdate $ping(name) $ping(ver) $versions_http(BotikTester) $versions_http(BotikTools)]
              if {$answer eq "yes"} {showURL $ping(url_dload)}
            }
         }
      }

      checkme.cgi {
         if { [string length $data] > 0 } {
            catch { showMessage info $data }
         }
      }

      whoami.cgi {
         # -------------------------------------------------- whoami.cgi
         set tokens [scolSplit $data]
         foreach {name val} $tokens {
            set ping(whoami,$name) $val
         }
         if { ![regexp $ping(regAbName) $ping(whoami,UserName)]   } { set ping(whoami,UserName)   "" }
         if { ![regexp {^(LAN|DIALUP)$} $ping(whoami,Connection)] } { set ping(whoami,Connection) "" }
         if { !(([chkIP $ping(whoami,IP)]) && ([isLocal $ping(whoami,HostName) $ping(whoami,IP)]))} {
                                                                      set ping(whoami,IP)         "" 
                                                                      set ping(whoami,HostName)   ""
         }
         if { ![goodEmail $ping(whoami,Email)]                    } { set ping(whoami,Email)      "" }
         if { [regexp {^(\d\d\d\d)/(\d\d)/(\d\d) (\d\d):(\d\d):(\d\d)$} $ping(whoami,Time) skip yyyy mm dd hh mi ss] } {
            set ping(whoami,Time) "$dd/$mm/$yyyy $hh:$mi:$ss"
            set ping(whoami,LTime) [strTime]
         } else {
            set ping(whoami,Time)  ""
            set ping(whoami,LTime) ""
         }
         # debug "whoami.cgi <$ping(whoami,UserName)><$ping(whoami,Connection)><$ping(whoami,IP)><$ping(whoami,HostName)><$ping(whoami,Email)>"
      }

      default {
      }
   }
   return
}

proc chkWhoamiUserName { } {
   global ping

   if {$ping(by_whoami,UserName)} {return 1}

   if {[string length $ping(abonent)] > 0} {
      set ping(own,UserName) $ping(abonent)
   }

   if {[string length $ping(whoami,UserName)] > 0} {
      set ping(abonent) $ping(whoami,UserName)
      set ping(by_whoami,UserName) 1
      return 1
   }
   return 0
}

proc chkWhoamiConnection { } {
   global ping

   if { $ping(by_whoami,Connection) } { return 1 }

   if { $ping(isModem) > -1 } {
      set ping(own,Connection) [lindex { LAN DIALUP } $ping(isModem)]
   }

   if { [string length $ping(whoami,Connection)] > 0 } {
      set ping(isModem) [limits [lsearch -exact { LAN DIALUP } $ping(whoami,Connection)] 0 1]
      set ping(by_whoami,Connection) 1
      return 1
   }
   return 0
}

proc chkWhoamiHostNameIP { } {
   global ping

   if { $ping(by_whoami,HostNameIP) } { return 1 }

   if { ([string length $ping(whoami,HostName)] > 0) && ([string length $ping(whoami,IP)] > 0) } {
      set ping(myhost) "$ping(whoami,HostName) \[$ping(whoami,IP)\]"
      set ping(by_whoami,HostNameIP) 1
      return 1
   }
   return 0
}

# При использовании следует задавать: name = UserName | Connection | HostNameIP
proc mWAI { name } {
   global ping
   set f 0
   catch { set f $ping(by_whoami,$name) }
   if {$f} { return "*" } else { return "" }
}

# ================= 1 Базовые процедуры тестирования =======================
#                      -------- pingTest базовая операция
#
# pingTest выполняет одно-пакетный ping для host (обычно это IP-адрес) и при заданных параметрах 
# Результат: $ping(ms) >= 0 и $ping(rec) = 0|1
#
# Для неудачных тестов еще результат (текст) команды ping сохраняется в кольцевой
# накопитель ping(bad_pings,*) --  число накоплений ограничено
# константой $ping(bad_pings,MAXK), при достижении данного предела новые
# поступления затирают предыдущие (по кольцу). ping(bad_pings,K) -- куда
# писать новые поступления, ping(bad_pings,N) -- сколько было актов
# записи.
# 
proc pingTest {host} {
   global ping
   array set ping [rawPing $host]
   if {$ping(rec) == 0} {
      set kk $ping(bad_pings,K)
      set ping(bad_pings,$kk) "\n$ping(lastPingCmd)\n$ping(lastPingRes)"  
      set ping(bad_pings,K) [expr ($kk + 1) % $ping(bad_pings,MAXK)]
      set ping(bad_pings,N) [expr $ping(bad_pings,N) + 1]
   }

   return
}
# ================= Прародительское окно ==========================================
proc setTitle { t i } {
    wm title . $t
    wm iconname . $i
    if {[windowsPlatform]} {
        wm iconbitmap . [file join . img botik_test.ico]
    } else {
        wm geometry . +200+200
    }
    wm protocol . WM_DELETE_WINDOW {
        doExit
    }
    bind . <Alt-r> "sendRouteInfo"
}
proc addTitlePercent {pc} {
    catch {
        set t [wm title .]
        if {[string match "(*%) *" $t]} {
            set t [lrange $t 1 end]
        }
        set t "($pc%) $t"
        wm title . $t
    }
}
proc setButtons { bs } {
   global iface
   catch {destroy .mw.top.bs}
   set padx [lindex  {0  0 40 30 15 6 3} [llength $bs]]
   # разрядка кнопок: 0  1 2  3  4  5  6 
   set wid [lindex {18 18 18 18 18 18 13} [llength $bs]]
   frame .mw.top.bs
   pack .mw.top.bs -side top -fill y
   foreach ntc $bs {
      set n   [lindex $ntc 0]
      set txt [lindex $ntc 1]
      set cmd [lindex $ntc 2]
      set txtlen [string length $txt]
      if {$txtlen > $wid} {
              set bwid $txtlen
      } else {
              set bwid $wid
      }
      button .mw.top.bs.$n -text $txt -command $cmd -bd 4 -width $bwid
      pack .mw.top.bs.$n -side left -expand 1 -pady 3 -padx $padx -fill both
}  }
#
proc defaultStatus { } {
   .mw.status configure -foreground blue4 -text $::ping(defaultstatus)
   update
}
#
proc specialStatus { s } {
   .mw.status configure -foreground tomato4 -text $s
}
#
proc btnName { b } {
   if { [string index $b 0] eq "."} {
      return $b
   } else {
      return .mw.top.bs.$b
}  }
#
proc stateBtns { s_bss } {
   foreach s_bs $s_bss {
      set st [lindex $s_bs 0]
      set bs [lindex $s_bs 1]
      foreach b $bs {
         catch {[btnName $b] configure -state $st}
}  }  }
#
proc clearCntnt { } {
   catch {destroy .mw.cntnt}
   frame .mw.cntnt
   pack  .mw.cntnt -side top -fill both -expand 1
}
#
proc startInitWindow { } {
   global ping iface

   catch {destroy .mw}
   setTitle "Тестирование СТ \"$::net(name)\" -- [strTime]"  "Botik-test"
   frame .mw -borderwidth 3
   pack  .mw -fill y -expand 1
   focus -force .mw
   
   frame .mw.top -bd 4 -relief ridge
   pack  .mw.top -side top -fill both -pady 1m
   label .mw.top.msg -font $iface(font1) -justify center -text $ping(version) -wraplength -1
   pack  .mw.top.msg -side top

   setButtons { {cancel "Пропустить" doSkipInit} }
   
   label .mw.status -font $iface(font1) -justify center -wraplength -1
   pack  .mw.status -side top
   
   frame .mw.delim -width 650 -height 3 -borderwidth 1 -relief sunken
   pack  .mw.delim -side top -pady 2 -padx 1

   clearCntnt
   # check version
   set ping(defaultstatus) "Инициализация программы: проверка версии программы..."
   defaultStatus
   if {!$ping(cancel_request)} {
      readURL $ping(url_versions) $ping(httpto)
   }
   # read WhoAmI info
   set ping(defaultstatus) "Инициализация программы: запрос данных о подключении..."
   defaultStatus
   if {!$ping(cancel_request)} {
      readURL $ping(url_whoami) $ping(httpto)
   }
   # read hostname
   set ping(defaultstatus) "Инициализация программы: проверка сетевого имени..."
   defaultStatus
   if {!$ping(cancel_request)} {
      myHostName
   }
}
proc doSkipInit {} {
    global ping
    set ping(cancel_request) 1
    catch {
        http::reset $ping(current_request) "cancelled by user"
        upvar 0 $ping(current_request) state
   	    close $state(sock)
    }
}
# ================= 3 Окно "ping-params" ==========================================
#                      -------- добавляет все checkbox-ы с хостом в окно "Ping-params"
proc addAllCheckBoxes { } {
   global ping
   mkCboxes
   set n $ping(NN)
   for {set i 0} {$i < $n} {incr i} {
      addCheckBox $i 1
   }
}
#                      -------- добавляет 1 checkbox с хостом в окно "Ping-params"
proc addCheckBox {i chk} {
   global ping lfrcb
   set ping(selected,$i) [limits $chk 0 1]
   #checkbutton [cbox $i] -text "$ping(n_host,$i)  \[$ping(ip_host,$i)\]  $ping(reason,$i)" -variable ping(selected,$i) -relief flat
   #[cboxestext] configure -state normal
   #[cboxestext] window create end -window [cbox $i]
   #[cboxestext] insert end "\n"
   #[cboxestext] configure -state disabled -cursor arrow
   set n   [_getZone $i]
   set lfr [lindex [cboxestext] [expr $n-1]]
   set j   [llength [pack slaves $lfr]]
   frame $lfr.fr$j
   checkbutton $lfr.fr$j.cb$j -text "$ping(n_host,$i)  \[$ping(ip_host,$i)\]  $ping(reason,$i)" -variable ping(selected,$i) -relief flat
   pack $lfr.fr$j -side top -fill x
   pack $lfr.fr$j.cb$j -side left
   set lfrcb($i) [list $n $j]
   return
}
#                      -------- обновляет текст checkboxа в окне "Ping-params"
proc updateCheckBox {i} {
   global ping
   catch {[cbox $i] configure -text "$ping(n_host,$i)  \[$ping(ip_host,$i)\]  $ping(reason,$i)"}
}
#                      -------- удаляет все checkbox-ы с хостом в окнe "Ping-params"
proc deleteAllCheckBoxes { } {
   catch {destroy [cboxes]}
   catch {destroy .mw.cntnt.scroll}
}
proc chkBlockTrace { } {
   global ping
   [traceBtn] configure -state disabled
   if { $ping(NN) >= $ping(MAXN) } {
      message warning "В списке ping-тестирования уже $ping(NN) хостов.\
                     Новые хосты к списку добавлять невозможно.\
                     Вы можете почистить список."
   } else { 
      if { $ping(traceN) < $ping(MAXtraceN) } {
         [traceBtn] configure -state normal
      }
   }
}
proc reorderPingHosts {} {
   global ping
   set nn 0
   set n $ping(NN)
   for {set i 0} {$i < $n} {incr i} {
      if { $ping(selected,$i) } {
         set n_h($nn)  $ping(n_host,$i)
         set ip_h($nn) $ping(ip_host,$i)
         set rsn($nn)  $ping(reason,$i)
         incr nn
      }
   }
   if {![info exists ping(n_host,0)]} {return}
   if { $nn == 0 } {
      set n_h(0)  $ping(n_host,0)
      set ip_h(0) $ping(ip_host,0)
      set rsn(0)  $ping(reason,0)
      set nn 1
   }
   for {set i 0} {$i < $nn} {incr i} {
      set ping(n_host,$i)  $n_h($i)
      set ping(ip_host,$i) $ip_h($i) 
      set ping(reason,$i)  $rsn($i)  
   }
   set ping(NN) $nn
}
#                      -------- почистить список checkbox-ов в окне "Ping-params"
proc clearChkBoxesInPingParamsWindow { } {
   deleteAllCheckBoxes
   reorderPingHosts
   chkBlockTrace
   addAllCheckBoxes
   update
   return
}
#                      -------- создать подразделы cntnt в окно "Ping-params"
proc mkFramesPP { } {
   frame .mw.cntnt.s
   pack .mw.cntnt.s -side top -fill x
   frame .mw.cntnt.s.lf -bd 4
   frame .mw.cntnt.s.rf 
   pack .mw.cntnt.s.lf -side right -fill x
   pack .mw.cntnt.s.rf -side left  -fill both
   frame .mw.cntnt.s.rf.rfc
   frame .mw.cntnt.s.rf.rft
   pack .mw.cntnt.s.rf.rft .mw.cntnt.s.rf.rfc -side bottom -fill x
}
#                      -------- фрейм для checkbox-ов в окнe "Ping-params"
proc mkCboxes { } {
   global iface
   set mfr .mw.cntnt.cbs
   frame $mfr -highlightthickness 2 -borderwidth 2 -relief sunken
   labelframe $mfr.lf1 -text [zoneName 1] -font $iface(font2)
   labelframe $mfr.lf2 -text [zoneName 2] -font $iface(font2)
   labelframe $mfr.lf3 -text [zoneName 3] -font $iface(font2)
   pack .mw.cntnt.cbs -side left -fill x -expand yes -fill both
   pack $mfr.lf1 $mfr.lf2 $mfr.lf3 -side top -expand 1 -fill both -padx 3 -pady 3
   #set b [.mw.cntnt.cbs cget -background]
   #text  .mw.cntnt.cbs.text -state disabled -yscrollcommand ".mw.cntnt.scroll set" -height 20 -wrap none -background $b
   #pack  .mw.cntnt.cbs.text -expand yes -fill both
   #scrollbar .mw.cntnt.scroll -command ".mw.cntnt.cbs.text yview"
   #pack .mw.cntnt.scroll -side right -fill y
}
#                      -------- имя checkboxов с хостом i в окно "Ping-params"
proc cbox {i} {
    foreach {lfr cb} $::lfrcb($i) {}
    return .mw.cntnt.cbs.lf$lfr.fr$cb.cb$cb
}
proc cboxes { }     { return .mw.cntnt.cbs }
proc cboxestext { } { return [list .mw.cntnt.cbs.lf1 .mw.cntnt.cbs.lf2 .mw.cntnt.cbs.lf3]}
#                      -------- имена двух кнопок в окне "Ping-params"
proc traceLab { } { return .mw.cntnt.s.rf.rft.tr_label }
proc traceEnt { } { return .mw.cntnt.s.rf.rft.tr_entry }
proc traceBtn { } { return .mw.cntnt.s.rf.rft.trace }
proc clearBtn { } { return .mw.cntnt.s.rf.rfc.clear }
#                      -------- фрейм ввода в окне "Ping-params"
proc subFramesPP { ntvs } {
   global iface
   foreach ntv $ntvs {
      set n [lindex $ntv 0]
      frame .mw.cntnt.s.lf.$n -bd 2
      entry .mw.cntnt.s.lf.$n.entry -relief sunken -width 5 -validate key -vcmd {validNumber %P}
      label .mw.cntnt.s.lf.$n.label -text [lindex $ntv 1] -font $iface(font6)
      pack  .mw.cntnt.s.lf.$n.entry -side right
      pack  .mw.cntnt.s.lf.$n.label -side right -padx 4
      .mw.cntnt.s.lf.$n.entry insert 0 [lindex $ntv 2]
      pack .mw.cntnt.s.lf.$n -side top -fill x
   }
}
proc validNumber {n} {
    return [expr {[string is integer -strict $n] || $n eq ""}]
}
proc sizeEnt    { } { return .mw.cntnt.s.lf.f1.entry }
proc timeoutEnt { } { return .mw.cntnt.s.lf.f2.entry }
proc npingsEnt  { } { return .mw.cntnt.s.lf.f3.entry }
#                      -------- пытаемся определить собственный host-name
proc myHostName { } {
   global ping

   if {[info exists ::gothostname]} {return}
   set ::gothostname 1
   set msg [myHName]
   if {[string length $msg] > 2} {
      #message warning "Не удалось определить собственное имя хоста.\
                   Возможно, серьезные проблемы с настройками\
                   и/или с аппаратурой.\
                   Подробности будут указаны в отчете."
      set ping(bad_traces) [expr $ping(bad_traces)+1]
      set n [expr $ping(raw_trrt,N)-1]
      set ping(raw_trrt,$n) "Попытка определить собственное имя -- странная трасса!\n$msg\n$ping(raw_trrt,$n)"
      return
   } else {
      set ping(raw_trrt,N) [expr $ping(raw_trrt,N)-1]
   }
   chkWhoamiHostNameIP
   return
}
#
proc myHName { } {
   global ping

   set hname [info hostname]
   set ping(own,HostName) $hname
   #set ping(myhost) $hname
   set n [rawTraceroute $hname]
   if {$n != 1} {return "Длина ($n) трассы к \"$hname\" не равна 1."}
   set hn $ping(trrt_h,0)
   set ip $ping(trrt_ip,0) 
   # [string first $hname $hn] != 0 
   if {![string match -nocase $hname* $hn]} { return "Имя из трассы \"$hn\" не начинается с \"$hname\"." }
   if {[string compare  $ip "127.0.0.1" ] == 0 } { return "Странный IP-адрес из трассы \"$ip\"." }
   if {[chkIP $ip] != 1 } { return "Странный IP-адрес из трассы \"$ip\"." }
   if {[isLocal $hn $ip] != 1 } { return "Хост \"$hn \[$ip\]\" не похож на хост из СТ \"$::net(name)\"." }
   if {[string first "." $hn] == -1 } {
#      message error "Не удается установить полное (с доменным\
#                   суффиксом) имя Вашей машины.\
#                   Скорее всего, сетевые настройки некорректны." 
   }
   if {$ping(myhost) eq ""} {
           set ping(myhost) "$hn \[$ip\]"
   }
   set ping(own,HostName)      $hn
   set ping(own,IP)            $ip
   return 0
}
#                      -------- главная функция окна "Ping-params"
proc startPingParamsWindow {} {
   global ping iface
   setTitle "Тестирование СТ \"$::net(name)\" -- [strTime]"  "Botik-test"
   set ping(defaultstatus)  "\[1\] выбрать параметры ping-теста, добавить \"проблемные\" хосты"
   defaultStatus
   setButtons { {config "< Настройки"   "startConfigureWindow"}
                {cancel "Закончить"     doExit}
                {help   "Справка"       "showHelp HelpForPingParams"}
                {next   "Ping-тест >>>" "updateValuesAndStartPTWindow"} }
   clearCntnt
   mkFramesPP
   subFramesPP [ subst { { f1 "размер пакета в байтах" $ping(size) } 
                         { f2 "ожидание пакета в мсек" $ping(timeout) } 
                         { f3 "число пакетов в одном тесте" $ping(npings) } } ]

   frame .mw.cntnt.s.rf.rfc.left
   button .mw.cntnt.s.rf.rfc.left.diag  -text "Проверить сетевые настройки" -font $iface(font6) -command "diagButtonCallback" -bd 4 -anchor w
   button .mw.cntnt.s.rf.rfc.left.clear -text "Почистить список хостов" -font $iface(font6) -command "clearChkBoxesInPingParamsWindow" -bd 4 -anchor w
   button [traceBtn] -text "Трассировать и добавить" -font $iface(font6) -command "mkTrace"  -bd 4
   label  [traceLab] -text "проблемный хост:" -font $iface(font6)
   entry  [traceEnt] -relief sunken -width 20
   pack   .mw.cntnt.s.rf.rfc.left -side left -fill both -expand 1
   if {[windowsPlatform]} {
      pack .mw.cntnt.s.rf.rfc.left.diag .mw.cntnt.s.rf.rfc.left.clear -side top -pady 2 -padx 4 -anchor w
   } else {
      pack .mw.cntnt.s.rf.rfc.left.clear -side top -pady 2 -padx 4 -anchor w
   }
   pack   [traceBtn] [traceLab] [traceEnt] -side left -padx 4 -pady 2
   catch {[traceEnt] insert 0 $ping(n_host,0)}

   bind [traceEnt]   <Return> "[traceBtn] invoke"
   bind [sizeEnt]    <Return> "[btnName next] invoke"
   bind [timeoutEnt] <Return> "[btnName next] invoke"
   bind [npingsEnt]  <Return> "[btnName next] invoke"

   set ping(showtrace) 0
   #checkbutton .mw.cntnt.s.rf.rfc.chk -text " показывать текст трассировок" -font $iface(font6) -variable ping(showtrace) -relief flat
   #pack  .mw.cntnt.s.rf.rfc.chk -side right

   set ping(bad_traces) 0
   set ping(raw_trrt,N) 0

   addAllCheckBoxes
   focus .mw.cntnt.s.lf.f1.entry
   if {![findSpeedNode] && [llength $ping(speed_ip)]} {
       addHost2 $ping(speed_ip) $speed::server1 "C"; # add speedtest node into hosts window
   }
   #changesInHelpWindow HelpForPingParams
   #bind . <Control-Return> "addHosts"
   update
   crucialCheck
}
proc diagButtonCallback {} {
    .mw configure -cursor watch
    update
    set diag [diagnose]
    .mw configure -cursor ""
    set ::ping(diag) [lindex $diag 0]
    set shortdiag  [lindex $diag 1]
    if {$::ping(diag) ne ""} {
        diagWindow
    } else {
        message info "Проверка не выявила ошибок в сетевых настройках."
    }
    set ::ping(diag) ""
}
proc addHosts {} {
    global ping
    if {[catch {package require twapi}] || ![winfo exists [traceBtn]]} {return}
        twapi::open_clipboard; # открытие буфера обмена на чтение и запись
        set cbtext [twapi::read_clipboard_text]; # чтение содержимого буфера обмена в виде текста
        twapi::close_clipboard; # закрытие буфера
        set ls [split $cbtext "\n"]
        set boxes1 {}
        set boxes2 {}
        set other  {}
        foreach el $ls {
        set ip    [lindex $el 0]
        set dns   [lindex $el 1]
        set avail [expr {![string equal -nocase [lindex $el end-1] "не"] && [string equal -nocase [lindex $el end] "доступен"]}]
        if {[chkIP $ip] && [string equal "\[" [string index $dns 0]] && [string equal "\]" [string index $dns end]]} {
            set dns [string range $dns 1 end-1]
            if {[ethBox $dns]} {
                if {$avail} {
                    lappend boxes1 [list $ip $dns "B"]
                } else {
                    lappend boxes2 [list $ip $dns "B-"]
                }
            } else {
                if {$avail} {
                    lappend other [list $ip $dns "T"]
                }
            }
        }
        }
        foreach trinity $boxes1 {
            set ip   [lindex $trinity 0]
            set dns  [lindex $trinity 1]
            set comm [lindex $trinity 2]
            addHost2 $ip $dns $comm
        }
        foreach trinity $boxes2 {
            set ip   [lindex $trinity 0]
            set dns  [lindex $trinity 1]
            set comm [lindex $trinity 2]
            addHost2 $ip $dns $comm
        }
        foreach trinity $other {
            set ip   [lindex $trinity 0]
            set dns  [lindex $trinity 1]
            set comm [lindex $trinity 2]
            addHost2 $ip $dns $comm
        }
}
proc findSpeedNode {} {
    global ping
    for {set i 1} {$i <= $ping(NN)} {incr i} {
        if {[info exists ping(n_host,$i)] && $ping(n_host,$i) eq $speed::server1} {
            return $i
        }
    }
    return 0
}
proc addHost2 {ip h comm} {
    global ping
    set ping(ip_host,$ping(NN)) $ip
    set ping(n_host,$ping(NN))  $h
    set ping(reason,$ping(NN))  "$comm"
    addCheckBox $ping(NN) 1
    incr ping(NN)
}
#                      -------- проверка, что check-box уже есть в окне "Ping-params"
proc existHost { ip } {
   global ping

   set n $ping(NN)
   for {set i 0} {$i < $n} {incr i} {
      if { $ping(ip_host,$i) eq $ip} {
         return $i;
      }
   }
   return -1;
}
#                      -------- обработать k-й хост ping(trrt_ip,i) из трассы для окна "Ping-params"
proc procTraceHost {i tmark} {
   global ping

   set k  [expr $i + 1]
   set ip $ping(trrt_ip,$i)
   set h  $ping(trrt_h,$i)
   set j  [existHost $ip]

   if {$j == -1} {
      if { $ping(NN) < $ping(MAXN) } {
         set ping(ip_host,$ping(NN)) $ip
         set ping(n_host,$ping(NN))  $h
         set ping(reason,$ping(NN))  "$tmark$k)"
         addCheckBox $ping(NN) [isLocal $h $ip]
         incr ping(NN)
      }
   } else {
      if { [string first $tmark $ping(reason,$j)] == -1} {
         set ping(reason,$j) "$ping(reason,$j)+$tmark$k)"
         updateCheckBox $j
      }
   }
   return
}
#                      -------- проверка ограничения на число трассировок в окне "Ping-params"
proc chkTraceLimit { } {
   global ping
   if { $ping(traceN) >= $ping(MAXtraceN) } {
      message warning "Уже выполнено $ping(traceN) трассировок. Этого вполне достаточно для тестирования."
      [traceBtn] configure -state disabled
   }
}
#                      -------- блокировка кнопок на время трассировки для окна "Ping-params"
proc mkTrace {} {
   global ping

   set re {^([a-zA-Z0-9\-\.]+)$}
   set h  [eval [traceEnt] get]
   if {[string length $h] == 0} {return}
   if {![regexp $re $h]} {
      message info "Неправильный формат данных. В этом поле можно указать доменное имя или IP-адрес сетевого узла."
      return
   }

   stateBtns [subst { { disabled {[traceBtn] [clearBtn] next config } } }]
   specialStatus "\[1\] Ждите окончания трассировки"
   .mw configure -cursor watch
   # watch X_cursor sailboat based_arrow_down bogosity box_spiral cross_reverse diamond_cross pirate target trek
   update

   mkTraceAll
   set ping(traceN) [expr $ping(traceN) + 1] 

   .mw configure -cursor arrow
   chkTraceLimit
   stateBtns [subst { { normal {[clearBtn] next config } } }]
   chkBlockTrace
   defaultStatus
}
#                      -------- выполнение трассировки и учет ее результатов в окне "Ping-params"
proc mkTraceAll {} {
   global ping iface

   set h [eval [traceEnt] get]

   if { [string length $h] == 0 } {
      return
   }

   set n [rawTraceroute $h]
   if { $n==0 } {
      message warning "Увы, трассировка не удалась."
      set ping(bad_traces) [expr $ping(bad_traces)+1]
      set n [expr $ping(raw_trrt,N)-1]
      set ping(raw_trrt,$n) "$ping(raw_trrt,$n)\nСтранная трасса?!"
      return
   }

   set ntr   $ping(raw_trrt,N)
   set trres $ping(raw_trrt,[expr $ntr-1])
   set tmark "tr($ntr,"

   if { $ping(showtrace) } {
      message info "Результат traceroute:\n\n$trres"
   }

   # результаты tracert обрабатываются в естественном порядке:

   for {set i 0} {$i < $n} {incr i} {
      procTraceHost $i $tmark
   }
   lappend ping(trrt_f) $ping(trrt_ip,[expr $n-1])

   return
}
proc checkBotikKey {} {
    global ping
    set file [appFile accessmode.txt]
    if {[file exists $file]} {
        set mode "WORLD"
        set time 0
        catch {
            set fd [open $file r]
            gets $fd line
            foreach {mode time} $line {break}
            close $fd
        }
        set ping(whoami,BotikKey) $mode
        if {$mode ne "WORLD" && [string is integer -strict $time] && [clock seconds] - $time <= 60} {
            set msg "Программа BotikKey на Вашем компьютере работает в режиме $mode. При таком режиме доступа измерение скорости внешнего канала невозможно.\nВы действительно хотите продолжить?"
            set ans [alertQuestion $msg]
            if {$ans eq "no"} {return 1}
        }
    }
    return 0
}
proc ethBox {host} {return [string match box-*.$::net(domain) $host]}
#                      -------- вычитать все параметры из окна "Ping-params", перейти к Ping-тесту
proc updateValuesAndStartPTWindow {} {
   global ping pinghostn
   if {[checkBotikKey]} {return}
   clearChkBoxesInPingParamsWindow
   #if {[set pos [findSpeedNode]] > 0}
      #set ping(selected,$pos) 0
   set size [eval [sizeEnt] get]
   if {[lempty $size]} {set size $ping(size)}
   set timeout [eval [timeoutEnt] get]
   if {[lempty $timeout]} {set timeout $ping(timeout)}
   set npings [eval [npingsEnt] get]
   if {[lempty $npings]} {set npings $ping(npings)}
   set ping(size)    [limits [expr int($size)] $ping(minpacsize) $ping(maxpacsize)]
   set x             [lindex {50 3000} $ping(isModem)]
   set ping(timeout) [limits [expr int($timeout)] $x $ping(maxto)]
   set ping(npings)  [limits [expr int($npings)] 10 $ping(MAXpingsN)]
   set n $ping(NN)
   set nn 0
   set bn 0
   for {set i 0} {$i < $n} {incr i} {
      if {$ping(selected,$i)} {
         if {[ethBox $ping(n_host,$i)]} {
             incr bn
             continue
         }
         set ping(host,$nn)     $ping(n_host,$i)
         set ping(host_ip,$nn)  $ping(ip_host,$i)
         set ping(h_reason,$nn) $ping(reason,$i)
         set pinghostn($ping(ip_host,$i)) $nn
         incr nn
      }
   }
   if {![info exists ping(n_host,0)]} {return}
   if {$nn == 0} {
         set ping(host,0)    $ping(n_host,0)
         set ping(host_ip,0) $ping(ip_host,0)
         set ping(h_reason,0) $ping(reason,0)
         incr nn
   }
   if {$bn > 0} {
      message warning "Среди отмеченных хостов найдено несколько ($bn) модулей EtherBox. По причине больших задержек они тестироваться не будут."
   }
   if {$nn > $ping(MAXNN)} {
      set nn $ping(MAXNN)
      message warning "Очень много отмеченных хостов. Только первые $ping(MAXNN) из отмеченных приняты во внимание."
   }
   set ping(N) $nn
   startPTWindow
}
# ================= 4 Окно "ping-тест" ============================================
#                      -------- форматы для окна "Ping-тест"
proc pingTitle { } {
   return [ format "%-17s %25s : %5s %5s : %4s%% : %6s : %6s : %6s" \
            "IP-адрес" "Имя хоста" out loss loss "ms min" "ms max" "ms avg" ]
}
proc pingFmt {ihost p_out p_in pc_loss ms_min ms_max ms_avg} {
   global ping
   set host    [rightDots 25 $ping(host,$ihost) ]
   set comment [rightDots 25 "\[$ping(host_ip,$ihost)\]" ]

   set loss [expr $p_out - $p_in]

   if { $p_in==0 } {
      return [ format "%-17s %25s : %5d %5d : %4d%% :   n/a  :   n/a  :   n/a " \
               $comment $host [expr int($p_out)] [expr int($loss)] [expr int($pc_loss)]  ]
   }

   return [ format "%-17s %25s : %5d %5d : %4d%% : %6d : %6d : %6d" \
            $comment $host [expr int($p_out)] [expr int($loss)] [expr int($pc_loss)] [expr int($ms_min)] [expr int($ms_max)] [expr int($ms_avg)] ]
}
#                      -------- имя строки $i в окне "Ping-тест"
proc namePT { i } {
   return .mw.cntnt.line$i
}
#                      -------- проверка ограничения на число ping-ов в окне "Ping-тест"
proc chkPingsLimit { } {
   global ping
   if { $ping(pingsN) >= $ping(MAXpingsN) } {
      message warning "Уже выполнено $ping(pingsN) ping-тестов. Этого вполне достаточно для тестирования."
      [btnName run] configure -state disabled
      set ping(defaultstatus) "\[2\] уже сделано достаточно ping-тестов ($ping(pingsN) пакетов), написать отчет?"
      defaultStatus
      return 1
   }
   set ping(defaultstatus) "\[2\] запустить еще ping-тест ($ping(npings) пакетов) или написать отчет?"
   defaultStatus
   return 0
}
proc kbit2mbit {kbit} {
    return [format "%.2f Мбит/с" [expr {$kbit / 1000.0}]]
}
#                      -------- главная функция окна "Ping-тест"
proc startPTWindow {} {
   global ping iface

   setTitle "Ping-тестирование -- [strTime]" "Ping-test"
   set ping(pingsN) 0
   catch {array unset ::pcnt}
   chkPingsLimit

   setButtons [subst { { back   "<< Назад"  startPingParamsWindow }
                       { cancel "Закончить" doExit } 
                       { help   "Справка"   "showHelp HelpForPingTest"} 
                       { run    "Еще $ping(npings) ping-пакетов" "runPings 1" }
                       { stop   "Остановить ping-тест" "stopPings"} 
                       { report "Написать отчет" "startReportWindow" } } ]
   [btnName stop] configure -state disabled
   clearCntnt

   # Шкала:
   set swidth 610
   frame .mw.cntnt.cY -bd 4 -width [expr {$swidth + 10}]
   label .mw.cntnt.cY.label -text "0%" -font $iface(font1) -anchor w
   if {[windowsPlatform]} {
       ttk::progressbar .mw.cntnt.cY.pc -variable ::tuneprogress -mode determinate -length $swidth
       set ::tuneprogress 0
       pack .mw.cntnt.cY -side top -fill x -expand 1
       pack .mw.cntnt.cY.pc -side left
       pack .mw.cntnt.cY.label -side right -expand 1 -fill x -padx 2
   } else {
       canvas .mw.cntnt.cY.canvas -width $swidth -height 20 -bd 0 -highlightthickness 0
       .mw.cntnt.cY.canvas create rectangle 0 0 1 1 -fill #35d538 -tags polyL; #DeepSkyBlue3
       .mw.cntnt.cY.canvas create rectangle 0 0 1 1 -fill snow1 -tags polyR
       pack .mw.cntnt.cY -side top
       pack .mw.cntnt.cY.canvas .mw.cntnt.cY.label -side left
   }
   setScalePC 0 1

   set n $ping(N)
   #  начальная роспись всех строк таблицы в окне "Ping-тест"   
   #  роспись заголовка таблицы в окне "Ping-тест"
   label [namePT Title] -foreground $ping(c_text) -font $iface(font3) \
                        -background $ping(c_init) -justify right -text [pingTitle]
   pack  [namePT Title] -side top
   
   foreach {h j k} {0 0 0} {}
   for {set i 0} {$i < $n} {incr i} {
      set zone [_getZone $i]
      if {$zone==1} {
         incr h
      } elseif {$zone==2} {
         incr j
      } else {incr k}
   }
   set len 85
   set char "="
      #  роспись остальных строк таблицы в окне "Ping-тест"
   if {$h > 0} {
      label .mw.cntnt.line_zone1 -foreground $ping(c_text) -font $iface(font5) \
         -background $ping(c_init) -justify right -text [insertBetween [zoneName 1] $char $len]
      pack .mw.cntnt.line_zone1 -side top
   }
   for {set i 0} {$i < $n} {incr i} {
      set zone [_getZone $i]
      if {$zone==2 || $zone==3} {continue}
      set ping($i,out)  0
      set ping($i,out2) 0
      set ping($i,in)   0
      set ping($i,loss) 0
      set ping($i,min)  1000000
      set ping($i,max)  0
      set ping($i,avg)  0
      set ping($i,sum)  0
      label [namePT $i] -foreground $ping(c_text) -font $iface(font4) \
                        -background $ping(c_init) -justify right -text [pingFmt $i 0 0 0 0 0 0]
      pack  [namePT $i] -side top
   }
   if {$j > 0} {
      if {[windowsPlatform]} {
          set font $iface(font5)
      } else {
          set font $iface(font2)
      }
      label .mw.cntnt.line_zone2 -foreground $ping(c_text) -font $font \
         -background $ping(c_init) -justify right -text [insertBetween [zoneName 2] $char $len]
      pack .mw.cntnt.line_zone2 -side top
   }
   #  роспись остальных строк таблицы в окне "Ping-тест"
   for {set i 0} {$i < $n} {incr i} {
      set zone [_getZone $i]
      if {$zone==1 || $zone==3} {continue}
      set ping($i,out)  0
      set ping($i,out2) 0
      set ping($i,in)   0
      set ping($i,loss) 0
      set ping($i,min)  1000000
      set ping($i,max)  0
      set ping($i,avg)  0
      set ping($i,sum)  0
      label [namePT $i] -foreground $ping(c_text) -font $iface(font4) \
                        -background $ping(c_init) -justify right -text [pingFmt $i 0 0 0 0 0 0]
      pack  [namePT $i] -side top
   }
   if {$k > 0} {
      if {[windowsPlatform]} {
          set font $iface(font5)
      } else {
          set font $iface(font2)
      }
      label .mw.cntnt.line_zone3 -foreground $ping(c_text) -font $font \
         -background $ping(c_init) -justify right -text [insertBetween [zoneName 3] $char [expr $len-4]]
      pack .mw.cntnt.line_zone3 -side top
   }
   #  роспись остальных строк таблицы в окне "Ping-тест"
   for {set i 0} {$i < $n} {incr i} {
      set zone [_getZone $i]
      if {$zone==1 || $zone==2} {continue}
      set ping($i,out)  0
      set ping($i,out2) 0
      set ping($i,in)   0
      set ping($i,loss) 0
      set ping($i,min)  1000000
      set ping($i,max)  0
      set ping($i,avg)  0
      set ping($i,sum)  0
      label [namePT $i] -foreground $ping(c_text) -font $iface(font4) \
                        -background $ping(c_init) -justify right -text [pingFmt $i 0 0 0 0 0 0]
      pack  [namePT $i] -side top
   }

   #changesInHelpWindow HelpForPingTest
   runPings
}
#                      -------- прервать пинги в окне "Ping-тест"
proc stopPings {} {
   set ::goon 0
}
#                      -------- все пинги всех хостов с покадровой перерисовкой экрана в окне "Ping-тест"
proc runPings {{more {0}}} {
   global ping goon

   if { [chkPingsLimit] } {
      return
   }
   incrCounter "bttest"
   set n $ping(N)
   set secMax [expr int(double($n * $ping(npings) * $ping(timeout)) / 1000.0)]
   set x      [lindex { 105 3000 } $ping(isModem)]
   set secMin [expr int(double($n * $ping(npings) * $x) / 1000.0)]

   setScalePC 0 1
   stateBtns { { disabled {back run report} } { normal { stop } } }
   specialStatus "\[2\] Выполняется ping-тест ($ping(npings) пакетов)"; # $secMin...$secMax секунд
   update

   set ping(t_start)  [strTime]
   set ping(t_start2) [strTime2]
   # ping(npings) - число пакетов
   # n - число хостов
   #set ping(pingsN) 0
   if {$more} {
       incr ping(pingsN) $ping(npings)
   } else {
       set ping(pingsN) $ping(npings)
   }
   set goon 1
   set ::execnt 0
   if {$ping(whoami,TARIFF) eq "base"} {
      set goon 1
      if {!$more} {set ping(pingsN) 0}
      for {set i 0} {$i < $n} {incr i} {
          set ping($i,out2) 0
      }
      for {set j 0} {$j < $ping(npings) && $goon && $ping(pingsN) < $ping(MAXpingsN)} {incr j} {
         for {set i 0} {$i < $n && $goon} {incr i} {
            onePing $i $ping(pingsN)
         }
         set ping(t_end) [strTime]
         incr ping(pingsN)
      }
      set goon 1
      pingFinished
   } else {
      doAllWork $n
   }
}
proc doAllWork {n} {
    global ping
    for {set i 0} {$i < $n} {incr i} {
        set ping($i,out2) 0
    }
    if {![info exists ::bt_exe]} {
        for {set i 0} {$i < $n} {incr i} {
            paraPing $i $ping(npings)
        }
        return
    }
    set hosts {}
    set cmd [list ping -h -n 1 -l $ping(size) -w $ping(timeout) -d 500]
    set tline "Request timed out."
    for {set i 0} {$i < $n} {incr i} {
        set ip $ping(host_ip,$i)
        set ::headings($ip) "Pinging $ip with $ping(size) bytes of data:"
        lappend cmd $ip
        lappend hosts $ip
    }
    for {set j 0} {$j < $ping(npings)} {incr j} {
        if {!$::goon} {pingFinished; return}
        set res [eval $cmd]; # running embedded ping
        set lines [split $res \n]
        set lcount 0
        set chosts {}
        foreach line $lines {
            if {[llength $line]==0} {continue}
            if {$n > 1} {
                set ipid [lindex $line 0]
                if {[string is integer -strict $ipid]} {
                    set ip [lindex $hosts $ipid]
                } else {continue}
                procPingLine [lrange $line 1 end] $ip "ping -l $ping(size) -w $ping(timeout) -n 1 $ip"
            } else {
                procPingLine $line $ip "ping -l $ping(size) -w $ping(timeout) -n 1 $ping(host_ip,0)"
            }
            lappend chosts $ip; # correctly processed hosts
            incr lcount
        }
        if {$lcount != $n} {
            # some info from proc 'ping' was unavailable
            set ihosts [diff $hosts $chosts]; # incorrectly processed hosts
            foreach ih $ihosts {
                procPingLine $tline $ih "ping -l $ping(size) -w $ping(timeout) -n 1 $ih"
            }
        }
    }
    pingFinished
}
# diff: возвращает те элементы из list1, которых нет в list2
proc diff {list1 list2} {
    foreach v $list1 {set la1($v) {}}
    foreach v $list2 {
        if {[info exists la1($v)]} {
            unset la1($v)
        }
    }
    return [lsort [array names la1]]
}
#                      -------- плавное изменение цвета от rgb0 до rgbf при j = 0 .. 100
proc colorJ { j rgb0 rgbf } {
   if { $j < 1} {
      set rgb $rgb0 
   } elseif { $j > 99} {
      set rgb $rgbf 
   } else {
      set rgb [list \
         [limits [expr {round( double((100-$j)*[lindex $rgb0 0] + $j*[lindex $rgbf 0])/double(100.0)) }]  0 255] \
         [limits [expr {round( double((100-$j)*[lindex $rgb0 1] + $j*[lindex $rgbf 1])/double(100.0)) }]  0 255] \
         [limits [expr {round( double((100-$j)*[lindex $rgb0 2] + $j*[lindex $rgbf 2])/double(100.0)) }]  0 255] \
      ]
   }
   set x [format "\#%02X%02X%02X" [lindex $rgb 0] [lindex $rgb 1] [lindex $rgb 2] ]
   return $x
}
proc paraPing {ihost np} {
    global ping
    set ip $ping(host_ip,$ihost)
    set pid 0
    if {[windowsPlatform]} {
        if {[WinNT6]} {
            set pid [pipexec $ping(pingpath) -4 -n $np -l $ping(size) -w $ping(timeout) $ip]
        } else {
            set pid [pipexec $ping(pingpath) -n $np -l $ping(size) -w $ping(timeout) $ip]
        }
    } else {
        set timeo [expr $ping(timeout)/1000.0]
        if {[macPlatform]} {
            set timeo [expr ceil($timeo)]
        }
        set pid [pipexec $ping(pingpath) -c $np -s $ping(size) -i $timeo $ip]
    }
    lappend ping(pids) $pid
}
proc pipexec {args} {
    set host [lindex $args end]
    set pipe [open "|$args" r]
    fconfigure $pipe -buffering line -blocking 1
    fileevent $pipe readable "gotPingLine $pipe $host $args"
    return [pid $pipe]
}
proc killPing {} {
    if {![info exists ::taskkill]} {
        set ::taskkill 0
        foreach pid $::ping(pids) {
            catch {kill $pid}
        }
        set ::ping(pids) {}
        unset ::taskkill
    }
}
proc gotPingLine {pipe host args} {
    global goon execnt ping
    if {!$goon} {
        fileevent $pipe readable {}
        killPing
        catch {close $pipe}
        incr execnt
        if {$execnt == $ping(N)} {pingFinished}
        return
    }
    set got [gets $pipe]
    set line {}
    if {[string length $got]} {
        set line $got
    }
    if {[fblocked $pipe]} {
        set line [read -nonewline $pipe]
    }
   if {[bt_exe]} {
        set line [encoding convertfrom cp866 $line]
   } else {
        set line [encoding convertfrom cp866 [encoding convertto cp1251 $line]]
   }
    regsub -all \n $line "" line
    set line [string trim $line]
    if {![lempty $line]} {
        if {![info exists ::headings($host)]} {
            set ::headings($host) $line
        } else {
            procPingLine $line $host $args
        }
    }
    set res 0
    catch {
        set res [eof $pipe]
    }
    if {$res} {
        catch {close $pipe}
        incr execnt
        if {$execnt == $ping(N)} {pingFinished}
    }
    return
}
proc procPingLine {line host pingcmd} {
    global ping pcnt headings
    set pres   $headings($host)\n
    if {[windowsPlatform]} {
        set pingre {:\s*.*=\d+\s*.*[=<>](\d+\.?\d*).*=\d+}
    } else {
        set pingre {:\s*.*=\d+\s*.*=\d+\s*.*=(\d+\.?\d*).*}
    }
    append pres $line
    set lastPingRes $pres
    set lastPingCmd $pingcmd
    set rec 0
    set ms  0
    if {[regexp $pingre $line skip ms]} {
        set rec 1
        if {![info exists pcnt($host)]} {
            set pcnt($host) 1
            changeColors $host $ms $rec $pcnt($host)
        } else {
            if {$pcnt($host) < $ping(pingsN)} {
                incr pcnt($host)
                changeColors $host $ms $rec $pcnt($host)
            }
        }
    } else {
        if {![info exists pcnt($host)]} {
            set pcnt($host) 1
            changeColors $host $ms $rec $pcnt($host)
        } elseif {$pcnt($host) < $ping(pingsN)} {
            incr pcnt($host)
            changeColors $host $ms $rec $pcnt($host)
        }
    }
    return
}
proc doExit {} {
    killPing
    exit
}
proc pingFinished {{r {0}}} {
    global headings goon execnt
    array unset headings
    killPing
    if {$r} {return}
    set goon   1
    set execnt 0
    stateBtns {{normal {back run report}} {disabled {stop}}}
    chkPingsLimit
    update
}
proc changeColors {host ms rec j} {
    global ping pinghostn
    set ping(t_end) [strTime]
    if {[info exists pinghostn($host)]} {
        set ihost $pinghostn($host)
    } else {return}

   set p_in    $ping($ihost,in)
   set p_out   $ping($ihost,out)
   set ms_min  $ping($ihost,min)
   set ms_max  $ping($ihost,max)
   set ms_sum  $ping($ihost,sum)
   set ms_avg  $ping($ihost,avg)

   incr p_out
   if {$rec == 1} {
      incr p_in
      set ms_min [min $ms $ms_min]
      set ms_max [max $ms $ms_max]
      set ms_sum [expr {$ms_sum + $ms}]
      set ms_avg [expr {round(double($ms_sum) / double($p_in))}]
   }

   set pc_loss [expr {round(100.0 - ((double($p_in)*100.0) / double($p_out))) }]

   if { $pc_loss < $ping(good) } {
      set clr [colorJ $j $ping(rgb_init) $ping(rgb_g) ]
   } {
      if { $pc_loss < $ping(bad) } {
         set clr [colorJ $j $ping(rgb_init) $ping(rgb_y) ]
      } {
         set clr [colorJ $j $ping(rgb_init) $ping(rgb_r) ]
      }
   }
   catch {
   [namePT $ihost] configure -background $clr \
         -text [pingFmt $ihost $p_out $p_in $pc_loss $ms_min $ms_max $ms_avg]
   }
   set ping($ihost,in)   $p_in
   set ping($ihost,out)  $p_out
   incr ping($ihost,out2)
   set ping($ihost,sum)  $ms_sum  
   set ping($ihost,min)  $ms_min  
   set ping($ihost,max)  $ms_max  
   set ping($ihost,avg)  $ms_avg  
   set ping($ihost,loss) $pc_loss
   set total [expr {double($ping(npings) * $ping(N))}]
   set current 0
   for {set i 0} {$i < $ping(N)} {incr i} {
      incr current $ping($i,out2)
   }
   set curpc [expr {int(($current/$total)*100.0)}]
   setScalePC $curpc 1
   update
}
#                      -------- 1 пинг 1 хоста и обновление 1 строки таблицы в окне "Ping-тест"
proc onePing {ihost j} {
   global ping
   pingTest $ping(host_ip,$ihost)
   changeColors $ping(host_ip,$ihost) $ping(ms) $ping(rec) $j
}
# ================= 5 Окно "Report" ===============================================
#                      -------- форматы разделителей окна "Report"
proc hrule { i } {
   set len 71
   if {[string is integer $i]} {
       if {$i == 1} {
          return [string repeat "-" $len]
       }
       if {$i == 2} {
          return [string repeat "- " [expr $len/2]][string repeat "-" [expr $len%2]]
       } else {
          set str " 8< "
          return [insertBetween $str "-" $len]; # почти "---------------------------------- 8< ---------------------------------"
       }
   } else {
        return [insertBetween $i "-" $len]
   }
}
# Вставка строки str посередине послед-ти, состоящей из повторов символа char, так,
# чтобы в результате получилась строка длины len
proc insertBetween {str char len} {
    set strlen [string length $str]
    if {$strlen >= $len} {return $str}
    set part1len [expr ($len-$strlen)/2]
    return [string repeat $char $part1len]$str[string repeat $char $part1len][string repeat $char [expr ($len-$strlen)%2]]
}
#                      -------- форматы для таблички "результаты ping-тестов" окна "Report"
proc pingShortTitle { } {
   return [ format "%-22s : %5s %5s : %4s%% : %6s : %6s : %6s" \
            "Имя хоста" out loss loss "ms min" "ms max" "ms avg" ]
}
proc pingShortFmt {ihost p_out p_in pc_loss ms_min ms_max ms_avg} {
   global ping
   
   set host    [rightDots 22 $ping(host,$ihost) ]
   set loss    [expr $p_out - $p_in]
   

   if { $p_in==0 } {
      return [ format "%-22s : %5d %5d : %4d%% :   n/a  :   n/a  :   n/a " \
               $host [expr int($p_out)] [expr int($loss)] [expr int($pc_loss)]]
   }

   return [ format "%-22s : %5d %5d : %4d%% : %6d : %6d : %6d" \
            $host [expr int($p_out)] [expr int($loss)] [expr int($pc_loss)] [expr int($ms_min)] [expr int($ms_max)] [expr int($ms_avg)] ]
}
#
proc interval { x y } {
   if { $x eq $y } {
      return $x
   }
   return "$x..$y"
}
proc bgtraffic {} {
    global ping
    if {![windowsPlatform] || [catch {
        package require twapi
    }]} {return}
    array set status_labels {
        nonoperational "Disconnected"
        disconnected   "Disconnected"
        wanconnecting  "Connecting"
        wanconnected   "Connected"
        operational    "Connected"
    }
    set idxs [twapi::get_netif_indices]
    set in1 [set out1 0]
    foreach idx $idxs {
        array set info [twapi::get_netif_info $idx -inbytes -outbytes -description -operstatus]
        set desc $info(-description)
        if {[string match *Loopback* $desc] || $status_labels($info(-operstatus)) ne "Connected"} {continue}
        set in1 $info(-inbytes)
        set out1 $info(-outbytes)
        break; # use only 1st connected interface
    }
    set res  ""
    set time 3; # seconds
    after [expr {$time*1000}]; # wait
    # collect data:
    foreach idx $idxs {
        array set info [twapi::get_netif_info $idx -inbytes -outbytes -description -operstatus]
        set desc $info(-description)
        if {[string match *Loopback* $desc] || $status_labels($info(-operstatus)) ne "Connected"} {continue}
        set res_in [expr {$info(-inbytes) - $in1}]
        set res_out [expr {$info(-outbytes) - $out1}]
        if {$res_in < 0} {set res_in 0}
        if {$res_out < 0} {set res_out 0}
        set kbits_in [expr {(($res_in*8)/$time)/1000}]
        set kbits_out [expr {(($res_out*8)/$time)/1000}]
        if {$kbits_in > 100 || $kbits_out > 100} {
            set res "\nОбнаружен фоновый IP-трафик: входящий: [kbit2mbit $kbits_in]; исходящий: [kbit2mbit $kbits_out]."
            append res " Для получения достоверных результатов ping-тестирования фонового трафика быть не должно."
            append res " Пожалуйста, останавливайте все сетевые приложения перед запуском программы $ping(name).\n"
            set ::bgtraf($desc) [list $kbits_in $kbits_out]
        }
        break; # use only 1st connected interface
    }
    set ::bgtraf(res) $res
    return
}
#                      -------- по заданным уровням поставить оценку и сказать словами (для окна "Report")
proc estimate { x exel good not_so_bad ws} {
   global ping
   if { $x < $exel } {
      set l 5
   } elseif { $x < $good } { 
      set l 4
   } elseif { $x < $not_so_bad } { 
      set l 3
   } else {
      set l 2
   }
   set ping(level) [min $ping(level) $l]
   set ping(words) [lindex $ws $l]
}
#                      -------- вернуть ping(short_report_text) "краткие выводы" и тэг ping(short_report_tag)
#                      -------- для окна "Report"
proc mkShortReport { } {
   global ping wReport ulbad dlbad

   # доля потерь и задержка:
   set llws   { 0 0 "Неприемлемо большая" "Удовлетворительная" "Маленькая  (хорошо!)" "Совсем маленькая (отлично!)" }
   # пакеты:
   set psws   { 0 0 "неприемлемо маленькие" "маленькие (удовлетв.)" "средние по размеру (хорошо!)" "крупные (отлично!)" }
   # число пакетов:
   set outws  { 0 0 "неприемлемо мало" "мало (удовлетв.)" "достаточное количество (хорошо!)" "много (отлично!)" }
   # тестирование:
   set testws { 0 0 "неприемлемо слабое" "слабое" "достаточно тщательное" "тщательное" }
   # какие проблемы:
   set QoSws  { 0 0 "серьезные проблемы" "мелкие проблемы" "хорошее качество связи" "отличное качество связи"}
   set c $ping(c_g)
   set t ""
   # Анализ потерь и задержек в зоне и вне зоны СТ
   set loss(1,min) 10000
   set loss(1,max) -1
   set lat(1,min)  10000
   set lat(1,max)  -1
   set nn(1)       0

   set loss(2,min) 10000
   set loss(2,max) -1
   set lat(2,min)  10000
   set lat(2,max)  -1
   set nn(2)       0

   set loss(3,min) 10000
   set loss(3,max) -1
   set lat(3,min)  10000
   set lat(3,max)  -1
   set nn(3)       0
   set out         0
   set n $ping(N)
   for {set i 0} {$i < $n} {incr i} {
      if {$ping(host,$i) eq $speed::server1} {continue}
      #set j               [isLocal $ping(host,$i) $ping(host_ip,$i)]
      set j            [getZone $i]; # 1 (==lab's), 2 (==!lab's) or 3 (==!Botik's)
      incr nn($j)
      set lat($j,min)  [min $lat($j,min)  $ping($i,avg) ]
      set lat($j,max)  [max $lat($j,max)  $ping($i,avg) ]
      set loss($j,min) [min $loss($j,min) $ping($i,loss)]
      set loss($j,max) [max $loss($j,max) $ping($i,loss)]
      set out          [max $out          $ping($i,out) ]
   }

   # Потери и задержки:
   set ping(level) 5
   estimate $loss(1,max) $ping(loss,exel) $ping(loss,good) $ping(loss,not_so_bad) $llws
   set ping(loc_loss_lvl) $ping(level)
   set loss1 "$ping(words) доля потерь пакетов ([interval $loss(1,min) $loss(1,max)]\%)"
   estimate $lat(1,max) $ping(lat,exel) $ping(lat,good) $ping(lat,not_so_bad) $llws
   set ping(loc_lat_lvl) $ping(level)
   set lat1 "$ping(words) задержка ([interval $lat(1,min) $lat(1,max)] ms)"
   set botik_level $ping(level)

   # Потери и задержки (не ответств.):
   set ping(level) 5
   estimate $loss(2,max) $ping(loss,exel) $ping(loss,good) $ping(loss,not_so_bad) $llws
   set loss2 "$ping(words) доля потерь пакетов ([interval $loss(2,min) $loss(2,max)]\%)"
   estimate $lat(2,max) $ping(lat,exel) $ping(lat,good) $ping(lat,not_so_bad) $llws
   set lat2 "$ping(words) задержка ([interval $lat(2,min) $lat(2,max)] ms)"
   set botik2_level $ping(level)

   # Потери вне зоны:
   set ping(level) 5
   estimate $loss(3,max) $ping(loss,exel) $ping(loss,good) $ping(loss,not_so_bad) $llws
   set ping(out_loss_lvl) $ping(level)
   set loss3 "$ping(words) доля потерь пакетов ([interval $loss(3,min) $loss(3,max)]\%)"
   set outer_level $ping(level)
   estimate $lat(3,max) $ping(lat,exel) $ping(lat,good) $ping(lat,not_so_bad) $llws
   set ping(out_lat_lvl) $ping(level)

   # Тщательность проверки
   set ping(level) 5
   estimate [expr 0-$ping(size)] $ping(psize,exel) $ping(psize,good) $ping(psize,not_so_bad) $psws
   set psize1 "использовались $ping(words) пакеты ($ping(size) байтов)"
   
   estimate [expr 0-$out] $ping(out,exel) $ping(out,good) $ping(out,not_so_bad) $outws
   set out1 "тестовая серия содержала $ping(words) пакетов ($out)"
   set test_level $ping(level)

   # Сборка отчета:
   set bkey $ping(whoami,BotikKey)
   set test0 [wrapLines 72 "     Было выполнено [lindex $testws $test_level] тестирование: $psize1, $out1."]

   if { $nn(1) > 0 } {
      set test1 [wrapLines 72 "     В зоне ответственности СТ \"$::net(name)\" проверка выявила [lindex $QoSws $botik_level]. $loss1. $lat1." ]
      if {$botik_level < 4 && $bkey eq "NONE"} {
         set w "Ухудшение качества связи может быть вызвано тем, что программа BotikKey на Вашем компьютере работает в режиме NONE (полное отсутствие связи)."
         set test1 [wrapLines 72 "$test1. $w." ]
      }
   } else {
      set test1 ""
      set botik_level 5
   }

   if { $nn(2) > 0 } {
      set test2 [wrapLines 72 "     Вне зоны ответственности СТ \"$::net(name)\" (машины Абонентов -- они просто могут быть неисправны) проверка выявила [lindex $QoSws $botik2_level]. $loss2. $lat2." ]
      if {$botik2_level < 4 && $bkey eq "NONE"} {
         set w "Ухудшение качества связи может быть вызвано тем, что программа BotikKey на Вашем компьютере работает в режиме NONE (полное отсутствие связи)."
         set test2 [wrapLines 72 "$test2. $w." ]
      }
   } else {
      set test2 ""
      set botik2_level 5
   }

   if {$nn(3) > 0} {
      set test3 "     Во внешнем мире проверка выявила [lindex $QoSws $outer_level]. $loss3"
      if {$outer_level < 4} {
         if {$bkey eq "NONE" || $bkey eq "LOCAL"} {
            set explain [expr {($bkey eq "NONE") ? "(полное отсутствие связи)" : "(только локальные обмены внутри СТ \"$::net(name)\")"}]
            set w "Ухудшение качества связи с внешним миром может быть вызвано тем, что программа BotikKey на Вашем компьютере работает в режиме $bkey $explain."
            set test3 [wrapLines 72 "$test3. $w." ]
         } else {
            set w "Однако, СТ \"$::net(name)\" не может отвечать за качество связи в этой зоне. Кроме того, возможны \"мнимые проблемы\" (см. Справку, Рекомендации по составлению списка хостов, подлежащих тестированию, п.3)"
            set test3 [wrapLines 72 "$test3. $w." ]
         }
      } else {
         set test3 [wrapLines 72 "$test3."]
      }
   } else {
      set test3 ""            
      set outer_level 5
   }

   if { $ping(bad_traces) > 0 } {
      set test4 "     Были \"странные\" трассы---или ошибки пользователя при вводе,\nили?... (см. ниже)\n"; # "nили?" - очень вероятная причина ошибочного ввода :-)
   } else {
      set test4 ""
   }

   # Выдача результата

   set ttag \
{   {x  x  2  3  4  5} 
    {x  x  x  x  x  x}
    {2  x YL GR GR GR}
    {3  x YL YL GR GR}
    {4  x RD YL GR GR}
    {5  x RD YL GR GR}
}
   set tRD RD
   set tYL YL
   set tag [lindex [lindex $ttag $test_level] $botik_level]

   set wReport(no_reasons) 0
   set report $test0$test1$test2$test3$test4
   set ulbad 0
   set dlbad 0
   if {[llength $ping(speedresult)] && \
       [string is double -strict $ping(whoami,TARIFF_SPEED)] && \
       $ping(whoami,TARIFF_SPEED) > 0} {
        set upload "?? Кбит/с"
        set dload  "?? Кбит/с"
        set uploadpc 0
        set dloadpc  0
        set type ""
        set spd  0
        foreach elt $ping(speedresult) {
            foreach {type spd} $elt {break}
            if {[string index $spd 0] eq "<" || [string index $spd 0] eq ">"} {
                set spd [string range $spd 1 end]
            }
            set kb [speed::kbits $spd]
            if {$type eq "upload"} {
                set upload [speed::kbit_fmt $spd]
                set uploadpc [expr {int((double($kb)/double($ping(whoami,TARIFF_SPEED))) * 100.0)}]
            }
            if {$type eq "download"} {
                set dload [speed::kbit_fmt $spd]
                set dloadpc [expr {int((double($kb)/double($ping(whoami,TARIFF_SPEED))) * 100.0)}]
            }
        }
        if {$dloadpc < 100} {
            set dlword "плохо"
            set dlbad 1
        } elseif {$dloadpc < 150} {
            set dlword "хорошо"
        } else {
            set dlword "отлично"
        }
        if {$uploadpc < 100} {
            set upword "плохо"
            set ulbad 1
        } elseif {$uploadpc < 150} {
            set upword "хорошо"
        } else {
            set upword "отлично"
        }
        if {$dloadpc > 0 || $uploadpc > 0} {
            set speedtext "\nСистема для Вашего подключения должна поддержать на внешнем канале скорость $ping(whoami,TARIFF_SPEED) Кбит/с -- это гарантированная минимальная скорость.\n\n"
            append speedtext "Фактическая скорость (измерено на внешнем канале):"
            if {$dloadpc > 0}  {append speedtext "\n\nСкорость загрузки данных (In) $dload, то есть $dloadpc% от гарантированной минимальной скорости -- это $dlword."}
            if {$uploadpc > 0} {append speedtext "\n\nСкорость выгрузки данных (Out) $upload, то есть $uploadpc% от гарантированной минимальной скорости -- это $upword."}
            append report $speedtext\n
        }
   }
   append report $::bgtraf(res)
   if {$tag eq $tRD || ($ulbad && $dlbad)} {
      set text "Обязательно пошлите данный отчет.\n$report"
      set tag $tRD
   } elseif {$tag eq $tYL || $ulbad || $dlbad} {
      set text "Немного причин, чтобы посылать данный отчет.\n$report"
      set tag $tYL
      incrCounter "bttest_success"
   } else {
      set wReport(no_reasons) 1
      set text "Не видно НИКАКИХ ПРИЧИН, чтобы посылать данный отчет.\n$report"
      set tag GR
      incrCounter "bttest_success"
   }
   set ping(short_report_text) $text
   set ping(short_report_tag)  $tag
}
#                      -------- вернуть строку-табличку "результаты ping-тестов" для окна "Report"
proc mkPingReport { } {
   global ping wReport speedreport
   set n $ping(N)
   if {$n < 1} {return ""}
   foreach {h j k} {0 0 0} {}
   for {set i 0} {$i < $n} {incr i} {
      set zone [getZone $i]
      if {$zone==1} {
         incr h
      } elseif {$zone==2} {
         incr j
      } else {incr k}
   }
   set len  71
   set char "="
   set s    ""
   if {$h > 0} {
      set s [insertBetween [zoneName 1] $char $len]
   }
   set spdrep ""
   set st [pingShortTitle]
   for {set i 0} {$i < $n} {incr i} {
      set zone [getZone $i]
      if {$zone==2 || $zone==3} {continue}
      set p_in    $ping($i,in)
      set p_out   $ping($i,out)
      set ms_sum  $ping($i,sum)  
      set ms_min  $ping($i,min)  
      set ms_max  $ping($i,max)  
      set ms_avg  $ping($i,avg)  
      set pc_loss $ping($i,loss)
      set s1 [pingShortFmt $i $p_out $p_in $pc_loss $ms_min $ms_max $ms_avg]
      if {$ping(n_host,$i) eq $speed::server1} {
        set spdrep $s1
      } else {
        append s \n $s1
      }
   }
   if {$j > 0} {
      append s \n [insertBetween [zoneName 2] $char $len]
   }
   for {set i 0} {$i < $n} {incr i} {
      set zone [getZone $i]
      if {$zone==1 || $zone==3} {continue}
      set p_in    $ping($i,in)
      set p_out   $ping($i,out)
      set ms_sum  $ping($i,sum)  
      set ms_min  $ping($i,min)  
      set ms_max  $ping($i,max)  
      set ms_avg  $ping($i,avg)  
      set pc_loss $ping($i,loss)
      set s1 [pingShortFmt $i $p_out $p_in $pc_loss $ms_min $ms_max $ms_avg]
      append s \n $s1
   }
   if {$k > 0} {
      append s \n [insertBetween [zoneName 3] $char $len]
   }
   for {set i 0} {$i < $n} {incr i} {
      set zone [getZone $i]
      if {$zone==1 || $zone==2} {continue}
      set p_in    $ping($i,in)
      set p_out   $ping($i,out)
      set ms_sum  $ping($i,sum)  
      set ms_min  $ping($i,min)  
      set ms_max  $ping($i,max)  
      set ms_avg  $ping($i,avg)  
      set pc_loss $ping($i,loss)
      set s1 [pingShortFmt $i $p_out $p_in $pc_loss $ms_min $ms_max $ms_avg]
      append s \n $s1
   }
   set speedreport ""
   if {!$wReport(no_reasons) && ($::ulbad || $::dlbad) && [llength $spdrep]>0} {
      set speedreport [subst \
{[hrule 1]
Служебная информация для персонала Оператора:
[hrule 2]
$st
[hrule 2]
$spdrep
[hrule 1]
}]
   }

   return [subst \
{[hrule 1]
Отчет по результатам ping-тестов:
[hrule 2]
$st
[hrule 2]
$s
[hrule 1]
}]

}
#                      -------- форматы для таблички "Имя хоста : Пояснения" для окна "Report"
proc hostTitle { } {
   return [ format "%30s : %-38s"  "Имя хоста" "Пояснения" ]
}
proc hostFmt {ihost} {
   global ping
   
   set host    [rightDots 30 $ping(host,$ihost) ]
   set comment [rightDots 28 "\[$ping(host_ip,$ihost)\]  $ping(h_reason,$ihost)" ]
   return [ format "%30s : %-38s" $host $comment ]
}
proc isBotikReason {r} {
    return [expr {[string match R* $r] || [string match S* $r] || [string match G* $r] || [string match C* $r]}]
}
proc isBotikRouter {h} {
    return [expr [string match *-router*.$::net(domain) $h] || [string match rtr-*.$::net(domain) $h]]
}
proc isSystemNode {h} {
    return [expr [lsearch -exact $::ping(sysnodes) $h] > -1]
}
proc isHomeRouter {hname reason} {
    if {![chkIP $hname] && \
        ![string match *.$::net(domain) $hname] && \
        ![string match *.pereslavl.ru $hname] && \
        [string match R* $reason] \
    } {return 1}
    return 0
}
proc getZone {i} {
    global ping
    if {[isLocal $ping(host,$i) $ping(host_ip,$i)]} {
        if {[isHomeRouter $ping(host,$i) $ping(h_reason,$i)]} {return 2}
        if {[isBotikReason $ping(h_reason,$i)] || [isBotikRouter $ping(host,$i)] || [isSystemNode $ping(host,$i)] || [ethBox $ping(host,$i)]} {
            return 1; # "Botik-Tech." zone
        } else {
            return 2; # Abonents zone
        }
    } else {
        return 3; # the outer world
    }
}
proc _getZone {i} {
    global ping
    if {[isLocal $ping(n_host,$i) $ping(ip_host,$i)]} {
        if {[isHomeRouter $ping(n_host,$i) $ping(reason,$i)]} {return 2}
        if {[isBotikReason $ping(reason,$i)] || [isBotikRouter $ping(n_host,$i)] || [isSystemNode $ping(n_host,$i)] || [ethBox $ping(n_host,$i)]} {
            return 1
        } else {
            return 2
        }
    } else {
        return 3
    }
}
proc zoneName {n} {
    if {$n==1} {
        return "Зона ответственности СТ \"$::net(name)\""
    } elseif {$n==2} {
        return "Вне зоны ответственности СТ \"$::net(name)\""
    } else {
        return "Внешний мир"
    }
}
#                      -------- вернуть строку-табличку "Имя хоста : Пояснения" для окна "Report"
proc mkHostsReport {{IPs {0}}} {
   global ping
   set n $ping(N)
   if {$n < 1} {return ""}
   set A [list]; #зона ответственности СТ
   set B [list]; #вне зоны ответственности СТ
   set C [list]; #внешний мир
   set zoneA [list]
   set zoneB [list]
   set zoneC [list]
   for {set i 0} {$i < $n} {incr i} {
      set zone [getZone $i]
      if {$ping(n_host,$i) eq $speed::server1} {continue}
      if {$zone==1} {
         lappend A $i
         lappend zoneA $ping(host_ip,$i)
      } elseif {$zone==2} {
         lappend B $i
         lappend zoneB $ping(host_ip,$i)
      } else {
         lappend C $i
         lappend zoneC $ping(host_ip,$i)
      }
   }

   if {$IPs} {
     return [list $zoneA $zoneB $zoneC]
   }

   set st [hostTitle]
   set s ""
   if {[llength $A] > 0} {
      set s [insertBetween [zoneName 1] "=" 71]
      foreach i $A {
         set s1 [hostFmt $i]
         append s \n$s1
      }
   }
   if {[llength $B] > 0} {
      append s \n [insertBetween [zoneName 2] "=" 71]
      foreach i $B {
         set s1 [hostFmt $i]
         append s \n$s1
      }
   }
   if {[llength $C] > 0} {
      append s \n [insertBetween [zoneName 3] "=" 71]
      foreach i $C {
         set s1 [hostFmt $i]
         append s \n$s1
      }
   }
   return [subst \
{
[hrule 1]
Пояснения, какие машины и по какой причине ping-тестировались:
[hrule 2]
$st
[hrule 2]
$s
[hrule 1]
}]
}
#                      -------- вернуть строку-отчет про трассировки для окна "Report"
proc mkTraceReport { } {
   global ping

   set n $ping(raw_trrt,N)

   if {$n < 1} {
      return "";
   }

   set s  ""
   for {set i 0} {$i < $n} {incr i} {
      set s1 $ping(raw_trrt,$i)
      set s  "$s\n[hrule 2]\n$s1"
   }
   return [subst \
{
[hrule 1]
У меня было подозрение на плохую связь с рядом хостов. Вот их трассы:
$s
[hrule 1]
}]
}
#                      -------- вернуть строку-отчет про пинги для окна "Report"
proc mkBadPingReport { } {
   global ping

   set kk $ping(bad_pings,K)
   set nn $ping(bad_pings,N)

   if {$nn == 0} {
      return ""
   }
   if {$nn > $ping(bad_pings,MAXK)} {
      set kk $ping(bad_pings,MAXK)
   }

   set t "\nБыли неудачные ping-тесты.  Всего $nn, здесь покажем $kk из них"
   for {set i 0} {$i < $kk} {incr i} {
      set t "$t\n[hrule 1]$ping(bad_pings,$i)"
   }
   return $t
}
#                      -------- wReport(Body4) -- что написал Абонент
proc mkBody4 { } {
   global wReport

   if {![winfo exists .mw.cntnt.f2.text2]} {return}
   if {![.mw.cntnt.f2.text2 edit modified]} {
      set wReport(Body4) ""
      return
   }
   set t [string trim [.mw.cntnt.f2.text2 get 0.0 end] ]
   set b ""
   foreach line [split $t "\n"] {
       set b "$b[wrapLines 72 [string trim $line ] ]"
   }
   set wReport(Body4) $b
   return
}
proc dateTime {} {
    return [clockFormat "%Y-%m-%d_%H_%M_%S"]
}
#
proc saveAs { } {
   global ping wReport

   mkBody4
   set text "$wReport(Body0)$wReport(Body1)$wReport(Body2)$wReport(Body3)$wReport(Body4)$wReport(Body5)$wReport(Body6)$wReport(Body7)$wReport(Body8)[mkRemark]"

   set types {
      {{Text Files}       {.txt}        }
      {{All Files}        *             }
   }

   set writeFileName "botik-tester-report-[dateTime].txt"
   set writeDir [desktop_dir]
   set filename [tk_getSaveFile -filetypes $types -defaultextension .txt \
                                -title "Сохранить отчет в файле?" \
                                -initialfile $writeFileName -initialdir $writeDir]
   if {[string length $filename] == 0} {return}
   set ::ddir [file dirname $filename]
   set writeFileName $filename
   set ok 0
   catch {
      set out [open $writeFileName w]
      puts $out $text
      close $out
      set ok 1
   } rc
   if { ! $ok } {
      set msg "Не удалось отчет записать в файл\n\"$writeFileName\"\
                 \n\nError: [mkErrorCode $rc]"
      message error $msg
      asksendmail $msg
   } else {
      #message info "Отчет записан в файл\n\"$writeFileName\""
   }
   return
}
#
proc intWReportFrom { } {
   global ping wReport

   if { [string length $wReport(From)] > 0 } {
      return
   }

   if { [string length $ping(whoami,Email)] > 0 } { 
      set wReport(From) $ping(whoami,Email)
      return
   }

   set host "[info hostname].???"

   chkWhoamiHostNameIP

   if { [string length $ping(myhost)] > 0 } {
      catch { set host [lindex [split $ping(myhost) " "] 0] }
   }
   set wReport(From) "postmaster@$host"
   return
}
#
proc goodEmail { email } {
#   return [regexp {^(\w|\.|\-)+@(\w|\.|\-)+$} $email]
    return [regexp {^(\w|\.|\-)+@[a-zA-Z0-9-]+(\.[a-zA-Z0-9-]+)+$} $email]
}
#
proc badFromEmail { } {
   global wReport
   if { ![goodEmail $wReport(From)]} {
      message warning "Ваш e-mail задан некорректно."
      return 1
   }
   return 0
}
#
proc mailtoSupport { } {
   global wReport ping mail_log mail_status mail_result

   if [badFromEmail] {
      return
   }
   #[btnName mailto] configure -state disabled
   specialStatus "Отправляем письмо..."
   update

   if {$wReport(no_reasons) && $ping(chk_noreason) && ![info exists ::override]} {
      message warning "Не выявлено никаких причин, чтобы посылать письмо."
   } else {
      if {$ping(diag) ne ""} {
            set qstn "При проверке сетевых настроек на Вашем компьютере найдены ошибки.\
                    Рекомендуем их исправить, прежде чем отсылать отчёт о результатах тестирования.\
                    В противном случае отчёт может быть отклонён персоналом СТ \"Ботик\".\
                    \n\nВы уверены что хотите послать отчёт?"
               set ans [alertQuestion $qstn]
               if {$ans eq "no"} {
                   defaultStatus
                   return
            }
            [btnName mailto] configure -state disabled
            update
      }
      mkBody4
      set text "$wReport(Body1)$wReport(Body2)$wReport(Body3)$wReport(Body4)$wReport(Body5)$wReport(Body7)$wReport(Body8)[mkRemark]"
      sendmail $text [list 1 $wReport(Subject)]

      if {$mail_status} {
         catch {[btnName mailto] configure -state normal}
         set wReport(Body6) "[hrule 1]\nОшибка при посылке письма:\n\nStatus = $mail_status\nResult = $mail_result\nLog:\n$mail_log\n"
         .mw.cntnt.f1.text configure -state normal
         .mw.cntnt.f1.text insert end $wReport(Body6) RD
         .mw.cntnt.f1.text configure -state disabled -cursor arrow
         set msg "Не удалось отправить письмо.\
                       \n$mail_result\
                       \nК отчету добавлено сообщение об этой ошибке.\
                       \nВы можете сохранить отчет в текстовый файл\
                       \nи прикрепить его к заявке в системе Надмин:Абоненту."
         message error $msg
      } else {
         set wReport(Body6) "[hrule 1]\nНет ошибок при посылке письма:\n\nStatus = $mail_status\nResult = $mail_result\nLog:\n$mail_log\n"
         message info "Письмо успешно отправлено.\
                       \nВы можете сохранить копию себе в текстовом файле."
        incrCounter "btreport_sent"
      }

   }
   defaultStatus
}
proc spd_updateStatus {timeo} {
    global spd_remain
    if {$speed::presult != 0 || $spd_remain < 0} {return}
    if {$spd_remain == 0} {
        return
    } elseif {$spd_remain >= 10} {
        set txt "Подготовка отчета: замер скорости... Осталось $spd_remain с."
    } else {
        set txt "Подготовка отчета: замер скорости... Осталось $spd_remain с. "
    }
    set ping(defaultstatus) $txt
    .mw.status configure -text $txt
    if {$spd_remain < $timeo} {update idletasks}
    incr spd_remain -1
    after 1000 "spd_updateStatus $timeo"
}
proc measureSpeed {} {
    global ping
    set to [expr {$speed::timeo * 2}]
    set ::spd_remain $to
    spd_updateStatus $to; update
    # do speed test of the global connection
    set ping(speedresult) [speed::do_speed_test]
    set res1 [speed::convert_result $ping(speedresult)]
    if {[lempty $res1]} {set res1 "скорость внешнего канала измерить не удалось\n"}
    # do speed test of the local connection
    set ping(speedresult2) [speed::do_speed_test 2]
    set res2 [speed::convert_result2 $ping(speedresult2)]
    if {[lempty $res2]} {set res2 "скорость до центр. узла измерить не удалось\n"}
    set ::spd_remain 0
    return $res1$res2
}
#                      -------- главная функция "Report"
proc startReportWindow { } {
   global ping wReport speedreport iface

   incrCounter "btreport"
   setTitle "Отчет о результатах тестирования -- [strTime]" "Botik Test Report"

   setButtons { {back    "<< Назад"         startPingParamsWindow }
                {help    "Справка"          "showHelp HelpForReport"}
                {saveAs  "Записать в файл"  "saveAs"}
                {mailto  "Послать e-mail"   "mailtoSupport"}
                {cancel  "Закончить"        doExit} }
   clearCntnt
   set btns [list [btnName back] [btnName help] [btnName saveAs] [btnName mailto] [btnName cancel]]

   frame .mw.cntnt.f0
   frame .mw.cntnt.f1
   frame .mw.cntnt.f2
   pack .mw.cntnt.f0  -side top
   pack .mw.cntnt.f2 .mw.cntnt.f1 -side top -expand yes -fill both

   label .mw.cntnt.f0.lab -font $iface(font1) -justify left -wraplength -1 -text "Напишите Ваш адрес:"

   intWReportFrom
   entry .mw.cntnt.f0.from -relief sunken -width 50 -textvariable wReport(From)
   label .mw.cntnt.f0.lab2 -font $iface(font1) -justify left -wraplength -1 -text "и комментарий:"
   pack  .mw.cntnt.f0.lab  -side left -pady 5
   pack  .mw.cntnt.f0.from .mw.cntnt.f0.lab2 -side left -padx 5 -pady 5
   
   text .mw.cntnt.f1.text -relief sunken -bd 2 -wrap word -font $iface(font4) -yscrollcommand ".mw.cntnt.f1.scroll set" -height 27
   if {[windowsPlatform]} {.mw.cntnt.f1.text configure -setgrid 1}
   scrollbar .mw.cntnt.f1.scroll -command ".mw.cntnt.f1.text yview"

   text .mw.cntnt.f2.text2 -relief sunken -bd 2 -wrap word -background $ping(c_b) -font $iface(font3) -yscrollcommand ".mw.cntnt.f2.scroll2 set" -height 3
   scrollbar .mw.cntnt.f2.scroll2 -command ".mw.cntnt.f2.text2 yview"

   pack .mw.cntnt.f1.scroll .mw.cntnt.f2.scroll2 -side right -fill y
   pack .mw.cntnt.f1.text .mw.cntnt.f2.text2 -expand yes -fill both
   
   .mw.cntnt.f1.text  tag configure N  -background {}         -lmargin1 20 -lmargin2 20 -rmargin 80 -font $iface(font4)
   .mw.cntnt.f1.text  tag configure B  -lmargin1 20 -lmargin2 20 -rmargin 80 -font $iface(font2) -justify center
   .mw.cntnt.f1.text  tag configure RD -background $ping(c_r) -lmargin1 20 -lmargin2 20 -rmargin 80 -font $iface(font3)
   .mw.cntnt.f1.text  tag configure YL -background $ping(c_y) -lmargin1 20 -lmargin2 20 -rmargin 80 -font $iface(font3)
   .mw.cntnt.f1.text  tag configure GR -background $ping(c_g) -lmargin1 20 -lmargin2 20 -rmargin 80 -font $iface(font3)
   .mw.cntnt.f1.text  tag configure BL -background $ping(c_b) -lmargin1 20 -lmargin2 20 -rmargin 80 -font $iface(font3)
   .mw.cntnt.f2.text2 tag configure BL -background $ping(c_b) -lmargin1 20 -lmargin2 20 -rmargin 80 -font $iface(font3)

   .mw.cntnt.f2.text2 insert end "Нужен ли визит к Вам ремонтников? (да, нет, не знаю):\
                                \n\nЕсли требуется визит ремонтников, то:\
                                \nФИО контактного лица:\
                                \n\nи его телефон:\
                                \n\nпо какому адресу выезжать ремонтной бригаде:\
                                \n\nКакое время для Вас удобно? (Наше рабочее время с 9:00 до 16:00\
                                с понедельника по пятницу, тел. 98-355):\
                                \nжелаемая дата:\n"

   #changesInHelpWindow HelpForReport

   .mw.cntnt.f1.text insert end "\n\nГотовим отчет; пожалуйста, подождите." B
   update

   set wReport(Subject) "Botik test report $ping(t_start)"
   set wReport(Body0)   [subst \
{Кому: ремонтная бригада СТ "$::net(name)"
Тема письма: $wReport(Subject)
Текст письма:
[hrule 3]
}]

chkWhoamiUserName
chkWhoamiHostNameIP
chkWhoamiConnection

   if { $ping(whoami,Time) ne "" } {
      set timeLTime "\nТочное время (с сервера):     $ping(whoami,Time)*\nЛокальное время (у Абонента): $ping(whoami,LTime)"
   } else {
      set timeLTime ""
   }

   foreach b $btns {
      $b configure -state disabled
   }

   set wReport(Body1)   [subst \
{День добрый!

Учетное имя Абонента:         $ping(abonent)[mWAI UserName]
Тестирование велось с машины: $ping(myhost)[mWAI HostNameIP]
                              [lindex { LAN DIALUP } $ping(isModem)][mWAI Connection],\
                              $ping(version)
Размер ping-пакета в байтах:  $ping(size)
Таймаут (мс):                 $ping(timeout)
[measureSpeed]$timeLTime
Начало ping-тестирования:     $ping(t_start)
Конец ping-тестирования:      $ping(t_end)
}]

   set ping(defaultstatus) "Подготовка отчета..."
   defaultStatus
   set fsys [failed_sysnodes]
   bgtraffic; # count and estimate background traffic
   # краткие выводы и прогноз полезности отправки письма:
   mkShortReport
   set wReport(Body2) $ping(short_report_text)
   set wReport(Body3) "[hrule 1]\n"
   set wReport(Body5) [subst {[mkPingReport][mkHostsReport][mkTraceReport][mkBadPingReport]}]
   set wReport(Body6) ""
   if {[info exists speedreport] && [llength $speedreport]>0} {
      append wReport(Body5) \n$speedreport\n
   }
   set ping(defaultstatus) "Подготовка отчета: сбор сведений о системе..."
   defaultStatus
   set wReport(Body7) "Сведения о системе:\n\n[systemInfo]"

#***
#version:1.41
#org:ORG
#from:host@pereslavl.ru
#ipaddr:193.232.174.1
#date:05-06-2007 17-39-41
#subject:Botik test report 05/06/2007 17:39:41
#zone1:
#zone2:
#zone3:
#remark:

   set diag [diagnose]; # ставим диагноз
   set ping(diag) [lindex $diag 0]
   set shortdiag  [lindex $diag 1]
   if {![lempty $shortdiag]} {append wReport(Body1) $shortdiag}
   append wReport(Body1) [hrule 1]\n
   set from $wReport(From)
   if {![info exists ::external_ip]} {
      set my_ip [myIP]
      if {$ping(whoami,IP) ne ""} {
         set ::external_ip $ping(whoami,IP)
      } elseif {$my_ip ne "" && $my_ip ne "127.0.0.1"} {
         set ::external_ip $my_ip
      } else {
          set ::external_ip ""
      }
   }
   if {$::external_ip eq "" && [info exists ::configip]} {set ::external_ip $::configip}
   set ip    $::external_ip
   set zones [mkHostsReport 1]
   set wReport(Body8) \n***\n
   append wReport(Body8) version:$ping(ver)\n
   append wReport(Body8) org:$ping(abonent)\n
   append wReport(Body8) from:$from\n
   append wReport(Body8) ipaddr:$ip\n
   append wReport(Body8) date:$ping(t_start2)\n
   append wReport(Body8) subject:$wReport(Subject)\n
   if {$ping(whoami,TARIFF) ne ""} {
       append wReport(Body8) tariff:$ping(whoami,TARIFF)\n
   }
   if {[string is double -strict $ping(whoami,TARIFF_SPEED)] && \
       $ping(whoami,TARIFF_SPEED) > 0} {
       append wReport(Body8) tariffspeed:$ping(whoami,TARIFF_SPEED)\n
   }
   set upload 0
   set dload  0
   set upload_l 0
   set dload_l  0
   set loc_lat   -1; # лок. задержка
   set loc_loss  -1; # лок. потери
   set loc_speed -1; # лок. скорость
   set out_lat   -1; # внешняя задержка
   set out_loss  -1; # внеш. потери
   set out_speed -1; # внеш. скорость
   if {$ping(loc_lat_lvl) == 2} {
      set loc_lat 1
   } else {set loc_lat 0}
   if {$ping(loc_loss_lvl) == 2} {
      set loc_loss 1
   } else {set loc_loss 0}
   if {$ping(out_lat_lvl) == 2} {
      set out_lat 1
   } else {set out_lat 0}
   if {$ping(out_loss_lvl) == 2} {
      set out_loss 1
   } else {set out_loss 0}
   if {[llength $ping(speedresult)]} {
        foreach elt $ping(speedresult) {
            foreach {type spd} $elt {break}
            if {[string index $spd 0] eq "<" || [string index $spd 0] eq ">"} {
                set spd [string range $spd 1 end]
            }
            set kb [speed::kbits $spd]
            if {$type eq "upload"} {set upload $kb}
            if {$type eq "download"} {set dload $kb}
        }
        append wReport(Body8) outspeed:$upload\n
        append wReport(Body8) inspeed:$dload\n
        if {[string is double -strict $ping(whoami,TARIFF_SPEED)] && $ping(whoami,TARIFF_SPEED) > 0} {
            if {$upload < $ping(whoami,TARIFF_SPEED) || $dload < $ping(whoami,TARIFF_SPEED)} {
                set out_speed 1; # there are some troubles with outer speed
            } else {set out_speed 0}; # there are no troubles
        }
   }
   if {[llength $ping(speedresult2)]} {
        foreach elt $ping(speedresult2) {
            foreach {type spd} $elt {break}
            if {[string index $spd 0] eq "<" || [string index $spd 0] eq ">"} {
                set spd [string range $spd 1 end]
            }
            set kb [speed::kbits $spd]
            if {$type eq "upload"} {set upload_l $kb}
            if {$type eq "download"} {set dload_l $kb}
        }
        append wReport(Body8) outspeedl:$upload_l\n
        append wReport(Body8) inspeedl:$dload_l\n
        set loc_prom [speed::kbits [expr {140*1024}]]
        if {[string is double -strict $ping(whoami,TARIFF_SPEED)] && $ping(whoami,TARIFF_SPEED) > 0} {
            if {$upload_l < $ping(whoami,TARIFF_SPEED) || $dload_l < $ping(whoami,TARIFF_SPEED) || \
                $upload_l < $ping(minlocspeed) || $dload_l < $ping(minlocspeed)} {
               set loc_speed 1; # there are some troubles with local speed
            } else {set loc_speed 0}; # there are no troubles
        }
   }
   append wReport(Body8) state:[join [list \
     $loc_loss $loc_lat $loc_speed $out_loss $out_lat $out_speed] ","]\n
   append wReport(Body8) netdown:[join $fsys ","]\n
   append wReport(Body8) zone1:[join [lindex $zones 0] ","]\n
   append wReport(Body8) zone2:[join [lindex $zones 1] ","]\n
   append wReport(Body8) zone3:[join [lindex $zones 2] ","]\n
   append wReport(Body8) traced:[join $ping(trrt_f) ","]\n
   append wReport(Body8) errors:[join $ping(diag_errors) ","]\n

   foreach b $btns {
      $b configure -state normal
   }

   .mw.cntnt.f1.text delete 0.0 end
   .mw.cntnt.f1.text insert end $wReport(Body0) N
   .mw.cntnt.f1.text insert end $wReport(Body1) N
   .mw.cntnt.f1.text insert end $wReport(Body2) $ping(short_report_tag)
   .mw.cntnt.f1.text insert end $wReport(Body3) N
   .mw.cntnt.f1.text insert end "...Сюда будет вставлен Ваш комментарий из верхнего окна...\n" BL
   .mw.cntnt.f1.text insert end $wReport(Body5) N
   .mw.cntnt.f1.text insert end $wReport(Body7) N
   .mw.cntnt.f1.text insert end $wReport(Body8) N
   focus -force .mw.cntnt.f1.text
   .mw.cntnt.f2.text2 edit modified 0
   bind .mw.cntnt.f1.text <MouseWheel> "catch {wheelEvent %X %Y %D}"
   bind .mw.cntnt.f1.text <Control-ntilde> "copySelection %W"
   bind .mw.cntnt.f1.text <Control-c> "copySelection %W"
   .mw.cntnt.f1.text configure -state disabled
   set ping(defaultstatus) "\[3\] если отчет вскрывает неисправности, то пошлите e-mail"
   defaultStatus
   if {$ping(diag) ne ""} {diagWindow}
}
proc copySelection {t} {
    set text [selection get -displayof $t -type STRING]
    copyToCB $text
}
proc copyToCB {text} {
    clipboard clear
    clipboard append $text
}
# окно диагностики подключения
proc diagWindow {} {
    set info $::ping(diag)
    set w .mw.diag
    catch {destroy $w}
    toplevel $w
    wm title $w "Проблемы в сетевых настройках"
    wm iconname $w "Проблемы"
    if {[windowsPlatform]} {
        wm iconbitmap $w [file join . img botik_test.ico]
    } else {
        wm geometry $w +200+200
    }
    text $w.text -yscrollcommand [list $w.scroll set] -height 20 -wrap word
    if {[windowsPlatform]} {$w.text configure -setgrid 1}
    $w.text tag configure big -font "Times 14"
    $w.text tag configure normal -font "Times 12"
    scrollbar $w.scroll -command [list $w.text yview]
    pack $w.scroll -side right -fill y
    pack $w.text -expand yes -fill both
    set n [expr [llength [split $info \n]]/2]; # число ошибок
    if {$n > 1} {
        set mistakesWereFound "найдено несколько ошибок. Их"
        set theseErrors "ошибки"; #genitive case
    } else {
        set mistakesWereFound "найдена ошибка. Её"
        set theseErrors "ошибку"
    }
    set intro "При проверке сетевых настроек на Вашем компьютере\
                $mistakesWereFound рекомендуется исправить, прежде чем\
                отсылать по e-mail отчёт о результатах тестирования.\
                В противном случае отчёт может быть отклонён персоналом СТ \"Ботик\".\
                Вы можете самостоятельно исправить $theseErrors, либо вызвать для этого ремонтную\
                бригаду на дом. Услуга платная.\n\n"

    $w.text insert 0.0 $intro big
    $w.text insert end $info normal
    findURLs $w.text $intro$info
    $w.text configure -state disabled
    bind $w.text <MouseWheel> "catch {wheelEvent %X %Y %D}"
    focus -force $w
    focus -force $w.text
    bind $w <KeyPress-Escape> "destroy $w"
    update
}
proc wheelEvent {x y delta} {
    set act 0
    set widget [winfo containing $x $y]
    if {$widget != ""} {
        if {[catch "$widget cget -yscrollcommand" cmd]} {return}
        if {$cmd != ""} {
            set scroller [lindex $cmd 0]
            set act 1
        }
    }
    if {$act == 1} {
        set xy [$widget yview]
        set factor [expr [lindex $xy 1]-[lindex $xy 0]]
        set cmd "[$scroller cget -command] scroll [expr -int($delta/(120*$factor))] units"
        eval $cmd
    }
}
proc configURLtag {t tag link} {
    $t tag configure $tag -underline 1 -foreground blue -font {Arial 12 bold}
    $t tag bind $tag <Any-Enter> "$t configure -cursor hand2"
    $t tag bind $tag <Any-Leave> "$t configure -cursor xterm"
    $t tag bind $tag <ButtonPress-1> "showURL $link"
}
# находит и подсвечивает ссылки в тексте
proc findURLs {t info} {
    set re  {https?://\S+}
    set lines [split $info \n]
    set i 0
    foreach line $lines {
        incr i
        set all [regexp -all -inline -- $re $line]
        foreach url $all {
            set fs   [string first $url $line]
            set len  [string length $url]
            set fidx $i.$fs
            set lidx $i.[expr $fs+$len]
            $t tag add URL$fidx $fidx $lidx
            configURLtag $t URL$fidx $url
        }
    }
}
proc mkRemark {} {
    if {[.mw.cntnt.f2.text2 edit modified]} {
        return remark:\n[base64::encode [tokoi $::wReport(Body4)]]\n
    }
    return remark:\n
}
# ================= 5 Окно справки =================================================
proc setTitleHW { tlong tshort } {
   wm title .wHelp $tlong
   wm iconname .wHelp $tshort
   catch {wm iconbitmap .wHelp [file join . img botik_test.ico]}
   return
}

proc initHelp { } {
   global ping help

   set help(windWidth) 300
   set help(bgTextWin) azure1
   set help(bgButWin)  gray84
   set help(bgButAct)  LightSteelBlue
   set help(textBtns)  1 ; # Кнопки текстовые или графические
    
   set help(titleLong)  "Справка по программе $ping(version)"
   set help(titleShort) "Help::$ping(version)"

   set help(currentHelp) -1
   set help(N)            0
   set help(I)           -1
   set help(URLs)         0

   set help(HelpIndex) \
[subst {
"Справка::Оглавление" "Help::$ping(version)::Index"
{Оглавление`H1`

o  `L1IT`O программе $ping(version)`HREF`HelpAbout` `L1N`
`N`
o  `L1IT`Как пользоваться справкой`HREF`HelpForHelp` `L1N`
`N`
o  `L1IT`Окно \"\[0\] Настройки тестера\"`HREF`HelpForSetUp` `L1N`
`N`
o  `L1IT`Окно \"\[1\] Параметры ping-теста\"`HREF`HelpForPingParams` `L1N`
`N`
>  `L2IT`Параметры ping-a`HREF`HelpForPingParams1` `L2N`
>  `L2IT`Определение списка`HREF`HelpForPingParams2` хостов, подлежащих тестированию `L2N`
>  `L2IT`Рекомендации по составлению`HREF`HelpForPingParams3` списка хостов, подлежащих тестированию `L2N`
`N`
o  `L1IT`Окно \"\[2\] Выполнение ping-теста\"`HREF`HelpForPingTest` `L1N`
`N`
o  `L1IT`Окно \"\[3\] Отчет по результатам тестов\"`HREF`HelpForReport` `L1N`
`N`
o  `L1IT`Как с нами связаться`HREF`HelpForClaim` `L1N`
`N`
o  `L1IT`Про обновление программы $ping(name)`HREF`HelpDownload` `L1N`
}}]

   set help(HelpDownload) \
[subst {
"Про обновление программы $ping(name)" "Update::$ping(name)"
{Про обновление программы $ping(name)`H1`

В случае выхода новой версии программы $ping(name)
у пользователей ОС Windows программа обновится автоматически и
без участия пользователя при повторном запуске (сработает автообновление).

Пользователям других ОС для обновления программы $ping(name) следует посетить страничку\
`N`$ping(url_dload)`HREF`$ping(url_dload)`.

}}]

   set help(HelpAbout) \
[subst {
"O программе $ping(version)" "About::$ping(version)"
{O программе $ping(version)`H1`

Официальный сайт программы: `N`$ping(url)`HREF`$ping(url)`.

Программа $ping(name) входит в состав пакета программ Botik Tools,\
разрабатываемого для Абонентов СТ "Ботик".

Официальный сайт пакета: `N`$ping(url_tools)`HREF`$ping(url_tools)`.

Программа $ping(name) изначально написана группой технической поддержки\
СТ "Ботик". Сейчас в ее развитии участвуют Абоненты СТ "Ботик" (и как\
разработчики, и как бета-тестеры).

Цель: упростить детальное тестирование и точную диагностику качества связи в СТ "$::net(name)".

Тестирование должно быть для Абонентов делом простым и быстрым, как "раз, два, три":
`N`
1. `L1IT`задаем параметры тестирования---параметры ping-a и какие хосты надо тестировать (умолчательные\
параметры уже хороши, в большинстве случаев данный шаг можно пропустить);`L1N`
`N`
2. `L1IT`выполняется одновременное ping-тестирование связи со всеми выбранными узлами;`L1N`
`N`
3. `L1IT`пишется правильный текст для e-mail в группу технической поддержки.`L1N`
`N`
Обычно все три шага занимают около 1 минуты.
`N`
Программа написана на языке Tcl/Tk и может быть легко перенесена на любые платформы.
`N`
Начало разработки $ping(start_date), текущая версия от $ping(ver_date).
}}]

   set help(HelpForHelp) \
[subst {
"Справка::Как пользоваться справкой" "Help::$ping(version)"
{Как пользоваться справкой`H1`

Рекомендуем следующий стиль работы со справой:
`N`
>  `L1IT`один раз откройте`L1B` окно со справкой;`L1N`
>  `L1IT`отрегулируйте удобное положение`L1B` основного окна и окна со справкой;`L1N`
`N`
После этого в окне справки Вы будете видеть описание, соответствующее текущему состоянию основного окна.

В тексте справки, как и обычно, можно переходить по гиперссылкам.

`N`Список всех разделов справки...`HREF`HelpIndex`
}}]

   set help(HelpForPingParams) \
[subst {
"Справка::Параметры ping-теста" "Help::Ping-test parameters"
{Как пользоваться справкой...`HREF`HelpForHelp`

Окно \"\[1\] Параметры ping-теста\"`H1`

Здесь задаются параметры для ping-теста (`N`подробнее...`HREF`HelpForPingParams1`):`N`
`N`
o  `L1IT`Размер пакета`L1B`
o  `L1IT`Время ожидания пакета`L1B`
o  `L1IT`Число пакетов в тесте`L1B`
`N`
и при помощи следующих средств (`N`подробнее...`HREF`HelpForPingParams2`) определяется,\
какие хосты (компьютеры) будут подвергнуты ping-тесту:
`N`
o  `L1IT`Список хостов`L1B`, "галочкой" отмечены подлежащие тестированию`L1N`
o  `L1IT`Проблемный хост`L1B` и кнопка `L1N`"Трассировать и добавить"`L1B`
o  `L1IT`Кнопка "Почистить список хостов"`L1B`

Хосты, отмеченные \"галочкой\" в `N`списке хостов`B`, будут (`N`кнопка "Ping-тест >>>"`B`) тестироваться.

Кнопка \"Проверить сетевые настройки\" запускает процедуру проверки сетевых настроек
компьютера. Все найденные ошибки настроек желательно исправить до выполнения пинг-тестирования и составления отчета.

Опция "измерить скорость внешнего канала" позволяет определить скорость сетевого обмена с узлом,
находящимся по другую сторону внешнего канала сети Интернет (в городе Москве).
При выборе этой опции измеряется скорость передачи (выгрузки) данных на узел
и скорость загрузки данных с узла (в Мбит/с). При этом, в отчёте о ping-тестировании даётся
не только констатация величины скорости, но и её сравнение с гарантированной минимальной скоростью,
предусмотренной тарифом. Все сетевые обмены, которые происходят во время измерения
скорости работы внешнего канала, бесплатны для абонентов СТ \"$::net(name)\".
Если опция "измерить скорость внешнего канала" дезактивирована, то будет произведён
замер скорости до центрального узла СТ \"$::net(name)\" (www.$::net(domain)).
Все замеры скоростей проводятся на этапе составления отчёта о ping-тестировании.

`N`Кнопки в верхней рамке`H2`
`N`
o  `L1IT`"Ping-тест >>>"`L1B` -- начать ping-тест хостов, отмеченных \"галочкой\".`L1N`
o  `L1IT`"Закончить"`L1B` -- прекратить выполнение программы.`L1N`
o  `L1IT`"<<< Настройки"`L1B` -- перейти в раздел `L1N`"\[0\] Настройки"`L1B`.`L1N`
`N`
См. также:`H2`
`N`
>  `L1IT`Параметры ping-a`HREF`HelpForPingParams1` `L1N`
>  `L1IT`Определение списка`HREF`HelpForPingParams2` хостов, подлежащих тестированию `L1N`
>  `L1IT`Рекомендации по составлению`HREF`HelpForPingParams3` списка хостов, подлежащих тестированию `L1N`
>  `L1IT`Список всех разделов справки`HREF`HelpIndex` `L1N`
}}]

   set help(HelpForPingParams1) \
[subst {
"Справка::Параметры ping-a" "Help::Ping parameters"
{Как пользоваться справкой...`HREF`HelpForHelp`

Параметры ping-a`H1`
`N`
o  `L1IT`Размер пакета`L1B`, от 64 до 1450 байтов.  Для тестирования лучше использовать крупные пакеты.`L1N`
`N`
o  `L1IT`Время ожидания пакета.`L1B` Если посланный пакет не вернулся за указанное время, то считается, что он\
потерян.`L1N`
`N`
>  `L2IT`Если тестируются хосты `L2N`только из СТ "$::net(name)"`L2EM`, то лучше устанавливать это время\
около `L2N`100..250..500 мсек`L2EM`.`L2N`
>  `L2IT`При тестировании `L2N`внешних узлов`L2EM` Интернет, данный параметр надо увеличивать\
(обычно `L2N`1000..2500..5000 мсек`L2EM` достаточно).`L2N`
>  `L2IT`Слишком малая`L2EM` величина времени ожидания приводит к `L2N`ошибочной диагностике\
потери пакета`L2EM`: программа не успевает дождаться возвращения пакета.`L2N`
>  `L2IT`Слишком большая`L2EM` величина времени ожидания приводит к `L2N`большому времени\
диагностики`L2EM`, так как утерянные пакеты долго ждутся.`L2N`
`N`
o  `L1IT`Число пакетов в тесте`L1B`.  Детальное тестирование требует посылки `L2N`100..200 (а лучше\
1000)`L1EM` пакетов.`L1N`
`N`
См. также:`H2`
`N`
>  `L1IT`Определение списка`HREF`HelpForPingParams2` хостов, подлежащих тестированию `L1N`
>  `L1IT`Рекомендации по составлению`HREF`HelpForPingParams3` списка хостов, подлежащих тестированию `L1N`
>  `L1IT`Окно \"\[1\] Параметры ping-теста\"`HREF`HelpForPingParams` `L1N`
>  `L1IT`Список всех разделов справки`HREF`HelpIndex` `L1N`
}}]

   set help(HelpForPingParams2) \
[subst {
"Справка::Список хостов для ping-теста" "Help::List of hosts"
{Как пользоваться справкой...`HREF`HelpForHelp`

Определение списка хостов, подлежащих тестированию`H1`

Следующие элементы `N`окна \[1\]`HREF`HelpForPingParams` позволяют составить список хостов (компьютеров),\
подлежащих тестированию:
`N`
o  `L1IT`Список хостов с возможностью выбора`L1B` -- только отмеченные "галочкой" хосты будут тестироваться.`L1N`
`N`
o  `L1IT`Кнопка "Почистить список хостов"`L1B` позволяет удалить из списка все строки, которые не отмечены\
галочкой. Данная кнопка введена только потому, что длинные списки трудно просматривать.`L1N`
`N`
o  `L1IT`Проблемный хост и кнопка "Трассировать и добавить"`L1B`.
`N`
    `L1IT`Если Вы считаете, что у Вас проблемы при работе с хостом `L1N`"aaa.bbb.cc"`L1EM`, то следует подвергнуть\
тестированию не только (и даже: "не столько") проблемный хост, но и `L1N`некоторые`L1EM` хосты на пути от Вас до\
него.`L1N`
`N`
    `L1IT`Кнопка "Трассировать и добавить"`L1B` строит такой путь (трассу) и добавляет к `L1N`списку\
хостов`L1EM` все промежуточные узлы и сам `L1N`проблемный хост`L1EM`.`L1N`
`N`
    `L1IT`При этом, среди добавленных к списку узлов `L1N`"галочками" отмечаются`L1EM` только узлы из зоны\
ответственности `L1N`СТ "$::net(name)"`L1EM`.`L1N`
`N`
    `L1IT`Если включен режим `L1N`"показывать текст трассировок"`L1B`, то после выполнения каждой\
трассировки (`L1N`кнопка "Трассировать и добавить"`L1B`), результаты трассировки будут отображаться в\
отдельном информационном окне.`L1N`
`N`
`N`Обозначения:`H2`
`N`
Хосты, входящие в трассу, имеют пометку `N`tr(k,j)`B`, где `N`j`B` -- число шагов до данного хоста, `N`k`B` --\
номер трассы, то есть который по счету раз Вы нажали кнопку `N`"Трассировать и добавить"`B`.`N`
`N`
См. также:`H2`
`N`
>  `L1IT`Рекомендации по составлению`HREF`HelpForPingParams3` списка хостов, подлежащих тестированию `L1N`
>  `L1IT`Параметры ping-a`HREF`HelpForPingParams1` `L1N`
>  `L1IT`Окно \"\[1\] Параметры ping-теста\"`HREF`HelpForPingParams` `L1N`
>  `L1IT`Список всех разделов справки`HREF`HelpIndex` `L1N`
}}]

   set help(HelpForPingParams3) \
[subst {
"Справка::Рекомендации для списка хостов для ping-теста" "Help::Rocommendations"
{Как пользоваться справкой...`HREF`HelpForHelp`

Рекомендации по составлению списка хостов, подлежащих тестированию`H1`
`N`
1. `L1IT`При добавлении трассировкой к списку тестируемых узлов новых хостов разумно (по крайней мере, для\
первой проверки) ограничиться тестированием фрагмента трассы из зоны ответственности СТ "$::net(name)".  То есть,\
разумно оставить "галочки" такими, как они расставлены программой.`L1N`
`N`
2. `L1IT`Если Вы все-таки включили в тестирование хосты не из зоны ответственности СТ "$::net(name)", то следует\
увеличить время ожидания пакета.`L1N`
`N`
3. `L1IT`Следует учитывать, что вне города встречаются узлы (обычно промежуточные и с "необычными" именами,\
как например: `L1N`"MSU-M9IX-E0-1-Ether.msu.ru"`L1EM`), которые отвергают попытки ping-тестирования.  Бесполезно\
их тестировать: для них проверка намеряет 100% потерь, хотя на самом деле связь и с этим, и с последующими в\
трассе узлами может быть идеальной.`L1N`
`N`
4. `L1IT`Время тестирования растет с ростом числа проверяемых компьютеров.  Не отмечайте галочками чрезмерно\
много хостов.`L1N`
`N`
5. `L1IT`Тестирование узлов вне СТ "$::net(name)" приводит к образованию внешнего (платного) трафика (около 80 коп.\
за 100 пакетов по 1450 байтов).`L1N`
`N`
`N`
См. также:`H2`
`N`
>  `L1IT`Параметры ping-a`HREF`HelpForPingParams1` `L1N`
>  `L1IT`Определение списка`HREF`HelpForPingParams2` хостов, подлежащих тестированию `L1N`
>  `L1IT`Окно \"\[1\] Параметры ping-теста\"`HREF`HelpForPingParams` `L1N`
>  `L1IT`Список всех разделов справки`HREF`HelpIndex` `L1N`
}}]

   set help(HelpForPingTest) \
[subst {
"Справка::Выполнение ping-теста" "Help::Ping test"
{Как пользоваться справкой...`HREF`HelpForHelp`

Окно \"\[2\] Выполнение ping-теста\"`H1`

В этом окне выполняются одновременные ping-тесты для всех отобранных для этого хостов (компьютеров). Цветом\
(красный, желтый, зеленый) отмечаются хосты с неприемлемым, большим и малым уровнем потерь пакетов.\
Интенсивность цветов меняется (от совсем бледных к насыщенным оттенкам) по мере того, как растет число\
тестовых пакетов, то есть, по мере того, как растет тщательность проверки.

В колонках таблицы (слева/направо) отображаются `N`IP-адрес`B` и `N`имя хоста`B`, число отправленных (`N`out`B`)\
и потерянных (`N`loss`B`) пакетов, процент потерь (`N`loss\%`B`), время "полета" туда-и-обратно (в мсек):\
минимальное (`N`ms min`B`), максимальное (`N`ms max`B`) и среднее (`N`ms avg`B`).

`N`Кнопки в верхней рамке`H2`
`N`
o  `L1IT`"Еще NNN пакетов"`L1B` -- начать еще одну серию ping-тестов`L1N`
o  `L1IT`"Остановить ping-тест"`L1B` -- прекратить текущую серию ping-тестов`L1N`
o  `L1IT`"Написать отчет >>>"`L1B` -- перейти в раздел `L1N`\"\[3\] Отчет по результатам тестов\"`L1B`.`L1N`
o  `L1IT`"Закончить"`L1B` -- прекратить выполнение программы.`L1N`
`N`
См. также:`H2`
`N`
>  `L1IT`Окно \"\[1\] Параметры ping-теста\"`HREF`HelpForPingParams` `L1N`
>  `L1IT`Окно \"\[3\] Отчет по результатам тестов\"`HREF`HelpForReport` `L1N`
>  `L1IT`Список всех разделов справки`HREF`HelpIndex` `L1N`
}}]

   set help(HelpForSetUp) \
[subst {
"Справка::Настройки тестера" "Help::Setup"
{Как пользоваться справкой...`HREF`HelpForHelp`

Окно \"\[0\] Настройки тестера\"`H1`

Настройку тестера следует выполнять в ситуации, когда доступ к СТ "$::net(name)" у Вас работает исправно.

Если эти два условия выполнены, то Вам не составит труда настроить программу.  
`N`
1  `L1IT`Учетное имя Абонента`L1EM` берется из договора (или см. ниже).`L1N`
`N`
2  `L1IT`Укажите `L1N`Ваш электронный адрес`L1EM` -- при посылке отчетов он будет указан в письме\
как обратный адрес (и еще как адрес для посылки копии -- так у Вас появится копия отчета).`L1N`
`N`
3  `L1IT`А остальные настройки лучше оставить так, как они есть (по крайней мере для первого раза).`L1N`
`N`
Замечание:`EM` Возможно, поле `N`"учетное имя Абонента"`EM` будет заполнено\
и неактивно (защищено от правок).  Это означает, что программе удалось данное поле заполнить самостоятельно.
`N`
Подсказка:`EM` Учетное имя Абонента можно узнать еще на `N`$ping(ab_page)`HREF`$ping(ab_page)` -- поле\
\"Учетное имя абонента:\";`N`
`N`
См. также:`H2`
`N`
>  `L1IT`Список всех разделов справки`HREF`HelpIndex` `L1N`
}}]

   set help(HelpForReport) \
[subst {
"Справка::Отчет по результатам тестов" "Help::Report"
{Как пользоваться справкой...`HREF`HelpForHelp`

Окно \"\[3\] Отчет по результатам тестов\"`H1`

Отчет по результатам тестов---это готовое к отправке письмо для `N`ремонтной бригады`EM`.

Посмотрите, удалось ли выполненными проверками выявить проблемы с сетью?  `N`Если`EM` проблемы выявлены, то имеет\
смысл послать данное письмо.  Для этого:
`N`
1  `L1IT`В верхней части окна в соответствующем поле `L1N`напишите Ваш адрес`L1EM`.`L1N`
`N`
2  `L1IT`Если считаете нужным, напишите Ваш `L1N`комментарий`L1EM` к отчету.`L1N`
`N`
3  `L1IT`Если при проверке сетевых настроек на Вашем компьютере найдены `L1N`ошибки`L1EM`, то попытайтесь их исправить самостоятельно, пользуясь ссылками на разделы ЧаВО.`L1N`
`N`
4  `L1IT`Нажмите кнопку `L1N`"Послать e-mail"`L1EM` (можно сделать 1 раз за сеанс). Будет послано письмо\
ремонтной бригаде и копия на Ваш адрес (заданный Вами в п. 1).`L1N`
`N`
5  `L1IT`Если послать письмо не удалось, то при помощи кнопки `L1N`"Записать в файл"`L1EM` Вы можете сохранить\
текст и послать его в другой раз.`L1N`
`N`
`N`Кнопки в верхней рамке`H2`
`N`
o  `L1IT`"Записать в файл"`L1B` -- записать отчет и Ваш комментарий в текстовый файл.`L1N`
o  `L1IT`"Послать e-mail"`L1B` -- послать отчет и Ваш комментарий ремонтной бригаде и копию на Ваш адрес.`L1N`
o  `L1IT`"Закончить"`L1B` -- прекратить выполнение программы.`L1N`
`N`
См. также:`H2`
`N`
>  `L1IT`Как с нами связаться`HREF`HelpForClaim` `L1N`
>  `L1IT`Окно \"\[2\] Выполнение ping-теста\"`HREF`HelpForPingTest` `L1N`
>  `L1IT`Список всех разделов справки`HREF`HelpIndex` `L1N`
}}]

   set help(HelpForClaim) \
[subst {
"Справка::Как с нами связаться" "Help::Claim"
{Как с нами связаться`H1`

Программа $ping(name) является рекомендуемым средством подачи обоснованной жалобы на качество связи.
Но если по каким-то причинам отправить отчёт не удаётся, то можно обратиться в службу поддержки СТ \"$::net(name)\"
несколькими другими способами:
>  `L1IT`оставить заявку на персональном сайте Надмин:Абоненту ( $ping(ab_page) );`L1N`
>  `L1IT`оставить заявку через терминалы в офисах Ботик-технологий, АйТи-Лаб или Сбербанка ( список адресов: $ping(term_page) );`L1N`
>  `L1IT`отправить SMS-сообщение на номер 8-961-160-58-29; в сообщении нужно указать учётное имя Абонента и телефон, по которому с Вами можно связаться;`L1N`
>  `L1IT`непосредственно обратиться к нашему персоналу в центральный офис ( $ping(office_page) );`L1N`
>  `L1IT`позвонить и оставить заявку по телефону (48535)98-355 или (48535)98-033.`L1N`

`N`Список всех разделов справки...`HREF`HelpIndex`
}}]

return

}
# ================= 6 Окно "Configure" ============================================
#                      -------- чтение init-файла, вернет 1 -- если все ОК, 0 -- иначе.
# 0 - have to make tuning, 1 - don't have to
proc readInitFile { } {
   global ping wReport bad_file_or_token bad_file_or_token_msg

   set f $ping(init_file)
   set tokens [readTokensFromFile $f]

   set ping(NN) 0
   set k -2
   set j  1
   foreach {h ip r} $tokens {
      if { $bad_file_or_token } { break }
      if { $k == -2 } {
         checkToken [regexp {^Versions$} $h]       "Триада $j, \"$h\" -- неверный 1-ый токен триады\n(ожидали \"Versions\")"
         checkToken [string is double -strict $ip] "Триада $j, \"$ip\" -- неверный 2-ой токен триады\n(ожидали номер версии)"
         checkToken [string is double -strict $r]  "Триада $j, \"$r\" -- неверный 3-ий токен триады\n(ожидали номер версии)"
         if { $bad_file_or_token } { break }
         set ping(init_ver)        $ip
      } elseif { $k == -1 } {
         checkToken [regexp $ping(regAbName) $h] "Триада $j, \"$h\" --  неверный 1-ый токен триады\n(ожидали имя абонента)"
         checkToken [regexp {^(LAN|DIALUP)$} $ip] "Триада $j, \"$ip\" -- неверный 2-ой токен триады\n(ожидали \"LAN\" или \"DIALUP\")"
         checkToken [goodEmail $r] "Триада $j, \"$r\" -- неверный 3-ий токен триады \n(ожидали e-mail)"
         if { $bad_file_or_token } { break }
         set ping(abonent) $h
         set wReport(From) $r
         set ping(isModem) [limits [lsearch -exact { LAN DIALUP } $ip] 0 1]
         chkWhoamiConnection
         chkWhoamiUserName         
         resetupLanDialupConstants
      } else {
         if { ($h eq {}) || ($ip eq {}) || ($r eq {}) } { break }
         checkToken [regexp {[-a-zA-Z0-9_.][-a-zA-Z0-9_.]*} $h] "Триада $j, \"$h\" -- неверное имя хоста"
         checkToken [chkIP $ip] "Триада $j, \"$ip\" -- неверный IP-адрес"
         checkToken [isLocal $h $ip] "Триада $j, \"$h\", \"$ip\" -- хост не из СТ \"$::net(name)\""
         if { $bad_file_or_token } { break }
         set ping(n_host,$k)  $h
         set ping(ip_host,$k) $ip
         set ping(reason,$k)  $r
      }
      incr k
      incr j
   }

   checkToken [expr ($k > -2)] "Файл пустой или не найден"
   checkToken [expr ($k >  0)] "Отсутствует список хостов для ping-теста"

   set ping(NN) $k
   set tres [getTraceInfo]
   if {$tres} {
      #message warning "Не удалось связаться с тест-сервером. Возможно,\
                      у Вас неполадки с сетью или в СТ \"$::net(name)\" ведутся\
                      профилактические работы. Процедура настройки будет невозможна."
      return 1
   }
   if { $bad_file_or_token } { 
      #message warning "Не удалось считать файл с настройками \"$f\".\n\
                   \n$bad_file_or_token_msg\n\
                   \nВозможно, это первый запуск данной версии программы.\n\
                   \nНеобходимо выполнить настройку программы."
      return 0
   }
   if {double($ping(init_ver)) != double($ping(ver))} {
      set answer [alertQuestion "Версия программы \"$ping(ver)\", а файл настроек\
                  построен для версии \"$ping(init_ver)\"\
                  Рекомендуем заново выполнить настройку $ping(name). Хотите ли Вы сделать это сейчас?"]
      if {$answer eq "yes"} {return 0}
   }
   if {[compareData]} {
      set answer [alertQuestion "Сетевая конфигурация Вашей подсети изменилась\
            с момента последней настройки программы.\
            Рекомендуем заново выполнить настройку $ping(name). Хотите ли Вы сделать это сейчас?"]
      if {$answer eq "yes"} {return 0}
   }
   return 1
}
proc crucialCheck {} {
    global ping
    set info ""
    if {![lempty $ping(whoami,pingBlocked)] && $ping(whoami,pingBlocked) eq "1"} {
        append info "Ваш компьютер не отвечает на Ping-запросы.\
                    Данное обстоятельство может негативно отразиться на результате\
                    обработки Вашей заявки, которая будет создана в системе Надмин::Абоненту\
                    после отправки Вами отчёта о ping-тестировании.\
                    Пожалуйста, настройте компьютер так, чтобы он отвечал на Ping-запросы.\
                    Если Вы не знаете как это сделать, обратитесь к разделу\
                    часто задаваемых вопросов на сайте СТ \"Ботик\".\n"
    }
    if {$info ne ""} {message warning $info}
}
# элементы ping с индексами:   timeout   lat,exel   lat,good   lat,not_so_bad
# переопределяются из таблицы после установки типа подключения
proc resetupLanDialupConstants { } {
   global ping
   set x $ping(isModem)
   foreach ij { timeout lat,exel lat,good lat,not_so_bad } {
      set ping($ij) [lindex $ping(lan_modem,$ij) $x]
   }
}
proc traceCmd {a b c d} {
    puts $::chan "$d:[string repeat { } $d]$b"
}
#                      -------- пытается считать конфигурацию и стартовать окна "Ping-params"
#                      -------- если не удастся -- стартует окно "Configure"
proc readConfigureAndStart { } {
   if {![readInitFile]} {
      startConfigureWindow
   } else {
      startPingParamsWindow
   }
}
#                      -------- чтение настроек, вернет 1 -- если все ОК, 0 -- иначе.
proc readHostsFile { } {
   global ping bad_file_or_token bad_file_or_token_msg

   set tokens [list]
   for {set i 0} {$i < $ping(srvNN)} {incr i} {
      lappend tokens $ping(srvreason,$i) $ping(n_srvhost,$i)
   }

   set ping(HN) 0
   set k 0
   set j 1

   foreach {r h} $tokens {
      if { ($h eq {}) || ($r eq {}) } { break }
      checkToken [regexp {^[-a-zA-Z0-9_.]+$} $h] "Пара $j, \"$h\" -- неверное имя хоста"
      regsub -all {[-]} $r " " r1
      set ping(hh,$k) $h
      set ping(hr,$k) $r1
      incr k
      incr j
   }
   set ping(HN) $k
   return 1
}
#                      -------- checkbox в окне "Configure"
proc addChkCW { n text var val } {
   global ping iface
   set $var $val
   frame .mw.cntnt.$n -bd 0
   checkbutton .mw.cntnt.$n.chk -text $text -font $iface(font4) -variable $var -relief flat
   pack  .mw.cntnt.$n.chk -side left
   pack  .mw.cntnt.$n -side top -fill x
}
#                      -------- шкала (%%) в окне "Configure"
proc setScalePC {width {pconly 0}} {
   set p [limits $width 0 100]
   if {$pconly} {
      set text "$p%"
   } else {
      set text "Настроек выполнено: $p%"
   }
   addTitlePercent $p
   if {[windowsPlatform]} {
       set ::tuneprogress $p
       catch {.mw.cntnt.cY.label configure -text $text}
       return
   }
   # 650-503 / 2 = 73.5, 503+73.5 = 576.5
   set w  [expr $p*5]
   set x1 [expr $w+1+73]
   set x2 [expr $x1+1]
   catch {.mw.cntnt.cY.canvas coords polyL 73  0 $x1 20}
   catch {.mw.cntnt.cY.canvas coords polyR $x2 0 576 20}
   catch {.mw.cntnt.cY.label configure -text $text}
}
#                      -------- главная функция окна "Configure"
proc startConfigureWindow {} {
   global ping wReport iface

   setTitle "Настройка тестера для СТ \"$::net(name)\" -- [strTime]" "BotikTester Setup"
   set ping(defaultstatus)  "\[0\] установить настройки для тестера"
   defaultStatus

   setButtons { {cancel "Закончить"  doExit}
                {help   "Справка"    "showHelp HelpForSetUp"}
                {next   "Далее >>"  "setupAndStartPingParamsWindow"} }
   clearCntnt

   # Шкала:
   frame .mw.cntnt.cY -bd 4
   label .mw.cntnt.cY.label -text "Настроек выполнено 0%:" -font $iface(font1) -justify center -wraplength -1 -anchor c
   
   set swidth 650
   if {[windowsPlatform]} {
       ttk::progressbar .mw.cntnt.cY.pc -variable ::tuneprogress -mode determinate -length $swidth
       set ::tuneprogress 0
       pack .mw.cntnt.cY.label .mw.cntnt.cY.pc -side top -fill x -expand 1
   } else {
       canvas .mw.cntnt.cY.canvas -width $swidth -height 20 -bd 0 -highlightthickness 0
       .mw.cntnt.cY.canvas create rectangle 0 0 1 1 -fill #35d538 -tags polyL
       .mw.cntnt.cY.canvas create rectangle 0 0 1 1 -fill snow1 -tags polyR
       pack  .mw.cntnt.cY.label .mw.cntnt.cY.canvas -side top -expand yes -fill x
   }

   pack  .mw.cntnt.cY -side top -fill x
   setScalePC 0
   frame .mw.cntnt.cY.delim -width 650 -height 3 -borderwidth 1 -relief sunken
   pack  .mw.cntnt.cY.delim -side top -pady 2 -padx 1
   # Остальные элементы
  
   frame .mw.cntnt.cX -bd 4
   entry .mw.cntnt.cX.entry -relief sunken -width 30 -textvariable ping(abonent)
   label .mw.cntnt.cX.label -text "учётное имя Абонента" -font $iface(font4)
   pack  .mw.cntnt.cX.entry -side left -padx 4
   pack  .mw.cntnt.cX.label -side left
   pack  .mw.cntnt.cX  -side top -fill x
   if {[chkWhoamiUserName]} {
      foreach w {.mw.cntnt.cX.entry .mw.cntnt.cX.label} {
         catch {$w configure -state disabled}
      }
   }

   frame .mw.cntnt.cF -bd 4
   intWReportFrom 
   entry .mw.cntnt.cF.entry -relief sunken -width 30 -textvariable wReport(From)
   label .mw.cntnt.cF.label -text "Ваш электронный адрес" -font $iface(font4)
   pack  .mw.cntnt.cF.entry -side left -padx 4
   pack  .mw.cntnt.cF.label -side left
   pack  .mw.cntnt.cF -side top -fill x

   set e1e .mw.cntnt.cX.entry
   set e2e .mw.cntnt.cF.entry
   set e1state [$e1e cget -state]
   bind $e1e <KeyPress-Return> "setupAndStartPingParamsWindow"
   bind $e2e <KeyPress-Return> "setupAndStartPingParamsWindow"
   if {$e1state ne "disabled" && $ping(abonent) eq ""} {
           focus -force $e1e
   } else {
           focus -force $e2e
   }
   addChkCW cB "тестировать все ближайшие роутеры?" ping(n_routers) 1

   if {! [readHostsFile] } { return }

   set n $ping(HN)

   for {set k 0} {$k < $n} {incr k} {
      if { $ping(hr,$k) ne "R" } {
         addChkCW c$k "проверять путь к \"$ping(hh,$k)\" ($ping(hr,$k))?" ping(hf,$k) 1
      }
   }


   focus .mw.cntnt.cX.entry
   #changesInHelpWindow HelpForSetUp
}
#                      -------- добавление точки ping-тестирования
proc addHostCW { h ip r } {
   global ping

   set n $ping(NN)
   for {set k 0} {$k < $n} {incr k} {
      if {$ip eq $ping(ip_host,$k)} {
         set ping(reason,$k) [newReason $ping(reason,$k) $r]
         return
      }
   }
   set ping(n_host,$n)  $h
   set ping(ip_host,$n) $ip
   set ping(reason,$n)  $r
   set ping(NN) [expr $n + 1]
   return
}
#
proc newReason { rold radd } {
   # return "$rold+$radd"
   if { ([string first . $radd] != -1)                   } { return $rold }
   if { ([string first . $rold] != -1) || ($rold eq "R") } { return $radd }
   return $rold
}
#                      -------- добавить сообщение в журнал 
proc warningCW { x flag } {
   global ping
   set msg "Не ожидали: $x"
   if { $flag == 1 } {
      set n [expr $ping(raw_trrt,N)-1]
      set msg "$msg\n$ping(raw_trrt,$n)\n"
   }
   incr ping(Nwng)
   set ping(wng)  "$ping(wng)\n====================================================\n$msg"
   return
}
#                      -------- Настройка БТестера: построение умолчательного списка точек трассирования
proc traceHosts { } {
   global ping
   incrCounter "btconfig"
   stateBtns { { disabled {next} } }
   setScalePC 0
   set n $ping(HN)
   set ping(Nwng) 0
   set ping(wng)  ""
   
   for {set k 0} {$k < $n} {incr k} {
      setScalePC [limits [expr round(double($k*100)/double($n))] 0 100]
      update
      if { ($ping(hr,$k) eq "R")&&($ping(n_routers) != 1) } { continue }
      if { ($ping(hr,$k) ne "R")&&($ping(hf,$k) != 1) } { continue }

      set h $ping(hh,$k)
      set r [lindex $ping(hr,$k) 0]

      specialStatus "\[0\] Ждите окончания трассировки \"$h\""
      .mw configure -cursor watch
      update

      # Если узел не пингуется, нет нужды его трассировать...
      set len 0
      pingTest $h
      set fping [expr $ping(rec) == 1]
      if {$fping} {
         set len [rawTraceroute $h]
      }
      .mw configure -cursor arrow
      defaultStatus
      if { $len == 0 } { 
         if {$fping} {
            warningCW "Не удалось протрассировать узел $h." 1
         } else {
            set text_ping ""
            catch { 
               set kk [expr $ping(bad_pings,K) - 1]
               if { $kk < 0 } {
                  set $kk $ping(bad_pings,MAXK)
               }
               set text_ping $ping(bad_pings,$kk) 
            }
            warningCW "Не прошел ping к $h\n$text_ping" 0
         }
         continue
      }
      
      if { ($r eq "R") && ($len < 1) } { continue }
      set len [expr $len-1]
      set hn $h
      set ip $ping(trrt_ip,$len)

      if { [isLocal $hn $ip] != 1 } {
         warningCW "Узел \"$hn \[$ip\]\"\nне распознан как локальный для СТ \"$::net(name)\"." 1
         continue
      }
      addHostCW $hn $ip $r
      # добавляем промежуточные узлы
      for {set i 0} {$i < $len} {incr i} {
         set hn $ping(trrt_h,$i)
         set ip $ping(trrt_ip,$i) 
         if { [isLocal $hn $ip] != 1 } {
            warningCW "Узел \"$hn \[$ip\]\"\nне распознан как локальный для СТ \"$::net(name)\"." 1
            continue
         }
         addHostCW $hn $ip "$r.[expr $i+1]"
      }
   }
   setScalePC 100
   # запись журнала:
   if {$ping(Nwng) > 0} {
      #showHelp HelpForSetUp
      #message warning \
              "В процессе настройки программы было обнаружено несколько ($ping(Nwng))\
             \nпроблем. Возможно, неполадки с сетью. Подробнее: читайте текущее окно справки.\n\
             \nСкорее всего, эти проблемы не скажутся на работоспособности программы."
   } else {incrCounter "btconfig_success"}
   stateBtns { { normal {next} } }
   setScalePC 0
   return 1
}
# 
#                      -------- выполнить настройки и если удачно -- к окну [1]
proc setupAndStartPingParamsWindow {} {
   global ping wReport

   if { $ping(isModem) < 0 } {
      message warning "Установите тип подключения Вашего компьютера"
      return 0
   }

   if { ! ($ping(by_whoami,UserName) || [regexp $ping(regAbName) $ping(abonent)]) } {
      message warning "Недопустимое имя Абонента"
      return 0
   }

   if [badFromEmail] {
      return 0
   }

   set ping(NN) 0

   if { ![traceHosts] } { return 0 }

   if { $ping(NN) == 0 } {
      message warning "Не определено ни одного хоста для тестирования. Возможно, неполадки с сетью."
      return 0
   }

   chkWhoamiUserName
   chkWhoamiConnection
   resetupLanDialupConstants

   set ping(init_ver)        $ping(ver)

   # Запись настроек в файл...
   set ping(conf) ""
   # Первая триада:
   set ping(conf) "$ping(conf)Versions:$ping(init_ver):0:"
   # Вторая триада:
   set x [lindex { LAN DIALUP } $ping(isModem)]
   set ping(conf) "$ping(conf)$ping(abonent):$x:$wReport(From):"
   # Остальные триады:
   set n $ping(NN)
   for {set k 0} {$k < $n} {incr k} {
      set ping(conf) "$ping(conf)\n$ping(n_host,$k):$ping(ip_host,$k):$ping(reason,$k):"
   }
   writeConfigCW
   startPingParamsWindow
}
#                      -------- запись настроек в файл
proc writeConfigCW {} {
   global ping
   set ok 0
   catch {
      set file $ping(init_file)
      set f [open $file w]
      puts $f $ping(conf)
      close $f
      set ok 1
   } rc
   if { !$ok } {
      set msg "Сохранить на диске настройки не удалось:\
               \nError: [mkErrorCode $rc]\
               \n\nУвы, при следующем запуске программы потребуется повторить\
               \nпроцедуру настройки."
      message error $msg
      asksendmail $msg
   }
   return
}
# search for failed system nodes (state=0)
proc failed_sysnodes {} {
    if {![windowsPlatform] || ![info exists ::sysnodes]} {return}
    set res {}
    set headers {HTTP/1.1 Date: Server: Content-Length: Connection: Content-Type: Vary:}
    catch {
        set data [informer_data 3]
        foreach line [split $data \n] {
            if {[llength $line] < 3} {continue}
            set node [lindex $line 0]
            if {[lsearch $headers $node] > -1} {continue}
            set sens [lindex $line 1]
            set measure [lindex $line end]
            if {![string is double -strict $measure] || $sens ne "STATE"} {continue}
            if {!$measure && [lsearch $::sysnodes $node] > -1} {
                lappend res $node
            }
        }
    }
    return $res
}
proc dataHandler {socket token} {
    gets $socket line
    if {[llength $line]} {
        lappend ::sysnodes [lindex $line 0]
    }
    if {[llength $line] == 1} {
        lappend ::ping(sysnodes) $line
        return
    }
    if {[llength $line] != 3} {return}
    set h  [lindex $line 0]
    set ip [lindex $line 1]
    set r  [lindex $line 2]
    set r0 [string index $r 0]
    if {$r0 eq "S"} {
        set r "${r}-центральный-сервер"
    } elseif {$r0 eq "G"} {
        set r "${r}-выход-в-мир"
    } elseif {$r0 ne "R" || [ethBox $h]} {
        return
    }
    set ::ping(n_srvhost,$::ping(srvNN))  $h
    set ::ping(ip_srvhost,$::ping(srvNN)) $ip
    set ::ping(srvreason,$::ping(srvNN))  $r
    incr ::ping(srvNN)
    return
}
# получение топологической информации у тест-сервера
proc getTraceInfo {} {
    global ping
    set ping(srvNN) 0
    if {$ping(cancel_request)} {    
        set ping(cancel_request) 0
        set ping(speed_ip) $speed::ip1
        return 0
    }
    set ping(defaultstatus) "Инициализация программы: запрос данных о топологии сети..."
    defaultStatus
    set host   nadmin.$::net(domain)
    set npings 5
    set cnt    0
    set ip [tryResolve $speed::server1]
    if {![llength $ip]} {
        set ping(speed_ip) $speed::ip1
    } else {set ping(speed_ip) $ip}
    for {set i 0} {$i < $npings} {incr i} {
        array set pingres [rawPing $host]
        if {$pingres(rec) == 0} {incr cnt}
    }
    # если все пинг-тесты не прошли, то считается что сервер недоступен
    if {$npings == $cnt} {return 0}
    set rc [catch {
        set ping(current_request) [http::geturl $ping(url_config) -handler dataHandler -timeout $ping(httpto)]
    }]
    if {!$rc && $ping(srvNN) > 0 && ![lcontain $::sysnodes $speed::server1]} {
        lappend ::sysnodes $speed::server1
        lappend ping(sysnodes) $speed::server1
    }
    return $rc
}
proc tryResolve {hostname} {
    global ping
    array set pingres [rawPing $hostname]
    if {$pingres(rec) == 0} {return}
    set txt $pingres(lastPingRes)
    if {[windowsPlatform]} {
        set frst [string first \[ $txt]
        set last [string first \] $txt]
    } else {
        set frst [string first "(" $txt]
        set last [string first ")" $txt]
    }
    if {$frst < 0 || $last < 0} {return}
    incr frst
    incr last -1
    set ip [string range $txt $frst $last]
    if {[llength $ip] && [chkIP $ip]} {return $ip}
    return
}
# сравнение tester.init и серверной топологической информации
# если на клиенте нет чего-то, что есть на сервере, то требуется перенастройка
proc compareData {} {
    global ping
    # если топол. инф-ю получить не удалось, то не нужно предлагать перенастраиваться:
    if {$ping(srvNN) == 0} {return 0}
    set chosts {}
    for {set i 0} {$i < $ping(NN)} {incr i} {
        set config_hosts($ping(n_host,$i)) 1
    }
    for {set i 0} {$i < $ping(srvNN)} {incr i} {
        # если в конфиг. файле tester.init не найдено такого сетевого узла,
        # о котором сообщил сервер, то узел этот в случае доступности
        # добавляется в конфиг. файл клиента через перенастройку
        if {![info exists config_hosts($ping(n_srvhost,$i))]} {
            array set pingres [rawPing $ping(n_srvhost,$i)]
            if {$pingres(rec) == 1} {
                return 1; # конфиг-я изменилась и рекомендуется перенастроиться
            }
        }
    }
    return 0
}
proc incrCounter {df} {}
proc traceCmd {a b c d} {
    puts $::tracechan "$d:[string repeat { } $d]$b"
}
proc traceoff {} {
    catch {cmdtrace off; close $::tracechan}
}
proc traceon {} {
    set ::tracechan [open trace.log w]
    fconfigure $::tracechan -encoding cp1251
    cmdtrace on notruncate procs command traceCmd
}

package require Tcl 8.4
if {$tcl_platform(platform) eq "windows"} {
    package require registry 1.1.3
    catch {
        package require informer 1.0
        informer_fetch3
    }
}
package require base64 2.3

# ================= Собственно скрипт =============================================
loadModule botikUts.tcl
loadModule net.tcl
loadModule botikHlp.tcl
loadModule report.tcl
initValues
loadModule speed.tcl
initHelp
startInitWindow
readConfigureAndStart