Argument not specified for parameter 'ParmName1' of 'Protected Function GetDataTable()

Option Compare Text
Imports Microsoft.VisualBasic
Imports System
Imports System.Data
Imports System.Configuration
Imports System.Collections
Imports System.Web
Imports System.Web.Security
Imports System.Web.UI
Imports System.Web.UI.WebControls
Imports System.Web.UI.WebControls.WebParts
Imports System.Web.UI.HtmlControls
Imports System.Collections.Specialized
Imports System.Data.SqlClient
Imports System.Linq
Imports System.Xml.Linq
Imports System.Data.Common
Imports System.IO
Imports System.Text
Imports System.Drawing
Imports System.Data.OleDb
Imports System.Globalization
Imports System.Threading
Imports System.Reflection
Imports System.Web.SessionState
Imports System.Web.Configuration
Imports System.Collections.Generic
Imports System.Text.RegularExpressions
Imports System.ComponentModel
Imports System.IO.IsolatedStorage
Imports System.Xml
Imports System.Data.Sql
Imports Microsoft.SqlServer.Management.Smo
Imports Microsoft.SqlServer.Management.Common
Imports Microsoft.SqlServer.Management
Imports System.Security
Imports System.Security.Principal
Imports System.Runtime.InteropServices
Imports System.Security.Permissions
Imports System.Data.SqlTypes
Imports System.Resources
Imports System.Drawing.Design
Imports System.Windows.Forms.Design
Imports System.Diagnostics
Imports System.Configuration.ConfigurationManager
Imports System.Drawing.Printing
Imports Ionic.Zlib
'Imports SqlAdmin

'Namespace SqlWebAdmin
Partial Public Class tempScript3
    Inherits System.Web.UI.Page
#Region "Data members"
    Public Shared sqlTable As New DataTable()
    Private ParameterArray As New ArrayList()
    Private connectionString As String
    Private connectionTable As String
    Public odbName As String
    Public pDBName As String
    Public dbTableName As String
    Public osqlQuery As String
    Public psqlQuery As String
    Public MsgBoxDatabase As String = Nothing
    Public MsgBoxTable As String = Nothing
    'Public MessageBox As String = Nothing
    Public MessageBoxProcedure As String = Nothing
    Public bDatabaseExists As Boolean = False
    Public bTableExists As Boolean = False
    Public strTable As String
    Public strTable2 As String
    Public strProcedure As String
    Public trusted_tb As String
    Public Shared Table As New DataTable()
    Public kr As Integer = -1
    Public gr As Integer = -1
    Public kv As Integer = -1
    Public gv As Integer = -1
    Public kvv As Integer = -1
    Public gvv As Integer = -1
    Public iCount As Integer = 0
    Public sDBName As String = "AdminDB2"
    Public sqlStmt As String = "select * from "
    Public TempTable As String = "tblModule"
    Public qDBName As String
    Public qsqlQuery As String
    Private sqlConn As New SqlConnection()
    Private cSqlObjectsFile As String = "buildobjects.sql"
    Private cSqlDataFile As String = "populatedata.sql"
    Private cSqlGetDataFile As String = "usersp_GetDBData.sql"
    Private XmlConfig As New System.Xml.XmlDocument()
    Private security As New SqlAdmin.Security()

    Dim GroupNo As Integer
    Dim SubGroupNo As Integer
    Dim MenuTbl As New Table
    'Dim MenuTbl As New DataTable
    Dim MenuFuncts As String
    Dim SuiteName As String
    Dim ModuleName As String
    Dim InSuite As Boolean
    Dim test As Boolean = True
    Private Const MasterTitle As String = "QL"
    Dim CurrentMenu As String
    Dim NewMenu As String
    Dim TIMS1Table As Table
    'Dim TIMS1Table As DataTable
    Dim MenuItems As Collection
    Dim LinkCount As Integer = 0
    Dim PopUpCount As Integer = 0

    Protected Const SchemaVersionNo As Double = 1.001
    ' Application database details
    Protected AppConnectString As String
    Protected AppConnection As SqlConnection
    ' miscellaneous stuff
    Protected DataTbl As DataTable
    Public ReportName As String
    Public PageSetup As String
    Public ArchivePDF As Boolean
    Public ArchiveExcel As Boolean
    Public ArchiveText As Boolean
    Public PrintPDF As Boolean
    Public PrintExcel As Boolean
    Public PrintText As Boolean
    Public PDFPrinter As String
    Public ExcelPrinter As String
    Public TextPrinter As String
    Private ArchiveData As New ArrayList()
    Protected KeyButtons As New Collection
    Public Facility As String
    Public PageName As String
    Public AppDBName As String
    Public DataDBName As String
    Public CompanyID As String
    Public CompanyName As String
    Public UserID As String
    Public UserLogin As String
    Public LoginName As String
    Public UserEmail As String
    Public Instance As String
    Public VarcharTruncate As Boolean = True
    Public DateFormat As String = "dd/MM/yyyy"
#End Region

