1 REM Обсуждение, адрес испытательного стенда и комментарии по адресу http://aspnetmania.com/Forums/ForumMessage/177191.html
  2 Option Compare Text
  3 Imports System.ComponentModel
  4 Imports System.Web.UI
  5 Imports System.Drawing
  6 Imports System.Data.SqlClient
  7 <DefaultProperty("sText"), ToolboxData("<{0}:WebCustomPanel runat=server></{0}:WebCustomPanel>"), ToolboxBitmap(GetType(Bitmap))> _
  8 Public Class WebCustomPanel
  9     Inherits System.Web.UI.WebControls.Panel
 10     <Bindable(True), Category("Appearance"), DefaultValue(""), Description("Текстовое наполнение html со всеми тегами и словами.")> _
 11     Public Property [sText]() As String
 12         Get
 13             Return CType(ViewState("sText"), String)
 14         End Get
 15         Set(ByVal Value As String)
 16             ViewState("sText") = Value
 17         End Set
 18     End Property
 19     <Bindable(True), Category("Data"), DefaultValue(""), Description("Строка соединения с базой данных SQL-сервер.")> _
 20     Public Property [sConnectionString]() As String
 21         Get
 22             Return CType(ViewState("sConnectionString"), String)
 23         End Get
 24         Set(ByVal Value As String)
 25             ViewState("sConnectionString") = Value
 26         End Set
 27     End Property
 28     <Bindable(True), Category("Data"), DefaultValue(""), Description("Хранимая процедура, выдающая таблицу из одной колонки - белый список тегов. Остальные теги выводятся в виде html-замены. Если при взятии хранимой процедуры возникнет ошибка, то считается, что все теги запрещены.")> _
 29     Public Property [sStoredProcedureWhite]() As String
 30         Get
 31             Return CType(ViewState("sStoredProcedureWhite"), String)
 32         End Get
 33         Set(ByVal Value As String)
 34             ViewState("sStoredProcedureWhite") = Value
 35         End Set
 36     End Property
 37     <Bindable(True), Category("Data"), DefaultValue(""), Description("Хранимая процедура, выдающая таблицу из одной колонки - чёрный список слов. В таких словах последняя буква будет заменена на многоточие. Если при взятии хранимой процедуры возникнет ошибка, то считается, что все слова разрешены.")> _
 38     Public Property [sStoredProcedureBlack]() As String
 39         Get
 40             Return CType(ViewState("sStoredProcedureBlack"), String)
 41         End Get
 42         Set(ByVal Value As String)
 43             ViewState("sStoredProcedureBlack") = Value
 44         End Set
 45     End Property
 46     <Bindable(True), Category("Data"), DefaultValue(True), Description("Если True, то белый список тегов включён.")> _
 47     Public Property [bIsWhite]() As Boolean
 48         Get
 49             Return CType(ViewState("bIsWhite"), Boolean)
 50         End Get
 51         Set(ByVal Value As Boolean)
 52             ViewState("bIsWhite") = Value
 53         End Set
 54     End Property
 55     <Bindable(True), Category("Data"), DefaultValue(True), Description("Если True, то чёрный список слов включён.")> _
 56     Public Property [bIsBlack]() As Boolean
 57         Get
 58             Return CType(ViewState("bIsBlack"), Boolean)
 59         End Get
 60         Set(ByVal Value As Boolean)
 61             ViewState("bIsBlack") = Value
 62         End Set
 63     End Property
 64     REM Конструктор
 65     Public Sub New()
 66         ViewState("sText") = "" 'текстовое наполнение со всеми тегами и словами
 67         ViewState("sConnectionString") = "" 'строка соединения с SQL-сервером
 68         ViewState("sStoredProcedureWhite") = "" 'столбец с белым списком
 69         ViewState("sStoredProcedureBlack") = "" 'столбец с чёрным списком
 70         ViewState("bIsWhite") = True 'действует ли белый список
 71         ViewState("bIsBlack") = True 'действует ли чёрный список
 72     End Sub
 73     REM Добавление дочерних элементов управления
 74     Protected Overrides Sub CreateChildControls()
 75         'var
 76         Dim oLiteralControl As New LiteralControl(sTextOut())
 77         'end var
 78         Controls.Add(oLiteralControl)
 79     End Sub
 80     REM Функция преобразования текста
 81     Public Function sTextOut() As String
 82         'var
 83         Dim i As Integer
 84         'var Zap
 85         Dim iNumWhite As Integer
 86         Dim iNumBlack As Integer
 87         Dim sSql As String 'имя хранимой процедуры
 88         Dim sErr As String
 89         Dim oZapWhite(,) As Object
 90         Dim oZapBlack(,) As Object
 91         'end var
 92         iNumWhite = iZap(sConnectionString, sStoredProcedureWhite, sErr, oZapWhite) - 1
 93         iNumBlack = iZap(sConnectionString, sStoredProcedureBlack, sErr, oZapBlack) - 1
 94         'замена <, >, = и возврата каретки
 95         sTextOut = sText.Replace("<", "&lt;").Replace(">", "&gt;").Replace("=", "<FONT COLOR=""black"">=</FONT>").Replace(Chr(10), "<br>")
 96         'замена script
 97         sTextOut = Replace(sTextOut, "script", "<FONT COLOR=""black"">script</FONT>")
 98         'восстановление <, > и = для белого списка
 99         For i = 0 To iNumWhite
