git.infodrom.org Git - infodrom/rico3/blob - plugins/asp/ricoLiveGridForms.vbs

   1 <%\r
   2 '**********************************\r
   3 ' Rico: GENERIC TABLE/VIEW EDITOR\r
   4 '  By Matt Brown\r
   5 '**********************************\r
   6 \r
   7 class TableEditTable\r
   8   Public TblName,alias,arFields,arData,arColInfo(100)\r
   9 end class\r
  10 \r
  11 \r
  12 class TableEditClass\r
  13 \r
  14 Public action,options,AutoInit,CurrentField,LookupField,sessions\r
  15 Public SvrOnly,gridID,formVar,gridVar,bufferVar,optionsVar,DefaultSort,formView\r
  16 \r
  17 Private Panels(20)\r
  18 Private objDB,CurrentPanel,oParseMain\r
  19 Private xhtmlcloser\r
  20 Private ErrorFlag,ErrorMsg,MainTbl\r
  21 Private Tables(30),TableCnt\r
  22 Private Fields(200),FieldCnt\r
  23 \r
  24 \r
  25 '*************************************************************************************\r
  26 ' Class Constructor\r
  27 '*************************************************************************************\r
  28 Private Sub Class_Initialize\r
  29   dim a,resize,i\r
  30   if IsObject(oDB) then set objDB=oDB  ' use oDB global as database connection, if it exists\r
  31 \r
  32   set options = CreateObject("Scripting.Dictionary")\r
  33   options("TableSelectNew")="___new___"\r
  34   options("TableSelectNone")=""\r
  35   options("canAdd")=true\r
  36   options("canEdit")=true\r
  37   options("canDelete")=true\r
  38   options("ConfirmDelete")=true\r
  39   options("ConfirmDeleteCol")=-1\r
  40   options("DebugFlag")=(trim(Request.QueryString("debug"))<>"")\r
  41   options("prefetchBuffer")=true\r
  42   options("PanelNamesOnTabHdr")=true\r
  43   options("highlightElem")="menuRow"\r
  44 \r
  45   set SvrOnly = CreateObject("Scripting.Dictionary")\r
  46   SvrOnly("DropDownSelect")=1\r
  47   SvrOnly("SelectSql")=1\r
  48   SvrOnly("SelectFilter")=1\r
  49   SvrOnly("TableIdx")=1\r
  50   SvrOnly("AddQuotes")=1\r
  51   SvrOnly("FilterFlag")=1\r
  52   SvrOnly("XMLprovider")=1\r
  53 \r
  54   xhtmlcloser=">"\r
  55   FieldCnt=-1\r
  56   CurrentPanel=-1\r
  57   TableCnt=-1\r
  58   AutoInit=true\r
  59   ErrorFlag=false\r
  60   ErrorMsg=""\r
  61   formView=true\r
  62   sessions=true\r
  63   set oParseMain=new sqlParse\r
  64   oParseMain.Init(-1)\r
  65 end Sub\r
  66 \r
  67 \r
  68 '*************************************************************************************\r
  69 ' Class Destructor\r
  70 '*************************************************************************************\r
  71 Private Sub Class_Terminate   ' Setup Terminate event.\r
  72   for i=0 to FieldCnt\r
  73     set Fields(i)=Nothing\r
  74   next\r
  75   set options = Nothing\r
  76   set SvrOnly = Nothing\r
  77   set oParseMain = Nothing\r
  78 end Sub\r
  79 \r
  80 \r
  81 Public Property Let TableFilter(filter)\r
  82   oParseMain.AddWhereCondition filter\r
  83 End Property\r
  84 \r
  85 \r
  86 ' returns field number if successful, empty if error\r
  87 Public Function AddEntryField(ColumnName,Heading,EntryTypeCode,DefaultValue)\r
  88   if InStr("/S/N/R/H/D/DT/I/F/B/T/TA/SL/RL/CL/tinyMCE/","/" & EntryTypeCode & "/") < 1 then\r
  89     TableEditError "invalid EntryTypeCode in TableEditClass"\r
  90     exit Function\r
  91   end if\r
  92   if not IncrCurrentField then exit Function\r
  93   CurrentField("ColName")=ColumnName\r
  94   CurrentField("Hdg")=Heading\r
  95   CurrentField("EntryType")=EntryTypeCode\r
  96   CurrentField("ColData")=DefaultValue\r
  97   select case EntryTypeCode\r
  98     case "D": CurrentField("type")="date"\r
  99     case "DT": CurrentField("type")="datetime"\r
 100     case "TA","tinyMCE" : CurrentField("TxtAreaRows")=4 : CurrentField("TxtAreaCols")=80\r
 101     case "R","RL": CurrentField("RadioBreak")="<br" & xhtmlcloser\r
 102     case "H": CurrentField("visible")=false\r
 103   end select\r
 104   dim s\r
 105   s=Tables(MainTbl).alias & "." & ColumnName\r
 106   If InStr("/B/T/TA/tinyMCE/","/" & EntryTypeCode & "/") > 0 Then s="rtrim(" & s & ")"\r
 107   oParseMain.AddColumn s,"rico_col" & FieldCnt\r
 108   AddEntryField=FieldCnt\r
 109 end Function\r
 110 \r
 111 \r
 112 ' returns field number if successful, empty if error\r
 113 Public Function AddEntryFieldW(ColumnName,Heading,EntryTypeCode,DefaultValue,Width)\r
 114   dim retval\r
 115   retval=AddEntryField(ColumnName,Heading,EntryTypeCode,DefaultValue)\r
 116   if not IsEmpty(retval) then CurrentField("width")=Width\r
 117   AddEntryFieldW=retval\r
 118 end Function\r
 119 \r
 120 ' DescColName is optional - pass empty if not used\r
 121 Public Function AddLookupField(CodeColName,DescColName,CodeHdg,DisplayHdg,EntryTypeCode,DefaultValue,sql)\r
 122   dim alias,s,codeField,descField,oParseLookup\r
 123   AddLookupField=AddEntryField(CodeColName,CodeHdg,EntryTypeCode,DefaultValue)\r
 124   CurrentField("visible")=false\r
 125   CurrentField("SelectSql")=sql\r
 126   if not IsEmpty(DescColName) then\r
 127     CurrentField("DescriptionField")=ExtFieldId(FieldCnt+1)\r
 128   end if\r
 129   set LookupField=CurrentField\r
 130   set oParseLookup=new sqlParse\r
 131   alias="t" & FieldCnt\r
 132   oParseLookup.ParseSelect sql\r
 133   if ubound(oParseLookup.arSelList)=1 then\r
 134     codeField=oParseLookup.arSelList(0)\r
 135     descField=oParseLookup.arSelList(1)\r
 136     s="left join " & oParseLookup.FromClause & " " & alias & " on t." & CodeColName & "=" & alias & "." & replace(replace(codeField,"%alias%",""),"%aliasmain%","")\r
 137     if not IsEmpty(oParseLookup.WhereClause) then s=s & " and " & replace(oParseLookup.WhereClause,"%alias%",alias & ".")\r
 138     oParseMain.AddJoin s\r
 139     IncrCurrentField\r
 140     CurrentField("ColName")="Lookup_" & FieldCnt\r
 141     CurrentField("Hdg")=DisplayHdg\r
 142     If not IsEmpty(DescColName) then\r
 143       descField=Tables(MainTbl).alias & "." & DescColName\r
 144       CurrentField("ColName")=DescColName\r
 145       CurrentField("FormView")="hidden"\r
 146       CurrentField("EntryType")="T"\r
 147     ElseIf IsFieldName(descField) Then\r
 148       descField=alias & "." & descField\r
 149     Else\r
 150       descField=replace(replace(descField,"%alias%",alias & "."),"%aliasmain%","t.")\r
 151     End If\r
 152     oParseMain.AddColumn descField,"rico_col" & FieldCnt\r
 153   else\r
 154     TableEditError "Invalid lookup query (" & sql & ")"\r
 155   end if\r
 156   set oParseLookup = Nothing\r
 157 end Function\r
 158 \r
 159 \r
 160 ' returns field number if successful, empty if error\r
 161 Public Function AddCalculatedField(ByVal ColumnFormula, ByVal Heading)\r
 162   if not IncrCurrentField then exit Function\r
 163   if left(ColumnFormula,1) <> "(" then ColumnFormula="(" & ColumnFormula & ")"\r
 164   CurrentField("ColName")="Calc_" & FieldCnt\r
 165   CurrentField("Hdg")=Heading\r
 166   oParseMain.AddColumn ColumnFormula,"rico_col" & FieldCnt\r
 167   AddCalculatedField=FieldCnt\r
 168 end Function\r
 169 \r
 170 \r
 171 Public Sub AddPanel(ByVal PanelHeading)\r
 172   if CurrentPanel >= ubound(Panels) then\r
 173     TableEditError "exceeded max # of panels in TableEditClass"\r
 174     exit sub\r
 175   end if\r
 176   CurrentPanel=CurrentPanel+1\r
 177   Panels(CurrentPanel)=PanelHeading\r
 178 end Sub\r
 179 \r
 180 \r
 181 Public Function DefineAltTable(ByVal AltTabName, arFieldList, arFieldData)\r
 182   if TableCnt >= ubound(Tables) then\r
 183     TableEditError "exceeded max # of alternate tables in TableEditClass"\r
 184     exit Function\r
 185   end if\r
 186   TableCnt=TableCnt+1\r
 187   set Tables(TableCnt)=new TableEditTable\r
 188   with Tables(TableCnt)\r
 189     .TblName=AltTabName\r
 190     .alias="a" & TableCnt\r
 191     .arFields=arFieldList\r
 192     .arData=arFieldData\r
 193     if ubound(.arFields) <> ubound(.arData) then\r
 194       TableEditError "# of fields does not match # of data entries supplied for table " & AltTabName\r
 195       exit Function\r
 196     end if\r
 197   end with\r
 198   DefineAltTable=TableCnt\r
 199 end Function\r
 200 \r
 201 \r
 202 ' returns true if FieldCnt successfully incremented\r
 203 Private Function IncrCurrentField\r
 204   if FieldCnt >= ubound(Fields) then\r
 205     TableEditError "exceeded max # of columns in TableEditClass"\r
 206     IncrCurrentField=false\r
 207     exit Function\r
 208   end if\r
 209   FieldCnt=FieldCnt+1\r
 210   set CurrentField = CreateObject("Scripting.Dictionary")\r
 211   set Fields(FieldCnt)=CurrentField\r
 212   if CurrentPanel>=0 then CurrentField("panelIdx")=CurrentPanel else CurrentField("panelIdx")=0\r
 213   CurrentField("AddQuotes")=true\r
 214   CurrentField("ReadOnly")=false\r
 215   CurrentField("TableIdx")=MainTbl\r
 216   IncrCurrentField=true\r
 217 end Function\r
 218 \r
 219 \r
 220 Public Sub SetTableName(ByVal s)\r
 221   dim actionparm\r
 222   TableCnt=TableCnt+1\r
 223   MainTbl=TableCnt\r
 224   set Tables(TableCnt)=new TableEditTable\r
 225   with Tables(TableCnt)\r
 226     .TblName=s\r
 227     .alias="t"\r
 228   end with\r
 229   oParseMain.FromClause=s & " t"\r
 230   gridID=LCase(replace(replace(s,".","_")," ","_"))\r
 231   formVar=gridID & "['edit']"\r
 232   gridVar=gridID & "['grid']"\r
 233   bufferVar=gridID & "['buffer']"\r
 234   optionsVar=gridID & "['options']"\r
 235   actionparm="_action_" & gridID\r
 236   action=trim(Request.QueryString(actionparm))\r
 237   if action="" then action=trim(Request.Form(actionparm))\r
 238   if action="" then action="table" else action=lcase(action)\r
 239 end Sub\r
 240 \r
 241 \r
 242 Private Sub AddSort(field,direction)\r
 243   if not IsEmpty(DefaultSort) then DefaultSort=DefaultSort & ","\r
 244   DefaultSort=DefaultSort & field & " " & direction\r
 245 end Sub\r
 246 \r
 247 \r
 248 Public Sub SortCurrent(direction)\r
 249   AddSort oParseMain.LastColumn,direction\r
 250   options("sortCol")=FieldCnt\r
 251   options("sortDir")=direction\r
 252 end Sub\r
 253 \r
 254 \r
 255 Public Sub SortAsc()\r
 256   SortCurrent "ASC"\r
 257 end Sub\r
 258 \r
 259 \r
 260 Public Sub SortDesc()\r
 261   SortCurrent "DESC"\r
 262 end Sub\r
 263 \r
 264 \r
 265 Public Sub ConfirmDeleteColumn()\r
 266   options("ConfirmDeleteCol")=FieldCnt\r
 267 end Sub\r
 268 \r
 269 \r
 270 Public Sub genXHTML()\r
 271   xhtmlcloser=" />"\r
 272 end Sub
 273 \r
 274 \r
 275 Public Sub SetDbConn(ByRef dbcls)\r
 276   set objDB=dbcls\r
 277 end Sub\r
 278 \r
 279 \r
 280 '*************************************************************************************\r
 281 ' Take appropriate action\r
 282 '*************************************************************************************\r
 283 Public Sub DisplayPage()\r
 284   if FieldCnt < 0 then exit sub\r
 285   if not ErrorFlag then GetColumnInfo\r
 286   if not ErrorFlag then\r
 287     select case action\r
 288       case "del"  if options("canDelete") then TableDeleteRecord\r
 289       case "ins"  if options("canAdd") then TableInsertRecord\r
 290       case "upd"  if options("canEdit") then TableUpdateRecord\r
 291       case else\r
 292         if sessions then session.contents(gridID)=SqlSelectData\r
 293         TableDisplay\r
 294     end select\r
 295   end if\r
 296   if ErrorFlag then\r
 297     response.write vbLf & "<p style='color:red;'><span style='text-decoration:underline;'>ERROR ENCOUNTERED</span><br" & xhtmlcloser & ErrorMsg\r
 298   end if\r
 299 end Sub\r
 300 \r
 301 ' if AltTable has a multi-column key, then add those additional constraints\r
 302 Private function AltTableKeyWhereClause(AltTabIdx)\r
 303   dim w,i\r
 304   for i=0 to ubound(Tables(AltTabIdx).arFields)\r
 305     if Tables(AltTabIdx).arColInfo(i).IsPKey then\r
 306       w=w & " and " & Tables(AltTabIdx).arFields(i) & "=" & Tables(AltTabIdx).arData(i)\r
 307     end if\r
 308   next\r
 309   AltTableKeyWhereClause=w\r
 310 end function\r
 311 \r
 312 Private function AltTableJoinClause(alias)\r
 313   dim i,w\r
 314   for i=0 to FieldCnt\r
 315     if Fields(i)("TableIdx")=MainTbl and not IsCalculatedField(i) then\r
 316       if Fields(i)("ColInfo").IsPKey then objDB.AddCondition w,Fields(i)("ColName") & "=" & alias & "." & Fields(i)("ColName")\r
 317     end if\r
 318   next\r
 319   AltTableJoinClause=w\r
 320 end function\r
 321 \r
 322 ' form where clause based on table's primary key\r
 323 Private function TableKeyWhereClause()\r
 324   dim i,w\r
 325   for i=0 to FieldCnt\r
 326     if Fields(i)("TableIdx")=MainTbl and not IsCalculatedField(i) then\r
 327       if Fields(i)("ColInfo").IsPKey then objDB.AddCondition w,Fields(i)("ColName") & "=" & FormatValue(trim(Request.Form("_k" & i)),i)\r
 328     end if\r
 329   next\r
 330   if IsEmpty(w) then\r
 331     TableEditError "no key value"\r
 332   else\r
 333     TableKeyWhereClause=" WHERE " & w\r
 334   end if\r
 335 end function\r
 336 \r
 337 ' name used external to this script\r
 338 Private function ExtFieldId(i)\r
 339   ExtFieldId=gridID & "_" & i\r
 340 end function\r
 341 \r
 342 \r
 343 Private function IsCalculatedField(i)\r
 344   IsCalculatedField=not Fields(i).exists("EntryType")\r
 345 end function\r
 346 \r
 347 \r
 348 '*************************************************************************************\r
 349 ' Retrieves column info from database for main table and any alternate tables\r
 350 '*************************************************************************************\r
 351 Private sub GetColumnInfo()\r
 352   dim c,i,j,FieldNum,cnt,colname,Columns(250),dicColIdx\r
 353   set dicColIdx = CreateObject("Scripting.Dictionary")\r
 354   dicColIdx.CompareMode=1\r
 355   for FieldNum=0 to FieldCnt\r
 356     dicColIdx.Add Fields(FieldNum)("TableIdx") & "." & Fields(FieldNum)("ColName"),FieldNum\r
 357     if options("canEdit")=false and options("canAdd")=false then Fields(FieldNum)("ReadOnly")=true\r
 358   next\r
 359   for i=0 to TableCnt\r
 360     cnt=objDB.GetColumnInfo(Tables(i).TblName,Columns)\r
 361     if cnt<1 then\r
 362       TableEditError "unable to retrieve column info for " & Tables(i).TblName & "<br>" & objDB.LastErrorMsg\r
 363       exit sub\r
 364     end if\r
 365     for c=0 to cnt-1\r
 366       colname=trim(Columns(c).ColName)\r
 367       if dicColIdx.exists(i & "." & colname) then\r
 368         FieldNum=dicColIdx(i & "." & colname)\r
 369         set Fields(FieldNum)("ColInfo")=Columns(c)\r
 370       elseif i<>MainTbl then\r
 371         for j=0 to ubound(Tables(i).arFields)\r
 372           if colname=Tables(i).arFields(j) then set Tables(i).arColInfo(j)=Columns(c)\r
 373         next\r
 374       elseif Columns(c).IsPKey then\r
 375         TableEditError "primary key field is not defined (" & Tables(i).TblName & "." & colname & ")"\r
 376         set dicColIdx = Nothing\r
 377         exit sub\r
 378       end if\r
 379     next\r
 380   next\r
 381   set dicColIdx = Nothing\r
 382 end sub\r
 383 \r
 384 Private sub TableUpdateDatabase(ByVal sqltext, ByVal actiontxt)\r
 385   dim errmsg,cnt\r
 386   if ErrorFlag then exit sub\r
 387   cnt=objDB.RunActionQueryReturnMsg(sqltext,errmsg)\r
 388   if IsEmpty(errmsg) and cnt=1 then\r
 389     response.write "<p class='ricoFormResponse " & actiontxt & "Successfully'></p>"\r
 390     if options("DebugFlag") then response.write "<p class='debug'>" & sqltext & "<br" & xhtmlcloser & "Records affected: " & cnt\r
 391   else\r
 392     TableEditError "unable to update database!<br" & xhtmlcloser & errmsg\r
 393   end if\r
 394 end sub\r
 395 \r
 396 \r
 397 Private function FormatValue(ByVal v, ByVal idx)\r
 398   dim fld,addquotes\r
 399   set fld=Fields(idx)\r
 400   addquotes=fld("AddQuotes")\r
 401   if v="" and Fields(idx)("ColInfo").Nullable then\r
 402     addquotes=false\r
 403     v="NULL"\r
 404   elseif fld("EntryType")="I" or fld("EntryType")="F" then\r
 405     addquotes=false\r
 406     if not IsNumeric(v) then v="NULL"\r
 407   elseif fld("EntryType")="N" and v=options("TableSelectNew") then\r
 408     v=trim(Request.Form("textnew__" & ExtFieldId(idx)))\r
 409   elseif InStr("SNR",left(fld("EntryType"),1)) > 0 and v=options("TableSelectNone") then\r
 410     addquotes=false\r
 411     v="NULL"\r
 412   end if\r
 413   if addquotes then v=objDB.addQuotes(v)\r
 414   FormatValue=v\r
 415 end function\r
 416 \r
 417 \r
 418 Private function FormatFormValue(idx)\r
 419   dim v\r
 420   if not Fields(idx).exists("EntryType") then exit function\r
 421   if Fields(idx)("EntryType")="H" or Fields(idx)("FormView")="exclude" then\r
 422     v=Fields(idx)("ColData")\r
 423   else\r
 424     v=trim(Request.Form(ExtFieldId(idx)))\r
 425   end if\r
 426   FormatFormValue=FormatValue(v,idx)\r
 427 end function\r
 428 \r
 429 \r
 430 '*************************************************************************************\r
 431 ' Deletes the specified record\r
 432 '   Assumes any AltTable columns are handled via referential integrity/cascading deletes\r
 433 '*************************************************************************************\r
 434 Private sub TableDeleteRecord()\r
 435   TableUpdateDatabase "DELETE FROM " & Tables(MainTbl).TblName & TableKeyWhereClause(), "deleted"\r
 436 end sub\r
 437 \r
 438 Private sub UpdateRecord(sqltext)\r
 439   dim errmsg\r
 440   objDB.RunActionQueryReturnMsg sqltext,errmsg\r
 441   if not IsEmpty(errmsg) then\r
 442     errmsg="unable to update database!<br" & xhtmlcloser & errmsg\r
 443     if options("DebugFlag") then errmsg=errmsg & "<p>SQL: " & sqltext\r
 444     TableEditError errmsg\r
 445   elseif options("DebugFlag") then\r
 446     response.write "<BR class='debug'>" & sqltext\r
 447   end if\r
 448 end sub\r
 449 \r
 450 Private sub UpdateAltTableRecords(i)\r
 451   dim j,sqltext,colnames,coldata,c\r
 452   if ErrorFlag then exit sub\r
 453 \r
 454   ' delete existing record\r
 455 \r
 456   sqltext="delete from " & Tables(i).TblName\r
 457   sqltext=sqltext & TableKeyWhereClause()\r
 458   sqltext=sqltext & AltTableKeyWhereClause(i)\r
 459   UpdateRecord(sqltext)\r
 460 \r
 461   ' insert new record\r
 462 \r
 463   colnames=""\r
 464   coldata=""\r
 465   for j=0 to FieldCnt\r
 466     if Fields(j).exists("ColInfo") then\r
 467       if Fields(j)("TableIdx")=i or Fields(j)("ColInfo").IsPKey then\r
 468         colnames=colnames & "," & Fields(j)("ColName")\r
 469         coldata=coldata & "," & FormatValue(trim(Request.Form(ExtFieldId(j))),j)\r
 470       end if\r
 471     end if\r
 472   next\r
 473   for j=0 to ubound(Tables(i).arFields)\r
 474     c=Tables(i).arFields(j)\r
 475     colnames=colnames & "," & c\r
 476     coldata=coldata & "," & Tables(i).arData(j)\r
 477   next\r
 478   sqltext="insert into " & Tables(i).TblName & " (" & mid(colnames,2) & ") values (" & mid(coldata,2) & ")"\r
 479   UpdateRecord(sqltext)\r
 480 end sub\r
 481 \r
 482 \r
 483 '*************************************************************************************\r
 484 ' Updates an existing record in the db\r
 485 '*************************************************************************************\r
 486 Private sub TableUpdateRecord()\r
 487   dim i,sqltext\r
 488   for i=0 to TableCnt\r
 489     if i<>MainTbl then UpdateAltTableRecords i\r
 490   next\r
 491   for i=0 to FieldCnt\r
 492     if not IsCalculatedField(i) then\r
 493       if Fields(i)("TableIdx")=MainTbl and Fields(i)("ColInfo").Writeable and not Fields(i).exists("InsertOnly") then\r
 494         sqltext=sqltext & "," & Fields(i)("ColName") & "=" & FormatFormValue(i)\r
 495       end if\r
 496     end if\r
 497   next\r
 498   sqltext="UPDATE " & Tables(MainTbl).TblName & " SET " & mid(sqltext,2)\r
 499   sqltext=sqltext & TableKeyWhereClause()\r
 500   TableUpdateDatabase sqltext, "updated"\r
 501 end sub\r
 502 \r
 503 '*************************************************************************************\r
 504 ' Inserts a new record into the db\r
 505 '*************************************************************************************\r
 506 Private sub TableInsertRecord()\r
 507   dim i,sqltext,sqlcol,sqlval,keyCnt,keyIdx\r
 508   keyCnt=0\r
 509   sqlcol=""\r
 510   sqlval=""\r
 511   for i=0 to FieldCnt\r
 512     if not IsCalculatedField(i) and Fields(i)("TableIdx")=MainTbl and not Fields(i).exists("UpdateOnly") then\r
 513       if Fields(i)("ColInfo").IsPKey then\r
 514         keyCnt=keyCnt+1\r
 515         keyIdx=i\r
 516       end if\r
 517       if Fields(i)("ColInfo").Writeable then\r
 518         sqlcol=sqlcol & "," & Fields(i)("ColName")\r
 519         sqlval=sqlval & "," & FormatFormValue(i)\r
 520       end if\r
 521     end if\r
 522   next\r
 523   sqltext="insert into " & Tables(MainTbl).TblName & " (" & mid(sqlcol,2) & ") values (" & mid(sqlval,2) & ")"\r
 524   TableUpdateDatabase sqltext, "added"\r
 525 end sub\r
 526 \r
 527 \r
 528 Private Sub TableEditError(msg)\r
 529   ErrorFlag=true\r
 530   ErrorMsg=msg\r
 531 End Sub\r
 532 \r
 533 \r
 534 Private Function IsFieldName(s)\r
 535   dim i,c\r
 536   i=1\r
 537   IsFieldName=false\r
 538   while i <= len(s)\r
 539     c=mid(s,i,1)\r
 540     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
 541       i=i+1\r
 542     else\r
 543       exit function\r
 544     end if\r
 545   wend\r
 546   IsFieldName=(i > 1)\r
 547 End Function\r
 548 \r
 549 \r
 550 '***********************************\r
 551 ' do post-processing on sql query\r
 552 '***********************************\r
 553 Private sub FinishQuery()\r
 554   dim oParseLookup\r
 555   dim i,s,codeField,descField,descQuery,alias,tabidx\r
 556 \r
 557   set oParseLookup=new sqlParse\r
 558   for i=0 to FieldCnt\r
 559     if Fields(i).exists("TableIdx") then tabidx=Fields(i)("TableIdx")\r
 560     if Fields(i).exists("FilterFlag") then\r
 561       ' add any column filters to where clause\r
 562       oParseMain.AddWhereCondition Tables(tabidx).alias & "." & Fields(i)("ColName") & "='" & Fields(i)("ColData") & "'"\r
 563     end if\r
 564     if Fields(i).exists("EntryType") then\r
 565       if InStr("CSNR",left(Fields(i)("EntryType"),1)) > 0 then\r
 566         if Fields(i).exists("SelectSql") then\r
 567           s=Fields(i)("SelectSql")\r
 568           if Fields(i).exists("SelectFilter") then\r
 569             oParseLookup.ParseSelect s\r
 570             oParseLookup.AddWhereCondition Fields(i)("SelectFilter")\r
 571             s=oParseLookup.UnparseSelect\r
 572           end if\r
 573           Fields(i)("DropDownSelect")=replace(replace(s,"%alias%",""),"%aliasmain%","")\r
 574         else\r
 575           s=Fields(i)("ColName")\r
 576           If Fields(i).exists("ColInfo") Then\r
 577             If Fields(i)("ColInfo").ColType="CHAR" and Fields(i)("ColInfo").FixedLength Then s="rtrim(" & s & ")"\r
 578           End If\r
 579           Fields(i)("DropDownSelect")="select distinct " & s & " from " & Tables(tabidx).TblName & " where " & Fields(i)("ColName") & " is not null"\r
 580         end if\r
 581       end if\r
 582     end if\r
 583 \r
 584     if tabidx<>MainTbl then\r
 585 \r
 586       ' column from alt table - no avoiding subqueries here\r
 587 \r
 588       s="(select " & Fields(i)("ColName") & " from " & Tables(tabidx).TblName & " a" & i & _\r
 589         " where " & AltTableJoinClause("t") & AltTableKeyWhereClause(tabidx) & ")"\r
 590       if mid(Fields(i)("EntryType"),2)="L" and Fields(i).exists("SelectSql") then\r
 591         oParseLookup.ParseSelect Fields(i)("SelectSql")\r
 592         if ubound(oParseLookup.arSelList)=1 then\r
 593           codeField=oParseLookup.arSelList(0)\r
 594           descField=oParseLookup.arSelList(1)\r
 595           descQuery="select " & descField & " from " & oParseLookup.FromClause & " where " & codeField & "=" & s\r
 596           if not IsEmpty(oParseLookup.WhereClause) then descQuery=descQuery & " and " & oParseLookup.WhereClause\r
 597           oParseMain.arSelList(i)="(" & objDB.concat(Array("(" & descQuery & ")","'<span class=""ricoLookup"">'",objDB.Convert2Char(s),"'</span>'"), false) & ")"\r
 598         else\r
 599           TableEditError "Invalid lookup query (" & Fields(i)("SelectSql") & ")"\r
 600           exit sub\r
 601         end if\r
 602       else\r
 603         oParseMain.arSelList(i)=s\r
 604       end if\r
 605 \r
 606     end if\r
 607   next\r
 608 \r
 609   if IsEmpty(DefaultSort) then DefaultSort=objDB.PrimaryKey(Tables(MainTbl).TblName)\r
 610   oParseMain.AddSort DefaultSort\r
 611 End Sub\r
 612 \r
 613 \r
 614 '***********************************\r
 615 ' returns details of sql query as an array\r
 616 '***********************************\r
 617 Public Function SqlSelectData()\r
 618   dim arr,i,SelectIdx,HdgIdx,a,b\r
 619   FinishQuery\r
 620   arr=oParseMain.ToArray()\r
 621   ReDim Preserve arr(ubound(arr)+2)\r
 622   HdgIdx=ubound(arr)\r
 623   SelectIdx=HdgIdx-1\r
 624   ReDim a(FieldCnt)\r
 625   arr(SelectIdx)=a\r
 626   ReDim b(FieldCnt)\r
 627   arr(HdgIdx)=b\r
 628   for i=0 to FieldCnt\r
 629     if Fields(i).exists("DropDownSelect") then arr(SelectIdx)(i)=Fields(i)("DropDownSelect")\r
 630     if Fields(i).exists("Hdg") then arr(HdgIdx)(i)=Fields(i)("Hdg")\r
 631   next\r
 632   SqlSelectData=arr\r
 633 end Function\r
 634 \r
 635 \r
 636 '***********************************\r
 637 ' Displays a table\r
 638 '***********************************\r
 639 Private sub TableDisplay()\r
 640   dim i,o\r
 641 \r
 642   response.write vbLf & "<p class='ricoBookmark'>"\r
 643   response.write "<span id='" & gridID & "_timer' class='ricoSessionTimer'></span>"\r
 644   response.write "<span id='" & gridID & "_bookmark' class='ricoBookmark'>&nbsp;</span>"\r
 645   response.write "<span id='" & gridID & "_savemsg' class='ricoSaveMsg'></span>"\r
 646   response.write "</p>"\r
 647   response.write vbLf & "<div id='" & gridID & "'></div>"\r
 648 \r
 649   response.write vbLf & "<script type='text/javascript'>"\r
 650   response.write vbLf & "var " & gridID & " = {};"\r
 651   response.write vbLf & optionsVar & " = {"\r
 652   for each o in options\r
 653     if not IsObject(options(o)) and not SvrOnly.exists(o) then response.write vbLf & "  " & o & ": " & FormatOption(options(o)) & ","\r
 654   next\r
 655   if CurrentPanel>=0 then\r
 656     response.write vbLf & "  panels: ["\r
 657     for i=0 to CurrentPanel\r
 658       if i>0 then response.write ","\r
 659       response.write "'" & Panels(i) & "'"\r
 660     next\r
 661     response.write "],"\r
 662   end if\r
 663   response.write vbLf & "  columnSpecs : ["\r
 664   for i=0 to FieldCnt\r
 665     if Fields(i).exists("TableIdx") then\r
 666       if Fields(i)("TableIdx")<>MainTbl then Fields(i)("UpdateOnly")=true\r
 667     end if\r
 668     if i>0 then response.write ","\r
 669     response.write vbLf & "    {"\r
 670     response.write " FieldName:'" & ExtFieldId(i) & "'"\r
 671     for each o in Fields(i)\r
 672       if not IsObject(Fields(i)(o)) and not SvrOnly.exists(o) then response.write "," & vbLf & "      " & o & ": " & FormatOption(Fields(i)(o)) '& "  /* " & vartype(Fields(i)(o)) & " */"\r
 673     next\r
 674     if Fields(i).exists("ColInfo") then\r
 675       response.write "," & vbLf & "      isNullable:" & FormatOption(Fields(i)("ColInfo").Nullable)\r
 676       response.write "," & vbLf & "      Writeable:" & FormatOption(Fields(i)("ColInfo").Writeable)\r
 677       response.write "," & vbLf & "      isKey:" & FormatOption(Fields(i)("ColInfo").IsPKey)\r
 678       if Fields(i)("ColInfo").ColLength then response.write "," & vbLf & "      Length:" & FormatOption(Fields(i)("ColInfo").ColLength)\r
 679     end if\r
 680     response.write " }"\r
 681   next\r
 682   response.write vbLf & "  ]"\r
 683   response.write vbLf & "};"\r
 684   if AutoInit then\r
 685     response.write vbLf & "Rico.onLoad(function() {"\r
 686     'response.write vbLf & "  try {"\r
 687     response.write vbLf & "  if(typeof Rico.LiveGrid=='undefined') throw('LiveGridForms requires the Rico.LiveGrid Library');"\r
 688     response.write vbLf & "  if(typeof Rico.GridMenu=='undefined') throw('LiveGridForms requires the Rico.GridMenu Library');"\r
 689     response.write vbLf & "  if(typeof Rico.Buffer=='undefined') throw('LiveGridForms requires the Rico.Buffer Library');"\r
 690     response.write vbLf & "  if(typeof Rico.Buffer.AjaxSQL=='undefined') throw('LiveGridForms requires the Rico.Buffer.AjaxSQL Library');"\r
 691     response.write InitScript\r
 692     'response.write vbLf & "  } catch(e) { alert(e.message); };"\r
 693     response.write vbLf & "});"\r
 694   end if\r
 695   response.write vbLf & "</script>"\r
 696 end sub\r
 697 \r
 698 \r
 699 '********************************************************************************************************\r
 700 ' Pad a number to the specified length with leading zeroes\r
 701 '********************************************************************************************************\r
 702 Private Function PadNumber(number, length)\r
 703   dim strNumber\r
 704 \r
 705   if IsNull(number) or IsEmpty(number) then strNumber=String(length,"-") else strNumber = Cstr(number)\r
 706   do while len(strNumber) < length\r
 707     strNumber = "0" & strNumber\r
 708   loop\r
 709 \r
 710   PadNumber=strNumber\r
 711 End Function\r
 712 \r
 713 Private Function FormatOption(s)\r
 714   if IsArray(s) then\r
 715     FormatOption="{" & join(s,",") & "}"\r
 716   else\r
 717     select case vartype(s)\r
 718       case 8,129,130,200,202\r
 719         ' string\r
 720         FormatOption="""" & replace(s,"""","\""") & """"\r
 721       case 11\r
 722         ' boolean\r
 723         if s then FormatOption="true" else FormatOption="false"\r
 724       case 7,133,134,135:\r
 725         ' date/time, format as ISO8601\r
 726         FormatOption="'" & year(s) & "-" & PadNumber(month(s),2) & "-" & PadNumber(day(s),2) & "T" & PadNumber(hour(s),2) & ":" & PadNumber(minute(s),2) & ":" & PadNumber(second(s),2) & "'"\r
 727       case 4,5,14 \r
 728         'single, double, decimal variants. Changing ',' to '.' \r
 729         FormatOption=replace(CStr(s),",",".") \r
 730       case else\r
 731         FormatOption=s\r
 732     end select\r
 733   end if\r
 734 End Function\r
 735 \r
 736 \r
 737 Public function InitScript()\r
 738   InitScript = vbLf & bufferVar & "=new Rico.Buffer.AjaxSQL('" & options("XMLprovider") & "', {TimeOut:" & Session.Timeout & "});" & _\r
 739                vbLf & "if(typeof " & gridID & "_GridInit=='function') " & gridID & "_GridInit();" & _\r
 740                vbLf & gridVar & "=new Rico.LiveGrid ('" & gridID & "'," & bufferVar & "," & optionsVar & ");" & _\r
 741                vbLf & gridVar & ".menu=new Rico.GridMenu();"\r
 742   if formView then\r
 743     InitScript = InitScript & vbLf & "if(typeof " & gridID & "_FormInit=='function') " & gridID & "_FormInit();" & _\r
 744                  vbLf & formVar & "=new Rico.TableEdit(" & gridVar & ");"\r
 745   end if\r
 746   InitScript = InitScript & vbLf & "if(typeof " & gridID & "_InitComplete=='function') " & gridID & "_InitComplete();"\r
 747 end function\r
 748 \r
 749 end class\r
 750 %>