Keskustelu: Ohjelmointikysymykset: VB6 automatisointi tälle koodille? (VB.NET)

Dim basePath As String
Dim chapterIndex As Integer
Dim chaptersCount As Integer
Dim chaptersFound As Boolean

Private Sub Form_Load()

   Dim files As String
   Dim filter As String

   basePath = App.Path & "\Chapters\"
   filter = "*.rtf"

   Dim file As String
   file = Dir(basePath & filter)

   If file <> "" Then

      Do Until file = ""
         files = files + file & "|"
         file = Dir()
      Loop

      files = Left(files, Len(files) - 1)
      Dim getCount() As String
      getCount = Split(files, "|")
      chaptersCount = UBound(getCount) + 1
      Erase getCount
      chapterIndex = 1
      Label1.Caption = "Chapter to load: " _
      & CStr(chapterIndex)
      chaptersFound = True

   End If

End Sub

Private Sub BtnLoad_Click()

   If Not chaptersFound Then
      MsgBox basePath & _
      " doesn't contain any chapter files"
      Exit Sub
   End If

   If Dir(basePath & "Chapter" _
   & CStr(chapterIndex) & ".rtf") = "" Then
      MsgBox "Loading failed..." & vbCrLf & _
      "File: " & basePath & "Chapter" _
      & CStr(chapterIndex) & ".rtf" _
      & " doesn't exists"
      Exit Sub
   End If

   RichTextBox1.LoadFile basePath & "Chapter" _
   & CStr(chapterIndex) & ".rtf"

   If chapterIndex < chaptersCount Then
      'BtnNext.Value = True
   End If

End Sub

Private Sub BtnPrev_Click()

   If chapterIndex > 1 Then
      chapterIndex = chapterIndex - 1
      Label1.Caption = "Chapter to load: " _
      & CStr(chapterIndex)
   End If

End Sub

Private Sub BtnNext_Click()

   If Not chaptersFound Then Exit Sub

   If chapterIndex < chaptersCount Then
      chapterIndex = chapterIndex + 1
      Label1.Caption = "Chapter to load: " _
      & CStr(chapterIndex)
   End If

End Sub

'...

   RichTextBox1.LoadFile basePath & "Chapter" _
   & CStr(chapterIndex) & ".rtf"

   Select Case chapterIndex
      Case 1: 'chapterIndex = JokuArvo
      '...
      Case 285:
        'If JonkunAsetuksenArvo = JokuArvo _
        'And JonkunToisenAsetuksenArvo = jokuArvo  Then 'Esim!
           chapterIndex = 40 'esim!
        'Elseif Not JonkunAsetuksenArvo = JonkuTiettyArvo Then
           'chapterIndex = 16200 'esim!
        'Else: chapterIndex = JokuMuuArvo 'Esim!
        'End If

      ' jne...
   End Select

   Label1.Caption = "Next chapter to load: " _
   & CStr(chapterIndex)

   '...

'Projektiin referenssi:
'Microsoft ActiveX Data Objects 2.x Library (x=minor version number)
'(msado2x.tlb)(x=minor version number)

Dim Conn As ADODB.Connection
Dim Rs As ADODB.Recordset
Dim ChaptersTable() As Variant

