git.oblomov.eu Git - ohcount/blob - test/expected_dir/frx1.frx/visualbasic/code

   1 VERSION 5.00
   2 Object = "{67397AA1-7FB1-11D0-B148-00A0C922E820}#6.0#0"; "MSADODC.OCX"
   3 Object = "{BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1.1#0"; "TABCTL32.OCX"
   4 Object = "{CDE57A40-8B86-11D0-B3C6-00A0C90AEA82}#1.0#0"; "MSDATGRD.OCX"
   5 Object = "{0ECD9B60-23AA-11D0-B351-00A0C9055D8E}#6.0#0"; "MSHFLXGD.OCX"
   6 Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
   7 Begin VB.Form frmMain
   8 BorderStyle     =   1  'Fixed Single
   9 Caption         =   "DB2 Visual Basic Samples"
  10 ClientHeight    =   6555
  11 ClientLeft      =   150
  12 ClientTop       =   435
  13 ClientWidth     =   10620
  14 LinkTopic       =   "Form1"
  15 MaxButton       =   0   'False
  16 MinButton       =   0   'False
  17 ScaleHeight     =   6555
  18 ScaleWidth      =   10620
  19 StartUpPosition =   3  'Windows Default
  20 Begin VB.CommandButton cmdSample
  21 Caption         =   "Create Sample DB"
  22 Height          =   495
  23 Left            =   8760
  24 TabIndex        =   21
  25 TabStop         =   0   'False
  26 Top             =   240
  27 Width           =   1695
  28 End
  29 Begin TabDlg.SSTab tabMain
  30 Height          =   6015
  31 Left            =   0
  32 TabIndex        =   6
  33 Top             =   120
  34 Width           =   8565
  35 _ExtentX        =   15108
  36 _ExtentY        =   10610
  37 _Version        =   393216
  38 Tabs            =   5
  39 TabsPerRow      =   5
  40 TabHeight       =   520
  41 TabCaption(0)   =   "Execute SQL"
  42 TabPicture(0)   =   "Demo.frx":0000
  43 Tab(0).ControlEnabled=   -1  'True
  44 Tab(0).Control(0)=   "flxRecords"
  45 Tab(0).Control(0).Enabled=   0   'False
  46 Tab(0).Control(1)=   "txtSQL"
  47 Tab(0).Control(1).Enabled=   0   'False
  48 Tab(0).Control(2)=   "frmAutoCommit"
  49 Tab(0).Control(2).Enabled=   0   'False
  50 Tab(0).Control(3)=   "cmdCommit"
  51 Tab(0).Control(3).Enabled=   0   'False
  52 Tab(0).Control(4)=   "cmdRollback"
  53 Tab(0).Control(4).Enabled=   0   'False
  54 Tab(0).Control(5)=   "chkAutoCommit"
  55 Tab(0).Control(5).Enabled=   0   'False
  56 Tab(0).Control(6)=   "DataGridSQL"
  57 Tab(0).Control(6).Enabled=   0   'False
  58 Tab(0).Control(7)=   "frmSamples"
  59 Tab(0).Control(7).Enabled=   0   'False
  60 Tab(0).Control(8)=   "frmExecuteSQL"
  61 Tab(0).Control(8).Enabled=   0   'False
  62 Tab(0).Control(9)=   "cmdSQLConnection"
  63 Tab(0).Control(9).Enabled=   0   'False
  64 Tab(0).Control(10)=   "cmdSQLRecordset"
  65 Tab(0).Control(10).Enabled=   0   'False
  66 Tab(0).Control(11)=   "cmdSQLCommand"
  67 Tab(0).Control(11).Enabled=   0   'False
  68 Tab(0).Control(12)=   "cmdSQLSamples(0)"
  69 Tab(0).Control(12).Enabled=   0   'False
  70 Tab(0).Control(13)=   "cmdSQLSamples(1)"
  71 Tab(0).Control(13).Enabled=   0   'False
  72 Tab(0).Control(14)=   "cmdSQLSamples(2)"
  73 Tab(0).Control(14).Enabled=   0   'False
  74 Tab(0).Control(15)=   "cmdSQLSamples(3)"
  75 Tab(0).Control(15).Enabled=   0   'False
  76 Tab(0).ControlCount=   16
  77 TabCaption(1)   =   "Hierarchical Data"
  78 TabPicture(1)   =   "Demo.frx":001C
  79 Tab(1).ControlEnabled=   0   'False
  80 Tab(1).Control(0)=   "cmdHierarchy"
  81 Tab(1).Control(1)=   "hflxRecords"
  82 Tab(1).Control(2)=   "lblHierScript"
  83 Tab(1).ControlCount=   3
  84 TabCaption(2)   =   "LOBs"
  85 TabPicture(2)   =   "Demo.frx":0038
  86 Tab(2).ControlEnabled=   0   'False
  87 Tab(2).Control(0)=   "lblEmpno"
  88 Tab(2).Control(1)=   "lblLastname"
  89 Tab(2).Control(2)=   "lblFirstname"
  90 Tab(2).Control(3)=   "AdodcLob"
  91 Tab(2).Control(4)=   "cmdCLOB"
  92 Tab(2).Control(5)=   "cmdBLOB"
  93 Tab(2).Control(6)=   "cmdRefresh"
  94 Tab(2).Control(7)=   "txtEmpno"
  95 Tab(2).Control(7).Enabled=   0   'False
  96 Tab(2).Control(8)=   "txtLastname"
  97 Tab(2).Control(8).Enabled=   0   'False
  98 Tab(2).Control(9)=   "txtFirstname"
  99 Tab(2).Control(9).Enabled=   0   'False
 100 Tab(2).Control(10)=   "txtClob"
 101 Tab(2).Control(10).Enabled=   0   'False
 102 Tab(2).Control(11)=   "picBlob"
 103 Tab(2).ControlCount=   12
 104 TabCaption(3)   =   "Store Procedures"
 105 TabPicture(3)   =   "Demo.frx":0054
 106 Tab(3).ControlEnabled=   0   'False
 107 Tab(3).Control(0)=   "optStoredProcedures(11)"
 108 Tab(3).Control(1)=   "cmdShowSecondRS"
 109 Tab(3).Control(2)=   "DataGridSP"
 110 Tab(3).Control(3)=   "txtSPResult"
 111 Tab(3).Control(4)=   "cmdSPCall"
 112 Tab(3).Control(5)=   "optStoredProcedures(10)"
 113 Tab(3).Control(6)=   "optStoredProcedures(9)"
 114 Tab(3).Control(7)=   "optStoredProcedures(8)"
 115 Tab(3).Control(8)=   "optStoredProcedures(7)"
 116 Tab(3).Control(9)=   "optStoredProcedures(6)"
 117 Tab(3).Control(10)=   "optStoredProcedures(5)"
 118 Tab(3).Control(11)=   "optStoredProcedures(4)"
 119 Tab(3).Control(12)=   "optStoredProcedures(3)"
 120 Tab(3).Control(13)=   "optStoredProcedures(2)"
 121 Tab(3).Control(14)=   "optStoredProcedures(1)"
 122 Tab(3).Control(15)=   "optStoredProcedures(0)"
 123 Tab(3).Control(16)=   "frmStoredProcedures"
 124 Tab(3).ControlCount=   17
 125 TabCaption(4)   =   "UDFs"
 126 TabPicture(4)   =   "Demo.frx":0070
 127 Tab(4).ControlEnabled=   0   'False
 128 Tab(4).Control(0)=   "cmdUDFs(5)"
 129 Tab(4).Control(1)=   "cmdUDFs(4)"
 130 Tab(4).Control(2)=   "cmdUDFs(3)"
 131 Tab(4).Control(3)=   "cmdUDFs(2)"
 132 Tab(4).Control(4)=   "cmdUDFs(1)"
 133 Tab(4).Control(5)=   "cmdUDFs(0)"
 134 Tab(4).Control(6)=   "hflxGridUDF"
 135 Tab(4).Control(7)=   "txtUDF"
 136 Tab(4).Control(7).Enabled=   0   'False
 137 Tab(4).Control(8)=   "Frame1"
 138 Tab(4).ControlCount=   9
 139 Begin VB.CommandButton cmdSQLSamples
 140 Caption         =   "Sample 4"
 141 Enabled         =   0   'False
 142 Height          =   375
 143 Index           =   3
 144 Left            =   7440
 145 TabIndex        =   67
 146 Top             =   2880
 147 Width           =   855
 148 End
 149 Begin VB.CommandButton cmdSQLSamples
 150 Caption         =   "Sample 3"
 151 Enabled         =   0   'False
 152 Height          =   375
 153 Index           =   2
 154 Left            =   6600
 155 TabIndex        =   66
 156 Top             =   2880
 157 Width           =   855
 158 End
 159 Begin VB.CommandButton cmdSQLSamples
 160 Caption         =   "Sample 2"
 161 Enabled         =   0   'False
 162 Height          =   375
 163 Index           =   1
 164 Left            =   7440
 165 TabIndex        =   65
 166 Top             =   2520
 167 Width           =   855
 168 End
 169 Begin VB.CommandButton cmdSQLSamples
 170 Caption         =   "Sample 1"
 171 Enabled         =   0   'False
 172 Height          =   375
 173 Index           =   0
 174 Left            =   6600
 175 TabIndex        =   64
 176 Top             =   2520
 177 Width           =   855
 178 End
 179 Begin VB.CommandButton cmdUDFs
 180 Caption         =   "TableUDF"
 181 Enabled         =   0   'False
 182 Height          =   495
 183 Index           =   5
 184 Left            =   -68400
 185 TabIndex        =   63
 186 Top             =   3600
 187 Width           =   1695
 188 End
 189 Begin VB.CommandButton cmdUDFs
 190 Caption         =   "SourcedColumnUDF"
 191 Enabled         =   0   'False
 192 Height          =   495
 193 Index           =   4
 194 Left            =   -68400
 195 TabIndex        =   62
 196 Top             =   3000
 197 Width           =   1695
 198 End
 199 Begin VB.CommandButton cmdUDFs
 200 Caption         =   "ScUDFReturningErr"
 201 Enabled         =   0   'False
 202 Height          =   495
 203 Index           =   3
 204 Left            =   -68400
 205 TabIndex        =   61
 206 Top             =   2400
 207 Width           =   1695
 208 End
 209 Begin VB.CommandButton cmdUDFs
 210 Caption         =   "ScratchpadScUDF"
 211 Enabled         =   0   'False
 212 Height          =   495
 213 Index           =   2
 214 Left            =   -68400
 215 TabIndex        =   60
 216 Top             =   1800
 217 Width           =   1695
 218 End
 219 Begin VB.CommandButton cmdUDFs
 220 Caption         =   "ClobScalarUDF"
 221 Enabled         =   0   'False
 222 Height          =   495
 223 Index           =   1
 224 Left            =   -68400
 225 TabIndex        =   59
 226 Top             =   1200
 227 Width           =   1695
 228 End
 229 Begin VB.CommandButton cmdUDFs
 230 Caption         =   "ScalarUDF"
 231 Enabled         =   0   'False
 232 Height          =   495
 233 Index           =   0
 234 Left            =   -68400
 235 TabIndex        =   58
 236 Top             =   600
 237 Width           =   1695
 238 End
 239 Begin MSHierarchicalFlexGridLib.MSHFlexGrid hflxGridUDF
 240 Height          =   1575
 241 Left            =   -74880
 242 TabIndex        =   57
 243 TabStop         =   0   'False
 244 Top             =   4320
 245 Width           =   6255
 246 _ExtentX        =   11033
 247 _ExtentY        =   2778
 248 _Version        =   393216
 249 FixedCols       =   0
 250 WordWrap        =   -1  'True
 251 AllowUserResizing=   1
 252 _NumberOfBands  =   1
 253 _Band(0).Cols   =   2
 254 End
 255 Begin VB.TextBox txtUDF
 256 BeginProperty Font
 257 Name            =   "Courier New"
 258 Size            =   9
 259 Charset         =   0
 260 Weight          =   400
 261 Underline       =   0   'False
 262 Italic          =   0   'False
 263 Strikethrough   =   0   'False
 264 EndProperty
 265 Height          =   3735
 266 Left            =   -74880
 267 Locked          =   -1  'True
 268 MultiLine       =   -1  'True
 269 ScrollBars      =   2  'Vertical
 270 TabIndex        =   56
 271 TabStop         =   0   'False
 272 Top             =   480
 273 Width           =   6255
 274 End
 275 Begin VB.Frame Frame1
 276 Caption         =   "Work with UDF:"
 277 Height          =   5535
 278 Left            =   -68520
 279 TabIndex        =   55
 280 Top             =   360
 281 Width           =   1935
 282 End
 283 Begin VB.OptionButton optStoredProcedures
 284 Caption         =   "MAIN_EXAMPLE"
 285 Enabled         =   0   'False
 286 Height          =   495
 287 Index           =   11
 288 Left            =   -69000
 289 TabIndex        =   54
 290 Top             =   1320
 291 Width           =   1935
 292 End
 293 Begin VB.CommandButton cmdShowSecondRS
 294 Caption         =   "Show Next RS"
 295 Height          =   495
 296 Left            =   -68280
 297 TabIndex        =   53
 298 Top             =   2640
 299 Visible         =   0   'False
 300 Width           =   1695
 301 End
 302 Begin MSDataGridLib.DataGrid DataGridSP
 303 Height          =   3788
 304 Left            =   -74850
 305 TabIndex        =   37
 306 Top             =   2070
 307 Visible         =   0   'False
 308 Width           =   6428
 309 _ExtentX        =   11351
 310 _ExtentY        =   6694
 311 _Version        =   393216
 312 BorderStyle     =   0
 313 Enabled         =   -1  'True
 314 HeadLines       =   1
 315 RowHeight       =   15
 316 RowDividerStyle =   1
 317 AllowAddNew     =   -1  'True
 318 AllowDelete     =   -1  'True
 319 BeginProperty HeadFont {0BE35203-8F91-11CE-9DE3-00AA004BB851}
 320 Name            =   "MS Sans Serif"
 321 Size            =   8.25
 322 Charset         =   0
 323 Weight          =   400
 324 Underline       =   0   'False
 325 Italic          =   0   'False
 326 Strikethrough   =   0   'False
 327 EndProperty
 328 BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
 329 Name            =   "MS Sans Serif"
 330 Size            =   8.25
 331 Charset         =   0
 332 Weight          =   400
 333 Underline       =   0   'False
 334 Italic          =   0   'False
 335 Strikethrough   =   0   'False
 336 EndProperty
 337 ColumnCount     =   2
 338 BeginProperty Column00
 339 DataField       =   ""
 340 Caption         =   ""
 341 BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
 342 Type            =   0
 343 Format          =   ""
 344 HaveTrueFalseNull=   0
 345 FirstDayOfWeek  =   0
 346 FirstWeekOfYear =   0
 347 LCID            =   1033
 348 SubFormatType   =   0
 349 EndProperty
 350 EndProperty
 351 BeginProperty Column01
 352 DataField       =   ""
 353 Caption         =   ""
 354 BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
 355 Type            =   0
 356 Format          =   ""
 357 HaveTrueFalseNull=   0
 358 FirstDayOfWeek  =   0
 359 FirstWeekOfYear =   0
 360 LCID            =   1033
 361 SubFormatType   =   0
 362 EndProperty
 363 EndProperty
 364 SplitCount      =   1
 365 BeginProperty Split0
 366 BeginProperty Column00
 367 EndProperty
 368 BeginProperty Column01
 369 EndProperty
 370 EndProperty
 371 End
 372 Begin VB.TextBox txtSPResult
 373 BeginProperty Font
 374 Name            =   "Courier New"
 375 Size            =   9
 376 Charset         =   0
 377 Weight          =   400
 378 Underline       =   0   'False
 379 Italic          =   0   'False
 380 Strikethrough   =   0   'False
 381 EndProperty
 382 Height          =   3855
 383 Left            =   -74880
 384 MultiLine       =   -1  'True
 385 TabIndex        =   52
 386 Top             =   2040
 387 Width           =   6495
 388 End
 389 Begin VB.CommandButton cmdSPCall
 390 Caption         =   "Call"
 391 Enabled         =   0   'False
 392 Height          =   495
 393 Left            =   -68280
 394 TabIndex        =   51
 395 Top             =   2040
 396 Width           =   1695
 397 End
 398 Begin VB.OptionButton optStoredProcedures
 399 Caption         =   "DBINFO_EXAMPLE"
 400 Enabled         =   0   'False
 401 Height          =   495
 402 Index           =   10
 403 Left            =   -70920
 404 TabIndex        =   50
 405 Top             =   1320
 406 Width           =   1935
 407 End
 408 Begin VB.OptionButton optStoredProcedures
 409 Caption         =   "DB2SQL_EXAMPLE"
 410 Enabled         =   0   'False
 411 Height          =   495
 412 Index           =   9
 413 Left            =   -72840
 414 TabIndex        =   49
 415 Top             =   1320
 416 Width           =   1935
 417 End
 418 Begin VB.OptionButton optStoredProcedures
 419 Caption         =   "CLOB_EXTRACT"
 420 Enabled         =   0   'False
 421 Height          =   495
 422 Index           =   8
 423 Left            =   -74760
 424 TabIndex        =   48
 425 Top             =   1320
 426 Width           =   1935
 427 End
 428 Begin VB.OptionButton optStoredProcedures
 429 Caption         =   "TWO_RESULT_SETS"
 430 Enabled         =   0   'False
 431 Height          =   495
 432 Index           =   7
 433 Left            =   -69000
 434 TabIndex        =   47
 435 Top             =   960
 436 Width           =   1935
 437 End
 438 Begin VB.OptionButton optStoredProcedures
 439 Caption         =   "ONE_RESULT_SET"
 440 Enabled         =   0   'False
 441 Height          =   495
 442 Index           =   6
 443 Left            =   -70920
 444 TabIndex        =   46
 445 Top             =   960
 446 Width           =   1935
 447 End
 448 Begin VB.OptionButton optStoredProcedures
 449 Caption         =   "DECIMAL_TYPE"
 450 Enabled         =   0   'False
 451 Height          =   495
 452 Index           =   5
 453 Left            =   -72840
 454 TabIndex        =   45
 455 Top             =   960
 456 Width           =   1935
 457 End
 458 Begin VB.OptionButton optStoredProcedures
 459 Caption         =   "ALL_DATA_TYPES"
 460 Enabled         =   0   'False
 461 Height          =   495
 462 Index           =   4
 463 Left            =   -74760
 464 TabIndex        =   44
 465 Top             =   960
 466 Width           =   1935
 467 End
 468 Begin VB.OptionButton optStoredProcedures
 469 Caption         =   "INOUT_PARAM"
 470 Enabled         =   0   'False
 471 Height          =   495
 472 Index           =   3
 473 Left            =   -69000
 474 TabIndex        =   43
 475 Top             =   600
 476 Width           =   1935
 477 End
 478 Begin VB.OptionButton optStoredProcedures
 479 Caption         =   "OUT_PARAM"
 480 Enabled         =   0   'False
 481 Height          =   495
 482 Index           =   2
 483 Left            =   -70920
 484 TabIndex        =   42
 485 Top             =   600
 486 Width           =   1935
 487 End
 488 Begin VB.OptionButton optStoredProcedures
 489 Caption         =   "IN_PARAMS"
 490 Enabled         =   0   'False
 491 Height          =   495
 492 Index           =   1
 493 Left            =   -72840
 494 TabIndex        =   41
 495 Top             =   600
 496 Width           =   1935
 497 End
 498 Begin VB.OptionButton optStoredProcedures
 499 Caption         =   "OUT_LANGUAGE"
 500 Enabled         =   0   'False
 501 Height          =   495
 502 Index           =   0
 503 Left            =   -74760
 504 TabIndex        =   40
 505 Top             =   600
 506 Width           =   1935
 507 End
 508 Begin VB.Frame frmStoredProcedures
 509 Caption         =   "Stored Procedure:"
 510 Height          =   1575
 511 Left            =   -74880
 512 TabIndex        =   39
 513 Top             =   360
 514 Width           =   8295
 515 End
 516 Begin VB.CommandButton cmdSQLCommand
 517 Caption         =   "on Command"
 518 Enabled         =   0   'False
 519 Height          =   495
 520 Left            =   6600
 521 TabIndex        =   35
 522 Top             =   1200
 523 Width           =   1695
 524 End
 525 Begin VB.CommandButton cmdSQLRecordset
 526 Caption         =   "on Recordset"
 527 Enabled         =   0   'False
 528 Height          =   495
 529 Left            =   6600
 530 TabIndex        =   34
 531 Top             =   1800
 532 Width           =   1695
 533 End
 534 Begin VB.CommandButton cmdSQLConnection
 535 Caption         =   "on Connection"
 536 Enabled         =   0   'False
 537 Height          =   495
 538 Left            =   6600
 539 TabIndex        =   8
 540 Top             =   600
 541 Width           =   1695
 542 End
 543 Begin VB.Frame frmExecuteSQL
 544 Caption         =   "Execute SQL"
 545 Height          =   2055
 546 Left            =   6480
 547 TabIndex        =   32
 548 Top             =   360
 549 Width           =   1935
 550 End
 551 Begin VB.Frame frmSamples
 552 Height          =   1095
 553 Left            =   6480
 554 TabIndex        =   38
 555 Top             =   2280
 556 Width           =   1935
 557 End
 558 Begin MSDataGridLib.DataGrid DataGridSQL
 559 Height          =   3690
 560 Left            =   150
 561 TabIndex        =   36
 562 Top             =   2190
 563 Width           =   6200
 564 _ExtentX        =   10927
 565 _ExtentY        =   6509
 566 _Version        =   393216
 567 BorderStyle     =   0
 568 HeadLines       =   1
 569 RowHeight       =   15
 570 RowDividerStyle =   1
 571 AllowAddNew     =   -1  'True
 572 AllowDelete     =   -1  'True
 573 BeginProperty HeadFont {0BE35203-8F91-11CE-9DE3-00AA004BB851}
 574 Name            =   "MS Sans Serif"
 575 Size            =   8.25
 576 Charset         =   0
 577 Weight          =   400
 578 Underline       =   0   'False
 579 Italic          =   0   'False
 580 Strikethrough   =   0   'False
 581 EndProperty
 582 BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
 583 Name            =   "MS Sans Serif"
 584 Size            =   8.25
 585 Charset         =   0
 586 Weight          =   400
 587 Underline       =   0   'False
 588 Italic          =   0   'False
 589 Strikethrough   =   0   'False
 590 EndProperty
 591 ColumnCount     =   2
 592 BeginProperty Column00
 593 DataField       =   ""
 594 Caption         =   ""
 595 BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
 596 Type            =   0
 597 Format          =   ""
 598 HaveTrueFalseNull=   0
 599 FirstDayOfWeek  =   0
 600 FirstWeekOfYear =   0
 601 LCID            =   1033
 602 SubFormatType   =   0
 603 EndProperty
 604 EndProperty
 605 BeginProperty Column01
 606 DataField       =   ""
 607 Caption         =   ""
 608 BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
 609 Type            =   0
 610 Format          =   ""
 611 HaveTrueFalseNull=   0
 612 FirstDayOfWeek  =   0
 613 FirstWeekOfYear =   0
 614 LCID            =   1033
 615 SubFormatType   =   0
 616 EndProperty
 617 EndProperty
 618 SplitCount      =   1
 619 BeginProperty Split0
 620 BeginProperty Column00
 621 EndProperty
 622 BeginProperty Column01
 623 EndProperty
 624 EndProperty
 625 End
 626 Begin VB.CheckBox chkAutoCommit
 627 Caption         =   " AutoCommit"
 628 Enabled         =   0   'False
 629 Height          =   255
 630 Left            =   6840
 631 TabIndex        =   31
 632 Top             =   4320
 633 Value           =   1  'Checked
 634 Width           =   1215
 635 End
 636 Begin VB.CommandButton cmdRollback
 637 Caption         =   "Rollback"
 638 Enabled         =   0   'False
 639 Height          =   495
 640 Left            =   6600
 641 TabIndex        =   10
 642 Top             =   5280
 643 Width           =   1695
 644 End
 645 Begin VB.CommandButton cmdCommit
 646 Caption         =   "Commit"
 647 Enabled         =   0   'False
 648 Height          =   495
 649 Left            =   6600
 650 TabIndex        =   9
 651 Top             =   4680
 652 Width           =   1695
 653 End
 654 Begin VB.Frame frmAutoCommit
 655 Height          =   1575
 656 Left            =   6480
 657 TabIndex        =   33
 658 Top             =   4320
 659 Width           =   1935
 660 End
 661 Begin VB.PictureBox picBlob
 662 BackColor       =   &H80000005&
 663 Height          =   5405
 664 Left            =   -74870
 665 ScaleHeight     =   5340
 666 ScaleWidth      =   6420
 667 TabIndex        =   30
 668 Top             =   490
 669 Visible         =   0   'False
 670 Width           =   6480
 671 End
 672 Begin VB.TextBox txtClob
 673 BeginProperty Font
 674 Name            =   "Courier New"
 675 Size            =   8.25
 676 Charset         =   0
 677 Weight          =   400
 678 Underline       =   0   'False
 679 Italic          =   0   'False
 680 Strikethrough   =   0   'False
 681 EndProperty
 682 Height          =   5415
 683 Left            =   -74880
 684 Locked          =   -1  'True
 685 MultiLine       =   -1  'True
 686 ScrollBars      =   3  'Both
 687 TabIndex        =   23
 688 TabStop         =   0   'False
 689 Top             =   480
 690 Width           =   6495
 691 End
 692 Begin VB.TextBox txtFirstname
 693 Appearance      =   0  'Flat
 694 BackColor       =   &H80000013&
 695 Enabled         =   0   'False
 696 Height          =   285
 697 Left            =   -68280
 698 Locked          =   -1  'True
 699 TabIndex        =   26
 700 TabStop         =   0   'False
 701 Top             =   5040
 702 Width           =   1695
 703 End
 704 Begin VB.TextBox txtLastname
 705 Appearance      =   0  'Flat
 706 BackColor       =   &H80000013&
 707 Enabled         =   0   'False
 708 Height          =   285
 709 Left            =   -68280
 710 Locked          =   -1  'True
 711 TabIndex        =   25
 712 TabStop         =   0   'False
 713 Top             =   4440
 714 Width           =   1695
 715 End
 716 Begin VB.TextBox txtEmpno
 717 Appearance      =   0  'Flat
 718 BackColor       =   &H80000013&
 719 Enabled         =   0   'False
 720 Height          =   285
 721 Left            =   -68280
 722 Locked          =   -1  'True
 723 TabIndex        =   24
 724 TabStop         =   0   'False
 725 Top             =   3840
 726 Width           =   1695
 727 End
 728 Begin VB.CommandButton cmdRefresh
 729 Caption         =   "Refresh Data"
 730 Enabled         =   0   'False
 731 Height          =   495
 732 Left            =   -68280
 733 TabIndex        =   12
 734 Top             =   480
 735 Width           =   1695
 736 End
 737 Begin VB.CommandButton cmdBLOB
 738 Caption         =   "Show Picture"
 739 Enabled         =   0   'False
 740 Height          =   495
 741 Left            =   -68280
 742 TabIndex        =   14
 743 Top             =   1680
 744 Width           =   1695
 745 End
 746 Begin VB.CommandButton cmdCLOB
 747 Caption         =   "Show Resume"
 748 Enabled         =   0   'False
 749 Height          =   495
 750 Left            =   -68280
 751 TabIndex        =   13
 752 Top             =   1080
 753 Width           =   1695
 754 End
 755 Begin VB.CommandButton cmdHierarchy
 756 Caption         =   "Display"
 757 Enabled         =   0   'False
 758 Height          =   495
 759 Left            =   -68280
 760 TabIndex        =   11
 761 Top             =   480
 762 Width           =   1695
 763 End
 764 Begin VB.TextBox txtSQL
 765 BeginProperty Font
 766 Name            =   "Courier New"
 767 Size            =   9
 768 Charset         =   0
 769 Weight          =   400
 770 Underline       =   0   'False
 771 Italic          =   0   'False
 772 Strikethrough   =   0   'False
 773 EndProperty
 774 Height          =   1575
 775 Left            =   120
 776 MultiLine       =   -1  'True
 777 ScrollBars      =   2  'Vertical
 778 TabIndex        =   7
 779 Top             =   480
 780 Width           =   6255
 781 End
 782 Begin MSHierarchicalFlexGridLib.MSHFlexGrid hflxRecords
 783 Height          =   4815
 784 Left            =   -74880
 785 TabIndex        =   17
 786 TabStop         =   0   'False
 787 Top             =   1080
 788 Width           =   8295
 789 _ExtentX        =   14631
 790 _ExtentY        =   8493
 791 _Version        =   393216
 792 FixedCols       =   0
 793 WordWrap        =   -1  'True
 794 AllowUserResizing=   1
 795 _NumberOfBands  =   1
 796 _Band(0).Cols   =   2
 797 End
 798 Begin MSHierarchicalFlexGridLib.MSHFlexGrid flxRecords
 799 Height          =   3735
 800 Left            =   120
 801 TabIndex        =   16
 802 TabStop         =   0   'False
 803 Top             =   2160
 804 Width           =   6255
 805 _ExtentX        =   11033
 806 _ExtentY        =   6588
 807 _Version        =   393216
 808 FixedCols       =   0
 809 WordWrap        =   -1  'True
 810 AllowUserResizing=   1
 811 _NumberOfBands  =   1
 812 _Band(0).Cols   =   2
 813 End
 814 Begin MSAdodcLib.Adodc AdodcLob
 815 Height          =   330
 816 Left            =   -68280
 817 Top             =   5520
 818 Width           =   1695
 819 _ExtentX        =   2990
 820 _ExtentY        =   582
 821 ConnectMode     =   1
 822 CursorLocation  =   3
 823 IsolationLevel  =   -1
 824 ConnectionTimeout=   15
 825 CommandTimeout  =   30
 826 CursorType      =   3
 827 LockType        =   3
 828 CommandType     =   8
 829 CursorOptions   =   0
 830 CacheSize       =   50
 831 MaxRecords      =   0
 832 BOFAction       =   0
 833 EOFAction       =   0
 834 ConnectStringType=   1
 835 Appearance      =   1
 836 BackColor       =   -2147483643
 837 ForeColor       =   -2147483640
 838 Orientation     =   0
 839 Enabled         =   0
 840 Connect         =   ""
 841 OLEDBString     =   ""
 842 OLEDBFile       =   ""
 843 DataSourceName  =   ""
 844 OtherAttributes =   ""
 845 UserName        =   ""
 846 Password        =   ""
 847 RecordSource    =   ""
 848 Caption         =   ""
 849 BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
 850 Name            =   "MS Sans Serif"
 851 Size            =   8.25
 852 Charset         =   0
 853 Weight          =   400
 854 Underline       =   0   'False
 855 Italic          =   0   'False
 856 Strikethrough   =   0   'False
 857 EndProperty
 858 _Version        =   393216
 859 End
 860 Begin VB.Label lblHierScript
 861 Caption         =   $"Demo.frx":008C
 862 ForeColor       =   &H80000011&
 863 Height          =   495
 864 Left            =   -74760
 865 TabIndex        =   68
 866 Top             =   540
 867 Width           =   6135
 868 End
 869 Begin VB.Label lblFirstname
 870 Caption         =   "First Name:"
 871 Height          =   255
 872 Left            =   -68280
 873 TabIndex        =   29
 874 Top             =   4800
 875 Width           =   1695
 876 End
 877 Begin VB.Label lblLastname
 878 Caption         =   "Last Name:"
 879 Height          =   255
 880 Left            =   -68280
 881 TabIndex        =   28
 882 Top             =   4200
 883 Width           =   1695
 884 End
 885 Begin VB.Label lblEmpno
 886 Caption         =   "Employee No.:"
 887 Height          =   255
 888 Left            =   -68280
 889 TabIndex        =   27
 890 Top             =   3600
 891 Width           =   1695
 892 End
 893 End
 894 Begin VB.CommandButton cmdVersionInfo
 895 Caption         =   "Get Environment Info"
 896 Enabled         =   0   'False
 897 Height          =   495
 898 Left            =   8760
 899 TabIndex        =   3
 900 Top             =   840
 901 Width           =   1695
 902 End
 903 Begin VB.CommandButton cmdConnectInfo
 904 Caption         =   "Get Connection Info"
 905 Enabled         =   0   'False
 906 Height          =   495
 907 Left            =   8760
 908 TabIndex        =   4
 909 Top             =   4200
 910 Width           =   1695
 911 End
 912 Begin VB.CommandButton cmdConnectDataShape
 913 Caption         =   "Connect DataShape"
 914 Height          =   495
 915 Left            =   8760
 916 TabIndex        =   2
 917 Top             =   3600
 918 Width           =   1695
 919 End
 920 Begin VB.CommandButton cmdConnectODBC
 921 Caption         =   "Connect ODBC"
 922 Height          =   495
 923 Left            =   8760
 924 TabIndex        =   1
 925 Top             =   3000
 926 Width           =   1695
 927 End
 928 Begin VB.CommandButton cmdDisconnect
 929 Caption         =   "Disconnect"
 930 Enabled         =   0   'False
 931 Height          =   495
 932 Left            =   8760
 933 TabIndex        =   5
 934 Top             =   4800
 935 Width           =   1695
 936 End
 937 Begin VB.CommandButton cmdConnectOLEDB
 938 Caption         =   "Connect OLE DB"
 939 Height          =   495
 940 Left            =   8760
 941 TabIndex        =   0
 942 Top             =   2400
 943 Width           =   1695
 944 End
 945 Begin VB.Frame frmConnection
 946 Caption         =   "Connection:"
 947 Height          =   3255
 948 Left            =   8640
 949 TabIndex        =   18
 950 Top             =   2160
 951 Width           =   1935
 952 End
 953 Begin VB.CommandButton cmdExit
 954 Caption         =   "Exit"
 955 Height          =   495
 956 Left            =   8760
 957 TabIndex        =   15
 958 Top             =   5520
 959 Width           =   1695
 960 End
 961 Begin VB.Frame fmExit
 962 Height          =   855
 963 Left            =   8640
 964 TabIndex        =   19
 965 Top             =   5280
 966 Width           =   1935
 967 End
 968 Begin MSComctlLib.StatusBar sbrStatus
 969 Align           =   2  'Align Bottom
 970 Height          =   375
 971 Left            =   0
 972 TabIndex        =   20
 973 Top             =   6180
 974 Width           =   10620
 975 _ExtentX        =   18733
 976 _ExtentY        =   661
 977 _Version        =   393216
 978 BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
 979 NumPanels       =   1
 980 BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
 981 AutoSize        =   1
 982 Object.Width           =   18680
 983 EndProperty
 984 EndProperty
 985 BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
 986 Name            =   "MS Sans Serif"
 987 Size            =   9.75
 988 Charset         =   0
 989 Weight          =   400
 990 Underline       =   0   'False
 991 Italic          =   0   'False
 992 Strikethrough   =   0   'False
 993 EndProperty
 994 End
 995 Begin VB.Frame frmEnvironment
 996 Caption         =   "Environment:"
 997 Height          =   1455
 998 Left            =   8640
 999 TabIndex        =   22
