e525624f3f692fe5801d1d5f80ae34e757cec339
[infodrom/rico3] / plugins / dotnet / sqlParse.ascx.vb
1 Partial Class sqlParse\r
2 Inherits System.Web.UI.UserControl\r
3 Implements ICloneable\r
4 \r
5 Public Class sqlColumn\r
6   Public sql As String, name As String\r
7   Public LookupQuery As String ' query to populate column\r
8 \r
9   Public Sub New(Optional sqlParm As String = "", Optional nameParm As String = "")\r
10     if sqlParm<>"" then sql=sqlParm\r
11     if nameParm<>"" then name=nameParm\r
12   End Sub\r
13 \r
14   Public function Unparse()\r
15     dim s As String=sql\r
16     if not IsNothing(name) then\r
17       s &= " AS " & name\r
18     end if\r
19     Unparse=s\r
20   end Function\r
21 End Class\r
22 \r
23 \r
24 \r
25 '********************************************************************************************************\r
26 ' Parse SQL a statement\r
27 '********************************************************************************************************\r
28 \r
29 Public IsDistinct As Boolean\r
30 Public SelectList As New ArrayList()\r
31 Public GroupBy As New ArrayList()\r
32 Public OrderBy As New ArrayList()\r
33 Public FromClause As String, WhereClause As String, HavingClause As String\r
34 Public Headings As New ArrayList()  ' set after an any unparse* call\r
35 \r
36 Public Function Clone As Object Implements ICloneable.Clone\r
37   Dim NewObj as object = Me.MemberwiseClone, item as String\r
38   ' shallow copy of OrderBy is insufficient because it may be modified by ricoResponse.ascx\r
39   NewObj.OrderBy = New ArrayList()\r
40   for each item in Me.OrderBy\r
41     NewObj.OrderBy.Add(item)\r
42   next\r
43   Return NewObj\r
44 End Function\r
45 \r
46 ' -------------------------------------------------------------\r
47 ' Rebuilds a SQL select statement that was parsed by ParseSelect\r
48 ' -------------------------------------------------------------\r
49 Private Function Unparse(arSkipCols) As String\r
50   dim sqltext As String = "SELECT "\r
51   if IsDistinct then sqltext &= "DISTINCT "\r
52   sqltext &= UnparseColumnListSkip(arSkipCols) & " FROM " & FromClause\r
53   if not IsNothing(WhereClause) then sqltext &= " WHERE " & WhereClause\r
54   if GroupBy.count > 0 then sqltext &= " GROUP BY " & join(GroupBy.ToArray(),",")\r
55   if not IsNothing(HavingClause) then sqltext &= " HAVING " & HavingClause\r
56   if OrderBy.count > 0 then sqltext &= " ORDER BY " & join(OrderBy.ToArray(),",")\r
57   Unparse=sqltext\r
58 end Function\r
59 \r
60 \r
61 Public Function UnparseSelect() As String\r
62   dim arSkipCols(-1) as string\r
63   UnparseSelect=Unparse(arSkipCols)\r
64 end Function\r
65 \r
66 \r
67 Public function UnparseSelectSkip(arSkipCols)\r
68   UnparseSelectSkip=Unparse(arSkipCols)\r
69 end Function\r
70 \r
71 \r
72 Public Function UnparseSelectDistinct() As String\r
73   dim arSkipCols(-1) as string\r
74   IsDistinct=true\r
75   UnparseSelectDistinct=Unparse(arSkipCols)\r
76 end Function\r
77 \r
78 \r
79 Public Function UnparseDistinctColumn(colnum as integer) As String\r
80   dim sqltext As String\r
81   sqltext="SELECT DISTINCT " & SelectList(colnum).sql & " FROM " & FromClause\r
82   if not IsNothing(WhereClause) then sqltext &= " WHERE " & WhereClause\r
83   Headings.Clear()\r
84   Headings.Add(SelectList(colnum).name)\r
85   UnparseDistinctColumn=sqltext\r
86 end Function\r
87 \r
88 \r
89 Public function UnparseColumnList() As String\r
90   dim strSelectList As New ArrayList(), i as integer, sql as String\r
91   Headings.Clear()\r
92   for i=0 to SelectList.count-1\r
93     strSelectList.Add(SelectList(i).sql & " AS rico_col" & i)\r
94     Headings.Add(SelectList(i).name)\r
95   next\r
96   UnparseColumnList=join(strSelectList.ToArray(),",")\r
97 end Function\r
98 \r
99 \r
100 Public function UnparseColumnListSkip(arSkipCols() as String) As String\r
101   dim strSelectList As New ArrayList(), i as integer\r
102   dim SkipIdx as integer=0, skip as boolean\r
103   Headings.Clear()\r
104   for i=0 to SelectList.count-1\r
105     skip=false\r
106     if SkipIdx < arSkipCols.Length then\r
107       skip=CBool(arSkipCols(SkipIdx)=CStr(i))\r
108       if skip then SkipIdx+=1\r
109     end if\r
110     if not skip then\r
111       strSelectList.Add(SelectList(i).sql & " AS rico_col" & i)\r
112       Headings.Add(SelectList(i).name)\r
113     end if\r
114   next\r
115   UnparseColumnListSkip=join(strSelectList.ToArray(),",")\r
116 end Function\r
117 \r
118 \r
119 ' returns a "windowed" select query\r
120 ' includeAS should be true for SQL Server 2005+ and false for Oracle\r
121 Public function UnparseWithRowNumber(offset as Integer, numrows as Integer, includeAS as Boolean, arSkipCols() as String) as String\r
122   dim unparseText as String\r
123   if OrderBy.count = 0 then Throw New Exception("an OrderBy clause is required")\r
124   unparseText="SELECT ROW_NUMBER() OVER (ORDER BY " & join(OrderBy.ToArray(),",") & ") AS rico_rownum," & UnparseColumnListSkip(arSkipCols) & " FROM " & FromClause\r
125   if not IsNothing(WhereClause) then unparseText &= " WHERE " & WhereClause\r
126   if GroupBy.count > 0 then unparseText &= " GROUP BY " & join(GroupBy.ToArray(),",")\r
127   if not IsNothing(HavingClause) then unparseText &= " HAVING " & HavingClause\r
128   unparseText="SELECT * FROM (" & unparseText & ")"\r
129   if includeAS then unparseText &= " AS rico_Main"\r
130   unparseText &= " WHERE rico_rownum > " & offset & " AND rico_rownum <= " & CStr(offset+numrows)\r
131   UnparseWithRowNumber=unparseText\r
132 end Function\r
133 \r
134 \r
135 Public sub Init()\r
136   SelectList.Clear()\r
137   GroupBy.Clear()\r
138   OrderBy.Clear()\r
139   FromClause=Nothing\r
140   WhereClause=Nothing\r
141   HavingClause=Nothing\r
142   IsDistinct=false\r
143 end sub\r
144 \r
145 \r
146 ' -------------------------------------------------------------\r
147 ' Parse a SQL select statement into its major components\r
148 ' Does not handle:\r
149 ' 1) union queries\r
150 ' 2) select into\r
151 ' 3) more than one space between "group" and "by", or "order" and "by"\r
152 ' 4) stored procedures\r
153 ' -------------------------------------------------------------\r
154 Public function ParseSelect(ByVal sqltext as String) As Boolean\r
155   dim i As Integer, j As Integer, l As Integer, idx As Integer, parencnt As Integer\r
156   dim clause As String, ch As String, curfield As String, nexttoken As String, inquote As Boolean, endquote As String\r
157   Init()\r
158   ParseSelect=false\r
159   sqltext=replace(sqltext,vbLf," ")\r
160   sqltext=" " & replace(sqltext,vbCr," ") & " SELECT "   ' SELECT suffix forces last curfield to be saved\r
161   'response.write "<p>ParseSelect: " & sqltext & "</p>"\r
162   l=len(sqltext)\r
163   parencnt=0\r
164   inquote=false\r
165   i=1\r
166   curfield=""\r
167   while i<l\r
168     ch=mid(sqltext,i,1)\r
169     if inquote then\r
170       if ch=endquote then\r
171         if endquote="'" and mid(sqltext,i,2)="''" then\r
172           curfield &= "'"\r
173           i=i+1\r
174         else\r
175           inquote=false\r
176         end if\r
177       end if\r
178       curfield &= ch\r
179     elseif ch="'" or ch="""" or ch="`" then\r
180       inquote=true\r
181       endquote=ch\r
182       curfield &= ch\r
183     elseif ch="[" then\r
184       inquote=true\r
185       endquote="]"\r
186       curfield &= ch\r
187     elseif ch="(" then\r
188       parencnt=parencnt+1\r
189       curfield &= ch\r
190     elseif ch=")" then\r
191       if parencnt=0 then exit function  ' sql statement has a syntax error\r
192       parencnt=parencnt-1\r
193       curfield &= ch\r
194     elseif parencnt > 0 then\r
195       curfield &= ch\r
196     elseif ch="," then\r
197       'response.write "<p>" & clause & ": " & server.htmlencode(curfield) & "</p>"\r
198       select case clause\r
199         case "SELECT":\r
200           AddColumn(curfield)\r
201           curfield=""\r
202         case "AS":\r
203           SelectList(SelectList.count-1).name=curfield\r
204           curfield=""\r
205           clause="SELECT"\r
206         case "GROUP BY": ArrayPush(GroupBy,curfield)\r
207         case "ORDER BY": ArrayPush(OrderBy,curfield)\r
208         case else: curfield &= ch\r
209       end select\r
210     elseif ch=" " then\r
211       j=InStr(i+1,sqltext," ")\r
212       if j<1 then\r
213         curfield &= ch\r
214       else\r
215         if ucase(mid(sqltext,j+1,3))="BY " then j=j+3\r
216         nexttoken=ucase(mid(sqltext,i+1,j-i-1))\r
217         'wscript.echo "'" & nexttoken & "'"\r
218         'response.write "<p>" & clause & " : " & nexttoken & " : " & server.htmlencode(curfield) & "</p>"\r
219         select case nexttoken\r
220           case "SELECT","INTO","FROM","WHERE","GROUP BY","HAVING","ORDER BY":\r
221             select case clause\r
222               case "SELECT":\r
223                 AddColumn(curfield)\r
224                 curfield=""\r
225               case "AS":\r
226                 SelectList(SelectList.count-1).name=curfield\r
227                 curfield=""\r
228               case "FROM":     SetParseField(FromClause,curfield)\r
229               case "WHERE":    SetParseField(WhereClause,curfield)\r
230               case "GROUP BY": ArrayPush(GroupBy,curfield)\r
231               case "HAVING":   SetParseField(HavingClause,curfield)\r
232               case "ORDER BY": ArrayPush(OrderBy,curfield)\r
233             end select\r
234             clause=nexttoken\r
235             i=j-1\r
236 \r
237           case "AS":\r
238             if clause="SELECT" then\r
239               AddColumn(curfield)\r
240               curfield=""\r
241               clause=nexttoken\r
242               i=j\r
243             elseif curfield<>"" then\r
244               curfield &= ch\r
245             end if\r
246 \r
247           case "DISTINCT":\r
248             if clause="SELECT" then\r
249               IsDistinct=true\r
250               curfield=""\r
251               i=j\r
252             elseif curfield<>"" then\r
253               curfield &= ch\r
254             end if\r
255 \r
256           case else: if curfield<>"" then curfield &= ch\r
257         end select\r
258       end if\r
259     else\r
260       curfield &= ch\r
261     end if\r
262     i=i+1\r
263   end while\r
264   ParseSelect=true\r
265 end function\r
266 \r
267 \r
268 Private Sub ArrayPush(s as ArrayList, ByRef newvalue as string)\r
269   s.add(newvalue)\r
270   newvalue=""\r
271 end sub\r
272 \r
273 Private Sub SetParseField(ByRef f as string, ByRef newvalue as string)\r
274   f=newvalue\r
275   newvalue=""\r
276 end sub\r
277 \r
278 \r
279 Public Sub AddColumn(sqlParm as String, Optional nameParm As String = "")\r
280   SelectList.add(new sqlColumn(sqlParm,nameParm))\r
281 End Sub\r
282 \r
283 \r
284 ' -------------------------------------------------------------\r
285 ' Add a join to the from clause\r
286 ' -------------------------------------------------------------\r
287 Public Sub AddJoin(ByVal JoinClause As String)\r
288   if InStr(FromClause," join ")>0 then FromClause="(" & FromClause & ")"  ' required by Access\r
289   FromClause=FromClause & " " & JoinClause\r
290 end sub\r
291 \r
292 Private Sub SplitSortSpec(ByVal sortspec As String, ByRef sortcol As String, ByRef sortdir As String)\r
293   sortspec=ucase(sortspec)\r
294   if right(sortspec,3)="ASC" then\r
295     sortcol=trim(left(sortspec,len(sortspec)-3))\r
296     sortdir="ASC"\r
297   elseif right(sortspec,4)="DESC" then\r
298     sortcol=trim(left(sortspec,len(sortspec)-4))\r
299     sortdir="DESC"\r
300   else\r
301     sortcol=trim(sortspec)\r
302     sortdir=""\r
303   end if\r
304 End Sub\r
305 \r
306 Private Function FindSortColumn(ByVal sortspec As String) As Integer\r
307   dim i As Integer, findcol As String, finddir As String, sortcol As String, sortdir As String\r
308   FindSortColumn=-1\r
309   SplitSortSpec(sortspec, findcol, finddir)\r
310   for i=0 to OrderBy.count-1\r
311     SplitSortSpec(OrderBy(i), sortcol, sortdir)\r
312     if sortcol=findcol then\r
313       FindSortColumn=i\r
314       exit for\r
315     end if\r
316   next\r
317 End Function\r
318 \r
319 ' -------------------------------------------------------------\r
320 ' Add sort criteria to the beginning of the order by clause\r
321 ' -------------------------------------------------------------\r
322 Public Sub AddSort(ByVal NewSort As String)\r
323   dim i As Integer, colidx As Integer\r
324   colidx=FindSortColumn(NewSort)\r
325   if colidx>=0 then\r
326     for i=colidx to 1 step -1\r
327       OrderBy(i)=OrderBy(i-1)\r
328     next\r
329     OrderBy(0)=NewSort\r
330   else\r
331     OrderBy.insert(0,NewSort)\r
332   end if\r
333 end sub\r
334 \r
335 ' -------------------------------------------------------------\r
336 ' Append sort criteria to the order by clause\r
337 ' -------------------------------------------------------------\r
338 Public Sub AppendSort(ByVal NewSort As String)\r
339   OrderBy.add(NewSort)\r
340 end sub\r
341 \r
342 ' -------------------------------------------------------------\r
343 ' Add a condition to the where clause\r
344 ' -------------------------------------------------------------\r
345 Public Sub AddWhereCondition(ByVal NewCondition)\r
346   AddCondition(WhereClause,NewCondition)\r
347 end sub\r
348 \r
349 ' -------------------------------------------------------------\r
350 ' Add a condition to the having clause\r
351 ' -------------------------------------------------------------\r
352 Public Sub AddHavingCondition(ByVal NewCondition)\r
353   AddCondition(HavingClause,NewCondition)\r
354 end sub\r
355 \r
356 Private Sub AddCondition(ByRef Clause, ByVal NewCondition)\r
357   if IsNothing(NewCondition) then exit sub\r
358   If IsNothing(Clause) Then\r
359     Clause="(" & NewCondition & ")"\r
360   Else\r
361     Clause &= " AND (" & NewCondition & ")"\r
362   End If\r
363 End Sub\r
364 \r
365 Public Sub DebugPrint(writer as object)\r
366   dim i as integer\r
367   writer.write("<p>Parse Result:")\r
368   writer.write("<table border='1'>")\r
369   if IsDistinct then writer.write("<tr valign='top'><td>DISTINCT<td>&nbsp;")\r
370   writer.write("<tr valign='top'><td>COLUMNS:<td><ol>")\r
371   for i=0 to SelectList.count-1\r
372     writer.write("<li>" & SelectList(i).Unparse)\r
373   next\r
374   writer.write("</ol><tr valign='top'><td>FROM:<td>" & FromClause)\r
375   if not IsNothing(WhereClause) then writer.write("<tr valign='top'><td>WHERE:<td>" & WhereClause)\r
376   if GroupBy.count > 0 then writer.write("<tr valign='top'><td>GROUP BY:<td>" & join(GroupBy.ToArray(),"<br>"))\r
377   if not IsNothing(HavingClause) then writer.write("<tr valign='top'><td>HAVING:<td>" & HavingClause)\r
378   if OrderBy.count > 0 then writer.write("<tr valign='top'><td>ORDER BY:<td>" & join(OrderBy.ToArray(),"<br>"))\r
379   writer.write("</table>")\r
380 End Sub\r
381 \r
382 End Class\r