--- /dev/null
+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 = sizeToWindow\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 requestParameters as New Hashtable()\r
+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 BufferType as String = "AjaxSQL" ' can be overridden to AjaxXML\r
+Public maxPrint as Integer = -1\r
+Public dndMgrIdx as Integer = -1\r
+Public fmt as String = "xml"\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
+\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
+ 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 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 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
+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 / blobdiff