1000 Top             =   0
1001 Width           =   1935
1002 End
1003 End
1004 Attribute VB_Name = "frmMain"
1005 Attribute VB_GlobalNameSpace = False
1006 Attribute VB_Creatable = False
1007 Attribute VB_PredeclaredId = True
1008 Attribute VB_Exposed = False
1009 Option Explicit
1010 Private con As ADODB.Connection
1011 Private rst As ADODB.Recordset
1012 Private strMsgText As String
1013 Private wShowInstructions As Integer
1014 Private Sub cmdConnectOLEDB_Click()
1015 Set con = ConnectOLEDB()
1016 sbrStatus.Panels(1).Text = "Connect to sample database succeeded!"
1017 EnableButtons
1018 If wShowInstructions = vbYes Then
1019 ShowConnectionInstruction
1020 End If
1021 cmdConnectOLEDB_Exit:
1022 Exit Sub
1023 cmdConnectOLEDB_Error:
1024 sbrStatus.Panels(1).Text = "ERROR: " & Err.Description
1025 If wShowInstructions = vbYes Then
1026 MsgBox "Connect to sample database failed!" & vbCr & _
1027 Err.Description & vbCr & _
1028 "Please correct the problem and try again.", _
1029 vbOKOnly + vbCritical, "Instruction"
1030 End If
1031 Resume cmdConnectOLEDB_Exit
1032 End Sub
1033 Private Sub cmdConnectODBC_Click()
1034 On Error GoTo cmdConnectODBC_Error
1035 Set con = ConnectODBC()
1036 sbrStatus.Panels(1).Text = "Connect to sample database succeeded!"
1037 EnableButtons
1038 If wShowInstructions = vbYes Then
1039 ShowConnectionInstruction
1040 End If
1041 cmdConnectODBC_Exit:
1042 Exit Sub
1043 cmdConnectODBC_Error:
1044 sbrStatus.Panels(1).Text = "ERROR: " & Err.Description
1045 If wShowInstructions = vbYes Then
1046 MsgBox "Connect to sample database failed!" & vbCr & _
1047 Err.Description & vbCr & _
1048 "Please correct the problem and try again.", _
1049 vbOKOnly + vbCritical, "Instruction"
1050 End If
1051 Resume cmdConnectODBC_Exit
1052 End Sub
1053 Private Sub cmdConnectDataShape_Click()
1054 On Error GoTo cmdConnectDataShape_Error
1055 Set con = ConnectDataShape()
1056 con.Attributes = adXactCommitRetaining + adXactAbortRetaining
1057 sbrStatus.Panels(1).Text = "Connect to sample database succeeded!"
1058 EnableButtons
1059 cmdHierarchy.Enabled = True
1060 lblHierScript.ForeColor = vbButtonText
1061 If wShowInstructions = vbYes Then
1062 ShowConnectionInstruction
1063 End If
1064 cmdConnectDataShape_Exit:
1065 Exit Sub
1066 cmdConnectDataShape_Error:
1067 sbrStatus.Panels(1).Text = "ERROR: " & Err.Description
1068 If wShowInstructions = vbYes Then
1069 MsgBox "Connect to sample database failed!" & vbCr & _
1070 Err.Description & vbCr & _
1071 "Please correct the problem and try again.", _
1072 vbOKOnly + vbCritical, "Instruction"
1073 End If
1074 Resume cmdConnectDataShape_Exit
1075 End Sub
1076 Private Sub EnableButtons()
1077 Dim tmpButton As CommandButton
1078 cmdConnectOLEDB.Enabled = False
1079 cmdConnectODBC.Enabled = False
1080 cmdConnectDataShape.Enabled = False
1081 cmdHierarchy.Enabled = False
1082 lblHierScript.ForeColor = vbGrayText
1083 cmdSample.Enabled = False
1084 cmdConnectInfo.Enabled = True
1085 cmdVersionInfo.Enabled = True
1086 cmdDisconnect.Enabled = True
1087 cmdRefresh.Enabled = True
1088 cmdSQLConnection.Enabled = True
1089 cmdSQLRecordset.Enabled = True
1090 cmdSQLCommand.Enabled = True
1091 For Each tmpButton In cmdSQLSamples
1092 tmpButton.Enabled = True
1093 Next
1094 cmdCommit.Enabled = False
1095 cmdRollback.Enabled = False
1096 chkAutoCommit.Enabled = True
1097 CheckAvailableStoredProcedures
1098 For Each tmpButton In cmdUDFs
1099 tmpButton.Enabled = True
1100 Next
1101 End Sub
1102 Private Sub ShowConnectionInstruction()
1103 MsgBox "Connect to sample database succeeded!" & vbCr & _
1104 "You may choose a Tab for specific functional demonstration," & vbCr & _
1105 "or press one of the info buttons for more information.", _
1106 vbOKOnly, "Instruction"
1107 End Sub
1108 Private Sub cmdDisconnect_Click()
1109 On Error GoTo cmdDisconnect_Error
1110 Set rst = Nothing
1111 Set DataGridSQL.DataSource = Nothing
1112 Set hflxRecords.DataSource = Nothing
1113 DataGridSQL.ClearFields
1114 hflxRecords.Clear
1115 picBlob.Visible = False
1116 txtClob.Text = ""
1117 txtEmpno.Text = ""
1118 txtLastname.Text = ""
1119 txtFirstname.Text = ""
1120 AdodcLob.Caption = ""
1121 chkAutoCommit.Value = 1
1122 DataGridSP.Visible = False
1123 txtSPResult.Text = ""
1124 txtUDF.Text = ""
1125 hflxGridUDF.Clear
1126 sbrStatus.Panels(1).Text = Disconnect(con)
1127 Dim tmpButton As CommandButton
1128 cmdConnectOLEDB.Enabled = True
1129 cmdConnectODBC.Enabled = True
1130 cmdConnectDataShape.Enabled = True
1131 cmdSample.Enabled = True
1132 cmdDisconnect.Enabled = False
1133 cmdHierarchy.Enabled = False
1134 lblHierScript.ForeColor = vbGrayText
1135 cmdConnectInfo.Enabled = False
1136 cmdVersionInfo.Enabled = False
1137 cmdSQLConnection.Enabled = False
1138 cmdSQLRecordset.Enabled = False
1139 cmdSQLCommand.Enabled = False
1140 For Each tmpButton In cmdSQLSamples
1141 tmpButton.Enabled = False
1142 Next
1143 cmdCommit.Enabled = False
1144 cmdRollback.Enabled = False
1145 chkAutoCommit.Enabled = False
1146 cmdRefresh.Enabled = False
1147 cmdBLOB.Enabled = False
1148 cmdCLOB.Enabled = False
1149 AdodcLob.Enabled = False
1150 cmdSPCall.Enabled = False
1151 CheckAvailableStoredProcedures
1152 For Each tmpButton In cmdUDFs
1153 tmpButton.Enabled = False
1154 Next
1155 If wShowInstructions = vbYes Then
1156 MsgBox "Sample Database is disconnected!" & vbCr & _
1157 "You may now choose one of the connections again.", _
1158 vbOKOnly, "Instruction"
1159 End If
1160 cmdDisconnect_Exit:
1161 Set rst = Nothing
1162 Set con = Nothing
1163 Exit Sub
1164 cmdDisconnect_Error:
1165 sbrStatus.Panels(1).Text = "ERROR: " & Err.Description
1166 If wShowInstructions = vbYes Then
1167 MsgBox "Disconnect from sample database failed!" & vbCr & _
1168 Err.Description & vbCr & _
1169 "Please correct the problem and try again.", _
1170 vbOKOnly + vbCritical, "Instruction"
1171 End If
1172 Resume cmdDisconnect_Exit
1173 End Sub
1174 Private Sub cmdConnectInfo_Click()
1175 sbrStatus.Panels(1).Text = ""
1176 MsgBox ConnectInfo(con), vbOKOnly, "Connection Information"
1177 End Sub
1178 Private Sub cmdVersionInfo_Click()
1179 sbrStatus.Panels(1).Text = ""
1180 MsgBox VersionInfo(con), vbOKOnly, "Versions Information"
1181 End Sub
1182 Private Sub cmdExit_Click()
1183 chkAutoCommit.Value = 1
1184 Set hflxRecords.DataSource = Nothing
1185 Set DataGridSQL.DataSource = Nothing
1186 Set rst = Nothing
1187 Set con = Nothing
1188 Unload Me
1189 End Sub
1190 Private Sub cmdSample_Click()
1191 On Error GoTo cmdSample_Error
1192 sbrStatus.Panels(1).Text = "Creating the sample database, please wait..."
1193 CreateSample
1194 sbrStatus.Panels(1).Text = "Create the sample database is done."
1195 If wShowInstructions = vbYes Then
1196 MsgBox "The sample database has been created!" & vbCr & _
1197 "You may now choose one of the connections.", _
1198 vbOKOnly, "Instruction"
1199 End If
1200 cmdSample_Exit:
1201 Exit Sub
1202 cmdSample_Error:
1203 sbrStatus.Panels(1).Text = "ERROR: " & Err.Description
1204 If wShowInstructions = vbYes Then
1205 MsgBox "Create sample database failed!" & vbCr & _
1206 Err.Description & vbCr & _
1207 "Please correct the problem and try again.", _
1208 vbOKOnly + vbCritical, "Instruction"
1209 End If
1210 Resume cmdSample_Exit
1211 End Sub
1212 Private Sub cmdSQLConnection_Click()
1213 On Error GoTo cmdSQLConnection_Error
1214 DataGridSQL.ClearFields
1215 Set rst = ExecuteSQLConnect(txtSQL, strMsgText, con)
1216 Set DataGridSQL.DataSource = rst
1217 sbrStatus.Panels(1).Text = strMsgText
1218 cmdSQLConnection_Exit:
1219 Exit Sub
1220 cmdSQLConnection_Error:
1221 sbrStatus.Panels(1).Text = "ERROR: " & Err.Description
1222 Resume cmdSQLConnection_Exit
1223 End Sub
1224 Private Sub cmdSQLCommand_Click()
1225 On Error GoTo cmdSQLCommand_Error
1226 DataGridSQL.ClearFields
1227 Set rst = ExecuteSQLCommand(txtSQL, strMsgText, con)
1228 Set DataGridSQL.DataSource = rst
1229 sbrStatus.Panels(1).Text = strMsgText
1230 cmdSQLCommand_Exit:
1231 Exit Sub
1232 cmdSQLCommand_Error:
1233 sbrStatus.Panels(1).Text = "ERROR: " & Err.Description
1234 Resume cmdSQLCommand_Exit
1235 End Sub
1236 Private Sub cmdSQLRecordset_Click()
1237 On Error GoTo cmdSQLRecordset_Error
1238 DataGridSQL.ClearFields
1239 Set rst = ExecuteSQLRecordset(txtSQL, strMsgText, con)
1240 Set DataGridSQL.DataSource = rst
1241 DataGridSQL.SetFocus
1242 sbrStatus.Panels(1).Text = strMsgText
1243 cmdSQLRecordset_Exit:
1244 Exit Sub
1245 cmdSQLRecordset_Error:
1246 sbrStatus.Panels(1).Text = "ERROR: " & Err.Description
1247 Resume cmdSQLRecordset_Exit
1248 End Sub
1249 Private Sub DataGridSQL_Error(ByVal DataError As Integer, Response As Integer)
1250 If wShowInstructions = vbYes Then
1251 MsgBox _
1252 "If errors keep happening," & vbCr & _
1253 "You may press [Disconnect] to clear errors.", _
1254 vbOKOnly, "Instruction"
1255 End If
1256 sbrStatus.Panels(1).Text = "Press [Disconnect] to clear continuous errors."
1257 End Sub
1258 Private Sub cmdSQLSamples_Click(Index As Integer)
1259 Select Case Index
1260 Case 0
1261 txtSQL.Text = "SELECT * FROM employee"
1262 Case 1
1263 txtSQL.Text = "SELECT firstnme, job, hiredate" & vbCrLf & _
1264 "FROM employee" & vbCrLf & _
1265 "WHERE workdept = 'D11'" & vbCrLf & _
1266 "ORDER BY hiredate"
1267 Case 2
1268 txtSQL.Text = "SELECT firstnme, job, salary + comm AS pay" & vbCrLf & _
1269 "FROM employee" & vbCrLf & _
1270 "WHERE (salary + comm) < 25000" & vbCrLf & _
1271 "ORDER BY pay DESC"
1272 Case 3
1273 txtSQL.Text = "SELECT workdept," & vbCrLf & _
1274 "       MAX(salary) AS maximum," & vbCrLf & _
1275 "       MIN(salary) As minimum" & vbCrLf & _
1276 "FROM employee GROUP BY workdept ORDER BY workdept"
1277 Case Else
1278 End Select
1279 End Sub
1280 Private Sub cmdSQLSamples_GotFocus(Index As Integer)
1281 Set DataGridSQL.DataSource = Nothing
1282 sbrStatus.Panels(1).Text = ""
1283 End Sub
1284 Private Sub chkAutoCommit_Click()
1285 On Error GoTo chkAutoCommit_Error
1286 If chkAutoCommit.Value = 0 Then
1287 AutoCommitOff con
1288 cmdCommit.Enabled = True
1289 cmdRollback.Enabled = True
1290 sbrStatus.Panels(1).Text = "AutoCommit mode is OFF."
1291 Else
1292 strMsgText = "Commit all previous changes (if any)?"
1293 If MsgBox(strMsgText, vbYesNo, "Turn Autocommit ON") = vbYes Then
1294 Commit con
1295 Else
1296 Rollback con
1297 End If
1298 cmdCommit.Enabled = False
1299 cmdRollback.Enabled = False
1300 sbrStatus.Panels(1).Text = "AutoCommit mode is ON."
1301 End If
1302 chkAutoCommit_Exit:
1303 RefreshDataGridSQL
1304 Exit Sub
1305 chkAutoCommit_Error:
1306 sbrStatus.Panels(1).Text = "ERROR: " & Err.Description
1307 Resume chkAutoCommit_Exit
1308 End Sub
1309 Private Sub cmdCommit_Click()
1310 On Error GoTo cmdCommit_Error
1311 If chkAutoCommit.Value = 0 Then
1312 Commit con
1313 AutoCommitOff con
1314 End If
1315 sbrStatus.Panels(1).Text = "Commit transactions succeeded."
1316 cmdCommit_Exit:
1317 RefreshDataGridSQL
1318 Exit Sub
1319 cmdCommit_Error:
1320 sbrStatus.Panels(1).Text = "ERROR: " & Err.Description
1321 Resume cmdCommit_Exit
1322 End Sub
1323 Private Sub cmdRollback_Click()
1324 On Error GoTo cmdRollback_Error
1325 If chkAutoCommit.Value = 0 Then
1326 Rollback con
1327 AutoCommitOff con
1328 End If
1329 sbrStatus.Panels(1).Text = "Rollback transactions succeeded."
1330 cmdRollback_Exit:
1331 RefreshDataGridSQL
1332 Exit Sub
1333 cmdRollback_Error:
1334 sbrStatus.Panels(1).Text = "ERROR: " & Err.Description
1335 Resume cmdRollback_Exit
1336 End Sub
1337 Private Sub RefreshDataGridSQL()
1338 If Not DataGridSQL.DataSource Is Nothing Then
1339 Set DataGridSQL.DataSource = Nothing
1340 rst.Requery
1341 Set DataGridSQL.DataSource = rst
1342 End If
1343 End Sub
1344 Private Sub cmdHierarchy_Click()
1345 hflxRecords.Clear
1346 Set hflxRecords.DataSource = ExecuteHSQL(strMsgText, con)
1347 sbrStatus.Panels(1).Text = strMsgText
1348 End Sub
1349 Private Sub cmdRefresh_Click()
1350 On Error GoTo cmdRefresh_Error
1351 GetLOB con, AdodcLob
1352 AdodcLob.Refresh
1353 txtClob.DataField = "RESUME"
1354 Set txtClob.DataSource = AdodcLob
1355 picBlob.DataField = "PICTURE"
1356 Set picBlob.DataSource = AdodcLob
1357 txtEmpno.DataField = "EMPNO"
1358 Set txtEmpno.DataSource = AdodcLob
1359 txtLastname.DataField = "LASTNAME"
1360 Set txtLastname.DataSource = AdodcLob
1361 txtFirstname.DataField = "FIRSTNME"
1362 Set txtFirstname.DataSource = AdodcLob
1363 cmdBLOB.Enabled = True
1364 cmdCLOB.Enabled = True
1365 AdodcLob.Enabled = True
1366 cmdRefresh_Exit:
1367 Exit Sub
1368 cmdRefresh_Error:
1369 sbrStatus.Panels(1).Text = "ERROR: " & Err.Description
1370 AdodcLob.Enabled = False
1371 cmdBLOB.Enabled = False
1372 cmdCLOB.Enabled = False
1373 Resume cmdRefresh_Exit
1374 End Sub
1375 Private Sub cmdBLOB_Click()
1376 picBlob.Visible = True
1377 End Sub
1378 Private Sub cmdCLOB_Click()
1379 picBlob.Visible = False
1380 End Sub
1381 Private Sub AdodcLob_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
1382 AdodcLob.Caption = AdodcLob.Recordset.AbsolutePosition
1383 End Sub
1384 Private Sub CheckAvailableStoredProcedures()
1385 Dim optStoredProcedure As Variant
1386 Dim proToken As ADOX.Procedure
1387 Dim pros As ADOX.Procedures
1388 Set pros = GetProcedures(con)
1389 For Each optStoredProcedure In optStoredProcedures
1390 optStoredProcedure.Enabled = False
1391 optStoredProcedure.Value = False
1392 cmdShowSecondRS.Visible = False
1393 cmdSPCall.Enabled = False
1394 Next
1395 For Each proToken In pros
1396 Select Case proToken.Name
1397 Case "OUT_LANGUAGE"
1398 optStoredProcedures(0).Enabled = True
1399 Case "IN_PARAMS"
1400 optStoredProcedures(1).Enabled = True
1401 Case "OUT_PARAM"
1402 optStoredProcedures(2).Enabled = True
1403 Case "INOUT_PARAM"
1404 optStoredProcedures(3).Enabled = True
1405 Case "ALL_DATA_TYPES"
1406 optStoredProcedures(4).Enabled = True
1407 Case "DECIMAL_TYPE"
1408 optStoredProcedures(5).Enabled = True
1409 Case "ONE_RESULT_SET"
1410 optStoredProcedures(6).Enabled = True
1411 Case "TWO_RESULT_SETS"
1412 optStoredProcedures(7).Enabled = True
1413 Case "CLOB_EXTRACT"
1414 optStoredProcedures(8).Enabled = True
1415 Case "DB2SQL_EXAMPLE"
1416 optStoredProcedures(9).Enabled = True
1417 Case "DBINFO_EXAMPLE"
1418 optStoredProcedures(10).Enabled = True
1419 Case "MAIN_EXAMPLE"
1420 optStoredProcedures(11).Enabled = True
1421 Case Else
1422 End Select
1423 Next proToken
1424 For Each optStoredProcedure In optStoredProcedures
1425 If optStoredProcedure.Enabled Then
1426 cmdSPCall.Enabled = True
1427 Exit For
1428 End If
1429 Next
1430 Set pros = Nothing
1431 Set proToken = Nothing
1432 End Sub
1433 Private Sub optStoredProcedures_Click(Index As Integer)
1434 sbrStatus.Panels(1).Text = ""
1435 txtSPResult.Text = ""
1436 If DataGridSP.Visible Then
1437 DataGridSP.Visible = False
1438 Set DataGridSP.DataSource = Nothing
1439 DataGridSP.ClearFields
1440 cmdShowSecondRS.Visible = False
1441 End If
1442 cmdSPCall.SetFocus
1443 End Sub
1444 Private Sub cmdSPCall_Click()
1445 Dim optStoredProcedure As Variant
1446 Dim strParam As String
1447 On Error GoTo cmdSPCall_Error
1448 For Each optStoredProcedure In optStoredProcedures
1449 If optStoredProcedure.Value = True Then
1450 Exit For
1451 End If
1452 Next
1453 If IsObject(optStoredProcedure) Then
1454 sbrStatus.Panels(1).Text = ""
1455 txtSPResult.Text = ""
1456 DataGridSP.Visible = False
1457 Else
1458 sbrStatus.Panels(1).Text = "ERROR: No stored procedure selected."
1459 Exit Sub
1460 End If
1461 Select Case optStoredProcedure.Caption
1462 Case "OUT_LANGUAGE"
1463 txtSPResult.Text = _
1464 "Stored procedures are implemented in LANGUAGE " & _
1465 CallSP_OUT_LANGUAGE(con)
1466 Case "IN_PARAMS"
1467 con.BeginTrans
1468 CallInParameters
1469 con.RollbackTrans
1470 Case "OUT_PARAM"
1471 txtSPResult.Text = _
1472 "Stored Procedure OUT_PARAM calculated median was " & _
1473 CallSP_OUT_PARAM(con)
1474 Case "INOUT_PARAM"
1475 CallInOutParameter
1476 Case "ALL_DATA_TYPES"
1477 CallAllDataTypes
1478 Case "DECIMAL_TYPE"
1479 txtSPResult.Text = _
1480 "Stored Procedure DECIMAL_TYPE returned value was " & _
1481 CallSP_DECIMAL_TYPE(con)
1482 Case "CLOB_EXTRACT"
1483 txtSPResult.Text = _
1484 "Resume section returned from calling CLOB_EXTRACT:" & _
1485 vbCrLf & vbCrLf & CallSP_CLOB_EXTRACT(con)
1486 Case "ONE_RESULT_SET"
1487 Set DataGridSP.DataSource = CallSP_ONE_RESULT_SET(con)
1488 DataGridSP.Visible = True
1489 Case "TWO_RESULT_SETS"
1490 Set rst = CallSP_TWO_RESULT_SETS(con)
1491 Set DataGridSP.DataSource = rst
1492 DataGridSP.Visible = True
1493 cmdShowSecondRS.Visible = True
1494 cmdShowSecondRS.Enabled = True
1495 cmdShowSecondRS.SetFocus
1496 Case "DB2SQL_EXAMPLE"
1497 strParam = "CLERK"
1498 txtSPResult.Text = _
1499 "Stored Procedure DB2SQL_EXAMPLE returned value was " & _
1500 CallSP_DB2SQL_EXAMPLE(con, strParam) & _
1501 vbCrLf & "for the job of " & strParam & "."
1502 Case "DBINFO_EXAMPLE"
1503 CallDbInfo
1504 Case "MAIN_EXAMPLE"
1505 strParam = "DESIGNER"
1506 txtSPResult.Text = _
1507 "Stored Procedure MAIN_EXAMPLE returned value was " & _
1508 CallSP_DB2SQL_EXAMPLE(con, strParam) & _
1509 vbCrLf & "for the job of " & strParam & "."
1510 End Select
1511 sbrStatus.Panels(1).Text = _
1512 "Stored Procedure " & optStoredProcedure.Caption & _
1513 " was called successfully."
1514 cmdSPCall_Exit:
1515 Exit Sub
1516 cmdSPCall_Error:
1517 sbrStatus.Panels(1).Text = "ERROR: " & Err.Description
1518 Resume cmdSPCall_Exit
1519 End Sub
1520 Private Sub cmdShowSecondRS_Click()
1521 Set DataGridSP.DataSource = rst.NextRecordset
1522 cmdShowSecondRS.Enabled = False
1523 cmdSPCall.SetFocus
1524 End Sub
1525 Private Sub CallInParameters()
1526 Dim strSQL As String
1527 strSQL = "SELECT SUM(salary) FROM employee WHERE workdept = 'E11'"
1528 Set rst = ExecuteSQLCommand(strSQL, strMsgText, con)
1529 txtSPResult.Text = "Before calling IN_PARAMS, " & vbCrLf & _
1530 "Sum of salaries for dept. E11 = " & _
1531 rst.Fields(0).Value & vbCrLf & vbCrLf
1532 CallSP_IN_PARAMS con
1533 txtSPResult.Text = txtSPResult.Text & _
1534 "SAMPLE Stored Procedure IN_PARAMS was called." & vbCrLf & vbCrLf
1535 Set rst = ExecuteSQLCommand(strSQL, strMsgText, con)
1536 txtSPResult.Text = txtSPResult.Text & _
1537 "After calling IN_PARAMS, " & vbCrLf & _
1538 "Sum of salaries for dept. E11 = " & _
1539 rst.Fields(0).Value & vbCrLf
1540 Set rst = Nothing
1541 strMsgText = ""
1542 End Sub
1543 Private Sub CallInOutParameter()
1544 Dim dblMedian As Double
1545 txtSPResult.Text = "Call OUT_PARAM to get the median."
1546 dblMedian = CallSP_OUT_PARAM(con)
1547 txtSPResult.Text = txtSPResult.Text & vbCrLf & _
1548 "Stored procedure returned successfully." & vbCrLf
1549 txtSPResult.Text = txtSPResult.Text & vbCrLf & _
1550 "Call INOUT_PARAM with the result just got."
1551 txtSPResult.Text = txtSPResult.Text & vbCrLf & _
1552 "New median returned from INOUT_PARAM = " & _
1553 CallSP_INOUT_PARAM(con, dblMedian)
1554 End Sub
1555 Private Sub CallAllDataTypes()
1556 Dim pms As ADODB.Parameters
1557 With txtSPResult
1558 .Text = "Call ALL_DATA_TYPES to get all types of data."
1559 Set pms = CallSP_ALL_DATA_TYPES(con)
1560 .Text = .Text & vbCrLf & "Stored procedure returned successfully."
1561 .Text = .Text & vbCrLf & _
1562 vbCrLf & "Value of SMALLINT = " & pms("SMALL").Value & _
1563 vbCrLf & "Value of INTEGER = " & pms("INTIN").Value & _
1564 vbCrLf & "Value of BIGINT = " & pms("BIGIN").Value & _
1565 vbCrLf & "Value of REAL = " & pms("REALIN").Value & _
1566 vbCrLf & "Value of DOUBLE = " & pms("DOUBLEIN").Value & _
1567 vbCrLf & "Value of CHAR(1) = " & pms("CHAROUT").Value & _
1568 vbCrLf & "Value of CHAR(15) = " & pms("CHARSOUT").Value & _
1569 vbCrLf & "Value of VARCHAR(12) = " & pms("VARCHAROUT").Value & _
1570 vbCrLf & "Value of DATE = " & pms("DATEOUT").Value & _
1571 vbCrLf & "Value of TIME = " & TimeValue(pms("TIMEOUT").Value)
1572 End With
1573 Set pms = Nothing
1574 End Sub
1575 Private Sub CallDbInfo()
1576 Dim pms As ADODB.Parameters
1577 Dim strJob As String
1578 txtSPResult.Text = "CALL stored procedure named DBINFO_EXAMPLE."
1579 strJob = "MANAGER"
1580 Set pms = CallSP_DBINFO_EXAMPLE(con, strJob)
1581 txtSPResult.Text = txtSPResult.Text & vbCrLf & _
1582 "Stored procedure returned successfully with SQLCODE = " & _
1583 pms("ERRORCODE").Value
1584 txtSPResult.Text = txtSPResult.Text & vbCrLf & _
1585 "Average salary for job " & strJob & " = " & pms("SALARY").Value
1586 txtSPResult.Text = txtSPResult.Text & vbCrLf & _
1587 "Database name from OUT parameter = " & Trim$(pms("DBNAME").Value)
1588 txtSPResult.Text = txtSPResult.Text & vbCrLf & _
1589 "Database version from OUT parameter = " & pms("DBVERSION").Value
1590 Set pms = Nothing
1591 End Sub
1592 Private Sub cmdUDFs_Click(Index As Integer)
1593 On Error GoTo cmdUDFs_Error
1594 sbrStatus.Panels(1).Text = ""
1595 txtUDF.Text = ""
1596 hflxGridUDF.ClearStructure
1597 Select Case cmdUDFs(Index).Caption
1598 Case "ScalarUDF"
1599 hflxGridUDF.ColWidth(3) = 2000
1600 Set hflxGridUDF.DataSource = CallUDFScalarUDF(strMsgText, con)
1601 Case "ClobScalarUDF"
1602 Set hflxGridUDF.DataSource = CallUDFClobScalarUDF(strMsgText, con)
1603 Case "ScratchpadScUDF"
1604 Set hflxGridUDF.DataSource = CallUDFScratchpadScUDF(strMsgText, con)
1605 Case "ScUDFReturningErr"
1606 Set hflxGridUDF.DataSource = CallUDFScUDFReturningErr(strMsgText, con)
1607 txtUDF.Text = strMsgText
1608 Err.Raise vbObjectError, , "See display area for detail."
1609 Case "SourcedColumnUDF"
1610 Set hflxGridUDF.DataSource = CallUDFSourcedColUDF(strMsgText, con)
1611 Case "TableUDF"
1612 Set hflxGridUDF.DataSource = CallUDFTableUDF(strMsgText, con)
1613 Case Else
1614 End Select
1615 txtUDF.Text = strMsgText
1616 sbrStatus.Panels(1).Text = _
1617 "Calling UDF " & cmdUDFs(Index).Caption & " was done."
1618 cmdUDFs_Exit:
1619 Exit Sub
1620 cmdUDFs_Error:
1621 sbrStatus.Panels(1).Text = "ERROR: " & Err.Description
1622 Resume cmdUDFs_Exit
1623 End Sub
1624 Private Sub Form_Load()
1625 tabMain.Tab = 0
1626 wShowInstructions = vbYes
1627 wShowInstructions = MsgBox("Would you like to have instructions?", _
1628 vbYesNo, "Welcome to the DB2 Visual Basic samples")
1629 End Sub
1630 Private Sub Form_Activate()
1631 If wShowInstructions = vbYes Then
1632 MsgBox _
1633 "Thank you for using instructions in this demonstration program!" & vbCr & vbCr & _
1634 "- Status messages are shown at the bottom of the working window;" & vbCr & _
1635 "- Buttons unavailable are being grayed out;" & vbCr & _
1636 "- SAMPLE database must be created if it doesn't exist;" & vbCr & _
1637 "- [Exit] button can be pressed at anytime to quit the program." & vbCr & vbCr & _
1638 "You may now choose one of the connections to begin the demonstraton.", _
1639 vbOKOnly, "Instruction"
1640 End If
1641 End Sub
1642 Private Sub tabMain_Click(intPreviousTab As Integer)
1643 Select Case tabMain.TabCaption(intPreviousTab)
1644 Case "Execute SQL"
1645 chkAutoCommit.Value = 1
1646 Set rst = Nothing
1647 Set DataGridSQL.DataSource = Nothing
1648 DataGridSQL.ClearFields
1649 Case "Hierarchical Data"
1650 Set hflxRecords.DataSource = Nothing
1651 hflxRecords.Clear
1652 Case "LOBs"
1653 txtClob.Text = ""
1654 txtEmpno.Text = ""
1655 txtLastname.Text = ""
1656 txtFirstname.Text = ""
1657 AdodcLob.Caption = ""
1658 AdodcLob.Enabled = False
1659 cmdBLOB.Enabled = False
1660 cmdCLOB.Enabled = False
1661 picBlob.Visible = False
1662 Case "Store Procedures"
1663 Set rst = Nothing
1664 Set DataGridSP.DataSource = Nothing
1665 DataGridSP.Visible = False
1666 DataGridSP.ClearFields
1667 cmdShowSecondRS.Visible = False
1668 txtSPResult.Text = ""
1669 Case "UDFs"
1670 txtUDF.Text = ""
1671 hflxGridUDF.Clear
1672 Case Else
1673 End Select
1674 sbrStatus.Panels(1).Text = ""
1675 End Sub
1676 Private Sub tabMain_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
1677 If wShowInstructions = vbYes Then
1678 If con Is Nothing Then  'no connection established
1679 MsgBox _
1680 "All funcitonal features require a valid connection.", _
1681 vbOKOnly + vbExclamation, "Instruction"
1682 Else
1683 Select Case tabMain.Caption
1684 Case "Execute SQL"
1685 MsgBox _
1686 "Please type a SQL statement into the text box, or," & vbCr & _
1687 "choose a preset one from the small Sample buttons, then," & vbCr & _
1688 "press one of the [Execute SQL] buttons to get the results." & vbCr & _
1689 "AutoCommit checkbox can be used to change the autocommit mode." & vbCr & vbCr & _
1690 "For more about the connection, command, and recordset objects," & vbCr & _
1691 "see the source code in the apExeSQL.bas module." & vbCr & vbCr & _
1692 "Note:" & vbCr & _
1693 "- The sample SQL statements can be edited." & vbCr & _
1694 "- Recordset results may be editable depending on the SQL statement issued.", _
1695 vbOKOnly, "Instruction"
1696 Case "Hierarchical Data"
1697 If InStr(con.Provider, "MSDataShape") Then
1698 MsgBox _
1699 "Please press the [Display] button to display hierarchical result.", _
1700 vbOKOnly, "Instruction"
1701 Else
1702 MsgBox _
1703 "Hierarchical Data is only available for a" & vbCr & _
1704 "valid connection with DataShape.", _
1705 vbOKOnly + vbExclamation, "Instruction"
1706 End If
1707 Case "LOBs"
1708 MsgBox _
1709 "After pressing the [Refresh Data] button;" & vbCr & _
1710 "Use arrow keys to manipulate results;" & vbCr & _
1711 "Press [Show Resume] button to display CLOBs;" & vbCr & _
1712 "Press [Show Picture] button to display BLOBs.", _
1713 vbOKOnly, "Instruction"
1714 Case "Store Procedures"
1715 MsgBox _
1716 "Choose an available stored procedure, then," & vbCr & _
1717 "press the [Call] button to get the results." & vbCr & vbCr & _
1718 "Note: To make them available, you first have to create and catalog" & vbCr & _
1719 "the stored procedures in the spserver stored procedure library.", _
1720 vbOKOnly, "Instruction"
1721 Case "UDFs"
1722 MsgBox _
1723 "Please choose one of the UDF buttons to show the usage.", _
1724 vbOKOnly, "Instruction"
1725 Case Else
1726 End Select
1727 End If
1728 End If
1729 End Sub