Private Sub UserForm_Activate()

   Dim dbBasePath As String
   Dim dbFileName As String
   Dim dbFullPath As String
   Dim connStr As String
   Dim pwd As String

   dbBasePath = App.Path & "\Databses"
   dbFileName = "MyDatabase.mdb"  'tai MyDatabase.accdb

   dbFullPath = Replace(dbBasePath _
   & "\" & dbFileName, "\\", "\")

   pwd = "" ' or not

   connStr = "Microsoft.ACE.OLEDB.12.0;Data Source=" & _
   dbFullPath & ";Jet OLEDB:Database Password=" & pwd & ";"

   Set Conn = New ADODB.Connection
   Set Rs = New ADODB.Recordset

   Conn.Provider = connStr
   Conn.Open
   Set Rs = New ADODB.Recordset

   Rs.Open "MyTable", Conn, _
   adOpenDynamic, adLockOptimistic, adCmdTable

   Rs.MoveFirst

   ReDim ChaptersTable(1 To Rs.Fields.Count - 1, 1 To 1)

   Dim i As Integer

   Do While Not Rs.EOF

      i = i + 1
      ReDim Preserve ChaptersTable( _
      1 To Rs.Fields.Count - 1, 1 To i)
      For j = 1 To Rs.Fields.Count - 1
         ChaptersTable(j, i) = Rs.Fields(j)
      Next j
      Rs.MoveNext

   Loop

   Rs.Close: Set Rs = Nothing
   Conn.Close: Set Conn = Nothing

   'Test:
   'For i = 1 To UBound(ChaptersTable, 2)
      'For j = 1 To UBound(ChaptersTable, 1)
         'MsgBox ChaptersTable(j, i)
      'Next j
   'Next i

End Sub

Private Sub Form_QueryUnload( _
Cancel As Integer, UnloadMode As Integer)
   Erase ChaptersTable
End Sub[/koodivb

'Referenssit:
'Microsoft ActiveX Data Objects 2.8 Library (msado15.dll)
'Microsoft ADO Ext. 2.8 for DLL as Security (msADOX.dll)
Dim Conn As ADODB.Connection
Dim Rs As ADODB.Recordset

Private Sub Form_Load()

   Dim dbBasePath As String
   Dim dbFileName As String
   Dim dbFullPath As String
   Dim connStr As String
   Dim pwd As String

   'dbBasePath = App.Path & "\Databses"

   If Dir(dbBasePath,vbDirectory) = "" Then
      MkDir(dbBasePath)
   End If

   dbFileName = "TestBase.accdb" ' tai "TestBase.mdb" '
   dbFullPath = Replace(dbBasePath & "\" & dbFileName, "\\", "\")
   pwd = "" ' tai sitten ei

   connStr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
   dbFullPath & ";Jet OLEDB:Database Password=" & pwd & ";"

   If Dir(dbFullPath) = "" Then

      Dim cat As adox.Catalog
      Set cat = New adox.Catalog

      cat.Create connStr

      Dim cmd As ADODB.Command
      Set Conn = New ADODB.Connection
      Conn.ConnectionString = connStr
      Conn.Open

      Set cmd = New ADODB.Command

      cmd.ActiveConnection = Conn
      cmd.CommandText = "Create Table TestTable (" & _
      "[TestField] Text(50))"
      cmd.Execute: Set cmd = Nothing

      Set Rs = New ADODB.Recordset

      Rs.Open "TestTable", Conn, _
      adOpenDynamic, adLockOptimistic, adCmdTable
      Rs.AddNew "TestField", "Testataan"
      Rs.MoveLast

      MsgBox (Rs.Fields("TestField").Value)

      Rs.Close: Set Rs = Nothing
      Conn.Close: Set Conn = Nothing

   End If

End Sub

Dim cmdBtnLeft As Integer, cmdBtnTop As Integer
Private Const cmdBtnWidth = 75, cmdBtnHeight = 23
Private btnIndex As Integer, ctlTagCaption As String
Private WithEvents cmdChapters As CommandButton

Sub Private Sub Form_Initialize()

   cmdBtnLeft = Me.Width - (cmdBtnWidth * 1.15)
   cmdBtnTop = 10: btnIndex = 1

End If

Private Sub Form_Load()

   Create_Ctl

End Sub

Sub Create_Ctl()

   remove_Ctl

   Set cmdChapters = _
   Me.Controls.Add("VB.CommandButton", cmdButton")

   With cmdChapters
      .Visible = True
      .Caption = "Next Chapter " & CStr(btnIndex)
      .left = cmdBtnLeft
      .Top = cmdBtnTop
      .Width = cmdBtnWidth
      .Height = cmdBtnHeight
      ctlTagCaption = .Caption
   End With

End Sub


Private Sub Remove_Ctl()

   Dim ctl As Control

   For Each ctl In Me.Controls

     On Error Resume Next

     If InStr(ctl.Caption, ctlTagCaption) > 0 Then
        Me.Controls.Remove(ctl.Name)
     End If

     If Err <> 0 Then
        Err.Clear
        On Error Goto 0
     End If

   Next

End Sub

Private Sub cmdChapters_Click()

   Select Case btnIndex
      Case 1
         MsgBox "jee" 'esim...
         btnIndex = 10
      Case 10
         MsgBox "yeah"
         btnIndex = 1
      ' jne...
   End Select

   Create_Ctl

End Sub

Private Sub Form_QueryUnload( _
Cancel As Integer, UnloadMode As Integer)

   Remove_Ctl

End Sub

Option Explicit
Private cn As New ADODB.Connection
Private Chapter As Long

Private Sub Button_Click(Index As Integer)
    'Haetaan actionin toiminta tietokannasta
    Dim rs As New ADODB.Recordset
    rs.Open "SELECT [ActionMessage], [ActionTargetChapter] FROM ChapterActions WHERE [Chapter]=" _
        & Chapter & " AND [ActionId]=" & Index, cn, adOpenStatic, adLockReadOnly
    ChapterGUI rs!ActionTargetChapter, rs!ActionMessage
    rs.Close
End Sub

Private Sub Form_Load()
    'Avataan tietokanta
    cn.Open "DRIVER={Microsoft Access Driver (*.mdb)};DBQ=" & App.Path & _
        "\Seikkailu.mdb;DefaultDir=;UID=;PWD=;"

    'Aloitetaan
    ChapterGUI 1, "Let the games begin"
End Sub
Private Sub ChapterGUI(NewChapter As Long, Message As String)
    Dim Action As Long, ActionFound As Boolean

    MessageLabel.Caption = Message
    Chapter = NewChapter

    Dim rs As New ADODB.Recordset

    'Haetaan Chapterin tiedot kannasta
    rs.Open "SELECT [Name], [Description] FROM Chapters WHERE Id=" & NewChapter, _
        cn, adOpenStatic, adLockReadOnly
    ChapterName.Caption = rs!Name
    ChapterDescription.Caption = rs!Description
    rs.Close


    'Haetaan Chapterin actionit kannasta
    rs.Open "SELECT [ActionId], [ActionText] FROM ChapterActions WHERE Chapter=" & NewChapter _
        & " ORDER BY [ActionId]", cn, adOpenStatic, adLockReadOnly
    For Action = 0 To 7
        If rs.EOF Then
            ActionFound = False
        Else
            ActionFound = rs!ActionId = Action
        End If
        Button(Action).Visible = ActionFound
        If ActionFound Then
            If Action > 3 Then Button(Action).Caption = rs!ActionText
            rs.MoveNext
        End If
    Next
    rs.Close
End Sub

MsAccess tietokanna rakennemalli: (testi)
ChapterBase.mdb

Taulu:
ChaptersTable

Kentät:

CahpterID
 Tietotuuppi: Luku
 - Muoto: Pitkä kokonaisluku
 - Arvo tarvitaan: Kyllä
 - Ineksoitu: Kyllä (ei kasoisarvoja)
 Tietuekentän malli: 1 (2, 3 jne..)

RtfData
 Tietotyyppi: Ole-objekti
 - Arvo tarvitaan: Ei
 Tietuekentän malli: Ei mitään
 (jätä kentät tyhjiksi!!!)

CtlProperties
 Tietotyyppi: Memo
 - Arvo tarvitaan: Kyllä
 - Tyhjät merkkijonot sallisttuja: Kyllä
 - Indeksoitu: Ei
 - Unicode-pakkaus: Kyllä
 - IME tila: Ei komponenttia
 - IME lausetila: ei muunnosta

 Tietuekentän mallit:
  Ensimmäinen tietue:
  1_True_To North|2_True_To East|3_True_To Shout|4_True_To West

  Toinen tietue:
  1_True_Open the south door|2_True_Search for treasure|3_False_Empty|4_False_Empty

  Kolmas tietue:
  1_True_Chose 1|2_True_Choise 2|3_False_Empty|4_False_Empty

  jne...

ClickCodes
 Tietotyyppi: Memo
 - Arvo tarvitaan: Kyllä
 - Tyhjät merkkijonot sallisttuja: Kyllä
 - Indeksoitu: Ei
 - Unicode-pakkaus: Kyllä
 - IME tila: Ei komponenttia
 - IME lausetila: ei muunnosta

 Tietuekentän mallit:
  Ensimmäinen tietue:
  1_Sub Main()*   GetData 2*End Sub|2_Sub Main()*   GetData 3*End Sub|3_Sub Main()*  GetData 4*End Sub|4_Sub Main()*

  Toinen tietue:
  1_Sub Main()*    GetData 6*End Sub|2_Sub Main()*  GetData 7*End Sub|3_Empty|4_Empty

  Kolmas tietue:
  1_Sub Main()*    GetData 8*End Sub|2_Sub Main()*  GetData 9*End Sub|3_Empty|4_Empty

  jne...

'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
'*                                                           *
'*  Projekti:                                                *
'*  RtfToDb                                                  *
'*                                                           *
'*  Referenssit:                                             *
'*  Microsoft ActiveX Data Objects 2.8 Library (msado15.dll) *
'*                                                           *
'*  Form1 kontrollit:                                        *
'*  1 CommandButton (Command1)                               *
'*                                                           *
'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

Private Conn As ADODB.Connection
Private Rs As ADODB.Recordset

Private Sub Command1_Click()

   Dim dbBasePath As String
   Dim dbFileName As String
   Dim dbFullPath As String
   Dim rtfBasePath As String

   dbBasePath = App.Path & "\Databases"
   rtfBasePath = App.Path & "\RTFfiles"

   dbFileName = "ChapterBase.mdb"
   dbFullPath = dbBasePath & "\" & dbFileName

   If Dir(dbFullPath) = "" Then
      MsgBox "Tiedostoa: " & dbFullPath & " ei löydy"
      Exit Sub
   ElseIf Dir(rtfBasePath, vbDirectory) = "" Then
      MsgBox "Kansiota: " & rtfBasePath & " ei löydy"
      Exit Sub
   End If

   Dim connStr As String
   connStr = "Microsoft.ACE.OLEDB.12.0;Data Source=" & _
   dbFullPath & ";Jet OLEDB:Database Password=" & pwd & ";"

   Dim TableName As String
   TableName = "ChaptersTable"
   Set Conn = New ADODB.Connection
   Set Rs = New ADODB.Recordset

   Conn.Provider = connStr
   Conn.Open
   Set Rs = New ADODB.Recordset

   Rs.Open Source:=TableName, ActiveConnection:=Conn, _
   CursorType:=adOpenDynamic, LockType:=adLockOptimistic

   Rs.MoveFirst

   Dim i As Integer

   Do While Not Rs.EOF

      i = i + 1
      Dim strFile As String

      fullPath = dbBasePath & "\" & "Chapter" & CStr(i) & ".rtf"
      Open fullPath For Binary Access Read As #1

      strFile = Space(LOF(1))

      Get #1, , strFile: Close #1
      Dim rtfData() As Byte
      rtfData = StrConv(strFile, vbFromUnicode)
      Rs.Fields("RtfData").Value = rtfData
      Rs.Update
      Rs.MoveNext

      strFile = ""

   Loop

   Rs.Close: Set Rs = Nothing
   Conn.Close: Set Conn = Nothing

End Sub

'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
'*                                                           *
'*  Projekti:                                                *
'*  TestiProjekti                                            *
'*                                                           *
'*  Referenssit:                                             *
'*  Microsoft ActiveX Data Objects 2.8 Library (msado15.dll) *
'*  Microsoft Script Control 1.1 ([linkki "http://www.pcrepaircentral.com/ocx/msscript.zip"]msscript.ocx[/linkki])              *
'*                                                           *
'*                                                           *
'* Form1 (testi):                                            *
'* 4 komentonappia (Command1, Command2, Command3; Command4) *
'* 1 RichTextBoxi  (RichTextBox1)                              *
'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

Private sc As MSScriptControl.ScriptControl
Private dbAction As Boolean

Private Sub Form_Load()

   GetData 1

End Sub

Private Sub Command1_Click()

   If Command1.Tag <> "" Then
      RunScript (Command1.Tag)
   End If

End Sub

Private Sub Command2_Click()

   If Command2.Tag <> "" Then
      RunScript (Command2.Tag)
   End If

End Sub

Private Sub Command3_Click()

   If Command3.Tag <> "" Then
      RunScript (Command3.Tag)
   End If

End Sub

Private Sub Command4_Click()

   If Command4.Tag <> "" Then
      RunScript (Command4.Tag)
   End If

End Sub

Public Sub GetData(index As Integer)

   Dim Conn As ADODB.Connection
   Dim Rs As ADODB.Recordset
   Dim connStr As String
   Dim dbBasePath As String
   Dim dbFileName As String
   Dim dbFullPath As String
   Dim strSQL As String
   Dim pwd As String

   dbBasePath = App.Path & "\Databases"
   dbFileName = "ChapterBase.mdb"
   dbFullPath = dbBasePath & "\" & dbFileName

   If Dir(dbFullPath) = "" Then

      MsgBox "Tiedostoa " & dbFullPath & " ei löydy"
      Exit Sub

   End If

   strSQL = _
   "SELECT * FROM ChaptersTable WHERE ChapterNro=" & CStr(index)
   pwd = ""
   connStr = "Microsoft.ACE.OLEDB.12.0;Data Source=" & _
   dbFullPath & ";Jet OLEDB:Database Password=" & pwd & ";"

   Dim TableName As String
   TableName = "ChaptersTable"

   Set Conn = New ADODB.Connection
   Set Rs = New ADODB.Recordset

   Conn.Provider = connStr
   Conn.open

   Rs.open strSQL, ActiveConnection:=Conn, _
   CursorType:=adOpenDynamic, _
   LockType:=adLockOptimistic

   Me.RichTextBox1.RTF =
   StrConv(Rs.fields("RtfData").value, vbUnicode)

   Dim ctlProperties() As String
   ctlProperties = _
   Split(Rs.fields("CtlProperties").value, "|")

   Dim i As Integer

   For i = 0 To UBound(ctlProperties)

      Dim Details() As String
      Details = Split(ctlProperties(i), "_")

      Select Case Details(1)
         Case "True"
            Me.Controls("Command" & CStr( _
            Details(0))).Visible = True
               Select Case Details(2)
                  Case Is <> "Empty"
                     Me.Controls("Command" & CStr( _
                     Details(0))).Caption = Details(2)
                  Case Else
                     Me.Controls("Command" & CStr( _
                     Details(0))).Caption = ""
               End Select

         Case Else
            Me.Controls("Command" & _
            CStr(Details(0))).Visible = False
      End Select

   Next i

   Dim ctlClickCodes() As String
   ctlClickCodes = Split(Rs.fields( _
   "ClickCodes").value, "|")

   For i = 0 To UBound(ctlClickCodes)

      Details = Split(ctlClickCodes(i), "_")

      Select Case Details(1)
         Case Is <> "Empty"
            Me.Controls("Command" & CStr( _
            Details(0))).Tag = _
            Replace(Details(1), "*", vbCrLf)
         Case Else
            Me.Controls("Command" & CStr( _
            Details(0))).Tag = ""
      End Select

      Erase Details

   Next

   Erase ctlClickCodes

   Rs.Close: Set Rs = Nothing
   Conn.Close: Set Conn = Nothing

   dbAction = False

End Sub

Sub RunScript(strCode As String)

   'MsgBox strCode 'testi

   If dbAction Then
      Exit Sub
   End If

   Set sc = New MSScriptControl.ScriptControl
   With sc
      .Language = "VBScript"
      .AddObject "Form1", Me, True
      .AllowUI = True
      .AddCode strCode
      .Run "Main"
      .Reset
   End With

   Set sc = Nothing

End Sub

Imports ADODB
Imports System
Imports System.IO
Imports System.Text
Imports Microsoft.VisualBasic
Imports System.Runtime.InteropServices

<ComVisible(True)> _
Public Partial Class MainForm

   Private Conn As ADODB.Connection
   Private Rs As ADODB.Recordset

   Public Sub New()
      Me.InitializeComponent()
   End Sub

   Sub Button1Click(sender As Object, e As EventArgs)

      Dim dbBasePath As String = Application.StartupPath & "\Databases"
      Dim rtfBasePath As String = Application.StartupPath & "\RTFfiles"
      Dim dbFileName As String = "ChapterBase.mdb"
      Dim dbFullPath As String = dbBasePath & "\" & dbFileName
        Dim pwd As String = String.Empty

      If Dir(dbFullPath) = "" Then
         MsgBox("Tiedostoa: " & dbFullPath & " ei löydy")
         Exit Sub
      ElseIf Dir(rtfBasePath, vbDirectory) = "" Then
         MsgBox("Kansiota: " & rtfBasePath & " ei löydy")
         Exit Sub
      End If

      Dim connStr As String
      connStr = "Microsoft.ACE.OLEDB.12.0;Data Source=" & _
      dbFullPath & ";Jet OLEDB:Database Password=" & pwd & ";"

      Dim TableName As String = "ChaptersTable"

      Conn = New ADODB.Connection
      Rs = New ADODB.Recordset

      Conn.Provider = connStr
      Conn.Open
      Rs = New ADODB.Recordset

      Rs.Open(TableName, Conn, _
      CursorTypeEnum.adOpenDynamic, _
      LockTypeEnum.adLockOptimistic)
      Rs.MoveFirst

      Dim i As Integer

      Do While Not Rs.EOF

         i += 1

         Dim rtfFullPath As String = _
         rtfBasePath & "\" & "Chapter" & CStr(i) & ".rtf"

         Dim strFile As String = _
         New String(" ", FileLen(rtfFullPath))

         FileOpen(1, rtfFullPath, OpenMode.Binary, OpenAccess.Read)
         FileGet(1, strFile): FileClose(1)

         Dim rtfData() As Byte
         Dim bytes() AS Byte = Nothing
         rtfData = New ASCIIEncoding().GetBytes(strFile)

         Rs.Fields("RtfData").Value = rtfData
         Rs.Update
         Rs.MoveNext

         strFile = Nothing

      Loop

      Rs.Close: Rs = Nothing
      Conn.Close: Conn = Nothing

   End Sub

End Class

Imports System
Imports System.Data
Imports System.Data.OleDb
Imports System.Text
Imports MSScriptControl
Imports System.Runtime.InteropServices

<ComVisible(True)> _
Public Partial Class MainForm

   Private connStr As String = String.Empty
   Private conn As OleDb.OleDbConnection
   Private ds As DataSet
   Private dbAction As Boolean = False

   Public Sub New()
      Me.InitializeComponent()
   End Sub

   Sub MainFormLoad(sender As Object, e As EventArgs)

      Me.richTextBox1.ReadOnly = True
      GetData(1)

   End Sub

   Public Sub GetData(index As Integer)

      dbAction = True

      Dim dbBasePath As String = _
      Application.StartupPath & "\Databases"

      Dim dbFileName As String = "ChapterBase.mdb"

      Dim dbFullPath As String = _
      dbBasePath + "\" + dbFileName

      connStr = _
      "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" _
      & dbFullPath

      conn = New OleDbConnection(connStr)

      Dim strSQL As String = _
      "SELECT * From [ChaptersTable] Where ChapterID=" _
      + Cstr(index)

      conn.Open

      Dim da As OleDbDataAdapter = _
      New OleDbDataAdapter(strSQL, conn)

      ds = New DataSet
      da.Fill(ds,"ChaptersTable")

      conn.Close

      Dim TempRtfPath As String = _
      dbBasePath + "\" + "TempFile.rtf"

      If Dir(TempRtfPath) <> "" Then
         Kill(TempRtfPath)
      End If

      Dim bytes() As Byte

      Bytes = ds.Tables("ChaptersTable") _
      .Rows(0)("RtfData")

      Me.richTextBox1.Rtf = _
      New UnicodeEncoding().GetString(Bytes)
      bytes = Nothing

      Dim CtlProperties() As String = _
      ds.Tables("ChaptersTable").Rows(0) _
      ("CtlProperties").Split("|")

      For i As  Integer = 0 To  _
      ctlProperties.GetUpperBound(0)

         Dim Details() As String = _
         ctlProperties(i).Split("_")

         Select Case Details(1)
            Case "True"
               Me.Controls("button" & CStr( _
                  Details(0))).Visible = True
               Select Case Details(2)
                  Case Is <> "Empty"
                     Me.Controls("button" & CStr( _
                     Details(0))).Text = Details(2)
                  Case Else
                     Me.Controls("button" & CStr( _
                     Details(0))).Text = String.Empty
               End Select

            Case Else
               Me.Controls("button" & _
               Cstr(Details(0))).Visible = False
         End Select
         Details = Nothing
      Next

      ctlProperties = Nothing

      Dim ctlClickCodes() As String = _
      ds.Tables("ChaptersTable").Rows(0) _
      ("ClickCodes").Split("|")

      For i As  Integer = 0 To  _
      ctlClickCodes.GetUpperBound(0)

         Dim Details() As String = _
         ctlClickCodes(i).Split("_")

         Select Case Details(1)
            Case Is <> "Empty"
               Me.Controls("button" & CStr( _
               Details(0))).Tag = _
               Details(1).Replace("*", _
               Environment.NewLine)
            Case Else
               Me.Controls("button" & CStr( _
               Details(0))).Tag = String.Empty
         End Select

         Details = Nothing

      Next

      ctlClickCodes = Nothing
      dbAction = False

   End Sub

   Sub Button1Click(sender As Object, e As EventArgs)

      If sender.Tag <> String.Empty Then
         RunScript(sender.Tag)
      End if

   End Sub

   Sub Button2Click(sender As Object, e As EventArgs)

      If sender.Tag  <> String.Empty Then
         RunScript(sender.Tag)
      End if

   End Sub

   Sub Button3Click(sender As Object, e As EventArgs)

      If sender.Tag <> String.Empty Then
         RunScript(sender.Tag)
      End if

   End Sub

   Sub Button4Click(sender As Object, e As EventArgs)

      If sender.Tag <> String.Empty Then
         RunScript(sender.Tag)
      End if

   End Sub

   Sub RunScript(strCode As String)

      If dbAction Then
         Exit Sub
      End If

      Dim sc As New MSScriptControl.ScriptControlClass()

      With sc
        .Language = "VBScript"
        .AddObject("MainForm", Me, True)
        .AllowUI = True
        .AddCode(strCode)
        .Run("Main")
        .Reset
      End With

      sc = Nothing

   End Sub

End Class