| 1 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 2 | # FILE : bodbc.tcl |
|---|
| 3 | # PURPOSE : This file contains a namespace called BODBC with its |
|---|
| 4 | # functions. It's for creating a ODBC connect options dialog and |
|---|
| 5 | # managing its events. |
|---|
| 6 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 7 | |
|---|
| 8 | # INCLUDES |
|---|
| 9 | package require byscommon |
|---|
| 10 | package require bcombobox |
|---|
| 11 | package require bfunctions |
|---|
| 12 | |
|---|
| 13 | |
|---|
| 14 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 15 | snit::type bodbcmodule { |
|---|
| 16 | # |
|---|
| 17 | # PURPOSE: BODBCModule widget class definition |
|---|
| 18 | # |
|---|
| 19 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 20 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 21 | # |
|---|
| 22 | # options: |
|---|
| 23 | # module -> Name of modules to connect |
|---|
| 24 | # stdtolcon -> Connection TOL : true |
|---|
| 25 | # stdtclcon -> Connection TCL : true |
|---|
| 26 | # procconnect -> Function connect : {} |
|---|
| 27 | # prodisconnect -> Function disconnect : {} |
|---|
| 28 | # iniconfig -> Header in .ini file : $modele |
|---|
| 29 | # savealias -> Save "alias" in .ini : true |
|---|
| 30 | # saveuser -> Save "user" in .ini : true |
|---|
| 31 | # savepwd -> Save "pwd" in .ini : false |
|---|
| 32 | # alias -> Alias by defect |
|---|
| 33 | # user -> User by defect |
|---|
| 34 | # pwd -> Password by defect |
|---|
| 35 | # connection -> name of connection TCL |
|---|
| 36 | # autoconnect -> connects automatically with Data Base |
|---|
| 37 | # |
|---|
| 38 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 39 | delegate option * to hull |
|---|
| 40 | |
|---|
| 41 | option -stdtolcon true |
|---|
| 42 | option -stdtclcon true |
|---|
| 43 | option -procconnect {} |
|---|
| 44 | option -prodisconnect {} |
|---|
| 45 | option -iniconfig {} |
|---|
| 46 | option -savealias true |
|---|
| 47 | option -saveuser true |
|---|
| 48 | option -savepwd false |
|---|
| 49 | option -alias {} |
|---|
| 50 | option -user {} |
|---|
| 51 | option -pwd {} |
|---|
| 52 | option -gestor {} |
|---|
| 53 | option -name {} |
|---|
| 54 | option -connection {} |
|---|
| 55 | option -autoconnect false |
|---|
| 56 | |
|---|
| 57 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 58 | constructor { args } { |
|---|
| 59 | # |
|---|
| 60 | # PURPOSE: beditselector constructor |
|---|
| 61 | # |
|---|
| 62 | # PARAMETERS: |
|---|
| 63 | # args -> options |
|---|
| 64 | # |
|---|
| 65 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 66 | # Apply all options passed at creation time. |
|---|
| 67 | $self configurelist $args |
|---|
| 68 | # load parameters .ini |
|---|
| 69 | $self _LoadParamIni |
|---|
| 70 | } |
|---|
| 71 | |
|---|
| 72 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 73 | method _LoadParamIni {} { |
|---|
| 74 | # |
|---|
| 75 | # PURPOSE: To recover values of the configuration file |
|---|
| 76 | # |
|---|
| 77 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 78 | # load parameters from ini |
|---|
| 79 | if {[string length [$self cget -iniconfig]]} { |
|---|
| 80 | Tolcon_Trace "_LoadParamIni ..." |
|---|
| 81 | set key [$self cget -iniconfig] |
|---|
| 82 | if {[$self cget -savealias]} { |
|---|
| 83 | $self configure -alias \ |
|---|
| 84 | [::iniFile::Read $key DataSource [$self cget -alias] ] |
|---|
| 85 | } |
|---|
| 86 | if {[$self cget -saveuser]} { |
|---|
| 87 | $self configure -user \ |
|---|
| 88 | [::iniFile::Read $key Userid [$self cget -user]] |
|---|
| 89 | } |
|---|
| 90 | if {[$self cget -savepwd]} { |
|---|
| 91 | $self configure -pwd \ |
|---|
| 92 | [::iniFile::Read $key Password [$self cget -pwd]] |
|---|
| 93 | } |
|---|
| 94 | } |
|---|
| 95 | } |
|---|
| 96 | |
|---|
| 97 | |
|---|
| 98 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 99 | method get { var} { |
|---|
| 100 | # |
|---|
| 101 | # PURPOSE: Obtain the value of a variable |
|---|
| 102 | # |
|---|
| 103 | # PARAMETERS: var -> name of variable |
|---|
| 104 | # |
|---|
| 105 | # RETURN: value of variable |
|---|
| 106 | # |
|---|
| 107 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 108 | return [subst $[subst "$var"]] |
|---|
| 109 | } |
|---|
| 110 | |
|---|
| 111 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 112 | method set { var value } { |
|---|
| 113 | # |
|---|
| 114 | # PURPOSE: Establish the value of a variable |
|---|
| 115 | # |
|---|
| 116 | # PARAMETERS: var -> name of variable |
|---|
| 117 | # value -> values of variable |
|---|
| 118 | # |
|---|
| 119 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 120 | set [subst $var] $value |
|---|
| 121 | } |
|---|
| 122 | } |
|---|
| 123 | |
|---|
| 124 | |
|---|
| 125 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 126 | snit::type bodbc { |
|---|
| 127 | # |
|---|
| 128 | # PURPOSE: BODBC type class definition |
|---|
| 129 | # |
|---|
| 130 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 131 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 132 | # variables: |
|---|
| 133 | # lstConnection -> list of list. Name module and variable connection |
|---|
| 134 | # widget -> array of name of widget |
|---|
| 135 | # counter -> variable accountant |
|---|
| 136 | # |
|---|
| 137 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 138 | delegate option * to hull |
|---|
| 139 | |
|---|
| 140 | variable lstConnection {} |
|---|
| 141 | variable widget |
|---|
| 142 | variable counter 0 |
|---|
| 143 | |
|---|
| 144 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 145 | method showdialog { { namMod {} } } { |
|---|
| 146 | # |
|---|
| 147 | # PURPUSE: Show the dialog |
|---|
| 148 | # |
|---|
| 149 | # PARAMETERS: |
|---|
| 150 | # namMod -> if it is specified I name of module, it asks for its information. |
|---|
| 151 | # ESLE |
|---|
| 152 | # it shows box of selection of module |
|---|
| 153 | # |
|---|
| 154 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 155 | set module {} |
|---|
| 156 | # one connection ? |
|---|
| 157 | if {[string length $namMod]} { |
|---|
| 158 | set module [$self _GetModuleToName $namMod] |
|---|
| 159 | } else { |
|---|
| 160 | switch -exact [llength $lstConnection] { |
|---|
| 161 | 0 { return 0 } |
|---|
| 162 | 1 { set module [lindex [lindex $lstConnection 0] 1] } |
|---|
| 163 | } |
|---|
| 164 | } |
|---|
| 165 | # create dialog |
|---|
| 166 | if {[string length $module]} { |
|---|
| 167 | $self _CreateDialog $module |
|---|
| 168 | } else { |
|---|
| 169 | $self _CreateDialog |
|---|
| 170 | } |
|---|
| 171 | } |
|---|
| 172 | |
|---|
| 173 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 174 | method validateconnection { namMod } { |
|---|
| 175 | # |
|---|
| 176 | # PURPUSE: it verifies if we are connected to the data base, else, show |
|---|
| 177 | # selection dialog |
|---|
| 178 | # |
|---|
| 179 | # PARAMETERS: |
|---|
| 180 | # namMod -> if it is specified I name of module, it asks for its information. |
|---|
| 181 | # |
|---|
| 182 | # RETURN: 1 -> connection OK |
|---|
| 183 | # 0 -> error |
|---|
| 184 | # |
|---|
| 185 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 186 | # get module |
|---|
| 187 | set module [$self _GetModuleToName $namMod] |
|---|
| 188 | if {![string length module]} { |
|---|
| 189 | #Tolcon_Trace "ValidateConnection. El modulo $namMod no existe" |
|---|
| 190 | return 0 |
|---|
| 191 | } |
|---|
| 192 | |
|---|
| 193 | # connection TCL && TCL |
|---|
| 194 | set status [$self checkconnection $module] |
|---|
| 195 | # activate connection TOL |
|---|
| 196 | if {($status) && ([$module cget -stdtolcon])} { |
|---|
| 197 | set op [GetUniqueName Real _ActTOLTK] |
|---|
| 198 | set alias [$module cget -alias] |
|---|
| 199 | set cmd "Real $op = DBActivate(\"$alias\");" |
|---|
| 200 | ::tol::console eval $cmd |
|---|
| 201 | ::tol::console stack release $op |
|---|
| 202 | } |
|---|
| 203 | # Auto connect |
|---|
| 204 | if {[expr !$status && [$module cget -autoconnect]]} { |
|---|
| 205 | set alias [$module cget -alias] |
|---|
| 206 | set user [$module cget -user] |
|---|
| 207 | set pwd [$module cget -pwd] |
|---|
| 208 | set status [$self _Connect $module $alias $user $pwd] |
|---|
| 209 | } |
|---|
| 210 | |
|---|
| 211 | # Dialogo |
|---|
| 212 | if {!$status} { |
|---|
| 213 | set status [$self _CreateDialog $module] |
|---|
| 214 | } |
|---|
| 215 | # return |
|---|
| 216 | #Tolcon_Trace "validateconnection $status" |
|---|
| 217 | return $status |
|---|
| 218 | } |
|---|
| 219 | |
|---|
| 220 | |
|---|
| 221 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 222 | method checkconnection {module} { |
|---|
| 223 | # |
|---|
| 224 | # PURPUSE: Verifies if its are connected to the data base in TCL and TOL |
|---|
| 225 | # |
|---|
| 226 | # PARAMETERS: |
|---|
| 227 | # module: name of connection (bodbcmodule) |
|---|
| 228 | # |
|---|
| 229 | # RETURN: 1 -> connection |
|---|
| 230 | # 0 -> no |
|---|
| 231 | # |
|---|
| 232 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 233 | # connection TCL |
|---|
| 234 | set statusTcl [$self checkconnectiontcl $module] |
|---|
| 235 | # connection TOL |
|---|
| 236 | set statusTol [$self checkconnectiontol $module] |
|---|
| 237 | #Tolcon_Trace "CheckConnection [expr $statusTcl && $statusTol]" |
|---|
| 238 | return [expr $statusTcl && $statusTol] |
|---|
| 239 | } |
|---|
| 240 | |
|---|
| 241 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 242 | method checkconnectiontcl {module} { |
|---|
| 243 | # |
|---|
| 244 | # PURPUSE: Verifies if is are connected to the data base in TCL |
|---|
| 245 | # |
|---|
| 246 | # PARAMETERS: |
|---|
| 247 | # module: name of connection (bodbcmodule) |
|---|
| 248 | # |
|---|
| 249 | # RETURN: 1 -> connection |
|---|
| 250 | # 0 -> no |
|---|
| 251 | # |
|---|
| 252 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 253 | #Tolcon_Trace "checkconnectiontcl $module" |
|---|
| 254 | set result 1 |
|---|
| 255 | |
|---|
| 256 | # connection TCL ? |
|---|
| 257 | if {[$module cget -stdtclcon]} { |
|---|
| 258 | if {[string length [$module cget -connection]]} { |
|---|
| 259 | if {[catch "[$module cget -connection] statement get tables" msg]} { |
|---|
| 260 | # no connection |
|---|
| 261 | #Tolcon_Trace "No conectado a TCL" |
|---|
| 262 | set result 0 |
|---|
| 263 | } |
|---|
| 264 | } else { |
|---|
| 265 | #Tolcon_Trace "No conectado a TCL" |
|---|
| 266 | set result 0 |
|---|
| 267 | } |
|---|
| 268 | } |
|---|
| 269 | #Tolcon_Trace "checkconnectiontcl $result" |
|---|
| 270 | return $result |
|---|
| 271 | } |
|---|
| 272 | |
|---|
| 273 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 274 | method checkconnectiontol {module} { |
|---|
| 275 | # |
|---|
| 276 | # PURPUSE: Verifies if is are connected to the data base in TOL |
|---|
| 277 | # |
|---|
| 278 | # PARAMETERS: |
|---|
| 279 | # module: name of connection (bodbcmodule) |
|---|
| 280 | # |
|---|
| 281 | # RETURN: 1 -> connection |
|---|
| 282 | # 0 -> no |
|---|
| 283 | # |
|---|
| 284 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 285 | #Tolcon_Trace "checkconnectiontol ... module: $module" |
|---|
| 286 | set status 1 |
|---|
| 287 | # connection TOL |
|---|
| 288 | if {[$module cget -stdtolcon]} { |
|---|
| 289 | # parameters |
|---|
| 290 | set alias [$module cget -alias] |
|---|
| 291 | # connect tol ? |
|---|
| 292 | set status [GetAliasOpen $alias] |
|---|
| 293 | } |
|---|
| 294 | #Tolcon_Trace "CheckConnectionTol.end = $status" |
|---|
| 295 | return $status |
|---|
| 296 | } |
|---|
| 297 | |
|---|
| 298 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 299 | method _ConnectDlg {} { |
|---|
| 300 | # |
|---|
| 301 | # PURPUSE: Makes connection a TOL and TCL with dialog |
|---|
| 302 | # |
|---|
| 303 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 304 | #Tolcon_Trace "ConnectDlg ..." |
|---|
| 305 | # variable widget |
|---|
| 306 | # wait |
|---|
| 307 | if { 0 } { |
|---|
| 308 | rbc::busy hold $widget(dlg) |
|---|
| 309 | update |
|---|
| 310 | } |
|---|
| 311 | # _Connect |
|---|
| 312 | set mamMod [BfoGetText $widget(module)] |
|---|
| 313 | # get module |
|---|
| 314 | set module {} |
|---|
| 315 | set lst [ltraspose $lstConnection] |
|---|
| 316 | set inx [lsearch [lindex $lst 0] $mamMod] |
|---|
| 317 | if {[expr $inx != -1]} { |
|---|
| 318 | set module [lindex [lindex $lst 1] $inx] |
|---|
| 319 | } |
|---|
| 320 | #Tolcon_Trace "Nombre del module: mamMod ; Modulo a cargar: $module" |
|---|
| 321 | set alias [BfoGetText $widget(alias)] |
|---|
| 322 | set user [BfoGetText $widget(user)] |
|---|
| 323 | set pwd [BfoGetText $widget(pwd)] |
|---|
| 324 | set status [$self _Connect $module $alias $user $pwd] |
|---|
| 325 | # OK -> close dialog ? |
|---|
| 326 | if {$status} { |
|---|
| 327 | $widget(dlg) enddialog ok |
|---|
| 328 | } |
|---|
| 329 | # end wait |
|---|
| 330 | if { 0 } { |
|---|
| 331 | rbc::busy release $widget(dlg) |
|---|
| 332 | } |
|---|
| 333 | } |
|---|
| 334 | |
|---|
| 335 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 336 | method _Connect {module alias user pwd} { |
|---|
| 337 | # |
|---|
| 338 | # PURPUSE: Makes connection a TOL and TCL |
|---|
| 339 | # |
|---|
| 340 | # PARAMETERS: |
|---|
| 341 | # module: name of connection (bodbcmodule) |
|---|
| 342 | # alias: name od bridge |
|---|
| 343 | # user: name of user |
|---|
| 344 | # pwd: password |
|---|
| 345 | # |
|---|
| 346 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 347 | # parameters |
|---|
| 348 | |
|---|
| 349 | Tolcon_Trace "_Connect: module: $module alias: $alias user: $user pwd: $pwd" |
|---|
| 350 | # connection TCL |
|---|
| 351 | set statusTcl [$self _ConnectTcl $module $alias $user $pwd] |
|---|
| 352 | # connection TOL |
|---|
| 353 | set statusTol [$self _ConnectTol $module $alias $user $pwd] |
|---|
| 354 | #Tolcon_Trace "Connect: [expr $statusTcl && $statusTol]" |
|---|
| 355 | # .ini ? |
|---|
| 356 | if {[string length [$module cget -iniconfig]]} { |
|---|
| 357 | #Tolcon_Trace ".ini" |
|---|
| 358 | if {[$module cget -savealias]} { |
|---|
| 359 | ::iniFile::Write [$module cget -iniconfig] DataSource $alias |
|---|
| 360 | } |
|---|
| 361 | if {[$module cget -saveuser]} { |
|---|
| 362 | ::iniFile::Write [$module cget -iniconfig] Userid $user |
|---|
| 363 | } |
|---|
| 364 | if {[$module cget -savepwd]} { |
|---|
| 365 | ::iniFile::Write [$module cget -iniconfig] Password $pwd |
|---|
| 366 | } |
|---|
| 367 | } |
|---|
| 368 | # update parameters |
|---|
| 369 | $module configure -alias $alias |
|---|
| 370 | $module configure -user $user |
|---|
| 371 | $module configure -pwd $pwd |
|---|
| 372 | |
|---|
| 373 | set gestor [SqlGetGestor [SqlGetDriver $alias]] |
|---|
| 374 | $module configure -gestor $gestor |
|---|
| 375 | |
|---|
| 376 | # execute proc ? |
|---|
| 377 | if {[string length [$module cget -procconnect]]} { |
|---|
| 378 | #Tolcon_Trace "execute proc" |
|---|
| 379 | eval [$module cget -procconnect] |
|---|
| 380 | } |
|---|
| 381 | |
|---|
| 382 | # OK ? |
|---|
| 383 | return [expr $statusTcl && $statusTol] |
|---|
| 384 | } |
|---|
| 385 | |
|---|
| 386 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 387 | method _ConnectTcl {module alias user pwd} { |
|---|
| 388 | # |
|---|
| 389 | # PURPUSE: Makes connection a TCL |
|---|
| 390 | # |
|---|
| 391 | # PARAMETERS: |
|---|
| 392 | # module: name of connection (bodbcmodule) |
|---|
| 393 | # alias: name od bridge |
|---|
| 394 | # user: name of user |
|---|
| 395 | # pwd: password |
|---|
| 396 | # |
|---|
| 397 | # RETURN: |
|---|
| 398 | # RETURN: 1 -> connection |
|---|
| 399 | # 0 -> no |
|---|
| 400 | # |
|---|
| 401 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 402 | #Tolcon_Trace "_ConnectTcl: module: $module alias: $alias user: $user pwd: $pwd Connect: [$module cget -stdtclcon]" |
|---|
| 403 | set status 1 |
|---|
| 404 | # connection TCL |
|---|
| 405 | if {[$module cget -stdtclcon]} { |
|---|
| 406 | if {[$self checkconnectiontcl $module]} { |
|---|
| 407 | set status [$self _DisconnectTcl $module] |
|---|
| 408 | } |
|---|
| 409 | if {$status} { |
|---|
| 410 | if {[string length [$module cget -connection]]} { |
|---|
| 411 | set con [$module cget -connection] |
|---|
| 412 | } else { |
|---|
| 413 | set con [$self _UniqueName [$module cget -name]] |
|---|
| 414 | } |
|---|
| 415 | if [catch "database $con $alias $user $pwd" msg] { |
|---|
| 416 | set status 0 |
|---|
| 417 | $module configure -connection {} |
|---|
| 418 | MessageDlg ._msgerr -type ok -icon error -message $msg |
|---|
| 419 | } else { |
|---|
| 420 | $module configure -connection $con |
|---|
| 421 | } |
|---|
| 422 | } |
|---|
| 423 | #Tolcon_Trace "ConnectTcl = $status" |
|---|
| 424 | } |
|---|
| 425 | # return |
|---|
| 426 | return $status |
|---|
| 427 | } |
|---|
| 428 | |
|---|
| 429 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 430 | method _ConnectTol {module alias user pass} { |
|---|
| 431 | # |
|---|
| 432 | # PURPUSE: Makes connection a TOL |
|---|
| 433 | # |
|---|
| 434 | # PARAMETERS: |
|---|
| 435 | # module: name of connection (bodbcmodule) |
|---|
| 436 | # alias: name od bridge |
|---|
| 437 | # user: name of user |
|---|
| 438 | # pwd: password |
|---|
| 439 | # |
|---|
| 440 | # RETURN: |
|---|
| 441 | # RETURN: 1 -> connection |
|---|
| 442 | # 0 -> no |
|---|
| 443 | # |
|---|
| 444 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 445 | #Tolcon_Trace "_ConnectTol: module: $module alias: $alias user: $user pwd: $pwd Connect: [$module cget -stdtolcon]" |
|---|
| 446 | if {[$module cget -stdtolcon]} { |
|---|
| 447 | if {[$self checkconnectiontol $module]} { |
|---|
| 448 | # intento activarla |
|---|
| 449 | # |
|---|
| 450 | if {[$self _ActivateAlias $alias]} { |
|---|
| 451 | # el alias ha sido activado correctamente |
|---|
| 452 | # |
|---|
| 453 | return 1 |
|---|
| 454 | } else { |
|---|
| 455 | # Algo ha ido mal, me dijeron que el alias estaba abierto |
|---|
| 456 | # pero no pude activarlo. |
|---|
| 457 | # |
|---|
| 458 | $self _CloseAlias $alias |
|---|
| 459 | } |
|---|
| 460 | } |
|---|
| 461 | return [$self _OpenAlias $alias $user $pass] |
|---|
| 462 | } |
|---|
| 463 | return 1 |
|---|
| 464 | } |
|---|
| 465 | |
|---|
| 466 | method _OpenAlias { alias user pass } { |
|---|
| 467 | tol::console eval [string map "%A $alias %U $user %P $pass" { |
|---|
| 468 | Real __dbopen_status__ = DBOpen("%A","%U","%P"); |
|---|
| 469 | }] |
|---|
| 470 | set status [lindex [tol::info variable [list Real __dbopen_status__]] 0] |
|---|
| 471 | tol::console stack release __dbopen_status__ |
|---|
| 472 | expr {$status>0.0} |
|---|
| 473 | } |
|---|
| 474 | |
|---|
| 475 | method _ActivateAlias { alias } { |
|---|
| 476 | tol::console eval [string map "%A $alias" { |
|---|
| 477 | Real __dbact_status__ = DBActivate("%A"); |
|---|
| 478 | }] |
|---|
| 479 | set status [lindex [tol::info variable [list Real __dbact_status__]] 0] |
|---|
| 480 | tol::console stack release __dbact_status__ |
|---|
| 481 | expr {$status>0.0} |
|---|
| 482 | } |
|---|
| 483 | |
|---|
| 484 | method _CloseAlias { alias } { |
|---|
| 485 | tol::console eval [string map "%A $alias" { |
|---|
| 486 | Real __dbclose_status__ = DBClose("%A"); |
|---|
| 487 | }] |
|---|
| 488 | set status [lindex [tol::info variable [list Real __dbclose_status__]] 0] |
|---|
| 489 | tol::console stack release __dbclose_status__ |
|---|
| 490 | expr {$status>0.0} |
|---|
| 491 | } |
|---|
| 492 | |
|---|
| 493 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 494 | method _Disconnect { } { |
|---|
| 495 | # |
|---|
| 496 | # PURPUSE: Makes disconnect of TOL and TCL |
|---|
| 497 | # |
|---|
| 498 | # RETURN: 1 -> disconnect |
|---|
| 499 | # 0 -> error |
|---|
| 500 | # |
|---|
| 501 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 502 | #Tolcon_Trace "Disconnect ..." |
|---|
| 503 | # get module |
|---|
| 504 | set lst [ltraspose $lstConnection] |
|---|
| 505 | set inx [lsearch [lindex $lst 0] [BfoGetText $widget(module)]] |
|---|
| 506 | if {[expr $inx != -1]} { |
|---|
| 507 | set module [lindex [lindex $lst 1] $inx] |
|---|
| 508 | } |
|---|
| 509 | # parameters |
|---|
| 510 | set alias [BfoGetText $widget(alias)] |
|---|
| 511 | # disconnect TOL |
|---|
| 512 | set statusTol [$self _DisconnectTol $module $alias] |
|---|
| 513 | |
|---|
| 514 | # disconnect TCL |
|---|
| 515 | set statusTcl [$self _DisconnectTcl $module] |
|---|
| 516 | |
|---|
| 517 | # control status |
|---|
| 518 | SetControlsStatus $self $widget(dlg) [expr !($statusTol && $statusTcl)] |
|---|
| 519 | |
|---|
| 520 | # execute proc ? |
|---|
| 521 | if {[string length [$module cget -prodisconnect]]} { |
|---|
| 522 | #Tolcon_Trace "Disconnect ... proc" |
|---|
| 523 | eval [$module cget -prodisconnect] |
|---|
| 524 | } |
|---|
| 525 | # return |
|---|
| 526 | #Tolcon_Trace "Disconnect = [expr $statusTol && $statusTcl]" |
|---|
| 527 | return [expr $statusTol && $statusTcl] |
|---|
| 528 | } |
|---|
| 529 | |
|---|
| 530 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 531 | method _DisconnectTol {module alias} { |
|---|
| 532 | # |
|---|
| 533 | # PURPUSE: Makes disconnect of TOL |
|---|
| 534 | # |
|---|
| 535 | # PARAMETERS: |
|---|
| 536 | # module: name of connection (bodbcmodule) |
|---|
| 537 | # alias: name od bridge |
|---|
| 538 | # |
|---|
| 539 | # RETURN: |
|---|
| 540 | # RETURN: 1 -> disconnect |
|---|
| 541 | # 0 -> no |
|---|
| 542 | # |
|---|
| 543 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 544 | #Tolcon_Trace "_DisconnectTol. module: $module alias: $alias Disconnect: [$module cget -stdtolcon]" |
|---|
| 545 | set status 1 |
|---|
| 546 | # disconnect TOL |
|---|
| 547 | if {[$module cget -stdtolcon]} { |
|---|
| 548 | # connecition TOL ? |
|---|
| 549 | set connect [GetAliasOpen $alias] |
|---|
| 550 | if {$connect} { |
|---|
| 551 | set op [GetUniqueName Real] |
|---|
| 552 | set cmd "Real $op = DBClose(\"$alias\");" |
|---|
| 553 | ::tol::console eval $cmd |
|---|
| 554 | array set aryInfo [TclInfoVar Real $op] |
|---|
| 555 | #> 1 -> OK, 0 -> ERROR |
|---|
| 556 | set status [lindex $aryInfo(CONTENT) 0] |
|---|
| 557 | unset aryInfo |
|---|
| 558 | ::tol::console stack release $op |
|---|
| 559 | } |
|---|
| 560 | #Tolcon_Trace "Disconnect: $status" |
|---|
| 561 | } |
|---|
| 562 | # return |
|---|
| 563 | return $status |
|---|
| 564 | } |
|---|
| 565 | |
|---|
| 566 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 567 | method _DisconnectTcl {module} { |
|---|
| 568 | # |
|---|
| 569 | # PURPUSE: Makes disconnect of TCL |
|---|
| 570 | # |
|---|
| 571 | # PARAMETERS: |
|---|
| 572 | # module: name of connection (bodbcmodule) |
|---|
| 573 | # alias: name od bridge |
|---|
| 574 | # |
|---|
| 575 | # RETURN: |
|---|
| 576 | # RETURN: 1 -> disconnect |
|---|
| 577 | # 0 -> no |
|---|
| 578 | # |
|---|
| 579 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 580 | #Tolcon_Trace "DisconnectTcl .... module: $module Disconnect: [$module cget -stdtclcon]" |
|---|
| 581 | set status 1 |
|---|
| 582 | # disconnect TCL |
|---|
| 583 | if {[$module cget -stdtclcon]} { |
|---|
| 584 | set con [$module cget -connection] |
|---|
| 585 | if {[string length $con]} { |
|---|
| 586 | $con disconnect |
|---|
| 587 | } |
|---|
| 588 | #Tolcon_Trace "DisconnectTcl = $status" |
|---|
| 589 | } |
|---|
| 590 | # return |
|---|
| 591 | return $status |
|---|
| 592 | } |
|---|
| 593 | |
|---|
| 594 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 595 | method _CreateDialog { {module {}} } { |
|---|
| 596 | # |
|---|
| 597 | # PURPOSE: Shows the connect options dialog |
|---|
| 598 | # |
|---|
| 599 | # PARAMETERS: |
|---|
| 600 | # module: name of connection (bodbcmodule) |
|---|
| 601 | # |
|---|
| 602 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 603 | Tolcon_Trace "CreateDialog: module: $module" |
|---|
| 604 | set status 0 |
|---|
| 605 | # exists module ? |
|---|
| 606 | set alias {} |
|---|
| 607 | set user {} |
|---|
| 608 | set password {} |
|---|
| 609 | if {[string length $module]} { |
|---|
| 610 | # parameters |
|---|
| 611 | set alias [$module cget -alias] |
|---|
| 612 | set user [$module cget -user] |
|---|
| 613 | set password [$module cget -pwd] |
|---|
| 614 | # connection |
|---|
| 615 | set status [$self checkconnection $module] |
|---|
| 616 | } |
|---|
| 617 | |
|---|
| 618 | set widget(dlg) [set dlg \ |
|---|
| 619 | [Dialog ._cnnopt -title [mc "Connect options"] \ |
|---|
| 620 | -parent . -default 0 -cancel 1 -modal local]] |
|---|
| 621 | if {$status} { |
|---|
| 622 | $dlg add -text [mc "Disconnect"] -image [::Bitmap::get stop] \ |
|---|
| 623 | -compound right -helptext [mc "Disconnect"] \ |
|---|
| 624 | -relief link -command [list $self _Disconnect] |
|---|
| 625 | } else { |
|---|
| 626 | $dlg add -text [mc "Connect"] -image [::Bitmap::get play]\ |
|---|
| 627 | -compound right -helptext [mc "Connect"] \ |
|---|
| 628 | -relief link -command [list $self _ConnectDlg] |
|---|
| 629 | } |
|---|
| 630 | |
|---|
| 631 | $dlg add -text [mc "Cancel"] -image [::Bitmap::get cancel]\ |
|---|
| 632 | -compound right -helptext [mc "Cancel"]\ |
|---|
| 633 | -relief link -command "$dlg enddialog cancel" |
|---|
| 634 | |
|---|
| 635 | set w [$dlg getframe] |
|---|
| 636 | wm resizable $dlg 0 0 |
|---|
| 637 | bind $widget(dlg) <F1> "ShowHelp Tb4Cbd" |
|---|
| 638 | |
|---|
| 639 | # one module ? |
|---|
| 640 | Label $w.lbmodule -text "[mc Connection]:" |
|---|
| 641 | if {[string length $module]} { |
|---|
| 642 | set widget(module) [Entry $w.ecbmodule -editable false \ |
|---|
| 643 | -text [$module cget -name]] |
|---|
| 644 | } else { |
|---|
| 645 | set widget(module) \ |
|---|
| 646 | [ComboBox $w.ecbmodule -editable false \ |
|---|
| 647 | -values [lindex [ltraspose $lstConnection] 0] \ |
|---|
| 648 | -modifycmd [list $self _ModifyLstConnection]] |
|---|
| 649 | # BComboBox (desactivado hasta que se realize un nuevo BComboBox) |
|---|
| 650 | # [bcombobox $w.ecbmodule -editable false \ |
|---|
| 651 | -values [lindex [ltraspose $lstConnection] 0] \ |
|---|
| 652 | -bkeypress true \ |
|---|
| 653 | -modifycmd [list $self _ModifyLstConnection]] |
|---|
| 654 | } |
|---|
| 655 | Label $w.lbalias -text "[mc Alias]:" |
|---|
| 656 | #ComboBox $w.cbalias |
|---|
| 657 | # -editable false -textvariable $alias |
|---|
| 658 | set widget(alias) \ |
|---|
| 659 | [ComboBox $w.cbalias -editable false \ |
|---|
| 660 | -text $alias] |
|---|
| 661 | # BComboBox (desactivado hasta que se realize un nuevo BComboBox) |
|---|
| 662 | # [bcombobox $w.cbalias -editable false \ |
|---|
| 663 | -text $alias \ |
|---|
| 664 | -bkeypress true] |
|---|
| 665 | Label $w.lbuser -text "[mc User]:" |
|---|
| 666 | set widget(user) [Entry $w.euser -text $user] |
|---|
| 667 | Label $w.lbpass -text "[mc Password]:" |
|---|
| 668 | set widget(pwd) [Entry $w.epass -show "*" -text $password] |
|---|
| 669 | set datasources [lsort -index 0 [database datasources]] |
|---|
| 670 | # puts "DataSources : $datasources" |
|---|
| 671 | set all_alias "" |
|---|
| 672 | foreach al $datasources { |
|---|
| 673 | lappend all_alias [lindex $al 0] |
|---|
| 674 | } |
|---|
| 675 | # puts "ALL_alias: $all_alias" |
|---|
| 676 | SetControlsStatus $self $dlg $status |
|---|
| 677 | $w.cbalias configure -values $all_alias |
|---|
| 678 | |
|---|
| 679 | grid $w.lbmodule -row 0 -column 0 -sticky e -padx 4 |
|---|
| 680 | grid $w.ecbmodule -row 0 -column 1 -sticky w -padx 2 |
|---|
| 681 | grid $w.lbalias -row 1 -column 0 -sticky e -padx 4 |
|---|
| 682 | grid $w.cbalias -row 1 -column 1 -sticky w -padx 2 |
|---|
| 683 | grid $w.lbuser -row 2 -column 0 -sticky e -padx 4 |
|---|
| 684 | grid $w.euser -row 2 -column 1 -sticky w -padx 2 |
|---|
| 685 | grid $w.lbpass -row 3 -column 0 -sticky e -padx 4 |
|---|
| 686 | grid $w.epass -row 3 -column 1 -sticky w -padx 2 |
|---|
| 687 | grid rowconfigure $w 1 -pad 6 |
|---|
| 688 | |
|---|
| 689 | set result [$dlg draw] |
|---|
| 690 | # puts "draw == $result" |
|---|
| 691 | |
|---|
| 692 | |
|---|
| 693 | destroy $dlg |
|---|
| 694 | Tolcon_Trace "_CreateDialog = $result" |
|---|
| 695 | return $result |
|---|
| 696 | } |
|---|
| 697 | |
|---|
| 698 | |
|---|
| 699 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 700 | method _ModifyLstConnection {} { |
|---|
| 701 | # |
|---|
| 702 | # PURPOSE: Updates the values after a selection |
|---|
| 703 | # |
|---|
| 704 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 705 | # module |
|---|
| 706 | set namMod [BfoGetText $widget(module)] |
|---|
| 707 | # load values |
|---|
| 708 | set module [$self _GetModuleToName $namMod] |
|---|
| 709 | if {[string length $module]} { |
|---|
| 710 | $widget(alias) configure -text [$module cget -alias] |
|---|
| 711 | $widget(user) configure -text [$module cget -user] |
|---|
| 712 | $widget(pwd) configure -text [$module cget -pwd] |
|---|
| 713 | # control state |
|---|
| 714 | SetControlsStatus $self $widget(dlg) [$self checkconnection $module] |
|---|
| 715 | } else { |
|---|
| 716 | $widget(alias) configure -text {} |
|---|
| 717 | $widget(user) configure -text {} |
|---|
| 718 | $widget(pwd) configure -text {} |
|---|
| 719 | } |
|---|
| 720 | |
|---|
| 721 | # set the focus in the first field not filled |
|---|
| 722 | if {!([$module cget -alias] eq "")} { |
|---|
| 723 | if {!([$module cget -user] eq "")} { |
|---|
| 724 | if {!([$module cget -pwd] eq "")} { |
|---|
| 725 | focus $widget(module) |
|---|
| 726 | } else { |
|---|
| 727 | focus $widget(pwd) |
|---|
| 728 | } |
|---|
| 729 | } else { |
|---|
| 730 | focus $widget(user) |
|---|
| 731 | } |
|---|
| 732 | } else { |
|---|
| 733 | focus $widget(alias) |
|---|
| 734 | } |
|---|
| 735 | } |
|---|
| 736 | |
|---|
| 737 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 738 | proc SetControlsStatus {self dlg status} { |
|---|
| 739 | # |
|---|
| 740 | # PURPOSE: Sets controls state to normal/disabled according to connection |
|---|
| 741 | # status. |
|---|
| 742 | # |
|---|
| 743 | # PARAMETERS: |
|---|
| 744 | # self -> instancia of bodbc |
|---|
| 745 | # dlg -> Instance of ODBCDialog |
|---|
| 746 | # status -> connection status (1 connected, 0 disconnected) |
|---|
| 747 | # |
|---|
| 748 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 749 | set w [$dlg getframe] |
|---|
| 750 | if {$status} { |
|---|
| 751 | set newStat disabled |
|---|
| 752 | # button disconnect |
|---|
| 753 | $dlg itemconfigure 0 -text [mc "Disconnect"] -image [::Bitmap::get stop]\ |
|---|
| 754 | -compound right -helptext [mc "Disconnect"] \ |
|---|
| 755 | -relief link -command [list $self _Disconnect] |
|---|
| 756 | } else { |
|---|
| 757 | set newStat normal |
|---|
| 758 | #button disconnect |
|---|
| 759 | $dlg itemconfigure 0 -text [mc "Connect"] -image [::Bitmap::get play]\ |
|---|
| 760 | -compound right -helptext [mc "Connect"] \ |
|---|
| 761 | -relief link -command [list $self _ConnectDlg] |
|---|
| 762 | |
|---|
| 763 | } |
|---|
| 764 | $w.cbalias configure -state $newStat |
|---|
| 765 | $w.euser configure -state $newStat |
|---|
| 766 | $w.epass configure -state $newStat |
|---|
| 767 | |
|---|
| 768 | if {[$w.epass cget -text] eq ""} { |
|---|
| 769 | focus $w.epass |
|---|
| 770 | } |
|---|
| 771 | # set the focus in the first field not filled |
|---|
| 772 | if {!([$w.cbalias cget -text] eq "")} { |
|---|
| 773 | if {!([$w.euser cget -text] eq "")} { |
|---|
| 774 | if {!([$w.epass cget -text] eq "")} { |
|---|
| 775 | focus $dlg |
|---|
| 776 | } else { |
|---|
| 777 | focus $w.epass |
|---|
| 778 | } |
|---|
| 779 | } else { |
|---|
| 780 | focus $w.euser |
|---|
| 781 | } |
|---|
| 782 | } else { |
|---|
| 783 | focus $w.cbalias |
|---|
| 784 | } |
|---|
| 785 | |
|---|
| 786 | } |
|---|
| 787 | |
|---|
| 788 | |
|---|
| 789 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 790 | method connection {args} { |
|---|
| 791 | # |
|---|
| 792 | # PURPOSE: Create a new module |
|---|
| 793 | # |
|---|
| 794 | # PARAMETERS: |
|---|
| 795 | # args: parameters of bodbcmodule |
|---|
| 796 | # |
|---|
| 797 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 798 | # parameters default |
|---|
| 799 | array set opts [list \ |
|---|
| 800 | -name {} \ |
|---|
| 801 | ] |
|---|
| 802 | array set opts $args |
|---|
| 803 | # exists $mod ? |
|---|
| 804 | if {[string length $opts(-name)]} { |
|---|
| 805 | if {[info exists lstConnection]} { |
|---|
| 806 | set lst [lindex [ltraspose $lstConnection] 0] |
|---|
| 807 | if {[expr [lsearch $lst $opts(-name)] != -1]} { |
|---|
| 808 | puts "Error. Modulo ya asignado." |
|---|
| 809 | return {} |
|---|
| 810 | } |
|---|
| 811 | } |
|---|
| 812 | } else { |
|---|
| 813 | puts "Error. No se ha especificado un nombre al modulo" |
|---|
| 814 | return {} |
|---|
| 815 | } |
|---|
| 816 | # create a new module |
|---|
| 817 | set namCon [$self _UniqueName $opts(-name)] |
|---|
| 818 | set namMod [eval ::bodbcmodule $namCon $args] |
|---|
| 819 | lappend lstConnection "$opts(-name) $namMod" |
|---|
| 820 | return $namMod |
|---|
| 821 | } |
|---|
| 822 | |
|---|
| 823 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 824 | method unregister {module} { |
|---|
| 825 | # |
|---|
| 826 | # PURPOSE: Eliminated one module register |
|---|
| 827 | # |
|---|
| 828 | # PARAMETERS: |
|---|
| 829 | # module: name of connection (bodbcmodule) |
|---|
| 830 | # |
|---|
| 831 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 832 | # eliminate register |
|---|
| 833 | set lst [ltraspose $lstConnection] |
|---|
| 834 | set inx [lsearch [lindex $lst 1] $module] |
|---|
| 835 | if {[expr $inx != -1]} { |
|---|
| 836 | set lstConnection [lreplace $lstConnection $inx $inx] |
|---|
| 837 | # disconnect |
|---|
| 838 | if {[$self checkconnectiontcl $module]} { |
|---|
| 839 | $self _DisconnectTcl $module |
|---|
| 840 | } |
|---|
| 841 | if {[$self checkconnectiontol $module]} { |
|---|
| 842 | $self _DisconnectTol $module [$module cget -alias] |
|---|
| 843 | } |
|---|
| 844 | # destroy |
|---|
| 845 | $module destroy |
|---|
| 846 | } |
|---|
| 847 | } |
|---|
| 848 | |
|---|
| 849 | |
|---|
| 850 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 851 | method get { var } { |
|---|
| 852 | # |
|---|
| 853 | # PURPOSE: Obtain the value of a variable |
|---|
| 854 | # |
|---|
| 855 | # PARAMETERS: var -> name of variable |
|---|
| 856 | # |
|---|
| 857 | # RETURN: value of variable |
|---|
| 858 | # |
|---|
| 859 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 860 | return [subst $[subst "$var"]] |
|---|
| 861 | } |
|---|
| 862 | |
|---|
| 863 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 864 | method _UniqueName { namMod } { |
|---|
| 865 | # |
|---|
| 866 | # PURPOSE: Obtain a unique name |
|---|
| 867 | # |
|---|
| 868 | # RETURN: name of bodbcmodule |
|---|
| 869 | # |
|---|
| 870 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 871 | set lst [lindex [ltraspose $lstConnection] 1] |
|---|
| 872 | while 1 { |
|---|
| 873 | incr counter |
|---|
| 874 | if {$counter > 2147483647} { |
|---|
| 875 | set counter 0 |
|---|
| 876 | } |
|---|
| 877 | set candidate db${namMod}${counter} |
|---|
| 878 | if {[expr [lsearch $lst $candidate] == -1]} { |
|---|
| 879 | return $candidate |
|---|
| 880 | } |
|---|
| 881 | } |
|---|
| 882 | } |
|---|
| 883 | |
|---|
| 884 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 885 | method _GetModuleToName { namMod } { |
|---|
| 886 | # |
|---|
| 887 | # PURPOSE: From the name of I modulate, we obtain the name of connection TCL |
|---|
| 888 | # |
|---|
| 889 | # PARAMETERS: |
|---|
| 890 | # namMod -> name of module |
|---|
| 891 | # |
|---|
| 892 | # RETURN: name of connection TCL |
|---|
| 893 | # |
|---|
| 894 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 895 | set module {} |
|---|
| 896 | if {[string length $namMod]} { |
|---|
| 897 | set lst [ltraspose $lstConnection] |
|---|
| 898 | set inx [lsearch [lindex $lst 0] $namMod] |
|---|
| 899 | if {[expr $inx != -1]} { |
|---|
| 900 | set module [lindex [lindex $lst 1] $inx] |
|---|
| 901 | } else { |
|---|
| 902 | set module {} |
|---|
| 903 | } |
|---|
| 904 | } |
|---|
| 905 | return $module |
|---|
| 906 | } |
|---|
| 907 | |
|---|
| 908 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 909 | proc GetAliasOpen {alias} { |
|---|
| 910 | # |
|---|
| 911 | # PURPOSE: It verifies that connection TOL this open one |
|---|
| 912 | # |
|---|
| 913 | # PARAMETERS: alias -> name of bridget |
|---|
| 914 | # |
|---|
| 915 | # RETURN: 1 -> open |
|---|
| 916 | # 0 -> no |
|---|
| 917 | # |
|---|
| 918 | #/////////////////////////////////////////////////////////////////////////// |
|---|
| 919 | |
|---|
| 920 | set result 0 |
|---|
| 921 | # command |
|---|
| 922 | set op [GetUniqueName Set] |
|---|
| 923 | set cmd "Set $op = DBGetOpened(\"\");" |
|---|
| 924 | # evaluation |
|---|
| 925 | ::tol::console eval $cmd |
|---|
| 926 | #Capturar el valor devuelto por TOL |
|---|
| 927 | array set aryInfo [TclInfoVar Set $op] |
|---|
| 928 | set lenAry [lindex $aryInfo(CONTENT) 0] |
|---|
| 929 | set inx 1 |
|---|
| 930 | while {!($result) && ([expr $inx <= $lenAry])} { |
|---|
| 931 | array set infoReg [TclInfoRef [list Set $op $inx 1]] |
|---|
| 932 | set aliasConn [lindex $infoReg(CONTENT) 0] |
|---|
| 933 | if {[string equal $alias $aliasConn]} { |
|---|
| 934 | set result 1 |
|---|
| 935 | } |
|---|
| 936 | incr inx |
|---|
| 937 | } |
|---|
| 938 | ::tol::console stack release $op |
|---|
| 939 | # return |
|---|
| 940 | #Tolcon_Trace "GetAliasOpen $result" |
|---|
| 941 | return $result |
|---|
| 942 | } |
|---|
| 943 | } |
|---|
| 944 | |
|---|
| 945 | |
|---|
| 946 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 947 | proc test_bodbc {} { |
|---|
| 948 | # |
|---|
| 949 | # PURPOSE: Test function of a bodbc |
|---|
| 950 | # |
|---|
| 951 | #///////////////////////////////////////////////////////////////////////////// |
|---|
| 952 | # package require msgcat |
|---|
| 953 | # namespace import msgcat::* |
|---|
| 954 | # ::msgcat::mclocale es |
|---|
| 955 | |
|---|
| 956 | package require tclodbc |
|---|
| 957 | package require BWidget |
|---|
| 958 | package require rbc |
|---|
| 959 | Bitmap::use |
|---|
| 960 | #lappend Bitmap::path ../images |
|---|
| 961 | |
|---|
| 962 | if {[winfo exists ._cnnopt]} { |
|---|
| 963 | destroy ._cnnopt |
|---|
| 964 | } |
|---|
| 965 | |
|---|
| 966 | set b [bodbc b] |
|---|
| 967 | |
|---|
| 968 | set telesp [$b connection -name telesp -alias ddw_ld -user dbo -pwd dbo] |
|---|
| 969 | set sadd [$b connection -name sadd -alias prueba -user bayes -pwd bayes] |
|---|
| 970 | |
|---|
| 971 | set latam [$b connection -name latam -alias TfnLatam -user bayes -pwd bayes \ |
|---|
| 972 | -stdtolcon 0 -stdtclcon 1 -procconnect [list puts "Conexion realizada"] \ |
|---|
| 973 | -prodisconnect [list puts "Deconexión realizada"] \ |
|---|
| 974 | -iniconfig TflLatamODBC \ |
|---|
| 975 | -savealias 1 \ |
|---|
| 976 | -saveuser 1 \ |
|---|
| 977 | -savepwd 0] |
|---|
| 978 | |
|---|
| 979 | set prbini [$b connection -name prbini \ |
|---|
| 980 | -procconnect [list puts "Conexion realizada"] \ |
|---|
| 981 | -prodisconnect [list puts "Deconexión realizada"] \ |
|---|
| 982 | -iniconfig PruebaIniODBC \ |
|---|
| 983 | -savealias 1 \ |
|---|
| 984 | -saveuser 1 \ |
|---|
| 985 | -savepwd 1] |
|---|
| 986 | |
|---|
| 987 | |
|---|
| 988 | $b connection -name sadd |
|---|
| 989 | |
|---|
| 990 | puts "Modulos cargados: [$b get lstConnection]" |
|---|
| 991 | |
|---|
| 992 | #$b showdialog |
|---|
| 993 | $b showdialog |
|---|
| 994 | } |
|---|
| 995 | |
|---|
| 996 | |
|---|
| 997 | package provide bodbc 1.0 |
|---|