100             sTextOut = Replace(sTextOut, Convert.ToString(oZapWhite(0, i)).Replace("<", "&lt;").Replace(">", "&gt;").Replace("=", "<FONT COLOR=""black"">=</FONT>"), Convert.ToString(oZapWhite(0, i)))
101         Next i
102         'замена последней буквы на многоточие для чёрного списка
103         For i = 0 To iNumBlack
104             sTextOut = Replace(sTextOut, Convert.ToString(oZapBlack(0, i)), Left(Convert.ToString(oZapBlack(0, i)), Len(Convert.ToString(oZapBlack(0, i))) - 1) & "...")
105         Next i
106     End Function
107     REM Функция взятия запроса как хранимой процедуры без параметров
108     Public Overloads Function iZap(ByVal sConnectString As String, ByVal sSql As String, ByRef sErr As String, ByRef oZap(,) As Object) As Integer
109         'var
110         Dim zapConnection As SqlConnection
111         Dim zapConnectString As String
112         Dim zapBconnect As Boolean
113         Dim zapCommand As SqlCommand
114         Dim zapReader As SqlDataReader
115         Dim zapX As Long
116         Dim zapY As Long
117         Dim i1 As Integer
118         'end var
119         zapConnection = New SqlConnection
120         zapCommand = New SqlCommand
121         zapBconnect = False
122         iZap = -1
123         zapConnectString = sConnectString
124         zapConnection.ConnectionString = zapConnectString
125         Try
126             zapConnection.Open()
127             zapBconnect = zapConnection.State
128             If zapBconnect Then iZap = 0
129             'zapCommand.CommandTimeout = 10
130             zapCommand.CommandType = CommandType.StoredProcedure
131             zapCommand.Connection = zapConnection
132             zapCommand.CommandText = sSql
133             zapReader = zapCommand.ExecuteReader()
134             zapX = zapReader.FieldCount
135             If zapX < 0 Then zapX = 0
136             If zapX > 0 Then zapX = zapX - 1
137             zapY = -1
138             ReDim oZap(zapX, 0)
139             While zapReader.Read()
140                 zapY += 1
141                 If zapY < 2147483647 Then
142                     iZap = zapY + 1
143                     ReDim Preserve oZap(zapX, zapY)
144                     For i1 = 0 To zapX
145                         If IsNothing(zapReader(i1)) Or IsDBNull(zapReader(i1)) Then oZap(i1, zapY) = 0 Else oZap(i1, zapY) = zapReader(i1)
146                     Next
147                 Else : sErr = zapY & " строк (>=2 147 483 647)"
148                 End If
149             End While
150             zapReader.Close()
151             zapReader = Nothing
152             zapCommand = Nothing
153         Catch err As Exception
154             sErr = err.Message
155         Finally
156             If Not (zapConnection Is Nothing) Then
157                 zapConnection.Close()
158                 zapConnection = Nothing
159             End If
160         End Try
161     End Function
162 End Class
163