#Region "Events Handlers"
    Protected Sub Page_Load(ByVal sender As Object, ByVal e As EventArgs)
        If IsPostBack Then
            MenuTbl = GetObject("MenuTbl")
            MenuFuncts = GetObject("MenuFuncts")
        Else
            tbModule.Text = IsNull(FetchParameter("M"), "")
            LoadSuites()
            LoadMenu()
            tbModule.Attributes.Add("style", "visibility: visible;")
            tbFacility.Attributes.Add("style", "visibility: visible;")
            tbNavigate.Attributes.Add("style", "visibility: visible;")
        End If
        If Not IsPostBack Then

        End If
    End Sub
    Private Sub LoadMenu()
        Dim dt As DataTable
        Dim DR As DataRow
        Dim Hdg As String = ""
        Dim SubHdg As String = ""
        Dim tr As TableRow = Nothing
        Dim td As TableCell = Nothing
        'Dim grouptbl As DataTable = Nothing
        Dim grouptbl As Table = Nothing
        'Dim subgrouptbl As DataTable = Nothing
        Dim subgrouptbl As Table = Nothing
        Dim UserID As String = "UserID"
        Dim CompanyID As String = "CompanyID"
        Dim instance As Integer = 12345678
        SuiteName = lblSelected.Text
        ModuleName = tbModule.Text
        GroupNo = 0
        SubGroupNo = 0
        Dim sb As New StringBuilder("function CollapseAll() {" & vbCrLf)
        MenuTbl = New Table
        'MenuTbl = New DataTable
        MenuTbl.ID = "MenuTbl"
        MenuTbl.Width = Unit.Parse("100%")
        MenuTbl.CellSpacing = 0
        MenuTbl.CellPadding = 0
        Try
            dt = GetDataTable(AppConnection, "usp_GetQLMenu", "@UserID", UserID, "@CompanyID", CompanyID, "@Instance", instance, "@Suite", SuiteName, "@Module", ModuleName)
            For Each DR In dt.Rows
                If MenuTbl.Rows.Count = 0 Then
                    tr = New TableRow
                    td = New TableCell
                    td.Attributes("align") = "center"
                    td.CssClass = "MenuSelected6"
                    td.Width = Unit.Parse("100%")
                    td.Text = Strings.StrConv(ModuleName, VbStrConv.ProperCase)
                    tr.Cells.Add(td)
                End If
                If CStr(DR.Item("SubHeading")).Trim = "" Then
                    Hdg = CStr(DR.Item("Heading"))
                    SubHdg = ""
                    grouptbl = NewMenuGroup(Strings.StrConv(Hdg, VbStrConv.ProperCase))
                    tr = New TableRow
                    td = New TableCell
                    td.VerticalAlign = VerticalAlign.Top
                    td.Controls.Add(grouptbl)
                    'Module Heading Name (Sales, Purchase etc)
                    td.CssClass = "MenuSelected3"
                    Strings.StrConv(tr.Cells.Add(td), VbStrConv.ProperCase)
                    Strings.StrConv(MenuTbl.Rows.Add(tr), VbStrConv.ProperCase)
                Else
                    CType(grouptbl.Rows(0).Cells(0), TableCell).Attributes.Remove("onclick")
                    If SubHdg <> CStr(DR.Item("SubHeading")) Then
                        SubHdg = CStr(DR.Item("SubHeading"))
                        subgrouptbl = NewMenuSubGroup(SubHdg)
                        sb.Append("CollapseOne('" & subgrouptbl.ID & "');" & vbCrLf)
                        tr = New TableRow
                        td = New TableCell
                        td.VerticalAlign = VerticalAlign.Top
                        td.Controls.Add(subgrouptbl)
                        ' sub heading menu items
                        td.CssClass = "MenuSelected6"
                        tr.Cells.Add(td)
                        'Strings.StrConv(grouptbl.Rows.Add(tr), VbStrConv.ProperCase)
                    End If
                    subgrouptbl.Rows.Add(NewMenuItemRow(Hdg, CStr(DR.Item("Description")), CStr(DR.Item("URL")), CStr(DR.Item("Target")), CStr(DR.Item("Program")), CStr(DR.Item("Title"))))
                End If
            Next
            sb.Append("}" & vbCrLf)
            MenuFuncts = sb.ToString
        Catch ex As Exception
            'Throw ex
            ErrorLabe2.Text = ":233:" & ex.ToString()
        End Try
        SaveObject("MenuTbl", MenuTbl)
        SaveObject("MenuFuncts", MenuFuncts)
    End Sub
    Function NewMenuGroup(ByVal Heading As String) As Table
        'Function NewMenuGroup(ByVal Heading As String) As DataTable
        Dim tb As New Table
        'Dim tb As New DataTable
        Dim tr As New TableRow
        Dim td As New TableCell
        GroupNo += 1
        tb.ID = "MenuGroup" & GroupNo.ToString
        tb.Width = Unit.Parse("100%")
        tb.CellPadding = 1
        tb.CellSpacing = 0
        tb.Attributes("onclick") = "if (allowMove() == true){ExpandThis(this);}"
        td.Attributes("onclick") = "if (allowMove() == true){ChangeModule(this.innerText);}"
        td.Text = Heading
        td.Attributes("nowrap") = "nowrap"
        tr.Cells.Add(td)
        tb.Rows.Add(tr)
        Return tb
    End Function
    Function NewMenuSubGroup(ByVal SubHeading As String) As Table
        'Function NewMenuSubGroup(ByVal SubHeading As String) As DataTable
        Dim tb As New Table
        'Dim tb As New DataTable
        SubGroupNo += 1
        tb.ID = "SubGroup" & SubGroupNo.ToString
        tb.Width = Unit.Parse("100%")
        tb.CellPadding = 1
        tb.CellSpacing = 0
        Dim tr As New TableRow
        tb.Attributes("onclick") = "if (allowMove() == true){CollapseAll();ExpandThis(this);}"
        Dim td As New TableCell
        Dim plus As String = "<img alt='' src='../Includes/Images/menu_open_button.png' />"
        Dim builder As StringBuilder = New StringBuilder(SubHeading, 20)
        Dim cap As Int16 = builder.EnsureCapacity(55)
        If Mid(builder.ToString(), 1, 4) = "S/L " Then
            MessageBox.Text = builder.Remove(0, 3).ToString()
            SubHeading = MessageBox.Text
        End If
        If Mid(builder.ToString(), 1, 4) = "P/L " Then
            MessageBox.Text = builder.Remove(0, 3).ToString()
            SubHeading = MessageBox.Text
        End If
        If Mid(builder.ToString(), 1, 4) = "N/L " Then
            MessageBox.Text = builder.Remove(0, 3).ToString()
            SubHeading = MessageBox.Text
        End If
        If Mid(builder.ToString(), 1, 4) = "C/B " Then
            MessageBox.Text = builder.Remove(0, 3).ToString()
            SubHeading = MessageBox.Text
        End If
        td.Text = plus & SubHeading
        td.Attributes("nowrap") = "nowrap"
        tr.Cells.Add(td)
        tb.Rows.Add(tr)
        Return tb
    End Function
    Function NewMenuItemRow(ByVal Heading As String, ByVal Item As String, ByVal URL As String, ByVal Target As String, ByVal ProgName As String, ByVal ProgDesc As String) As TableRow
        Dim tr As New TableRow
        Dim td As New TableCell
        Dim ToolTipText As String = (ProgName & " " & ProgDesc).Trim
        td.Text = "&nbsp;&nbsp;&nbsp;&nbsp;" & Item.Trim
        td.Attributes("nowrap") = "nowrap"
        td.Attributes("onclick") = "if (allowMove() == true){" & "parent." & Target.Trim & ".location='" & URL.Trim & "&ClearAR=true';" & "}"
        If ToolTipText > "" Then td.Attributes.Add("title", ToolTipText.Trim)
        'Sub Menu Item
        tr.CssClass = "MenuSelected5"
        tr.Style("display") = "none"
        tr.Cells.Add(td)
        Return tr
    End Function
    Private Sub LoadSuites()
        Dim Conn As New SqlConnection
        Dim cmd As New SqlCommand
        Dim daMyDataAdapter As New SqlDataAdapter
        Dim dsMyDataSet As New DataSet
        Dim dt As New DataTable
        Dim DR As DataRow
        Dim tr As TableRow = Nothing
        Dim td As TableCell = Nothing
        Dim connStr As String = ConfigurationManager.ConnectionStrings("Application").ConnectionString
        Conn = New SqlConnection(connStr)
        Dim queryString As String = "SELECT S.Name, S.ListOrder FROM tblCompany C, tblAccess A, tblPermission P, tblSuite S, tblModule M, tblSubModule X, tblMenuItem MI, tblFacility F WHERE C.CompanyID = 2 AND A.UserID = 1 AND	A.CompanyID = C.CompanyID AND P.RoleID = A.RoleID AND MI.FacilityID = F.FacilityID AND MI.SubModuleID = X.SubModuleID AND	M.SuiteID = S.SuiteID AND	M.ModuleID = X.ModuleID AND	F.InMenu <> 0 AND	S.Admin = C.Admin AND	F.Admin = C.Admin AND	F.FacilityID = MI.FacilityID GROUP BY S.ListOrder, S.Name ORDER BY S.ListOrder, S.Name"
        Conn.Open()
        cmd.CommandText = queryString
        cmd.Connection = Conn
        Try
            daMyDataAdapter.SelectCommand = cmd
            daMyDataAdapter.Fill(dsMyDataSet)
            Conn.Close()
        Catch ex As Exception
            MessageBox.Text = ex.ToString()
        Finally
            Conn.Close()
            Conn.Dispose()
            cmd.Dispose()
        End Try
        dt = dsMyDataSet.Tables(0)
        Dim drCount As Integer = dt.Rows.Count
        Dim plusImage As String = "<img alt='' src='../Includes/Images/bg_button.png' style='width:165px; height:20px;' />"
        For Each DR In dt.Rows
            If dt.Rows.Count = 0 Then
                tr = New TableRow
                td = New TableCell
                td.Attributes("align") = "center"
                td.Width = Unit.Parse("100%")
                td.Text = "MODULES:"
                tr.Cells.Add(td)
                dt.Rows.Add(tr)
            Else
                tr = New TableRow
                td = New TableCell
                tr.Cells.Add(td)
            End If
        Next
        lbxSuites.DataSource = dt
        lbxSuites.DataBind()
    End Sub
    Protected Sub tbModule_TextChanged(ByVal sender As Object, ByVal e As System.EventArgs) _
    Handles tbModule.TextChanged
        test = False
        tbFacility.Text = ""
        LoadMenu()
    End Sub
    Protected Sub R1_ItemCommand(ByVal Sender As Object, ByVal e As RepeaterCommandEventArgs)
        lblSelected.Text = CType(e.CommandSource, Button).Text
        tbModule.Text = ""
        LoadMenu()
    End Sub
    Protected Sub btnImage_Click(ByVal sender As Object, ByVal e As System.Web.UI.ImageClickEventArgs) 'Handles btnImage.Click

    End Sub
    Protected Function FetchParameter(ByVal FieldName As String) As String
        ' Procedure to extract a named parameter from the query string/url.
        Dim arrParameter() As String
        arrParameter = Page.Request.QueryString.GetValues(FieldName)
        If arrParameter Is Nothing Then
            Return Nothing
        Else
            Return arrParameter(0)
        End If
    End Function
    Function IsNull(ByVal obj As Object, ByVal DefObj As Object) As Object
        ' Function to return a default value for a null object
        Select Case True
            Case IsNothing(obj)
                Return DefObj
            Case IsDBNull(obj)
                Return DefObj
            Case Else
                Return obj
        End Select
    End Function
    Protected Function GetObject(ByVal objName As String) As Object
        ' Fetch an object from the session state store
        ' (For the current instance)
        Return Session(objName & Instance)
        'Return Session(objName)
    End Function
    Protected Sub SaveObject(ByVal ObjName As String, ByVal Obj As Object)
        ' Save an object in the session state store
        ' (For the current instance)
        Session(ObjName & Instance) = Obj
        'Session(ObjName) = Obj
    End Sub
    Protected Sub RemoveObject(ByVal ObjName As String)
        ' Removes an object from the session state store
        ' (For the current instance)
        Session.Remove(ObjName & Instance)
        'Session.Remove(ObjName)
    End Sub
    Sub ProcessZippedCols(ByRef dt As DataTable)
        Dim i As Integer, dr As DataRow
        Dim ColName As String, NewColName As String
        For i = 0 To dt.Columns.Count - 1
            ColName = dt.Columns(i).ColumnName
            If ColName.StartsWith("Zipped(") Then
                NewColName = ColName.Substring(7, ColName.Length - 8)
                dt.Columns.Add(New DataColumn(NewColName, GetType(String)))
                For Each dr In dt.Rows
                    If IsDBNull(dr.Item(ColName)) Then
                        dr.Item(NewColName) = DBNull.Value
                    Else
                        dr.Item(NewColName) = UnZip(dr.Item(ColName))
                    End If
                Next
                dt.Columns.Remove(dt.Columns(i))
                i -= 1
            End If
        Next i
    End Sub
    Protected Function UnZip(ByVal inbytes As Byte()) As String
        'Dim ims As New MemoryStream(inbytes)
        'Dim oms As New MemoryStream
        'Dim ds As New Ionic.Zlib.DeflateStream(oms, CompressionMode.Decompress, True)
        'Dim buffer(4096) As Byte
        'Dim n As Integer = -1

        'Do While (n <> 0)
        '    If n > 0 Then
        '        ds.Write(buffer, 0, n)
        '    End If
        '    n = ims.Read(buffer, 0, buffer.Length)
        'Loop

        'ds.FlushMode = FlushType.Finish
        'ds.Flush()
        'Return ims.ToString
        Return Encoding.ASCII.GetString(Ionic.Zlib.DeflateStream.UncompressBuffer(inbytes))
    End Function
    Protected Function Zip(ByVal instring As String) As Byte()
        'Dim ims As New MemoryStream(Encoding.ASCII.GetBytes(instring))
        'Dim oms As New MemoryStream
        'Dim ds As New Ionic.Zlib.DeflateStream(oms, CompressionMode.Compress, CompressionLevel.BestCompression, True)
        'Dim buffer(4096) As Byte
        'Dim n As Integer = -1
        'Do While (n <> 0)
        '    If n > 0 Then
        '        ds.Write(buffer, 0, n)
        '    End If
        '    n = ims.Read(buffer, 0, buffer.Length)
        'Loop

        'ds.FlushMode = FlushType.Finish
        'ds.Flush()
        'Return oms.ToArray()
        Return Ionic.Zlib.DeflateStream.CompressString(instring)
    End Function
    Protected Function ExecuteStoredProc(ByVal ProcName As String, ByRef Conn As SqlConnection, _
                                         Optional ByVal RefreshScreen As Boolean = False, _
                                         Optional ByVal Facility As String = "", _
                                         Optional ByVal Logit As Boolean = True) As Integer
        ' Procedure to perform a Stored Procedure
        ' Build SQl Command
        Dim cmd As SqlCommand, Res As Integer
        cmd = BuildSQLCmd(ProcName, Conn)
        Try
            ' Transfer values to sql command parameters
            'PopulateParametersFromScreen(cmd)
            ' Attempt the update (execute the sql command/procedure)
            cmd.ExecuteNonQuery()
            Res = cmd.Parameters(0).Value
            ' Examine results
            Select Case Res
                Case 0  ' Execute was OK
                    If Logit Then AppLogActivity(cmd, Facility)
                Case 1, 3, 4  ' Un-expected Error
                    If cmd.Parameters.Contains("@Message") Then ErrorLabe2.Text = ":480:" & cmd.Parameters("@Message").Value
                    If cmd.Parameters.Contains("@Message") Then ErrorLabe2.Text = ":481:" & cmd.Parameters("@Message").Value
                Case Else ' Something else went wrong
                    ErrorLabe2.Text = ":483:An un-expected error has occurred." & Res.ToString()
            End Select
            If RefreshScreen Then PopulateScreenFromParameters(cmd)
            If cmd.Parameters.Contains("@JavaScript") Then
                Dim js As String = IsNull(cmd.Parameters("@JavaScript").Value, "")
                SetFeedbackJs(js)
            End If
            Return Res
        Catch ex As Exception
            ErrorLabe2.Text = ":496:An error has occurred" & ex.ToString()
            Return 1
        End Try
    End Function
    Protected Sub SetFeedbackJs(ByVal js As String)
        RegisterScript(Me, "FeedBack", js)
    End Sub
    Sub RegisterScript(ByRef wPage As Page, ByVal jsname As String, ByVal jstext As String)
        If ScriptManager.GetCurrent(wPage) Is Nothing Then
            wPage.ClientScript.RegisterStartupScript(GetType(String), jsname, jstext, True)
        Else
            ScriptManager.RegisterStartupScript(wPage, GetType(String), jsname, jstext, True)
        End If
    End Sub
    Protected Sub PopulateScreenFromParameters(ByRef cmd As SqlCommand, _
                                               Optional ByVal IsAutoReturn As Boolean = False)
        ' Procedure to transfer data values from the parameters in an SQL command
        ' to controls on the page
        Dim parm As SqlParameter, ctrl As Control
        Dim fname As String, x As Integer, Prop As String
        For Each parm In cmd.Parameters
            If parm.Direction = ParameterDirection.InputOutput _
            Or parm.Direction = ParameterDirection.Output Then
                ' If the parameter name contains a dot, it is a related property
                ' of a field (the name will be in the form FieldName.PropertyName)
                x = InStr(parm.ParameterName, ".")
                If x > 0 Then
                    ' Extract field name and property name and set field's property
                    fname = parm.ParameterName.Substring(0, x - 1).Replace("@", "")
                    Prop = parm.ParameterName.Substring(x)
                    ctrl = FindControl(fname)
                    If Not ctrl Is Nothing Then
                        'To allow setting of page properties
                        If IsPageProperty(Prop) Then
                            SetPageProperty(ctrl, Prop, parm.Value)
                        Else
                            SetProperty(ctrl, Prop, parm.Value)
                        End If
                    End If
                Else
                    ' Set field value
                    If Not IsAutoReturn Then
                        fname = parm.ParameterName.Replace("@", "fld")
                        ctrl = FindControl(fname)
                        'If Not ctrl Is Nothing Then Common.SetField(ctrl, parm.Value)
                    End If
                End If

            End If
        Next
    End Sub
    Sub SetProperty(ByRef ctrl As Object, ByVal prop As String, ByVal propval As Object)
        ' Procedure to set an objects property from a value in a string
        Try
            Select Case prop
                Case "Visible"
                    ctrl.Visible = CBool(propval)
                Case "Enabled"
                    ctrl.Enabled = CBool(propval)
                Case "ReadOnly"
                    ctrl.ReadOnly = CBool(propval)
                Case "CssClass", "Class"
                    ctrl.CssClass = CStr(propval)
                Case "Style"
                    ctrl.Style = CStr(propval)
                Case "Text"
                    ctrl.Text = CStr(propval)
                Case "MaximumValue"
                    ctrl.MaximumValue = CStr(propval)
                Case "MinimumValue"
                    ctrl.MinimumValue = CStr(propval)
                Case "Value"
                    ctrl.Value = CStr(propval)
                Case "MaxLength"
                    ctrl.MaxLength = CInt(propval)
                Case "Width"
                    ctrl.Width = Unit.Parse(CStr(propval))
                Case "SQLProc"
                    ctrl.SQLProc = FormatForJavaScript(CStr(propval))
                Case "NavigateUrl"
                    ctrl.NavigateUrl = CStr(propval)
                Case "Folder"
                    ctrl.Folder = CStr(propval)
                Case Else
                    SetAttribute(ctrl, prop, propval.ToString)
            End Select
        Catch
            ' all errors supressed (for now)
        End Try
    End Sub
    Protected Sub SetPageProperty(ByVal ctrl As Control, ByVal propName As String, ByVal propVal As Object)
        Try
            Select Case propName
                Case "KeyButton"
                    SetKeyButton(CInt(propVal), ctrl.ID)
            End Select
        Catch ex As Exception
        End Try
    End Sub
    Sub SetAttribute(ByRef ctrl As Control, ByVal attrName As String, _
                 ByVal attrVal As String)
        Dim wc As WebControl
        Dim hc As HtmlControls.HtmlControl
        Try
            Select Case True
                Case TypeOf ctrl Is WebControl
                    wc = ctrl
                    wc.Attributes.Add(attrName, attrVal)
                    Exit Select
                Case TypeOf ctrl Is HtmlControls.HtmlControl
                    hc = ctrl
                    hc.Attributes.Add(attrName, attrVal)
                    Exit Select
            End Select
        Catch ex As Exception
        End Try
    End Sub
    Function FormatForJavaScript(ByVal str As String) As String
        Return str.Replace("\", "\\").Replace("'", "\'").Replace("""", "\""")
    End Function
    Sub SetKeyButton(ByVal KeyValue As Integer, ByVal btn As Button)
        If KeyValue = KeyCodes.Enter Then
            SetEnterButton(btn)
        Else
            SetKeyButton(KeyValue, btn.ID)
        End If

    End Sub
    Sub SetKeyButton(ByVal KeyValue As Integer, ByVal ButtonID As String)
        Dim kv As String = KeyValue.ToString
        Dim kb(1) As String
        kb(0) = kv
        kb(1) = ButtonID
        If KeyButtons.Contains(kv) Then KeyButtons.Remove(kv)
        KeyButtons.Add(kb, kv)
    End Sub
    Sub SetEnterButton(ByVal btn As Button)
        If btn.Visible And btn.Enabled Then
            Me.Form.DefaultButton = btn.ID
        End If
    End Sub
    Sub SetEnterButton(ByVal Caller As Page, ByVal btn As Button)
        If btn.Visible And btn.Enabled Then
            Select Case btn.Text.ToUpper
                Case "PROCEED", "CONTINUE", "NEXT", "PREVIEW", "OPEN"
                    Caller.Form.DefaultButton = btn.ID
            End Select
        End If
    End Sub
    Function IsPageProperty(ByVal propName As String) As Boolean
        If propName = "KeyButton" Then
            Return True
        Else
            Return False
        End If
    End Function
    Protected Sub AppLogActivity(ByVal Details As String, ByVal Facility As String)
        Dim cmd As SqlCommand = BuildSQLCmd("usp_SystemLog", AppConnection)
        cmd.Parameters("@Action").Value = "F"
        cmd.Parameters("@Details").Value = Zip(Details)
        Try
            cmd.ExecuteNonQuery()
        Catch ex As Exception
        Finally
            cmd = Nothing
        End Try
    End Sub
    Protected Sub AppLogActivity(ByVal logcmd As SqlCommand, ByVal Facility As String)
        Dim sb As New StringBuilder("Procedure: " & logcmd.CommandText & vbCrLf)
        Dim P As SqlParameter, opn As String
        For Each P In logcmd.Parameters
            If P.Value IsNot Nothing Then
                Select Case True
                    Case (Not P.ParameterName.StartsWith("@Old")) And logcmd.Parameters.Contains(P.ParameterName.Replace("@", "@Old"))
                        opn = P.ParameterName.Replace("@", "@Old")
                    Case P.ParameterName.StartsWith("@Old") And logcmd.Parameters.Contains(P.ParameterName.Replace("@Old", "@"))
                        opn = P.ParameterName.Replace("@Old", "@")
                    Case Else
                        opn = ""
                End Select
                Select Case True
                    Case opn = "", (Not AreTheseEqual(P.Value, logcmd.Parameters(opn).Value))
                        sb.Append("Parameter: " & P.ParameterName & " = " & P.Value.ToString & vbCrLf)
                End Select
            End If
        Next
        AppLogActivity(sb.ToString, Facility)
    End Sub
    Function AreTheseEqual(ByVal Obj1 As Object, ByVal Obj2 As Object) As Boolean
        ' Function to compare two objects that may be null and return
        ' true if they are equal (if they are both null they will be 
        ' considered equal)
        If (Obj1 Is Nothing) And (Obj2 Is Nothing) Then Return True
        If (Obj1 Is Nothing) And (Not Obj2 Is Nothing) Then Return False
        If (Not Obj1 Is Nothing) And (Obj2 Is Nothing) Then Return False
        If IsDBNull(Obj1) And IsDBNull(Obj2) Then Return True
        If IsDBNull(Obj1) And (Not IsDBNull(Obj2)) Then Return False
        If (Not IsDBNull(Obj1)) And IsDBNull(Obj2) Then Return False
        If TypeOf Obj1 Is System.String _
        And TypeOf Obj2 Is System.String Then
            Return (StrComp(Obj1.ToString.Trim, Obj2.ToString.Trim, _
                            CompareMethod.Binary) = 0)
        Else
            Return (Obj1.ToString = Obj2.ToString)
        End If
    End Function
    Protected Overridable Function BuildSQLCmd(ByVal StoredProcName As String, _
                                               ByVal Conn As SqlConnection, _
                                               Optional ByVal tr As SqlTransaction = Nothing, _
                                               Optional ByVal AutoParams As Boolean = True) As SqlCommand
        ' Procedure to create and build a command object given the name
        ' of the stored procedure
        Dim cmd As SqlCommand
        Dim cmdTimeout As Integer = Nothing
        Try
            cmdTimeout = CInt(GetAppSetting("CommandTimeout"))
        Catch ex As Exception
            cmdTimeout = Nothing
        End Try
        Try
            If tr Is Nothing Then
                cmd = New SqlCommand(StoredProcName, Conn)
            Else
                cmd = New SqlCommand(StoredProcName, Conn, tr)
            End If
            cmd.CommandType = CommandType.StoredProcedure
            If Not cmdTimeout = Nothing Then
                cmd.CommandTimeout = cmdTimeout
            End If
            SqlCommandBuilder.DeriveParameters(cmd)
            If AutoParams Then
                ' Look for special parameters that need to be set with database names
                With cmd
                    If .Parameters.Contains("@AppDBName") _
                    And AppConnection.Database > "" Then .Parameters("@AppDBName").Value = AppConnection.Database
                    If .Parameters.Contains("@DataDBName") Then .Parameters("@DataDBName").Value = DataDBName
                    If .Parameters.Contains("@CompanyID") _
                    And CompanyID IsNot Nothing Then .Parameters("@CompanyID").Value = CompanyID
                    If .Parameters.Contains("@CompanyName") _
                    And CompanyName IsNot Nothing Then .Parameters("@CompanyName").Value = CompanyName
                    If .Parameters.Contains("@CoName") _
                    And CompanyName IsNot Nothing Then .Parameters("@CoName").Value = CompanyName
                    If .Parameters.Contains("@UserID") Then .Parameters("@UserID").Value = UserID
                    If .Parameters.Contains("@Instance") Then .Parameters("@Instance").Value = Instance
                    If .Parameters.Contains("@IsPostback") Then .Parameters("@IsPostback").Value = IsPostBack
                    If .Parameters.Contains("@PageIndex") Then .Parameters("@PageIndex").Value = PageNo
                End With
            End If
        Catch ex As Exception
            ErrorLabe2.Text = ":745:" & ex.ToString()
            Return Nothing
        End Try
        Return cmd
    End Function
    Protected Property PageNo() As Integer
        Get
            Return GetObject("PageIndex")
        End Get
        Set(ByVal value As Integer)
            SaveObject("PageIndex", value)
        End Set
    End Property
    Function GetAppSetting(ByVal keyName As String) As String
        Return ConfigurationManager.AppSettings(keyName)
    End Function
    'GetDataTable(AppConnection, "usp_GetQLMenu", "@UserID", UserID, "@CompanyID", CompanyID, "@Instance", instance, "@Suite", SuiteName, "@Module", ModuleName)
    Protected Function GetDataTable(ByVal Conn As SqlConnection, _
                      ByVal SQLProc As String, _
                      ByVal ParmName1 As String, ByVal ParmValue1 As String, _
                      ByVal ParmName2 As String, ByVal ParmValue2 As String, _
                      ByVal ParmName3 As String, ByVal ParmValue3 As String, _
                      ByVal ParmName4 As String, ByVal ParmValue4 As String, _
                      ByVal ParmName5 As String, ByVal ParmValue5 As String) As DataTable
        ' Procedure to retrieve data using a named Stored Procedure with
        ' one parameter
        Try
            Dim cmd As SqlCommand = BuildSQLCmd(SQLProc, Conn)
            SetParameter(cmd.Parameters(ParmName1), ParmValue1)
            SetParameter(cmd.Parameters(ParmName2), ParmValue2)
            SetParameter(cmd.Parameters(ParmName3), ParmValue3)
            SetParameter(cmd.Parameters(ParmName4), ParmValue4)
            SetParameter(cmd.Parameters(ParmName5), ParmValue5)
            Return GetDataTable(cmd)
        Catch ex As Exception
            'Throw ex
            ErrorLabe2.Text = ":781:" & ex.ToString()
        End Try
    End Function
    Sub SetParameter(ByRef Parm As SqlParameter, ByVal strVal As String)
        ' Procedure to populate an SQL parameter from a string
        'Dim errMsg As String = ""
        errMsg.Text = ""
        Try
            If Trim(strVal) = "" Then
                Select Case Parm.SqlDbType
                    Case SqlDbType.VarChar
                        errMsg.Text = "Error Processing Text Field"
                        If VarcharTruncate And Parm.Size <> -1 Then
                            Parm.Value = strVal & Space(Parm.Size - strVal.Length)
                        Else
                            Parm.Value = strVal
                        End If
                    Case SqlDbType.Char, SqlDbType.Text
                        errMsg.Text = "Error Processing Text Field"
                        Parm.Value = strVal
                    Case Else
                        errMsg.Text = "Error Processing Field"
                        Parm.IsNullable = True
                        Parm.Value = DBNull.Value
                End Select
            Else
                Select Case Parm.SqlDbType
                    Case SqlDbType.Int
                        errMsg.Text = "Error Processing Numeric Field"
                        Parm.Value = New SqlTypes.SqlInt32(CInt(strVal))
                    Case SqlDbType.BigInt
                        errMsg.Text = "Error Processing Numeric Field"
                        Parm.Value = New SqlTypes.SqlInt64(CLng(strVal))
                    Case SqlDbType.SmallInt
                        errMsg.Text = "Error Processing Numeric Field"
                        Parm.Value = New SqlTypes.SqlInt16(CShort(strVal))
                    Case SqlDbType.TinyInt
                        errMsg.Text = "Error Processing Numeric Field"
                        Parm.Value = CByte(CShort(strVal))
                    Case SqlDbType.Bit
                        errMsg.Text = "Error Processing Bit Field"
                        Parm.Value = CBool(strVal)
                    Case SqlDbType.VarChar
                        errMsg.Text = "Error Processing Text Field"
                        If VarcharTruncate And Parm.Size <> -1 Then
                            Parm.Value = strVal & Space(Parm.Size - strVal.Length)
                        Else
                            Parm.Value = strVal
                        End If
                    Case SqlDbType.Char, SqlDbType.Text
                        errMsg.Text = "Error Processing Text Field"
                        Parm.Value = strVal
                    Case SqlDbType.DateTime, SqlDbType.SmallDateTime
                        errMsg.Text = "Error Processing Date Field"
                        Parm.Value = New SqlTypes.SqlDateTime(ParseTIMSDate(strVal))
                    Case SqlDbType.Decimal
                        errMsg.Text = "Error Processing Decimal Field"
                        Parm.Value = New SqlTypes.SqlDecimal(CDec(strVal))
                    Case SqlDbType.Float
                        errMsg.Text = "Error Processing Decimal Field"
                        Parm.Value = New SqlTypes.SqlDouble(CDbl(strVal))
                    Case SqlDbType.Real
                        errMsg.Text = "Error Processing Decimal Field"
                        Parm.Value = New SqlTypes.SqlSingle(CSng(strVal))
                    Case SqlDbType.Money, SqlDbType.SmallMoney
                        errMsg.Text = "Error Processing Decimal Field"
                        Parm.Value = New SqlTypes.SqlMoney(CDbl(strVal))
                End Select
            End If
        Catch ex As Exception
            ' Dim ex2 As Exception
            ' ex2 = New Exception(errMsg, ex)
            ErrorLabe2.Text = ":853:" & ex.ToString()
            Throw ex
        End Try
    End Sub
    Function ParseTIMSDate(ByVal TIMSDate As String) As Date
        ' Wrapper function to substitute date tags with actual dates
        Dim Tag As String, Adj As String, Inc As Integer, OK As Boolean = True
        Dim x1 As String, x2 As String
        Dim d As Integer, m As Integer, y As Integer
        Select Case True
            Case IsDate(TIMSDate)
                Return Date.Parse(TIMSDate)
            Case IsNumeric(TIMSDate)
                x1 = Right(Format(CInt(TIMSDate), "000000"), 6)
                d = CInt(x1.Substring(0, 2))
                m = CInt(x1.Substring(2, 2))
                y = CInt(x1.Substring(4, 2))
                ' This has been added as TIMS was taking all numeric entries
                ' and pasrsing as strings which do not always equal the date 
                ' the user intended e.g. 32/01/10 would return 01/02/10
                x2 = Left(x1, 2) + "/" + Mid(x1, 3, 2) + "/" + Right(x1, 2)
                If IsDate(x2) Then
                    ' Needed for year 2000 handling to be compatible with
                    ' TIMS 1
                    If y < 50 Then
                        y = 2000 + y
                    Else
                        y = 1900 + y
                    End If
                    Return DateSerial(y, m, d)
                Else
                    Throw New Exception("Invalid Date - " + TIMSDate + _
                                        " is not a valid Date Entry")
                End If
            Case TIMSDate = "$TODAY"
                Return Today
            Case TIMSDate = "$OLDEST"
                Return Date.Parse("01/01/1950")
            Case TIMSDate = "$NEWEST"
                Return Date.Parse("31/12/2049")
            Case Left(TIMSDate, 4) = "$DAY", _
                 Left(TIMSDate, 4) = "$MON", _
                 Left(TIMSDate, 4) = "$EOM", _
                 Left(TIMSDate, 4) = "$SOM"
                Tag = TIMSDate.Substring(1, 1)
                Adj = TIMSDate.Substring(4)
            Case Left(TIMSDate, 5) = "$YEAR"
                Tag = TIMSDate.Substring(1, 1)
                Adj = TIMSDate.Substring(5)
            Case Else
                Throw New Exception("Invalid Date - " + TIMSDate + " is not a valid Date Entry")
        End Select
        Try
            Inc = CInt(IIf((Adj.Trim = ""), "0", Adj))
        Catch ex As Exception
            OK = False
        End Try
        If OK Then
            Select Case Tag
                Case "D"    ' Day
                    Return DateAdd(DateInterval.Day, Inc, Today)
                Case "M"    ' Month
                    Return DateAdd(DateInterval.Month, Inc, Today)
                Case "E"    ' End of Month
                    Return DateAdd(DateInterval.Day, Inc, EndOfMonth())
                Case "S"    ' Start of Month
                    Return DateAdd(DateInterval.Day, Inc, StartOfMonth())
                Case "Y"    ' Year
                    Return DateAdd(DateInterval.Year, Inc, Today)
            End Select
        Else
            Throw New Exception("Invalid Date Substitute")
        End If
    End Function
    Function StartOfMonth() As Date
        'Return DateSerial(Year(Today), Month(Today), 1)
    End Function
    Function EndOfMonth() As Date
        Return DateAdd(DateInterval.Day, -1, DateAdd(DateInterval.Month, 1, StartOfMonth()))
    End Function
    Public Enum KeyCodes
        'Null = 0
        BkSp = 8
        Tab = 9
        Enter = 13
        Shift = 16
        Ctrl = 17
        Alt = 18
        Pausebreak = 19
        CapsLock = 20
        Esc = 27
        Space = 32
        PageUp = 33
        PageDown = 34
        EndKey = 35
        Home = 36
        Left = 37
        Up = 38
        Right = 39
        Down = 40
        Plus = 43
        PrintScreen = 44
        Ins = 45
        Del = 46
        F1 = 112
        F2 = 113
        F3 = 114
        F4 = 115
        F5 = 116
        F6 = 117
        F7 = 118
        F8 = 119
        F9 = 120
        F10 = 121
        F11 = 122
        F12 = 123
        NumLock = 144
        ScrollLock = 145
    End Enum
#End Region
#Region "Methods"

#End Region

End Class
'End Namespace

Select allOpen in new window