git.oblomov.eu Git - ohcount/blob - test/src_dir/frx1.frx

   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 '---------------------------------------------------------------------------
1010 '
1011 ' Licensed Materials - Property of IBM
1012 ' Governed under the terms of the IBM Public License
1013 '
1014 ' (C) COPYRIGHT International Business Machines Corp. 2002
1015 ' All Rights Reserved.
1016 '
1017 ' US Government Users Restricted Rights - Use, duplication or
1018 ' disclosure restricted by GSA ADP Schedule Contract with IBM Corp.
1019 '---------------------------------------------------------------------------
1020 '
1021 ' SOURCE FILE NAME: Demo.frm
1022 '
1023 ' SAMPLE: Visual Basic Demo with user interface for the sample modules
1024 '
1025 ' MODULES USED:
1026 '         cli_Info.bas
1027 '         cliExeSQL.bas
1028 '         dbCommit.bas
1029 '         dbConn.bas
1030 '         dbInfo.bas
1031 '         dtHier.bas
1032 '         dtLob.bas
1033 '         spCall.bas
1034 '         udfUse.bas
1035 '         Util.bas
1036 '
1037 ' For more information about samples, refer to the README file.
1038 '
1039 ' For more information on the SQL language, refer to the SQL Reference.
1040 '
1041 ' For the latest information on programming, compiling, and running DB2
1042 ' applications, refer to the DB2 application development website at
1043 '     http://www.software.ibm.com/data/db2/udb/ad
1044 '---------------------------------------------------------------------------
1045
1046 Option Explicit
1047
1048 Private con As ADODB.Connection
1049 Private rst As ADODB.Recordset
1050 Private strMsgText As String
1051 Private wShowInstructions As Integer
1052
1053 'This procedure calls ConnectOLEDB() in the module dbConn to get
1054 'a connection object.
1055 Private Sub cmdConnectOLEDB_Click()
1056   'define the error handler
1057 '  On Error GoTo cmdConnectOLEDB_Error
1058
1059   'connect to database
1060   Set con = ConnectOLEDB()
1061
1062   'generate a message of success
1063   sbrStatus.Panels(1).Text = "Connect to sample database succeeded!"
1064
1065   'config status of the buttons
1066   EnableButtons
1067
1068   'show instructions
1069   If wShowInstructions = vbYes Then
1070     ShowConnectionInstruction
1071   End If
1072
1073 cmdConnectOLEDB_Exit:
1074   Exit Sub
1075
1076 cmdConnectOLEDB_Error:
1077   'generate an error message
1078   sbrStatus.Panels(1).Text = "ERROR: " & Err.Description
1079
1080   'show instructions
1081   If wShowInstructions = vbYes Then
1082     MsgBox "Connect to sample database failed!" & vbCr & _
1083       Err.Description & vbCr & _
1084       "Please correct the problem and try again.", _
1085       vbOKOnly + vbCritical, "Instruction"
1086   End If
1087
1088   Resume cmdConnectOLEDB_Exit
1089 End Sub
1090
1091 'This procedure calls ConnectODBC() in the module dbConn to get
1092 'a connection object.
1093 Private Sub cmdConnectODBC_Click()
1094   'define the error handler
1095   On Error GoTo cmdConnectODBC_Error
1096
1097   'connect to database
1098   Set con = ConnectODBC()
1099
1100   'generate a message of success
1101   sbrStatus.Panels(1).Text = "Connect to sample database succeeded!"
1102
1103   'config status of the buttons
1104   EnableButtons
1105
1106   'show instructions
1107   If wShowInstructions = vbYes Then
1108     ShowConnectionInstruction
1109   End If
1110
1111 cmdConnectODBC_Exit:
1112   Exit Sub
1113
1114 cmdConnectODBC_Error:
1115   'generate an error message
1116   sbrStatus.Panels(1).Text = "ERROR: " & Err.Description
1117
1118   'show instructions
1119   If wShowInstructions = vbYes Then
1120     MsgBox "Connect to sample database failed!" & vbCr & _
1121       Err.Description & vbCr & _
1122       "Please correct the problem and try again.", _
1123       vbOKOnly + vbCritical, "Instruction"
1124   End If
1125
1126   Resume cmdConnectODBC_Exit
1127 End Sub
1128
1129 'This procedure calls ConnectDataShape() in the module dbConn to
1130 'get a connection object.
1131 Private Sub cmdConnectDataShape_Click()
1132   'define the error handler
1133   On Error GoTo cmdConnectDataShape_Error
1134
1135   'connect to database
1136   Set con = ConnectDataShape()
1137   con.Attributes = adXactCommitRetaining + adXactAbortRetaining
1138
1139   'generate a message of success
1140   sbrStatus.Panels(1).Text = "Connect to sample database succeeded!"
1141
1142   'config status of the buttons
1143   EnableButtons
1144   cmdHierarchy.Enabled = True
1145   lblHierScript.ForeColor = vbButtonText
1146
1147   'show instructions
1148   If wShowInstructions = vbYes Then
1149     ShowConnectionInstruction
1150   End If
1151
1152 cmdConnectDataShape_Exit:
1153   Exit Sub
1154
1155 cmdConnectDataShape_Error:
1156   'generate an error message
1157   sbrStatus.Panels(1).Text = "ERROR: " & Err.Description
1158
1159   'show instructions
1160   If wShowInstructions = vbYes Then
1161     MsgBox "Connect to sample database failed!" & vbCr & _
1162       Err.Description & vbCr & _
1163       "Please correct the problem and try again.", _
1164       vbOKOnly + vbCritical, "Instruction"
1165   End If
1166
1167   Resume cmdConnectDataShape_Exit
1168 End Sub
1169
1170 'This procedure enables buttons after a connection is created.
1171 Private Sub EnableButtons()
1172   Dim tmpButton As CommandButton
1173   cmdConnectOLEDB.Enabled = False
1174   cmdConnectODBC.Enabled = False
1175   cmdConnectDataShape.Enabled = False
1176   cmdHierarchy.Enabled = False
1177   lblHierScript.ForeColor = vbGrayText
1178   cmdSample.Enabled = False
1179   cmdConnectInfo.Enabled = True
1180   cmdVersionInfo.Enabled = True
1181   cmdDisconnect.Enabled = True
1182   cmdRefresh.Enabled = True
1183   cmdSQLConnection.Enabled = True
1184   cmdSQLRecordset.Enabled = True
1185   cmdSQLCommand.Enabled = True
1186   For Each tmpButton In cmdSQLSamples
1187     tmpButton.Enabled = True
1188   Next
1189   cmdCommit.Enabled = False
1190   cmdRollback.Enabled = False
1191   chkAutoCommit.Enabled = True
1192   CheckAvailableStoredProcedures
1193   For Each tmpButton In cmdUDFs
1194     tmpButton.Enabled = True
1195   Next
1196 End Sub
1197
1198 'This procedure shows the instruction message after creating a connection.
1199 Private Sub ShowConnectionInstruction()
1200   MsgBox "Connect to sample database succeeded!" & vbCr & _
1201     "You may choose a Tab for specific functional demonstration," & vbCr & _
1202     "or press one of the info buttons for more information.", _
1203     vbOKOnly, "Instruction"
1204 End Sub
1205
1206 'This procedure calls Disconnect() in the module dbConn to close
1207 'a connection object.
1208 Private Sub cmdDisconnect_Click()
1209   'define the error handler
1210   On Error GoTo cmdDisconnect_Error
1211
1212   'clear displays and release data sources
1213   Set rst = Nothing
1214   Set DataGridSQL.DataSource = Nothing
1215   Set hflxRecords.DataSource = Nothing
1216   DataGridSQL.ClearFields
1217   hflxRecords.Clear
1218   picBlob.Visible = False
1219   txtClob.Text = ""
1220   txtEmpno.Text = ""
1221   txtLastname.Text = ""
1222   txtFirstname.Text = ""
1223   AdodcLob.Caption = ""
1224   chkAutoCommit.Value = 1
1225   DataGridSP.Visible = False
1226   txtSPResult.Text = ""
1227   txtUDF.Text = ""
1228   hflxGridUDF.Clear
1229
1230   'disconnect from database
1231   sbrStatus.Panels(1).Text = Disconnect(con)
1232
1233   'configure status of the buttons
1234   Dim tmpButton As CommandButton
1235   cmdConnectOLEDB.Enabled = True
1236   cmdConnectODBC.Enabled = True
1237   cmdConnectDataShape.Enabled = True
1238   cmdSample.Enabled = True
1239   cmdDisconnect.Enabled = False
1240   cmdHierarchy.Enabled = False
1241   lblHierScript.ForeColor = vbGrayText
1242   cmdConnectInfo.Enabled = False
1243   cmdVersionInfo.Enabled = False
1244   cmdSQLConnection.Enabled = False
1245   cmdSQLRecordset.Enabled = False
1246   cmdSQLCommand.Enabled = False
1247   For Each tmpButton In cmdSQLSamples
1248     tmpButton.Enabled = False
1249   Next
1250   cmdCommit.Enabled = False
1251   cmdRollback.Enabled = False
1252   chkAutoCommit.Enabled = False
1253   cmdRefresh.Enabled = False
1254   cmdBLOB.Enabled = False
1255   cmdCLOB.Enabled = False
1256   AdodcLob.Enabled = False
1257   cmdSPCall.Enabled = False
1258   CheckAvailableStoredProcedures
1259   For Each tmpButton In cmdUDFs
1260     tmpButton.Enabled = False
1261   Next
1262
1263   'show instructions
1264   If wShowInstructions = vbYes Then
1265     MsgBox "Sample Database is disconnected!" & vbCr & _
1266       "You may now choose one of the connections again.", _
1267       vbOKOnly, "Instruction"
1268   End If
1269
1270 cmdDisconnect_Exit:
1271   Set rst = Nothing
1272   Set con = Nothing
1273   Exit Sub
1274
1275 cmdDisconnect_Error:
1276   'generate an error message
1277   sbrStatus.Panels(1).Text = "ERROR: " & Err.Description
1278
1279   'show instructions
1280   If wShowInstructions = vbYes Then
1281     MsgBox "Disconnect from sample database failed!" & vbCr & _
1282       Err.Description & vbCr & _
1283       "Please correct the problem and try again.", _
1284       vbOKOnly + vbCritical, "Instruction"
1285   End If
1286
1287   Resume cmdDisconnect_Exit
1288 End Sub
1289
1290 'This procedure calls ConnectInfo in dbInfo to obtain information
1291 'and displays the connection information on a message box.
1292 Private Sub cmdConnectInfo_Click()
1293   sbrStatus.Panels(1).Text = ""
1294   MsgBox ConnectInfo(con), vbOKOnly, "Connection Information"
1295 End Sub
1296
1297 'This procedure calls VersionInfo in apInfo to obtain information
1298 'and displays the version information on a message box.
1299 Private Sub cmdVersionInfo_Click()
1300   sbrStatus.Panels(1).Text = ""
1301   MsgBox VersionInfo(con), vbOKOnly, "Versions Information"
1302 End Sub
1303
1304 'This procedure close the main screen and quit the program.
1305 Private Sub cmdExit_Click()
1306   'check if it is necessary to commit any changes
1307   chkAutoCommit.Value = 1
1308
1309   'release all the memory allocated
1310   Set hflxRecords.DataSource = Nothing
1311   Set DataGridSQL.DataSource = Nothing
1312   Set rst = Nothing
1313   Set con = Nothing
1314
1315   'exit
1316   Unload Me
1317 End Sub
1318
1319 'This procedure calls CreateSample in Util to re-create the
1320 'sample database.
1321 Private Sub cmdSample_Click()
1322   'define the error handler
1323   On Error GoTo cmdSample_Error
1324
1325   'create the sample database
1326   sbrStatus.Panels(1).Text = "Creating the sample database, please wait..."
1327   CreateSample
1328   sbrStatus.Panels(1).Text = "Create the sample database is done."
1329
1330   'show instructions
1331   If wShowInstructions = vbYes Then
1332     MsgBox "The sample database has been created!" & vbCr & _
1333       "You may now choose one of the connections.", _
1334       vbOKOnly, "Instruction"
1335   End If
1336
1337 cmdSample_Exit:
1338   Exit Sub
1339
1340 cmdSample_Error:
1341   'generate an error message
1342   sbrStatus.Panels(1).Text = "ERROR: " & Err.Description
1343
1344   'show instructions
1345   If wShowInstructions = vbYes Then
1346     MsgBox "Create sample database failed!" & vbCr & _
1347       Err.Description & vbCr & _
1348       "Please correct the problem and try again.", _
1349       vbOKOnly + vbCritical, "Instruction"
1350   End If
1351
1352   Resume cmdSample_Exit
1353 End Sub
1354
1355 'This procedure calls ExecuteSQLConnect in apExeSQL to execute a
1356 'SQL statement.
1357 Private Sub cmdSQLConnection_Click()
1358   'define the error handler
1359   On Error GoTo cmdSQLConnection_Error
1360
1361   'display results and/or message
1362   DataGridSQL.ClearFields
1363   Set rst = ExecuteSQLConnect(txtSQL, strMsgText, con)
1364   Set DataGridSQL.DataSource = rst
1365   sbrStatus.Panels(1).Text = strMsgText
1366
1367 cmdSQLConnection_Exit:
1368   Exit Sub
1369
1370 cmdSQLConnection_Error:
1371   'generate an error message and exit
1372   sbrStatus.Panels(1).Text = "ERROR: " & Err.Description
1373   Resume cmdSQLConnection_Exit
1374 End Sub
1375
1376 'This procedure calls ExecuteSQLCommand in apExeSQL to execute a
1377 'SQL statement.
1378 Private Sub cmdSQLCommand_Click()
1379   'define the error handler
1380   On Error GoTo cmdSQLCommand_Error
1381
1382   'display results and/or message
1383   DataGridSQL.ClearFields
1384   Set rst = ExecuteSQLCommand(txtSQL, strMsgText, con)
1385   Set DataGridSQL.DataSource = rst
1386   sbrStatus.Panels(1).Text = strMsgText
1387
1388 cmdSQLCommand_Exit:
1389   Exit Sub
1390
1391 cmdSQLCommand_Error:
1392   'generate an error message and exit
1393   sbrStatus.Panels(1).Text = "ERROR: " & Err.Description
1394   Resume cmdSQLCommand_Exit
1395 End Sub
1396
1397 'This procedure calls ExecuteSQLRecordset in apExeSQL to execute a
1398 'SQL statement.
1399 Private Sub cmdSQLRecordset_Click()
1400   'define the error handler
1401   On Error GoTo cmdSQLRecordset_Error
1402
1403   'display results and/or message
1404   DataGridSQL.ClearFields
1405   Set rst = ExecuteSQLRecordset(txtSQL, strMsgText, con)
1406   Set DataGridSQL.DataSource = rst
1407   DataGridSQL.SetFocus
1408   sbrStatus.Panels(1).Text = strMsgText
1409
1410 cmdSQLRecordset_Exit:
1411   Exit Sub
1412
1413 cmdSQLRecordset_Error:
1414   'generate an error message and exit
1415   sbrStatus.Panels(1).Text = "ERROR: " & Err.Description
1416   Resume cmdSQLRecordset_Exit
1417 End Sub
1418
1419 'This procedure displays instructions for exiting recursive errors while
1420 'editing on the DataGird
1421 Private Sub DataGridSQL_Error(ByVal DataError As Integer, Response As Integer)
1422   If wShowInstructions = vbYes Then
1423     MsgBox _
1424       "If errors keep happening," & vbCr & _
1425       "You may press [Disconnect] to clear errors.", _
1426       vbOKOnly, "Instruction"
1427   End If
1428   sbrStatus.Panels(1).Text = "Press [Disconnect] to clear continuous errors."
1429 End Sub
1430
1431 'This procedure generates a sample SQL statement
1432 Private Sub cmdSQLSamples_Click(Index As Integer)
1433   Select Case Index
1434     Case 0
1435       txtSQL.Text = "SELECT * FROM employee"
1436     Case 1
1437       txtSQL.Text = "SELECT firstnme, job, hiredate" & vbCrLf & _
1438                     "FROM employee" & vbCrLf & _
1439                     "WHERE workdept = 'D11'" & vbCrLf & _
1440                     "ORDER BY hiredate"
1441     Case 2
1442       txtSQL.Text = "SELECT firstnme, job, salary + comm AS pay" & vbCrLf & _
1443                     "FROM employee" & vbCrLf & _
1444                     "WHERE (salary + comm) < 25000" & vbCrLf & _
1445                     "ORDER BY pay DESC"
1446     Case 3
1447       txtSQL.Text = "SELECT workdept," & vbCrLf & _
1448                     "       MAX(salary) AS maximum," & vbCrLf & _
1449                     "       MIN(salary) As minimum" & vbCrLf & _
1450                     "FROM employee GROUP BY workdept ORDER BY workdept"
1451     Case Else
1452   End Select
1453 End Sub
1454
1455 'This procedure clears the results when choosing a predefined SQL
1456 'statement sample
1457 Private Sub cmdSQLSamples_GotFocus(Index As Integer)
1458   Set DataGridSQL.DataSource = Nothing
1459   sbrStatus.Panels(1).Text = ""
1460 End Sub
1461
1462 'This procedure toggles the autocommit mode on/off by calling
1463 'procedures in the module dbCommit.
1464 Private Sub chkAutoCommit_Click()
1465   'define the error handler
1466   On Error GoTo chkAutoCommit_Error
1467
1468   If chkAutoCommit.Value = 0 Then
1469     'turn the autocommit mode OFF
1470     AutoCommitOff con
1471     cmdCommit.Enabled = True
1472     cmdRollback.Enabled = True
1473     sbrStatus.Panels(1).Text = "AutoCommit mode is OFF."
1474   Else
1475     'ask if the user wants to commit all the previous changes
1476     'before turning the autocommit mode ON
1477     strMsgText = "Commit all previous changes (if any)?"
1478     If MsgBox(strMsgText, vbYesNo, "Turn Autocommit ON") = vbYes Then
1479       Commit con
1480     Else
1481       Rollback con
1482     End If
1483     cmdCommit.Enabled = False
1484     cmdRollback.Enabled = False
1485     sbrStatus.Panels(1).Text = "AutoCommit mode is ON."
1486   End If
1487
1488 chkAutoCommit_Exit:
1489   RefreshDataGridSQL
1490   Exit Sub
1491
1492 chkAutoCommit_Error:
1493   'generate an error message and exit
1494   sbrStatus.Panels(1).Text = "ERROR: " & Err.Description
1495   Resume chkAutoCommit_Exit
1496 End Sub
1497
1498 'This procedure commits any previous changes by calling
1499 'procedures in the module dbCommit.
1500 Private Sub cmdCommit_Click()
1501   'define the error handler
1502   On Error GoTo cmdCommit_Error
1503
1504   'commit the changes and start a new transaction
1505   If chkAutoCommit.Value = 0 Then
1506     Commit con
1507     AutoCommitOff con
1508   End If
1509   sbrStatus.Panels(1).Text = "Commit transactions succeeded."
1510
1511 cmdCommit_Exit:
1512   RefreshDataGridSQL
1513   Exit Sub
1514
1515 cmdCommit_Error:
1516   'generate an error message and exit
1517   sbrStatus.Panels(1).Text = "ERROR: " & Err.Description
1518   Resume cmdCommit_Exit
1519 End Sub
1520
1521 'This procedure rollbacks any previous changes by calling
1522 'procedures in the module dbCommit.
1523 Private Sub cmdRollback_Click()
1524   'define the error handler
1525   On Error GoTo cmdRollback_Error
1526
1527   'rollback the changes and start a new transaction
1528   If chkAutoCommit.Value = 0 Then
1529     Rollback con
1530     AutoCommitOff con
1531   End If
1532   sbrStatus.Panels(1).Text = "Rollback transactions succeeded."
1533
1534 cmdRollback_Exit:
1535   RefreshDataGridSQL
1536   Exit Sub
1537
1538 cmdRollback_Error:
1539   'generate an error message and exit
1540   sbrStatus.Panels(1).Text = "ERROR: " & Err.Description
1541   Resume cmdRollback_Exit
1542 End Sub
1543
1544 'This is a helper procedure which refreshes the data displayed
1545 'on the DataGridSQL.
1546 Private Sub RefreshDataGridSQL()
1547   If Not DataGridSQL.DataSource Is Nothing Then
1548     Set DataGridSQL.DataSource = Nothing
1549     rst.Requery
1550     Set DataGridSQL.DataSource = rst
1551   End If
1552 End Sub
1553
1554 'This procedure calls ExecuteHSQL() in the module dtHier to
1555 'obtain a hierarchical recordset object.
1556 Private Sub cmdHierarchy_Click()
1557   'display in Grids
1558   hflxRecords.Clear
1559   Set hflxRecords.DataSource = ExecuteHSQL(strMsgText, con)
1560
1561   'display text information message
1562   sbrStatus.Panels(1).Text = strMsgText
1563 End Sub
1564
1565 'This procedure calls GetLOB in dtLob to get an ADO Control for LOBs.
1566 Private Sub cmdRefresh_Click()
1567   'define the error handler
1568   On Error GoTo cmdRefresh_Error
1569
1570   'get an ADO Control for the LOBs
1571   GetLOB con, AdodcLob
1572   AdodcLob.Refresh
1573
1574   'set display objects
1575   txtClob.DataField = "RESUME"
1576   Set txtClob.DataSource = AdodcLob
1577   picBlob.DataField = "PICTURE"
1578   Set picBlob.DataSource = AdodcLob
1579   txtEmpno.DataField = "EMPNO"
1580   Set txtEmpno.DataSource = AdodcLob
1581   txtLastname.DataField = "LASTNAME"
1582   Set txtLastname.DataSource = AdodcLob
1583   txtFirstname.DataField = "FIRSTNME"
1584   Set txtFirstname.DataSource = AdodcLob
1585
1586   'enable buttons
1587   cmdBLOB.Enabled = True
1588   cmdCLOB.Enabled = True
1589   AdodcLob.Enabled = True
1590
1591 cmdRefresh_Exit:
1592   Exit Sub
1593
1594 cmdRefresh_Error:
1595   'generate an error message and exit
1596   sbrStatus.Panels(1).Text = "ERROR: " & Err.Description
1597   AdodcLob.Enabled = False
1598   cmdBLOB.Enabled = False
1599   cmdCLOB.Enabled = False
1600   Resume cmdRefresh_Exit
1601 End Sub
1602
1603 'This procedure enables the display of employee pictures.
1604 Private Sub cmdBLOB_Click()
1605   picBlob.Visible = True
1606 End Sub
1607
1608 'This procedure enables the display of employee resumes.
1609 Private Sub cmdCLOB_Click()
1610   picBlob.Visible = False
1611 End Sub
1612
1613 'This is a helper procedure for Adodc caption display.
1614 Private Sub AdodcLob_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
1615   AdodcLob.Caption = AdodcLob.Recordset.AbsolutePosition
1616 End Sub
1617
1618 'This procedure checks and enables buttons for available stored
1619 'procedures
1620 Private Sub CheckAvailableStoredProcedures()
1621   Dim optStoredProcedure As Variant
1622   Dim proToken As ADOX.Procedure
1623   Dim pros As ADOX.Procedures
1624
1625   'get information for all available procedures
1626   Set pros = GetProcedures(con)
1627
1628   'reset all selections
1629   For Each optStoredProcedure In optStoredProcedures
1630     optStoredProcedure.Enabled = False
1631     optStoredProcedure.Value = False
1632     cmdShowSecondRS.Visible = False
1633     cmdSPCall.Enabled = False
1634   Next
1635
1636   'enable buttons for available stored procedures
1637   For Each proToken In pros
1638     Select Case proToken.Name
1639       Case "OUT_LANGUAGE"
1640         optStoredProcedures(0).Enabled = True
1641       Case "IN_PARAMS"
1642         optStoredProcedures(1).Enabled = True
1643       Case "OUT_PARAM"
1644         optStoredProcedures(2).Enabled = True
1645       Case "INOUT_PARAM"
1646         optStoredProcedures(3).Enabled = True
1647       Case "ALL_DATA_TYPES"
1648         optStoredProcedures(4).Enabled = True
1649       Case "DECIMAL_TYPE"
1650         optStoredProcedures(5).Enabled = True
1651       Case "ONE_RESULT_SET"
1652         optStoredProcedures(6).Enabled = True
1653       Case "TWO_RESULT_SETS"
1654         optStoredProcedures(7).Enabled = True
1655       Case "CLOB_EXTRACT"
1656         optStoredProcedures(8).Enabled = True
1657       Case "DB2SQL_EXAMPLE"
1658         optStoredProcedures(9).Enabled = True
1659       Case "DBINFO_EXAMPLE"
1660         optStoredProcedures(10).Enabled = True
1661       Case "MAIN_EXAMPLE"
1662         optStoredProcedures(11).Enabled = True
1663       Case Else
1664     End Select
1665   Next proToken
1666
1667   'enable Call button if any stored procedure available
1668   For Each optStoredProcedure In optStoredProcedures
1669     If optStoredProcedure.Enabled Then
1670       cmdSPCall.Enabled = True
1671       Exit For
1672     End If
1673   Next
1674
1675   'release objects
1676   Set pros = Nothing
1677   Set proToken = Nothing
1678 End Sub
1679
1680 'This procedure clears the screen in switching the stored procedures
1681 Private Sub optStoredProcedures_Click(Index As Integer)
1682   sbrStatus.Panels(1).Text = ""
1683   txtSPResult.Text = ""
1684   If DataGridSP.Visible Then
1685     DataGridSP.Visible = False
1686     Set DataGridSP.DataSource = Nothing
1687     DataGridSP.ClearFields
1688     cmdShowSecondRS.Visible = False
1689   End If
1690   cmdSPCall.SetFocus
1691 End Sub
1692
1693 'This procedure calls various subroutines and subroutines in the
1694 'module spCall to execute corresponding stored procedures and
1695 'displays the results onto the screen.
1696 Private Sub cmdSPCall_Click()
1697   Dim optStoredProcedure As Variant
1698   Dim strParam As String
1699
1700   'define the error handler
1701   On Error GoTo cmdSPCall_Error
1702
1703   'check for the selected stored procedure by iteration
1704   For Each optStoredProcedure In optStoredProcedures
1705     If optStoredProcedure.Value = True Then
1706       Exit For
1707     End If
1708   Next
1709
1710   'clear the screen for result display
1711   If IsObject(optStoredProcedure) Then
1712     sbrStatus.Panels(1).Text = ""
1713     txtSPResult.Text = ""
1714     DataGridSP.Visible = False
1715   Else
1716     sbrStatus.Panels(1).Text = "ERROR: No stored procedure selected."
1717     Exit Sub
1718   End If
1719
1720   'call the corresponding selected stored procedure
1721   Select Case optStoredProcedure.Caption
1722     Case "OUT_LANGUAGE"
1723       txtSPResult.Text = _
1724         "Stored procedures are implemented in LANGUAGE " & _
1725         CallSP_OUT_LANGUAGE(con)
1726     Case "IN_PARAMS"
1727       con.BeginTrans
1728       CallInParameters
1729       con.RollbackTrans
1730     Case "OUT_PARAM"
1731       txtSPResult.Text = _
1732       "Stored Procedure OUT_PARAM calculated median was " & _
1733       CallSP_OUT_PARAM(con)
1734     Case "INOUT_PARAM"
1735       CallInOutParameter
1736     Case "ALL_DATA_TYPES"
1737       CallAllDataTypes
1738     Case "DECIMAL_TYPE"
1739       txtSPResult.Text = _
1740       "Stored Procedure DECIMAL_TYPE returned value was " & _
1741       CallSP_DECIMAL_TYPE(con)
1742     Case "CLOB_EXTRACT"
1743       txtSPResult.Text = _
1744         "Resume section returned from calling CLOB_EXTRACT:" & _
1745         vbCrLf & vbCrLf & CallSP_CLOB_EXTRACT(con)
1746     Case "ONE_RESULT_SET"
1747       Set DataGridSP.DataSource = CallSP_ONE_RESULT_SET(con)
1748       DataGridSP.Visible = True
1749     Case "TWO_RESULT_SETS"
1750       Set rst = CallSP_TWO_RESULT_SETS(con)
1751       Set DataGridSP.DataSource = rst
1752       DataGridSP.Visible = True
1753       cmdShowSecondRS.Visible = True
1754       cmdShowSecondRS.Enabled = True
1755       cmdShowSecondRS.SetFocus
1756     Case "DB2SQL_EXAMPLE"
1757       strParam = "CLERK"
1758       txtSPResult.Text = _
1759         "Stored Procedure DB2SQL_EXAMPLE returned value was " & _
1760         CallSP_DB2SQL_EXAMPLE(con, strParam) & _
1761         vbCrLf & "for the job of " & strParam & "."
1762     Case "DBINFO_EXAMPLE"
1763       CallDbInfo
1764     Case "MAIN_EXAMPLE"
1765       strParam = "DESIGNER"
1766       txtSPResult.Text = _
1767         "Stored Procedure MAIN_EXAMPLE returned value was " & _
1768         CallSP_DB2SQL_EXAMPLE(con, strParam) & _
1769         vbCrLf & "for the job of " & strParam & "."
1770   End Select
1771
1772   'generate a message of success
1773   sbrStatus.Panels(1).Text = _
1774     "Stored Procedure " & optStoredProcedure.Caption & _
1775     " was called successfully."
1776
1777 cmdSPCall_Exit:
1778   Exit Sub
1779
1780 cmdSPCall_Error:
1781   'generate an error message and exit
1782   sbrStatus.Panels(1).Text = "ERROR: " & Err.Description
1783   Resume cmdSPCall_Exit
1784 End Sub
1785
1786 'This procedure shows the second result set returned by calling
1787 'the stored procedurd TWO_RESULT_SETS
1788 Private Sub cmdShowSecondRS_Click()
1789   'show next recordset
1790   Set DataGridSP.DataSource = rst.NextRecordset
1791   cmdShowSecondRS.Enabled = False
1792   cmdSPCall.SetFocus
1793 End Sub
1794
1795 'This procedure calls CallSP_IN_PARAMS in the module spCall and
1796 'compares information obtained from the same table before and
1797 'after calling the stored procedure
1798 Private Sub CallInParameters()
1799   'initialize variables
1800   Dim strSQL As String
1801   strSQL = "SELECT SUM(salary) FROM employee WHERE workdept = 'E11'"
1802
1803   'get information before calling the stored procedure
1804   Set rst = ExecuteSQLCommand(strSQL, strMsgText, con)
1805   txtSPResult.Text = "Before calling IN_PARAMS, " & vbCrLf & _
1806                      "Sum of salaries for dept. E11 = " & _
1807                      rst.Fields(0).Value & vbCrLf & vbCrLf
1808
1809   'call the stored procedure
1810   CallSP_IN_PARAMS con
1811   txtSPResult.Text = txtSPResult.Text & _
1812     "SAMPLE Stored Procedure IN_PARAMS was called." & vbCrLf & vbCrLf
1813
1814   'get information after calling the stored procedure
1815   Set rst = ExecuteSQLCommand(strSQL, strMsgText, con)
1816   txtSPResult.Text = txtSPResult.Text & _
1817                      "After calling IN_PARAMS, " & vbCrLf & _
1818                      "Sum of salaries for dept. E11 = " & _
1819                      rst.Fields(0).Value & vbCrLf
1820   Set rst = Nothing
1821   strMsgText = ""
1822 End Sub
1823
1824 'This procedure calls CallSP_INOUT_PARAM in the module spCall by
1825 'using a parameter got form calling CallSP_OUT_PARAM and outputs
1826 'a result message
1827 Private Sub CallInOutParameter()
1828   'define variable
1829   Dim dblMedian As Double
1830
1831   'get a parameter from OUT_PARAM
1832   txtSPResult.Text = "Call OUT_PARAM to get the median."
1833   dblMedian = CallSP_OUT_PARAM(con)
1834   txtSPResult.Text = txtSPResult.Text & vbCrLf & _
1835     "Stored procedure returned successfully." & vbCrLf
1836
1837   'call the stored procedure with the parameter
1838   txtSPResult.Text = txtSPResult.Text & vbCrLf & _
1839     "Call INOUT_PARAM with the result just got."
1840   txtSPResult.Text = txtSPResult.Text & vbCrLf & _
1841     "New median returned from INOUT_PARAM = " & _
1842     CallSP_INOUT_PARAM(con, dblMedian)
1843 End Sub
1844
1845 'This procedure calls CallSP_ALL_DATA_TYPES in the module spCall
1846 'and displays the results
1847 Private Sub CallAllDataTypes()
1848   'initialize object and settings
1849   Dim pms As ADODB.Parameters
1850   With txtSPResult
1851
1852   'call the stored procedure
1853   .Text = "Call ALL_DATA_TYPES to get all types of data."
1854   Set pms = CallSP_ALL_DATA_TYPES(con)
1855   .Text = .Text & vbCrLf & "Stored procedure returned successfully."
1856
1857   'output the results
1858     .Text = .Text & vbCrLf & _
1859       vbCrLf & "Value of SMALLINT = " & pms("SMALL").Value & _
1860       vbCrLf & "Value of INTEGER = " & pms("INTIN").Value & _
1861       vbCrLf & "Value of BIGINT = " & pms("BIGIN").Value & _
1862       vbCrLf & "Value of REAL = " & pms("REALIN").Value & _
1863       vbCrLf & "Value of DOUBLE = " & pms("DOUBLEIN").Value & _
1864       vbCrLf & "Value of CHAR(1) = " & pms("CHAROUT").Value & _
1865       vbCrLf & "Value of CHAR(15) = " & pms("CHARSOUT").Value & _
1866       vbCrLf & "Value of VARCHAR(12) = " & pms("VARCHAROUT").Value & _
1867       vbCrLf & "Value of DATE = " & pms("DATEOUT").Value & _
1868       vbCrLf & "Value of TIME = " & TimeValue(pms("TIMEOUT").Value)
1869
1870   'reset and release the object
1871   End With
1872   Set pms = Nothing
1873 End Sub
1874
1875 'This procedure calls CallSP_DBINFO_EXAMPLE in the module spCall
1876 'with a JOB as an IN parameter and displays the results obtained
1877 'from the stored procedure containing information of the table and
1878 'the database.
1879 Private Sub CallDbInfo()
1880   'define objects and variables
1881   Dim pms As ADODB.Parameters
1882   Dim strJob As String
1883
1884   'call the stored procedure
1885   txtSPResult.Text = "CALL stored procedure named DBINFO_EXAMPLE."
1886   strJob = "MANAGER"
1887   Set pms = CallSP_DBINFO_EXAMPLE(con, strJob)
1888
1889   'display the results
1890   txtSPResult.Text = txtSPResult.Text & vbCrLf & _
1891     "Stored procedure returned successfully with SQLCODE = " & _
1892     pms("ERRORCODE").Value
1893   txtSPResult.Text = txtSPResult.Text & vbCrLf & _
1894     "Average salary for job " & strJob & " = " & pms("SALARY").Value
1895   txtSPResult.Text = txtSPResult.Text & vbCrLf & _
1896     "Database name from OUT parameter = " & Trim$(pms("DBNAME").Value)
1897   txtSPResult.Text = txtSPResult.Text & vbCrLf & _
1898     "Database version from OUT parameter = " & pms("DBVERSION").Value
1899   Set pms = Nothing
1900 End Sub
1901
1902 'This procedure calls various subroutines in the module udUse to
1903 'execute corresponding user defined functions and displays the
1904 'results onto the screen.
1905 Private Sub cmdUDFs_Click(Index As Integer)
1906   'define the error handler
1907   On Error GoTo cmdUDFs_Error
1908
1909   'clear the screen for result display
1910   sbrStatus.Panels(1).Text = ""
1911   txtUDF.Text = ""
1912   hflxGridUDF.ClearStructure
1913
1914   'call the specific UDF procedure
1915   Select Case cmdUDFs(Index).Caption
1916     Case "ScalarUDF"
1917       hflxGridUDF.ColWidth(3) = 2000
1918       Set hflxGridUDF.DataSource = CallUDFScalarUDF(strMsgText, con)
1919     Case "ClobScalarUDF"
1920       Set hflxGridUDF.DataSource = CallUDFClobScalarUDF(strMsgText, con)
1921     Case "ScratchpadScUDF"
1922       Set hflxGridUDF.DataSource = CallUDFScratchpadScUDF(strMsgText, con)
1923     Case "ScUDFReturningErr"
1924       Set hflxGridUDF.DataSource = CallUDFScUDFReturningErr(strMsgText, con)
1925       txtUDF.Text = strMsgText
1926       Err.Raise vbObjectError, , "See display area for detail."
1927     Case "SourcedColumnUDF"
1928       Set hflxGridUDF.DataSource = CallUDFSourcedColUDF(strMsgText, con)
1929     Case "TableUDF"
1930       Set hflxGridUDF.DataSource = CallUDFTableUDF(strMsgText, con)
1931     Case Else
1932   End Select
1933   txtUDF.Text = strMsgText
1934
1935   'generate a message of success
1936   sbrStatus.Panels(1).Text = _
1937     "Calling UDF " & cmdUDFs(Index).Caption & " was done."
1938
1939 cmdUDFs_Exit:
1940   Exit Sub
1941
1942 cmdUDFs_Error:
1943   'generate an error message and exit
1944   sbrStatus.Panels(1).Text = "ERROR: " & Err.Description
1945   Resume cmdUDFs_Exit
1946 End Sub
1947
1948 'This procedure defines initial parameters.
1949 Private Sub Form_Load()
1950   tabMain.Tab = 0
1951   wShowInstructions = vbYes
1952
1953   'ask the user for displaying the instructions or not
1954   wShowInstructions = MsgBox("Would you like to have instructions?", _
1955     vbYesNo, "Welcome to the DB2 Visual Basic samples")
1956 End Sub
1957
1958 'This procedure shows instructions at the begining of the program.
1959 Private Sub Form_Activate()
1960   If wShowInstructions = vbYes Then
1961     MsgBox _
1962       "Thank you for using instructions in this demonstration program!" & vbCr & vbCr & _
1963       "- Status messages are shown at the bottom of the working window;" & vbCr & _
1964       "- Buttons unavailable are being grayed out;" & vbCr & _
1965       "- SAMPLE database must be created if it doesn't exist;" & vbCr & _
1966       "- [Exit] button can be pressed at anytime to quit the program." & vbCr & vbCr & _
1967       "You may now choose one of the connections to begin the demonstraton.", _
1968       vbOKOnly, "Instruction"
1969   End If
1970 End Sub
1971
1972 'This procedure maintains screen integrity for the Main Tabs.
1973 Private Sub tabMain_Click(intPreviousTab As Integer)
1974   'clear the the Tab screen before switching
1975   Select Case tabMain.TabCaption(intPreviousTab)
1976     Case "Execute SQL"
1977       chkAutoCommit.Value = 1
1978       Set rst = Nothing
1979       Set DataGridSQL.DataSource = Nothing
1980       DataGridSQL.ClearFields
1981     Case "Hierarchical Data"
1982       Set hflxRecords.DataSource = Nothing
1983       hflxRecords.Clear
1984     Case "LOBs"
1985       txtClob.Text = ""
1986       txtEmpno.Text = ""
1987       txtLastname.Text = ""
1988       txtFirstname.Text = ""
1989       AdodcLob.Caption = ""
1990       AdodcLob.Enabled = False
1991       cmdBLOB.Enabled = False
1992       cmdCLOB.Enabled = False
1993       picBlob.Visible = False
1994     Case "Store Procedures"
1995       Set rst = Nothing
1996       Set DataGridSP.DataSource = Nothing
1997       DataGridSP.Visible = False
1998       DataGridSP.ClearFields
1999       cmdShowSecondRS.Visible = False
2000       txtSPResult.Text = ""
2001     Case "UDFs"
2002       txtUDF.Text = ""
2003       hflxGridUDF.Clear
2004     Case Else
2005   End Select
2006   sbrStatus.Panels(1).Text = ""
2007 End Sub
2008
2009 'This procedure shows instructions for the Main Tabs.
2010 Private Sub tabMain_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
2011   'show instructions
2012   If wShowInstructions = vbYes Then
2013     If con Is Nothing Then  'no connection established
2014       MsgBox _
2015         "All funcitonal features require a valid connection.", _
2016         vbOKOnly + vbExclamation, "Instruction"
2017     Else
2018       Select Case tabMain.Caption
2019         Case "Execute SQL"
2020           MsgBox _
2021             "Please type a SQL statement into the text box, or," & vbCr & _
2022             "choose a preset one from the small Sample buttons, then," & vbCr & _
2023             "press one of the [Execute SQL] buttons to get the results." & vbCr & _
2024             "AutoCommit checkbox can be used to change the autocommit mode." & vbCr & vbCr & _
2025             "For more about the connection, command, and recordset objects," & vbCr & _
2026             "see the source code in the apExeSQL.bas module." & vbCr & vbCr & _
2027             "Note:" & vbCr & _
2028             "- The sample SQL statements can be edited." & vbCr & _
2029             "- Recordset results may be editable depending on the SQL statement issued.", _
2030             vbOKOnly, "Instruction"
2031         Case "Hierarchical Data"
2032           If InStr(con.Provider, "MSDataShape") Then
2033             MsgBox _
2034               "Please press the [Display] button to display hierarchical result.", _
2035               vbOKOnly, "Instruction"
2036           Else
2037             MsgBox _
2038               "Hierarchical Data is only available for a" & vbCr & _
2039               "valid connection with DataShape.", _
2040               vbOKOnly + vbExclamation, "Instruction"
2041           End If
2042         Case "LOBs"
2043           MsgBox _
2044             "After pressing the [Refresh Data] button;" & vbCr & _
2045             "Use arrow keys to manipulate results;" & vbCr & _
2046             "Press [Show Resume] button to display CLOBs;" & vbCr & _
2047             "Press [Show Picture] button to display BLOBs.", _
2048             vbOKOnly, "Instruction"
2049         Case "Store Procedures"
2050           MsgBox _
2051             "Choose an available stored procedure, then," & vbCr & _
2052             "press the [Call] button to get the results." & vbCr & vbCr & _
2053             "Note: To make them available, you first have to create and catalog" & vbCr & _
2054             "the stored procedures in the spserver stored procedure library.", _
2055             vbOKOnly, "Instruction"
2056         Case "UDFs"
2057           MsgBox _
2058             "Please choose one of the UDF buttons to show the usage.", _
2059             vbOKOnly, "Instruction"
2060         Case Else
2061       End Select
2062     End If
2063   End If
2064 End Sub
2065
2066
2067
2068