-Imports System.Data\r
-\r
-Partial Class LiveGrid\r
-Inherits System.Web.UI.UserControl\r
- \r
-' ----------------------------------------------------\r
-' Constants\r
-' ----------------------------------------------------\r
-\r
-Public Const sizeToWindow=-1\r
-Public Const sizeToData=-2\r
-Public Const sizeToBody=-3\r
-Public Const sizeToParent=-4\r
-\r
-' ----------------------------------------------------\r
-' Private Properties\r
-' ----------------------------------------------------\r
-\r
-Private _rows As Integer = sizeToBody\r
-Private _sqlFilters as New ArrayList()\r
-Private _gridHeading As ITemplate = Nothing\r
-Private _headingTop As ITemplate = Nothing\r
-Private _headingBottom As ITemplate = Nothing\r
-Protected globalInitScript as String = ""\r
-Protected HdgContainer As New GridContainer()\r
-Protected DebugString As String\r
-Protected oSqlCompat as sqlCompatibilty\r
-Protected oParseMain as New sqlParse()\r
-\r
-\r
-' ----------------------------------------------------\r
-' Public Properties\r
-' ----------------------------------------------------\r
-Public columns as New ArrayList()\r
-Public dataProvider as String = "ricoQuery.aspx"\r
-Public menuEvent as String = "dblclick"\r
-Public frozenColumns as Integer = 0\r
-Public canSortDefault as Boolean = True\r
-Public canHideDefault as Boolean = True\r
-Public canFilterDefault as Boolean = True\r
-Public allowColResize as Boolean = True\r
-Public highlightElem as String = "menuRow"\r
-Public highlightMethod as String\r
-Public prefetchBuffer as Boolean = True\r
-Public DisplayTimer as Boolean = True\r
-Public DisplayBookmark as Boolean = True\r
-Public Caption as String\r
-Public click as String\r
-Public dblclick as String\r
-Public contextmenu as String\r
-Public headingSort as String\r
-Public beforeInit as String\r
-Public afterInit as String\r
-Public TableFilter as String\r
-Public FilterLocation as Integer = -2\r
-Public FilterAllToken as String\r
-Public FilterBoxMaxLen as Integer = -1\r
-Public FilterAnchorLeft as Boolean = false ' when matching text box values, should they match beginning of string (true) or anywhere in string (false)?
-Public saveColumnWidth as Boolean = True\r
-Public saveColumnFilter as Boolean = False\r
-Public saveColumnSort as Boolean = False\r
-Public cookieDays as Integer\r
-Public DefaultSort as String\r
-Public maxPrint as Integer = -1\r
-Public dndMgrIdx as Integer = -1\r
-Public UsingMinRico as Boolean = False ' using minified version of Rico?\r
-Public sessions as Boolean = True\r
-Public minPageRows as Integer = -1\r
-Public maxPageRows as Integer = -1\r
-Public defaultWidth as Integer = -1 ' if -1, then use unformatted column width, otherwise this is the default width in pixels\r
-Public debug as Boolean = False\r
-Public LogSqlOnError as Boolean = false ' include sql statement in results if an error occurs (true/false)\r
-\r
-' ----------------------------------------------------\r
-' Public Properties for buffer\r
-' ----------------------------------------------------\r
-Public BufferType as String = "AjaxSQL" ' can be overridden to AjaxXML\r
-Public fmt as String = "xml"\r
-Public largeBufferSize as Integer = -1 ' controls size of client buffer and AJAX fetch size\r
-Public requestParameters as New Hashtable()\r
-\r
-\r
-Public Property rows() As Integer\r
- Get\r
- Return _rows\r
- End Get\r
- Set(ByVal Value As Integer)\r
- _rows=Value\r
- End Set\r
-End Property\r
-\r
-<TemplateContainer(GetType(GridContainer))> _\r
-Public Property GridColumns() As ITemplate\r
- Get\r
- Return _gridHeading\r
- End Get\r
- Set\r
- _gridHeading = value\r
- End Set\r
-End Property\r
-\r
-<TemplateContainer(GetType(GridContainer))> _\r
-Public Property HeadingTop() As ITemplate\r
- Get\r
- Return _headingTop\r
- End Get\r
- Set\r
- _headingTop = value\r
- End Set\r
-End Property\r
-\r
-<TemplateContainer(GetType(GridContainer))> _\r
-Public Property HeadingBottom() As ITemplate\r
- Get\r
- Return _headingBottom\r
- End Get\r
- Set\r
- _headingBottom = value\r
- End Set\r
-End Property\r
-\r
-Public WriteOnly Property sqlQuery() As String\r
- Set(ByVal SqlText As String)\r
- if oParseMain.ParseSelect(SqlText) then\r
- ' sync column headings\r
- dim i as Integer\r
- for i=0 to oParseMain.SelectList.Count-1\r
- if i < Me.columns.Count then\r
- if IsNothing(Me.columns(i).Heading) then\r
- Me.columns(i).Heading=oParseMain.SelectList(i).name\r
- else\r
- oParseMain.SelectList(i).name=Me.columns(i).Heading\r
- end if\r
- else\r
- AddCalculatedField(oParseMain.SelectList(i).name, oParseMain.SelectList(i).sql)\r
- end if\r
- next\r
- if sessions then session.contents(Me.UniqueId)=oParseMain\r
- else\r
- Throw New Exception("Invalid SQL statement")\r
- end if\r
- End Set\r
-End Property\r
-\r
-Public ReadOnly Property ParseClone() As object\r
- Get\r
- return oParseMain.Clone()\r
- End Get\r
-End Property\r
-\r
-Protected ReadOnly Property TimerSpan() As String\r
- Get\r
- if Me.DisplayTimer then\r
- Return "<span id='" & Me.UniqueId & "_timer' class='ricoSessionTimer'> </span>"\r
- else\r
- Return ""\r
- end if\r
- End Get\r
-End Property\r
-\r
-Protected ReadOnly Property BookmarkSpan() As String\r
- Get\r
- if Me.DisplayBookmark then\r
- Return "<span id='" & Me.UniqueId & "_bookmark'> </span>"\r
- else\r
- Return ""\r
- end if\r
- End Get\r
-End Property\r
-\r
-Protected ReadOnly Property SaveMsgSpan() As String\r
- Get\r
- if Me.formView then\r
- Return "<span id='" & Me.UniqueId & "_savemsg' class='ricoSaveMsg'></span>"\r
- else\r
- Return ""\r
- end if\r
- End Get\r
-End Property\r
-\r
-Protected ReadOnly Property CaptionSpan() As String\r
- Get\r
- if IsNothing(Caption) then\r
- Return ""\r
- else\r
- Return "<span id='" & Me.UniqueId & "_caption' class='ricoCaption'>" & Me.Caption & "</span>"\r
- end if\r
- End Get\r
-End Property\r
-\r
-Protected ReadOnly Property FilterIcon() As String\r
- Get\r
- if FilterLocation >= -1 then\r
- Return "<a id='ex3_filterLink' href='#' style='margin-right:1em;'></a>"\r
- else\r
- Return ""\r
- end if\r
- End Get\r
-End Property\r
-\r
-Protected ReadOnly Property Bookmark() As String\r
- Get\r
- if Me.DisplayBookmark or Me.DisplayTimer or not IsNothing(Caption) then\r
- Return "<p class='ricoBookmark'>" & Me.CaptionSpan & Me.TimerSpan & Me.FilterIcon & Me.BookmarkSpan & Me.SaveMsgSpan & "</p>"\r
- else\r
- Return ""\r
- end if\r
- End Get\r
-End Property\r
-\r
-Private function FmtBool(b)\r
- if b then FmtBool="true" else FmtBool="false"\r
-end function\r
-\r
-Protected ReadOnly Property init_Script() As String\r
- Get\r
- Dim script as New System.Text.StringBuilder(), confirmCol as Integer=0\r
- script.Append("var " & Me.UniqueId & " = {};" & vbCrLf)\r
- script.Append("function " & Me.UniqueId & "_init" & "() {" & vbCrLf)\r
- if not IsNothing(beforeInit) then script.Append(beforeInit & vbCrLf)\r
-\r
- ' grid options\r
-\r
- script.Append(" " & optionsVar & " = {" & vbCrLf)\r
- script.Append(" visibleRows: " & Me.rows & "," & vbCrLf)\r
- script.Append(" frozenColumns: " & frozenColumns & "," & vbCrLf)\r
- script.Append(" canSortDefault: " & FmtBool(canSortDefault) & "," & vbCrLf)\r
- script.Append(" canHideDefault: " & FmtBool(canHideDefault) & "," & vbCrLf)\r
- script.Append(" canFilterDefault: " & FmtBool(canFilterDefault) & "," & vbCrLf)\r
- script.Append(" allowColResize: " & FmtBool(allowColResize) & "," & vbCrLf)\r
- script.Append(" highlightElem: '" & highlightElem & "'," & vbCrLf)\r
- if not IsNothing(highlightMethod) then script.Append(" highlightMethod: '" & highlightMethod & "'," & vbCrLf)\r
- script.Append(" prefetchBuffer: " & FmtBool(prefetchBuffer) & "," & vbCrLf)\r
- script.Append(" menuEvent: '" & menuEvent & "'," & vbCrLf)\r
- if not IsNothing(RecordName) then script.Append(" RecordName: '" & RecordName & "'," & vbCrLf)\r
- script.Append(" saveColumnInfo: {width:" & FmtBool(saveColumnWidth) & ", filter:" & FmtBool(saveColumnFilter) & ", sort:" & FmtBool(saveColumnSort) & "}," & vbCrLf)\r
- if not IsNothing(cookieDays) then script.Append(" cookieDays: " & cookieDays & "," & vbCrLf)\r
- \r
- if panels.count > 0 then\r
- script.Append(" PanelNamesOnTabHdr: " & FmtBool(PanelNamesOnTabHdr) & "," & vbCrLf)\r
- script.Append(" panels: ['" & join(panels.ToArray(),"','") & "']," & vbCrLf)\r
- end if\r
- if not IsNothing(headingSort) then script.Append(" headingSort: '" & headingSort & "'," & vbCrLf)\r
- if not IsNothing(click) then script.Append(" click: " & click & "," & vbCrLf)\r
- if not IsNothing(dblclick) then script.Append(" dblclick: " & dblclick & "," & vbCrLf)\r
- if not IsNothing(contextmenu) then script.Append(" contextmenu: " & contextmenu & "," & vbCrLf)\r
- if FilterLocation >= -1 then script.Append(" FilterLocation: " & FilterLocation & "," & vbCrLf)\r
- if not IsNothing(FilterAllToken) then script.Append(" FilterAllToken: '" & FilterAllToken & "'," & vbCrLf)\r
- if FilterBoxMaxLen >= 0 then script.Append(" FilterBoxMaxLen: " & FilterBoxMaxLen & "," & vbCrLf)\r
- if FilterAnchorLeft then script.Append(" FilterAnchorLeft: " & FmtBool(FilterAnchorLeft) & "," & vbCrLf)\r
- if maxPrint >= 0 then script.Append(" maxPrint: " & maxPrint & "," & vbCrLf)\r
- if dndMgrIdx >= 0 then script.Append(" dndMgrIdx: " & dndMgrIdx & "," & vbCrLf)\r
- if minPageRows >= 0 then script.Append(" minPageRows: " & minPageRows & "," & vbCrLf)\r
- if maxPageRows >= 0 then script.Append(" maxPageRows: " & maxPageRows & "," & vbCrLf)\r
- if defaultWidth > 0 then script.Append(" defaultWidth: " & defaultWidth & "," & vbCrLf)\r
- \r
- if formView then\r
- script.Append(" canAdd: " & FmtBool(canAdd) & "," & vbCrLf)\r
- script.Append(" canEdit: " & FmtBool(canEdit) & "," & vbCrLf)\r
- script.Append(" canClone: " & FmtBool(canClone) & "," & vbCrLf)\r
- script.Append(" canDelete: " & FmtBool(canDelete) & "," & vbCrLf)\r
- script.Append(" ConfirmDelete: " & FmtBool(ConfirmDelete) & "," & vbCrLf)\r
- script.Append(" TableSelectNew: '" & TableSelectNew & "'," & vbCrLf)\r
- script.Append(" TableSelectNone: '" & TableSelectNone & "'," & vbCrLf)\r
- if panelHeight > 0 then script.Append(" panelHeight: " & panelHeight & "," & vbCrLf)\r
- if panelWidth > 0 then script.Append(" panelWidth: " & panelWidth & "," & vbCrLf)\r
- if maxDisplayLen > 0 then script.Append(" maxDisplayLen: " & maxDisplayLen & "," & vbCrLf)\r
- if not IsNothing(formOpen) then script.Append(" formOpen: " & formOpen & "," & vbCrLf)\r
- if not IsNothing(formClose) then script.Append(" formClose: " & formClose & "," & vbCrLf)\r
- if not IsNothing(formSubmit) then script.Append(" formSubmit: " & onSubmitResponse & "," & vbCrLf)\r
- if not IsNothing(onSubmitResponse) then script.Append(" onSubmitResponse: " & onSubmitResponse & "," & vbCrLf)\r
- if not IsNothing(showSaveMsg) then script.Append(" showSaveMsg: '" & showSaveMsg & "'," & vbCrLf)\r
- end if\r
- script.Append(" columnSpecs : [" & vbCrLf)\r
- Dim c as Integer\r
- for c=0 to columns.count-1\r
- if c > 0 then script.Append("," & vbCrLf)\r
- script.Append(CType(columns(c),GridColumn).script)\r
- if columns(c).ConfirmDeleteColumn then confirmCol=c\r
- next\r
- script.Append("]")\r
- if formView then script.Append("," & vbCrLf & "ConfirmDeleteCol: " & confirmCol)\r
- script.Append(vbCrLf & " }" & vbCrLf)\r
-\r
- ' buffer\r
-\r
- dim a as New ArrayList()\r
- script.Append(" " & bufferOptVar & " = {")\r
- if requestParameters.Count > 0 then\r
- Dim param As DictionaryEntry\r
- For Each param In requestParameters\r
- a.Add(vbCrLf & " {name:'" & param.Key & "',value:'" & param.Value & "'}")\r
- Next\r
- script.Append(vbCrLf & " requestParameters: [" & String.Join(",", a.ToArray(Type.GetType("System.String"))) & vbCrLf & " ]")\r
- end if\r
- if BufferType="AjaxSQL" then\r
- if a.Count > 0 then script.Append(",")\r
- script.Append(vbCrLf & " TimeOut: " & Session.Timeout & ",")\r
- if largeBufferSize > 0 then script.Append(vbCrLf & " largeBufferSize: " & largeBufferSize & ",")\r
- script.Append(vbCrLf & " fmt: '" & fmt & "'")\r
- end if\r
- script.Append(vbCrLf & " }" & vbCrLf)\r
- script.Append(" " & bufferVar & " = new Rico.Buffer." & BufferType & "('" & dataProvider & "', " & bufferOptVar & ");" & vbCrLf)\r
-\r
- ' grid\r
-\r
- script.Append(" " & gridVar & " = new Rico.LiveGrid ('" & Me.UniqueId & "', " & bufferVar & ", " & optionsVar & ");" & vbCrLf)\r
- if not IsNothing(menuEvent) then\r
- script.Append(" " & gridVar & ".menu = new Rico.GridMenu();" & vbCrLf)\r
- end if\r
-\r
- ' form\r
-\r
- if formView then\r
- script.Append(" if(typeof " & Me.UniqueId & "_FormInit=='function') " & Me.UniqueId & "_FormInit();" & vbCrLf)\r
- script.Append(" " & formVar & "=new Rico.TableEdit(" & gridVar & ");" & vbCrLf)\r
- end if\r
-\r
- script.Append(" if(typeof " & Me.UniqueId & "_InitComplete=='function') " & Me.UniqueId & "_InitComplete();" & vbCrLf)\r
- if not IsNothing(afterInit) then script.Append(afterInit & vbCrLf)\r
-\r
- script.Append("}" & vbCrLf)\r
- Return script.ToString\r
- End Get\r
-End Property\r
-\r
-\r
-' ----------------------------------------------------\r
-' Properties for LiveGridForms\r
-' ----------------------------------------------------\r
-\r
-Public dbConnection as object\r
-Public formView as Boolean = false\r
-Public TableSelectNew as String = "___new___"\r
-Public TableSelectNone as String = ""\r
-Public canAdd as Boolean = true\r
-Public canEdit as Boolean = true\r
-Public canClone as Boolean = false\r
-Public canDelete as Boolean = true\r
-Public ConfirmDelete as Boolean = true\r
-Public RecordName as String\r
-Public PanelNamesOnTabHdr as Boolean = true\r
-Public showSaveMsg as String\r
-Public dbDialect as String\r
-Public panels as New ArrayList()\r
-Public panelHeight as Integer = -1\r
-Public panelWidth as Integer = -1\r
-Public maxDisplayLen as Integer = -1\r
-\r
-' events\r
-Public formOpen as String\r
-Public formClose as String\r
-Public formSubmit as String\r
-Public onSubmitResponse as String\r
-\r
-Public gridVar as String\r
-Public formVar as String\r
-Public bufferVar as String\r
-Public bufferOptVar as String ' name of buffer options js var\r
-Public optionsVar as String ' name of grid options js var\r
-\r
-Protected Tables as New ArrayList()\r
-Protected _action As String\r
-Protected MainTbl as Integer = -1\r
-\r
-\r
-Public Property TableName() As String\r
- Get\r
- if MainTbl >= 0 then\r
- Return Tables(MainTbl).TblName\r
- else\r
- Return Nothing\r
- end if\r
- End Get\r
- Set\r
- MainTbl=Tables.Count\r
- dim tab as new AltTable()\r
- tab.TblName=value\r
- tab.TblAlias="t"\r
- AddTable(tab)\r
- End Set\r
-End Property\r
-\r
-Public Function AddTable(t as AltTable) as Integer\r
- AddTable=Tables.Count\r
- if IsNothing(t.TblAlias) then t.TblAlias="a" & Tables.Count\r
- Tables.Add(t)\r
-End Function\r
-\r
-Public ReadOnly Property action() As String\r
- Get\r
- Return _action\r
- End Get\r
-End Property\r
-\r
-Public ReadOnly Property CurrentField() As GridColumn\r
- Get\r
- Return columns(columns.count-1)\r
- End Get\r
-End Property\r
-\r
-\r
-' ----------------------------------------------------\r
-' Methods\r
-' ----------------------------------------------------\r
-Sub Page_Init()\r
- formVar=Me.UniqueId & "['edit']"\r
- gridVar=Me.UniqueId & "['grid']"\r
- bufferVar=Me.UniqueId & "['buffer']"\r
- bufferOptVar=Me.UniqueId & "['bufferopt']"\r
- optionsVar=Me.UniqueId & "['options']"\r
- dim actionparm as String="_action_" & Me.UniqueId\r
- _action=trim(Request.QueryString(actionparm))\r
- if _action="" then _action=trim(Request.Form(actionparm))\r
- if _action="" then _action="table" else _action=lcase(_action)\r
-\r
- If Not (_gridHeading Is Nothing) Then\r
- _gridHeading.InstantiateIn(HdgContainer)\r
- For Each ctrl As Control In HdgContainer.Controls\r
- If TypeOf(ctrl) is GridColumn then\r
- AddColumn(CType(ctrl,GridColumn))\r
- ElseIf TypeOf(ctrl) is GridPanel then\r
- panels.Add(CType(ctrl,GridPanel).heading)\r
- ElseIf TypeOf(ctrl) is AltTable then\r
- AddTable(ctrl)\r
- end if\r
- Next\r
- End If\r
-\r
- If Not (_headingTop Is Nothing) Then\r
- Dim container As New GridContainer()\r
- _headingTop.InstantiateIn(container)\r
- LiveGridHeadingsTop.Controls.Add(container)\r
- End If\r
- \r
- If Not (_headingBottom Is Nothing) Then\r
- Dim container As New GridContainer()\r
- _headingBottom.InstantiateIn(container)\r
- LiveGridHeadingsBottom.Controls.Add(container)\r
- End If\r
-End Sub\r
-\r
-\r
-' -------------------------------------------------------------\r
-' Adds a new column to grid, returns column index\r
-' -------------------------------------------------------------\r
-Public Function AddColumn(ColumnObj as GridColumn) as integer\r
- if ColumnObj.isLookupField() then\r
- \r
- ' this items get applied to the lookup field instead of the code field\r
- dim Hdg as string = ColumnObj.Heading\r
- dim width as integer = ColumnObj.Width\r
- dim filterUI as string = ColumnObj.filterUI\r
- dim ConfirmDelete as boolean = ColumnObj.ConfirmDeleteColumn\r
- dim DescriptionCol as String = ColumnObj.DescriptionCol\r
-\r
- ColumnObj.Heading=Hdg & " Code"\r
- ColumnObj.panelIdx=panels.count-1\r
- ColumnObj.FieldName=ExtFieldId(columns.count)\r
- ColumnObj.filterUI=Nothing\r
- ColumnObj.Width=-1\r
- ColumnObj.visible=false\r
- ColumnObj.ConfirmDeleteColumn=false\r
- if not IsNothing(DescriptionCol) then\r
- ColumnObj.DescriptionField=ExtFieldId(columns.count+1)\r
- end if\r
- columns.Add(ColumnObj)\r
- \r
- ColumnObj=new GridColumn()\r
- ColumnObj.filterUI=filterUI\r
- ColumnObj.Width=width\r
- ColumnObj.Heading=Hdg\r
- ColumnObj.ConfirmDeleteColumn=ConfirmDelete\r
- if IsNothing(DescriptionCol) then\r
- ColumnObj.Formula="" ' to be filled in by FormSqlQuery()\r
- else\r
- ColumnObj.ColName=DescriptionCol\r
- ColumnObj.FormView="hidden"\r
- ColumnObj.EntryType="T"\r
- end if\r
- end if\r
- ColumnObj.panelIdx=panels.count-1\r
- ColumnObj.FieldName=ExtFieldId(columns.count)\r
- AddColumn=columns.count\r
- columns.Add(ColumnObj)\r
-End Function\r
-\r
-\r
-' -------------------------------------------------------------\r
-' Adds a new column to grid, returns column index\r
-' -------------------------------------------------------------\r
-Public Function AddCalculatedField(Heading as string, ColumnFormula as string, optional width as integer = -1, optional ClassName as string = "") as GridColumn\r
- Dim ColumnObj as New GridColumn()\r
- if left(ColumnFormula,1) <> "(" then ColumnFormula="(" & ColumnFormula & ")"\r
- ColumnObj.ColName="Calc_" & columns.count\r
- ColumnObj.Formula=ColumnFormula\r
- ColumnObj.Heading=Heading\r
- if width >= 0 then ColumnObj.Width=width\r
- if ClassName <> "" then ColumnObj.ClassName=ClassName\r
- AddColumn(ColumnObj)\r
- AddCalculatedField=ColumnObj\r
-End Function\r
-\r
-\r
-Private Function IsFieldName(s) as boolean\r
- dim i as integer, c as string\r
- i=1\r
- IsFieldName=false\r
- while i <= len(s)\r
- c=mid(s,i,1)\r
- if (c >= "0" and c <= "9" and i > 1) or (c >= "A" and c <= "Z") or (c >= "a" and c <= "z") or (c = "_") then\r
- i=i+1\r
- else\r
- exit function\r
- end if\r
- end while\r
- IsFieldName=(i > 1)\r
-End Function\r
-\r
-\r
-' name used external to this script\r
-Private function ExtFieldId(i) as string\r
- ExtFieldId=Me.UniqueId & "_" & i\r
-end function\r
-\r
-\r
-Private function FormatValue(v as String, ByVal ColIdx as Integer) as String\r
- dim addquotes as Boolean = columns(ColIdx).AddQuotes\r
- select case left(columns(ColIdx).EntryType,1)\r
- case "I","F":\r
- addquotes=false\r
- if not IsNumeric(v) then v=""\r
- case "N":\r
- if v=TableSelectNew then\r
- v=trim(Request.Form("textnew__" & ExtFieldId(ColIdx)))\r
- elseif v=TableSelectNone then\r
- v=""\r
- end if\r
- case "S","R":\r
- if v=TableSelectNone then v=""\r
- end select\r
- if v="" and columns(ColIdx).isNullable then\r
- FormatValue="NULL"\r
- elseif addquotes then\r
- FormatValue=oSqlCompat.addQuotes(v)\r
- else\r
- FormatValue=v\r
- end if\r
-end function\r
-\r
-\r
-Private function FormatFormValue(idx as Integer) as String\r
- dim v as String\r
- if IsNothing(columns(idx).EntryType) then exit function\r
- if columns(idx).EntryType="H" or columns(idx).FormView="exclude" then\r
- v=columns(idx).ColData\r
- else\r
- v=trim(Request.Form(ExtFieldId(idx)))\r
- end if\r
- FormatFormValue=FormatValue(v,idx)\r
-end function\r
-\r
-\r
-Private Function AltTableJoinClause(AltTabIdx as Integer) as String\r
- dim i as Integer, Condition as String\r
- for i=0 to columns.Count-1\r
- if columns(i).TableIdx=MainTbl and columns(i).isKey then\r
- AddCondition(Condition, Tables(MainTbl).TblAlias & "." & columns(i).ColName & "=" & Tables(AltTabIdx).TblAlias & "." & columns(i).ColName)\r
- end if\r
- next\r
- for i=0 to Tables(AltTabIdx).altFields.Count-1\r
- if Tables(AltTabIdx).altFields(i).isKey then\r
- AddCondition(Condition, Tables(AltTabIdx).FieldCondition(i))\r
- end if\r
- next\r
- AltTableJoinClause=Condition\r
-End Function\r
-\r
-\r
-' -------------------------------------------------------------\r
-' Add a condition to a where or having clause\r
-' -------------------------------------------------------------\r
-Public Sub AddCondition(ByRef WhereClause as String, ByVal NewCondition as String)\r
- if IsNothing(NewCondition) then exit sub\r
- If IsNothing(WhereClause) Then\r
- WhereClause = "(" & NewCondition & ")"\r
- Else\r
- WhereClause &= " AND (" & NewCondition & ")"\r
- End If\r
-End Sub\r
-\r
-\r
-' -------------------------------------------------------------\r
-' Return the form value of a column based on its column name (insert or update action)\r
-' -------------------------------------------------------------\r
-Public Function FormValue(ByVal SearchName as String) as String\r
- Dim idx as Integer = ColIndex(SearchName)\r
- if idx < 0 then\r
- FormValue = ""\r
- else\r
- FormValue = FormatFormValue(idx)\r
- end if\r
-End Function\r
-\r
-\r
-' -------------------------------------------------------------\r
-' Return the index of a column based on its column name, or -1 if not found\r
-' -------------------------------------------------------------\r
-Public Function ColIndex(ByVal SearchName as String) as Integer\r
- dim i as Integer\r
- ColIndex=-1\r
- for i=0 to columns.Count-1\r
- if columns(i).ColName=SearchName then\r
- ColIndex=i\r
- Exit Function\r
- end if\r
- next\r
-End Function\r
-\r
-\r
-' -------------------------------------------------------------\r
-' Return the a column object based on its column name, or Nothing if not found\r
-' -------------------------------------------------------------\r
-Public Function getColumnByName(ByVal SearchName as String) as GridColumn\r
- dim i as Integer\r
- for i=0 to columns.Count-1\r
- if columns(i).ColName=SearchName then\r
- getColumnByName=columns(i)\r
- Exit Function\r
- end if\r
- next\r
-End Function\r
-\r
-\r
-' -------------------------------------------------------------\r
-' Return the a column object based on its heading, or Nothing if not found\r
-' -------------------------------------------------------------\r
-Public Function getColumnByHeading(ByVal SearchName as String) as GridColumn\r
- dim i as Integer\r
- for i=0 to columns.Count-1\r
- if columns(i).Heading=SearchName then\r
- getColumnByHeading=columns(i)\r
- Exit Function\r
- end if\r
- next\r
-End Function\r
-\r
-\r
-' -------------------------------------------------------------\r
-' Return the index of a table based on its table name\r
-' -------------------------------------------------------------\r
-Public Function TabIndex(ByVal SearchName as String)\r
- dim i as Integer\r
- for i=0 to Tables.Count-1\r
- if Tables(i).TblName=SearchName then\r
- TabIndex=i\r
- Exit Function\r
- end if\r
- next\r
-End Function\r
-\r
-\r
-' -------------------------------------------------------------\r
-' Return the index of the new filter\r
-' -------------------------------------------------------------\r
-Public Function AddFilter(ByVal newfilter as String)\r
- AddFilter=_sqlFilters.Count\r
- _sqlFilters.Add(newfilter)\r
-End Function\r
-\r
-\r
-' form where clause based on table's primary key\r
-Public function MainTableKeyWhereClause() as String\r
- MainTableKeyWhereClause = TableKeyWhereClause(MainTbl)\r
-End Function\r
-\r
-\r
-' form where clause based on table's primary key\r
-Private function TableKeyWhereClause(TabIdx as Integer) as String\r
- dim i as Integer, w as String\r
- for i=0 to columns.Count-1\r
- if (columns(i).TableIdx=MainTbl or columns(i).TableIdx=TabIdx) and IsNothing(columns(i).Formula) and columns(i).isKey then\r
- AddCondition(w, columns(i).ColName & "=" & FormatValue(trim(Request.Form("_k" & i)),i))\r
- end if\r
- next\r
- if IsNothing(w) then\r
- 'Throw New Exception("no key value")\r
- else\r
- TableKeyWhereClause=" WHERE " & w\r
- end if\r
-end function\r
-\r
-\r
-Protected Sub GetColumnInfo()\r
- dim t as Integer, r as Integer, c as Integer, colname as String, schemaTable As DataTable\r
- Dim restrictions(3) As String\r
- if IsNothing(Me.dbConnection) then exit sub\r
- for t=0 to Tables.Count-1\r
- if debug then DebugString &= "<p>Table: " & Tables(t).TblName & " tblidx=" & t & " colcnt=" & columns.Count\r
-\r
- Dim command = Me.dbConnection.CreateCommand()\r
- command.CommandText = "select * from " & Tables(t).TblName\r
- dim rdr = command.ExecuteReader(CommandBehavior.KeyInfo or CommandBehavior.SchemaOnly)\r
- schemaTable = rdr.GetSchemaTable()\r
- For Each colinfo As DataRow In schemaTable.Rows\r
- colname = colinfo("ColumnName").ToString\r
- for c=0 to columns.Count-1\r
- if t=columns(c).TableIdx and colname=columns(c).ColName then\r
- with columns(c)\r
- .isNullable=CBool(colinfo("AllowDBNull"))\r
- .TypeName=replace(colinfo("DataType").ToString(),"System.","")\r
- if .TypeName<>"String" AndAlso not IsDBNull(colinfo("NumericPrecision")) AndAlso colinfo("NumericPrecision")<>0 then\r
- .Length=colinfo("NumericPrecision")\r
- elseif not IsDBNull(colinfo("ColumnSize")) then\r
- .Length=colinfo("ColumnSize")\r
- end if\r
- .Writeable=not colinfo("IsReadOnly")\r
- .isKey=colinfo("IsKey")\r
- 'columns(c).FixedLength=((colinfo("COLUMN_FLAGS") and &H0000010) <> 0)\r
- if debug then DebugString &= "<br> Column: " & colname & " type=" & .TypeName & " len=" & .Length & " nullable=" & .isNullable & " isKey=" & .isKey\r
- end with\r
- exit for\r
- end if\r
- next\r
- \r
- for c=0 to Tables(t).altFields.Count-1\r
- if colname=Tables(t).altFields(c).ColName then\r
- Tables(t).altFields(c).isKey=colinfo("IsKey")\r
- exit for\r
- end if\r
- next\r
- Next\r
- rdr.Close()\r
- \r
- ' AllowDBNull is not accurate when using Jet driver\r
- if InStr(Me.dbConnection.ConnectionString,"Microsoft.Jet") > 0 then\r
- restrictions(2)=Tables(t).TblName\r
- schemaTable = Me.dbConnection.GetSchema("Columns",restrictions)\r
- For Each colinfo As DataRow In schemaTable.Rows\r
- colname = colinfo("column_name").ToString\r
- for c=0 to columns.Count-1\r
- if t=columns(c).TableIdx and colname=columns(c).ColName then\r
- with columns(c)\r
- .isNullable=CBool(colinfo("is_nullable"))\r
- if debug then DebugString &= "<br> Column: " & colname & " nullable=" & .isNullable\r
- end with\r
- exit for\r
- end if\r
- next\r
- Next\r
- end if\r
- Next\r
-End Sub\r
-\r
-\r
-Protected Function UpdateDatabase(sqltext as String, actiontxt as String) as String\r
- dim cnt as Integer\r
- if IsNothing(Me.dbConnection) then\r
- UpdateDatabase="<p>ERROR: no database connection</p>"\r
- else\r
- Try\r
- Dim command = Me.dbConnection.CreateCommand()\r
- command.CommandText = sqltext\r
- cnt=command.ExecuteNonQuery()\r
- UpdateDatabase="<p class='ricoFormResponse " & actiontxt & "Successfully'></p>"\r
- Catch ex As Exception\r
- dim msg="<p>ERROR: unable to update database - " & server.HTMLencode(ex.Message.ToString()) & "</p>"\r
- if LogSqlOnError then msg &= "<br>" & server.HTMLencode(sqltext)\r
- UpdateDatabase=msg\r
- End Try\r
- 'if debug then msg &= " - " & sqltext & " - Records affected: " & cnt\r
- end if\r
-End Function\r
-\r
-\r
-Public Sub DeleteRecord(writer as HTMLTextWriter)\r
- dim sqltext as String = "DELETE FROM " & Tables(MainTbl).TblName & TableKeyWhereClause(MainTbl)\r
- writer.WriteLine(UpdateDatabase(sqltext, "deleted"))\r
-End Sub\r
-\r
-\r
-Public Sub InsertRecord(writer as HTMLTextWriter)\r
- dim i as Integer, keyIdx as Integer\r
- dim keyCnt as Integer=0\r
- dim sqlcol as String=""\r
- dim sqlval as String=""\r
- for i=0 to columns.Count-1\r
- if columns(i).TableIdx=MainTbl and not IsNothing(columns(i).EntryType) and columns(i).UpdateOnly=false then\r
- if columns(i).isKey then\r
- keyCnt=keyCnt+1\r
- keyIdx=i\r
- end if\r
- if columns(i).Writeable then\r
- sqlcol &= "," & columns(i).ColName\r
- sqlval &= "," & FormatFormValue(i)\r
- end if\r
- end if\r
- next\r
- if IsNothing(sqlcol) then\r
- writer.WriteLine("<p>Nothing to add</p>")\r
- else\r
- dim sqltext as String="insert into " & Tables(MainTbl).TblName & " (" & mid(sqlcol,2) & ") values (" & mid(sqlval,2) & ")"\r
- dim updateMsg as String = UpdateDatabase(sqltext, "added")\r
- writer.WriteLine(updateMsg)\r
- end if\r
-End Sub\r
-\r
-\r
-Public Sub UpdateRecord(writer as HTMLTextWriter)\r
- dim i as Integer, sqltext as String, errmsg as String=""\r
- for i=0 to Tables.Count-1\r
- if i<>MainTbl then errmsg &= UpdateAltTableRecords(i)\r
- next\r
- if errmsg<>"" then\r
- writer.WriteLine("<p>" & errmsg & "</p>")\r
- exit sub\r
- end if\r
- for i=0 to columns.Count-1\r
- if columns(i).TableIdx=MainTbl and not IsNothing(columns(i).EntryType) and columns(i).Writeable and columns(i).InsertOnly=false then\r
- sqltext &= "," & columns(i).ColName & "=" & FormatFormValue(i)\r
- end if\r
- next\r
- if not IsNothing(sqltext) then\r
- sqltext="UPDATE " & Tables(MainTbl).TblName & " SET " & mid(sqltext,2) & TableKeyWhereClause(MainTbl)\r
- writer.WriteLine(UpdateDatabase(sqltext, "updated"))\r
- elseif Tables.Count > 1 then\r
- ' only updated altTable records\r
- writer.WriteLine("<p class='ricoFormResponse updatedSuccessfully'></p>")\r
- else\r
- writer.WriteLine("<p>Nothing to update</p>")\r
- end if\r
-End Sub\r
-\r
-\r
-Private function UpdateAltTableRecords(tabidx as Integer)\r
- dim j as Integer, cnt as Integer\r
- dim sqltext as String, colnames as String, coldata as String\r
- dim whereClause as String, errmsg as String\r
-\r
- ' check for existing record\r
-\r
- whereClause = TableKeyWhereClause(tabidx) & Tables(tabidx).KeyCondition()\r
- sqltext="select count(*) from " & Tables(tabidx).TblName & " " & Tables(tabidx).TblAlias & whereClause\r
- Try\r
- Dim command = Me.dbConnection.CreateCommand()\r
- command.CommandText = sqltext\r
- cnt=command.ExecuteScalar()\r
- Catch ex As Exception\r
- errmsg = "UpdateAltTableRecords Count<br>ERROR: " & server.HTMLencode(ex.Message.ToString())\r
- if LogSqlOnError then errmsg &= "<br>" & sqltext\r
- UpdateAltTableRecords = errmsg\r
- exit function\r
- End Try\r
- \r
- if cnt = 0 then\r
-\r
- ' insert new record\r
- \r
- colnames=""\r
- coldata=""\r
- for j=0 to columns.Count-1\r
- if (columns(j).TableIdx=tabidx and not IsNothing(columns(j).EntryType)) or columns(j).isKey then\r
- colnames &= "," & columns(j).ColName\r
- coldata &= "," & FormatFormValue(j)\r
- end if\r
- next\r
- for j=0 to Tables(tabidx).altFields.Count-1\r
- colnames &= "," & Tables(tabidx).altFields(j).ColName\r
- coldata &= "," & Tables(tabidx).altFields(j).Data\r
- next\r
- Try\r
- Dim command = Me.dbConnection.CreateCommand()\r
- sqltext="insert into " & Tables(tabidx).TblName & " (" & mid(colnames,2) & ") values (" & mid(coldata,2) & ")"\r
- command.CommandText = sqltext\r
- cnt=command.ExecuteNonQuery()\r
- Catch ex As Exception\r
- errmsg="UpdateAltTableRecords Insert<br>ERROR: " & server.HTMLencode(ex.Message.ToString())\r
- if LogSqlOnError then errmsg &= "<br>" & sqltext\r
- UpdateAltTableRecords = errmsg\r
- End Try\r
-\r
- else\r
-\r
- ' update record\r
- \r
- sqltext=""\r
- for j=0 to columns.Count-1\r
- if columns(j).TableIdx=tabidx and not IsNothing(columns(j).EntryType) then\r
- sqltext &= "," & columns(j).ColName & "=" & FormatFormValue(j)\r
- end if\r
- next\r
- for j=0 to Tables(tabidx).altFields.Count-1\r
- sqltext &= "," & Tables(tabidx).altFields(j).ColName & "=" & Tables(tabidx).altFields(j).Data\r
- next\r
- if sqltext <> "" then\r
- Try\r
- Dim command = Me.dbConnection.CreateCommand()\r
- sqltext="update " & Tables(tabidx).TblName & " set " & mid(sqltext,2) & whereClause\r
- command.CommandText = sqltext\r
- cnt=command.ExecuteNonQuery()\r
- Catch ex As Exception\r
- errmsg="UpdateAltTableRecords Update<br>ERROR: " & server.HTMLencode(ex.Message.ToString())\r
- if LogSqlOnError then errmsg &= "<br>" & sqltext\r
- UpdateAltTableRecords = errmsg\r
- End Try\r
- end if\r
- end if\r
-end function\r
-\r
-\r
-' -------------------------------------\r
-' form main sql query to populate the grid\r
-' -------------------------------------\r
-Protected Sub FormSqlQuery()\r
- Dim oParseLookup=new sqlParse\r
- Dim oParseSubQry=new sqlParse\r
- Dim i as Integer\r
- Dim j as Integer\r
- Dim s as String\r
- Dim tabidx as Integer\r
- Dim csvPrimaryKey as String\r
- if debug then DebugString &= "<p>FormSqlQuery"\r
- oParseMain.FromClause=Tables(MainTbl).TblName & " t"\r
- for i=0 to Tables.Count-1\r
- if i<>MainTbl then\r
- s="left join " & Tables(i).TblName & " " & Tables(i).TblAlias & " ON " & AltTableJoinClause(i)\r
- oParseMain.AddJoin(s)\r
- end if\r
- next\r
- oParseMain.AddWhereCondition(TableFilter)\r
- \r
- ' build sql for each column\r
- \r
- for i=0 to columns.Count-1\r
- if columns(i).TableIdx>=0 then tabidx=columns(i).TableIdx\r
- if columns(i).FilterFlag then\r
- ' add any column filters to where clause\r
- oParseMain.AddWhereCondition(Tables(tabidx).TblAlias & "." & columns(i).ColName & "='" & columns(i).ColData & "'")\r
- end if\r
-\r
- if not IsNothing(columns(i).Formula) then\r
-\r
- ' computed column\r
-\r
- oParseMain.AddColumn("(" & columns(i).Formula & ")", columns(i).Heading)\r
-\r
- elseif tabidx=MainTbl then\r
-\r
- ' column from main table - avoid subqueries to make it compatible with MS Access & MySQL < v4.1\r
-\r
- if columns(i).isKey then\r
- if not IsNothing(csvPrimaryKey) then csvPrimaryKey &= ","\r
- csvPrimaryKey &= Tables(tabidx).TblAlias & "." & columns(i).ColName\r
- end if\r
- if columns(i).isLookupField() and not IsNothing(columns(i).SelectSql) then\r
- Dim TblAlias as String="t" & CStr(i)\r
- s=replace(columns(i).SelectSql,"%alias%",TblAlias & ".")\r
- oParseLookup.ParseSelect(s)\r
- if oParseLookup.SelectList.count=2 then\r
- Dim codeField as String=oParseLookup.SelectList(0).sql\r
- Dim descField as String=oParseLookup.SelectList(1).sql\r
- If IsFieldName(descField) Then\r
- descField=TblAlias & "." & descField\r
- Else\r
- descField=replace(replace(descField,"%alias%",TblAlias & "."),"%aliasmain%","t.")\r
- End If\r
- s="left join " & oParseLookup.FromClause & " " & TblAlias & " on t." & columns(i).ColName & "=" & TblAlias & "." & replace(replace(codeField,"%alias%",""),"%aliasmain%","")\r
- if not IsNothing(oParseLookup.WhereClause) then s &= " and " & replace(oParseLookup.WhereClause,"%alias%",TblAlias & ".")\r
- oParseMain.AddJoin(s)\r
- oParseMain.AddColumn(Tables(tabidx).TblAlias & "." & columns(i).ColName)\r
- if IsNothing(columns(i).DescriptionCol) then\r
- columns(i+1).Formula=descField\r
- end if\r
- \r
- else\r
- Throw New Exception("Invalid lookup query (" & columns(i).SelectSql & ")")\r
- end if\r
- else\r
- oParseMain.AddColumn(Tables(tabidx).TblAlias & "." & columns(i).ColName, columns(i).Heading)\r
- end if\r
-\r
- else\r
-\r
- ' column from alt table - no avoiding subqueries here\r
-\r
- if columns(i).isLookupField() and not IsNothing(columns(i).SelectSql) then\r
- oParseLookup.ParseSelect(columns(i).SelectSql)\r
- if oParseLookup.SelectList.count=2 then\r
- Dim descQuery as String="select " & oParseLookup.SelectList(1).sql & " from " & oParseLookup.FromClause & " where " & _\r
- oParseLookup.SelectList(0).sql & "=" & Tables(tabidx).TblAlias & "." & columns(i).ColName\r
- if not IsNothing(oParseLookup.WhereClause) then descQuery=descQuery & " and " & oParseLookup.WhereClause\r
- oParseMain.AddColumn(Tables(tabidx).TblAlias & "." & columns(i).ColName)\r
- columns(i+1).Formula="(" & descQuery & ")"\r
- else\r
- Throw New Exception("Invalid lookup query (" & columns(i).SelectSql & ")")\r
- end if\r
- else\r
- oParseMain.AddColumn(Tables(tabidx).TblAlias & "." & columns(i).ColName, columns(i).Heading)\r
- end if\r
-\r
- end if\r
-\r
- if not IsNothing(columns(i).EntryType) then\r
- Dim SessionColId as String = ExtFieldId(i)\r
- if InStr("CSNR",left(columns(i).EntryType,1)) > 0 then\r
- if not IsNothing(columns(i).SelectSql) then\r
- s=columns(i).SelectSql\r
- if not IsNothing(columns(i).SelectFilter) then\r
- oParseLookup.ParseSelect(s)\r
- oParseLookup.AddWhereCondition(columns(i).SelectFilter)\r
- s=oParseLookup.UnparseSelect\r
- end if\r
- oParseMain.SelectList(i).LookupQuery=replace(replace(s,"%alias%",""),"%aliasmain%","")\r
- else\r
- oParseMain.SelectList(i).LookupQuery="select distinct " & columns(i).ColName & " from " & Tables(tabidx).TblName & " where " & columns(i).ColName & " is not null"\r
- end if\r
- end if\r
- end if\r
- next\r
- if not IsNothing(DefaultSort) then\r
- oParseMain.AddSort(DefaultSort)\r
- elseif not IsNothing(csvPrimaryKey) then\r
- oParseMain.AddSort(csvPrimaryKey)\r
- end if\r
-End Sub\r
-\r
-\r
-Protected Overrides Sub OnPreRender(ByVal e As System.EventArgs) \r
- MyBase.OnPreRender(e)\r
- if not IsNothing(dbConnection) then\r
- oSqlCompat=New sqlCompatibilty(dbDialect)\r
- end if\r
- \r
- ' Create headings\r
- Dim i as Integer\r
- for i=0 to columns.Count-1\r
- if not IsNothing(columns(i).AltTable) then\r
- columns(i).TableIdx=TabIndex(columns(i).AltTable)\r
- else\r
- columns(i).TableIdx=MainTbl\r
- end if\r
- Dim cell as New TableHeaderCell()\r
- cell.Text=columns(i).Heading\r
- if i<frozenColumns then cell.CssClass="ricoFrozen"\r
- LiveGridHeadingsMain.Controls.Add(cell)\r
- next\r
- \r
- if BufferType="AjaxXML" or not sessions then Me.DisplayTimer=false\r
- if Tables.count > 0 then\r
- Me.GetColumnInfo()\r
- if _action="table" and sessions then\r
- Me.FormSqlQuery()\r
- session.contents(Me.UniqueId)=oParseMain\r
- session.contents(Me.UniqueId & ".filters")=Me._sqlFilters\r
- elseif _action="query" then\r
- Me.FormSqlQuery()\r
- end if\r
- end if\r
-\r
- ' populate globalInitScript\r
- Dim FixedGridScript as String = ""\r
- Dim VarGridScript as String = ""\r
- Dim gblFormView as Boolean = false\r
- If Not Page.IsStartupScriptRegistered("LiveGridInit") Then\r
- For Each ctrl As Control In Page.Controls\r
- If TypeOf(ctrl) is LiveGrid then\r
- if CType(ctrl,LiveGrid).Rows >= 0 then\r
- FixedGridScript &= " " & ctrl.UniqueId & "_init" & "();" & vbCrLf\r
- else\r
- VarGridScript &= " " & ctrl.UniqueId & "_init" & "();" & vbCrLf\r
- end if\r
- if CType(ctrl,LiveGrid).formView then gblFormView=true\r
- End If\r
- Next\r
- 'globalInitScript = "Rico.acceptLanguage('" & Request.ServerVariables("HTTP_ACCEPT_LANGUAGE") & "');" & vbCrLf\r
- if not UsingMinRico then\r
- globalInitScript &= "Rico.loadModule('LiveGridAjax','LiveGridMenu');" & vbCrLf\r
- if gblFormView then globalInitScript &= "Rico.loadModule('LiveGridForms');" & vbCrLf\r
- end if\r
- globalInitScript &= "Rico.onLoad( function() {" & vbCrLf\r
- globalInitScript &= FixedGridScript ' initialize grids with fixed # of rows first\r
- globalInitScript &= VarGridScript & "});" & vbCrLf ' then initialize grids with variable # of rows\r
- Page.RegisterStartupScript("LiveGridInit", "")\r
- End If\r
-End Sub\r
-\r
-\r
-Public Class GridContainer\r
- Inherits Control\r
- Implements INamingContainer\r
-End Class\r
-\r
-End Class\r
projects / infodrom / rico3 / commitdiff