<%
        
'File Description @0-AE1083C9
'======================================================
'
'  This file contains the following classes:
'      Class clsSQLParameters
'      Class clsSQLParameter
'      Class clsFields
'      Class clsControls
'      Class clsControl
'      Class clsField
'      Class clsButton
'      Class clsFileUpload
'      Class clsDatePicker
'      Class clsListControl
'      Class clsErrors
'      Class clsEmptyDataSource
'      Class clsDataSource
'      Class clsCommand
'      Class clsStringBuffer
'      Class clsConverter
'
'======================================================
'End File Description

'Constant List @0-52D70043

' ------- Controls ---------------
Const ccsLabel             = 00001
Const ccsLink              = 00002
Const ccsTextBox           = 00003
Const ccsTextArea          = 00004
Const ccsListBox           = 00005
Const ccsRadioButton       = 00006
Const ccsButton            = 00007
Const ccsCheckBox          = 00008
Const ccsImage             = 00009
Const ccsImageLink         = 00010
Const ccsHidden            = 00011
Const ccsCheckBoxList      = 00012
Const ccsDatePicker        = 00013

Dim ccsControlTypes(13)
ccsControlTypes(ccsLabel)        = "Label"
ccsControlTypes(ccsLink)         = "Link"
ccsControlTypes(ccsTextBox)      = "TextBox"
ccsControlTypes(ccsTextArea)     = "TextArea"
ccsControlTypes(ccsListBox)      = "ListBox"
ccsControlTypes(ccsRadioButton)  = "RadioButton"
ccsControlTypes(ccsButton)       = "Button"
ccsControlTypes(ccsCheckBox)     = "CheckBox"
ccsControlTypes(ccsImage)        = "Image"
ccsControlTypes(ccsImageLink)    = "ImageLink"
ccsControlTypes(ccsHidden)       = "Hidden"
ccsControlTypes(ccsCheckBoxList) = "CheckBoxList"
ccsControlTypes(ccsDatePicker)   = "DatePicker"

' ------- Operators --------------
Const opEqual              = 00001
Const opNotEqual           = 00002
Const opLessThan           = 00003
Const opLessThanOrEqual    = 00004
Const opGreaterThan        = 00005
Const opGreaterThanOrEqual = 00006
Const opBeginsWith         = 00007
Const opNotBeginsWith      = 00008
Const opEndsWith           = 00009
Const opNotEndsWith        = 00010
Const opContains           = 00011
Const opNotContains        = 00012
Const opIsNull             = 00013
Const opNotNull            = 00014

' ------- Datasource types -------
Const dsTable              = 00001
Const dsSQL                = 00002
Const dsProcedure          = 00003
Const dsListOfValues       = 00004
Const dsEmpty              = 00005

' ------- Command types -------
Const cmdOpen              = 00001
Const cmdExec              = 00002

' ------- Parse types ------------
Const ccsParseAccumulate   = True
Const ccsParseOverwrite    = False

' ------- Listbox populating types ------------
Const ccsJoins             = 0
Const ccsStringConcats     = 1

' ------- CheckBox states --------
Const ccsChecked           = True
Const ccsUnchecked         = False
'End Constant List

'clsSQLParameters Class @0-CE6B1D13

Class clsSQLParameters
  
  Public Connection
  Public Criterion()
  Public AssembledWhere
  Public ParameterSources
  Public Errors
  Public DataSource

  Public ParametersList

  Private Sub Class_Initialize()
    ReDim Criterion(100)
    Set ParametersList = Server.CreateObject("Scripting.Dictionary")
    Set DataSource = Nothing
  End Sub

  Private Sub Class_Terminate()
    Set ParametersList = Nothing
  End Sub

  Public Default Property Get Parameters(Name)
    Set Parameters = ParametersList(Name)
  End Property

  Public Property Set Parameters(Name, NewParameter)
    Set ParametersList(Name) = NewParameter
  End Property

  Property Get Count()
    Count = ParametersList.Count
  End Property

  Function AddParameter(ID, ParameterSource, DataType, Format, DBFormat, DefaultValue, UseIsNull)
    Dim SQLParameter
    Set SQLParameter = New clsSQLParameter
    With SQLParameter
      Set .Connection = Connection
      .DataType = DataType
      .Format = Format
      .DBFormat = DBFormat
      .Caption = ParameterSource
      .DefaultValue = DefaultValue
      .UseIsNull = UseIsNull
      Set .DataSource = DataSource
      If IsObject(ParameterSources) Then
        If IsEmpty(DefaultValue) Or ((DataType <> ccsText And DataType <> ccsMemo) And CStr(DefaultValue) = "") Then
          .Text = ParameterSources(ParameterSource)
        Else
          If IsEmpty(ParameterSources(ParameterSource)) Or ((DataType <> ccsText And DataType <> ccsMemo) And ParameterSources(ParameterSource) = "") Then
            .Text = DefaultValue
          Else
            .Text = ParameterSources(ParameterSource)
          End If
        End If
      End If
    End With
    Set ParametersList(ID) = SQLParameter
    Set SQLParameter = Nothing
  End Function

  Function getParamByID(ID)
    Set getParamByID = ParametersList(ID)
  End Function

  Property Get AllParamsSet()
    Dim ParametersItems, I, Result

    Result = True
    I = 0
    ParametersItems = ParametersList.Items
    While Result AND (I <= UBound(ParametersItems))
      Result = (NOT IsEmpty(ParametersItems(I).Value)) OR (IsEmpty(ParametersItems(I).Value) AND ParametersItems(I).UseIsNull)
      I = I + 1
    Wend
    AllParamsSet = Result
  End Property

  Function GetError()
    Dim ParametersItems, I, Result

    ParametersItems = ParametersList.Items
    For I = 0 To UBound(ParametersItems)
      Result = Result & ParametersItems(I).Errors.ToString
    Next
    GetError = Result
  End Function

  Function opAND(Brackets, LeftPart, RightPart)
    Dim Result
    If NOT IsEmpty(LeftPart) Then
      If NOT IsEmpty(RightPart) Then
        Result = LeftPart & " and " & RightPart
      Else
        Result = LeftPart
      End If
    Else
      If NOT IsEmpty(RightPart) Then
        Result = RightPart
      End If
    End If
    If Brackets And NOT IsEmpty(Result) Then _
      Result = " (" & Result & ") "
    opAND = Result
  End Function

  Function opOR(Brackets, LeftPart, RightPart)
    Dim Result
    If NOT IsEmpty(LeftPart) Then
      If NOT IsEmpty(RightPart) Then
        Result = LeftPart & " or " & RightPart
      Else
        Result = LeftPart
      End If
    Else
      If NOT IsEmpty(RightPart) Then
        Result = RightPart
      End If
    End If
    If Brackets And NOT IsEmpty(Result) Then _
        If Brackets Then Result = " (" & Result & ") "
    opOR = Result
  End Function

  Function Operation(Operator, Brackets, FieldName, Parameter)
    If CStr(Parameter.Text) <> "" Then
      Dim Result
      Dim Value, SQLValue
      Value = Parameter.SQLText
      SQLValue = Connection.ToSQL(Value, Parameter.DataType)

      Select Case Operator
        Case opEqual
          Result = FieldName & " = " & SQLValue
        Case opNotEqual
          Result = FieldName & " <> " & SQLValue
        Case opLessThan
          Result = FieldName & " < " & SQLValue
        Case opLessThanOrEqual
          Result = FieldName & " <= " & SQLValue
        Case opGreaterThan
          Result = FieldName & " > " & SQLValue
        Case opGreaterThanOrEqual
          Result = FieldName & " >= " & SQLValue
        Case opBeginsWith
          Result = FieldName & " like '" & Value & "%'"
        Case opNotBeginsWith
          Result = FieldName & " not like '" & Value & "%'"
        Case opEndsWith
          Result = FieldName & " like '%" & Value & "'"
        Case opNotEndsWith
          Result = FieldName & " not like '%" & Value & "'"
        Case opContains
          Result = FieldName & " like '%" & Value & "%'"
        Case opNotContains
          Result = FieldName & " not like '%" & Value & "%'"
        Case opIsNull
          Result = FieldName & " is null"
        Case opNotNull
          Result = FieldName & " is not null"
      End Select
      Operation = Result
    Else
     If Parameter.UseIsNull Then
       Select Case Operator
         Case opNotEqual, opNotBeginsWith, opNotEndsWith, opNotContains, opNotNull
           Result = FieldName & " is not null"
         Case Else
           Result = FieldName & " is null"
       End Select
       Operation = Result
     Else
       Operation = Empty
     End If
    End If
  End Function
End Class
'End clsSQLParameters Class

'clsSQLParameter Class @0-660A24C2
Class clsSQLParameter
  Public Errors
  Public DataType
  Public Format
  Public DBFormat
  Public Caption
  Public Connection
  Public DataSource
  Public DefaultValue
  Public UseIsNull

  Private VarValue
  Private SQLTextValue
  Private TextValue

  Private Sub Class_Initialize()
    VarValue = Empty
    SQLTextValue = Empty
    TextValue = Empty
    UseIsNull = False

    DataType = ccsText
    Set Errors = New clsErrors
  End Sub
  
  Private Sub Class_Terminate()
    Set Errors = Nothing
  End Sub

  Function GetParsedValue(ParsingValue, MaskFormat)
    Dim Result

    If Not IsEmpty(ParsingValue) Then
      Select Case DataType
        Case ccsDate
          If VarType(ParsingValue) = vbDate Then
            Result = ParsingValue
          ElseIf CCValidateDate(ParsingValue, MaskFormat) Then
            Result = CCParseDate(ParsingValue, MaskFormat)
          Else
            If IsArray(Format) Then 
              PrintDBError "", "", "Der Wert im Feld " & Caption & " ist nicht gültig. Benutzen Sie folgendes Format: " & Join(Format, "") & "." 
            Else 
              PrintDBError "", "", "Im Feld " & Caption & " wurde kein gültiger Wert eingegeben."
            End If
          End If
        Case ccsBoolean
          Result = CCParseBoolean(ParsingValue, MaskFormat)
        Case ccsInteger
          If CCValidateNumber(ParsingValue, MaskFormat) Then 
            Result = CCParseInteger(ParsingValue, MaskFormat) 
          Else 
            PrintDBError "", "", "Im Feld " & Caption & " wurde kein gültiger Wert eingegeben."
          End If
        Case ccsFloat
          If CCValidateNumber(ParsingValue, MaskFormat) Then 
            Result = CCParseFloat(ParsingValue, MaskFormat)
          Else
            PrintDBError "", "", "Im Feld " & Caption & " wurde kein gültiger Wert eingegeben."
          End If
        Case ccsText, ccsMemo
          Result = CStr(ParsingValue)
      End Select
    End If

    GetParsedValue = Result
  End Function

  Function GetFormattedValue(MaskFormat)
    Dim Result, Value

    If IsEmpty(VarValue) Then 
      Value = DefaultValue 
    Else 
      Value = VarValue
    End If

    Select Case DataType
      Case ccsDate
        Result = CCFormatDate(Value, MaskFormat)
      Case ccsBoolean
        Result = CCFormatBoolean(Value, MaskFormat)
      Case ccsInteger, ccsFloat
        Result = CCFormatNumber(Value, MaskFormat)
      Case ccsText, ccsMemo
        Result = CStr(Value)
        If CStr(Result) <> "" Then Result = Connection.EscapeChars(Result)
    End Select

    GetFormattedValue = Result
  End Function

  Property Let Value(NewValue)
    VarValue = Empty
    SQLTextValue = Empty
    TextValue = Empty
    If NOT IsEmpty(NewValue) And Not (NewValue="") Then
      Select Case DataType
        Case ccsDate
          VarValue = CDate(NewValue)
        Case ccsBoolean
          VarValue = CBool(NewValue)
        Case ccsInteger
          VarValue = CLng(NewValue)
        Case ccsFloat
          VarValue = CDbl(NewValue)
        Case ccsText, ccsMemo
          VarValue = CStr(NewValue)
      End Select
    End If
  End Property

  Property Get Value()
    If IsEmpty(VarValue) Then 
      Value = DefaultValue 
    Else
      Value = VarValue
    End If
  End Property

  Property Let Text(NewText)
    If Not IsEmpty(NewText) Then
      SQLTextValue = Empty
      TextValue = NewText
      VarValue = GetParsedValue(TextValue, Format)
    End If
  End Property

  Property Get Text()
    If IsEmpty(TextValue) Then TextValue = GetFormattedValue(Format)
    Text = TextValue
  End Property

  Property Let SQLText(varNewSQLText)
    SQLTextValue = varNewSQLText
  End Property

  Property Get SQLText()
    If IsEmpty(SQLTextValue) Then 
      SQLTextValue = GetFormattedValue(DBFormat)
    End If
    SQLText = SQLTextValue
  End Property

End Class

'End clsSQLParameter Class

'clsFields Class @0-791D3D1C
Class clsFields
  Private objFields
  Private Items
  Private Counter

  Private Sub Class_Initialize()
    Set objFields = CreateObject("Scripting.Dictionary")
  End Sub

  Sub AddFields(Fields) ' Add new objects to Object array
    Dim I
    If IsArray(Fields) Then
      For I = LBound(Fields) To UBound(Fields)
        Set objFields(Fields(I).Name) = Fields(I)
      Next
    End If
  End Sub

  Public Default Property Get Item(Name)
    Set Item = objFields(Name)
  End Property

  Sub InitEnum()
    Items = objFields.Items
    Counter = 0
  End Sub

  Function NextItem()
    Set NextItem = Items(Counter)
    Counter = Counter + 1
  End Function

  Function EndOfEnum()
    EndOfEnum = (Counter > UBound(Items))
  End Function

  Function Exists(Name)
    Exists = objFields.Exists(Name)
  End Function

End Class
'End clsFields Class

'CCCreateCollection Function @0-61899D71
Function CCCreateCollection(Block, TargetBlock, Accumulate, Controls)
  Dim Collection
  Set Collection = New clsControls
  With Collection
    Set .Block = Block
    If NOT IsNull(TargetBlock) Then
      Set .TargetBlock = TargetBlock
    End If
    .Accumulate = Accumulate
    .AddControls Controls
  End With
  Set CCCreateCollection = Collection
End Function

'End CCCreateCollection Function

'clsControls Class @0-2F2957A8
Class clsControls
  Private Objects ' Dictionary object
  Private CCSEventResult
  Private EnumData
  Private Counter
  
  Public Block
  Public Accumulate

  Private objTargetBlock
  Private isSetTargetBlock
  Private mVisible

  Private Sub Class_Initialize()
    Set Objects = Server.CreateObject("Scripting.Dictionary")
    mVisible = True
  End Sub

  Private Sub Class_Terminate()
    Set Objects = Nothing
  End Sub

  Sub AddControls(Controls) ' Add new objects to Object array
    Dim ArraySize, NumberControls, I

    If IsArray(Controls) Then
      NumberControls = UBound(Controls)
      ArraySize = Objects.Count

      For i = ArraySize To ArraySize + NumberControls
        Objects.Add i,Controls(I)
      Next
    End If
  End Sub

  Sub AddControl(Control) ' Add a new object to Object array
    If TypeName(Control) = "clsControls" Then 
      Objects.Add Objects.Count, Control
    Else
      Objects.Add Control.Name, Control
    End If
  End Sub

  Property Get Items(ItemName)
    If Objects.Exists(ItemName) Then
      Set Items = Objects(ItemName)
    Else
      Set Items = Nothing
    End If
  End Property
  
  Property Let Items(ItemName, NewItem)
    If Objects.Exists(ItemName) Then
      Objects(ItemName) = NewItem
    Else
      Objects.Add ItemName, NewItem
    End If
  End Property

  Function GetItemByName(ItemName)
    Dim Element
    For Each Element In Objects
      If Objects.Item(Element).Name = ItemName Then
        Set GetItemByName = Objects.Item(Element)
        Exit Function
      End If
    Next
    Set GetItemByName = Nothing
  End Function

  Sub Show()
    Dim Element, Obj

    If NOT mVisible Then Exit Sub

    For Each Element In Objects
      Set Obj = Objects.Item(element)
      If TypeName(Obj) = "clsControls" Then
        Obj.Show
      Else
        Obj.Show Block 
      End If
    Next

    If Not IsEmpty(Accumulate) Then
      If isSetTargetBlock Then
        Block.ParseTo Accumulate, objTargetBlock
      Else
        Block.Parse Accumulate
      End If
    End If

  End Sub

  Sub Validate()
    Dim Element
    For Each Element In Objects
      Objects.Item(Element).Validate
    Next
  End Sub

  Function isValid()
    Dim Element
    For Each Element In Objects
      If Objects.Item(Element).Errors.Count > 0 Then
        isValid = False
        Exit Function
      End If
    Next
    isValid = True
  End Function

  Function GetErrors()
    Dim Errors, Element
    For Each Element In Objects
      Errors = Errors & Objects.Item(Element).Errors.ToString
    Next
    GetErrors = Errors
  End Function

  Property Set TargetBlock(NewBlock)
    isSetTargetBlock = True
    Set objTargetBlock = NewBlock
  End Property

  Sub InitEnum()
    EnumData = Objects.Items
    Counter = 0
  End Sub
  
  Function NextItem()
    Set NextItem = EnumData(Counter)
    Counter = Counter + 1
  End Function
  
  Function EndOfEnum()
    EndOfEnum = (Counter > UBound(EnumData))
  End Function 

  Property Let Visible(newValue)
    mVisible = CBool(newValue)
  End Property

  Property Get Visible()
    Visible = mVisible
  End Property

End Class

'End clsControls Class

'CCCreateControl Function @0-706BB4D6
Function CCCreateControl(ControlType,  Name, Caption, DataType, Format, InitValue)
	Dim Control
	Set Control = New clsControl
	With Control    
		.ControlType = ControlType
		.Name = Name
		.BlockName = ccsControlTypes(ControlType) & " " & Name
		.ControlTypeName = ccsControlTypes(ControlType)
		.Caption = Caption
		.DataType = DataType
		.Format = Format
  	If NOT IsEmpty(InitValue) Then
      If ControlType = ccsCheckBox Then
          .State = True
      Else
  			.Text = InitValue
      End If
		End If
	End With
	Set CCCreateControl = Control
End Function
'End CCCreateControl Function

'clsControl Class @0-BD2FDB2D
Class clsControl
  Public Errors
  Public DataType
  Public Format
  Public DBFormat
  Public Caption
  Public ControlType
  Public ControlTypeName
  Public Name
  Public BlockName
  Public ExternalName
  Public HTML
  Public Required
  Public CheckedValue
  Public UncheckedValue
  Public State
  Public Visible
  Public TemplateBlock

  Public Parameters

  Private mPage
  Private VarValue
  Private TextValue

  Public CCSEvents
  Private CCSEventResult

  Private Sub Class_Initialize()
    VarValue = Empty
    TextValue = Empty
    Visible = True
    ExternalName = Empty

    DataType = ccsText
    HTML = False
    Required = False
    Set Errors = New clsErrors
    Set CCSEvents = CreateObject("Scripting.Dictionary")
    Parameters = ""
  End Sub

  Private Sub Class_Terminate()
    Set Errors = Nothing
  End Sub

  Function Validate()
    If Required And CStr(VarValue) = "" And Errors.Count = 0 Then
      Errors.addError(CCSRunTimeMessages.GetMessage("RequiredField", Array("FieldName", Caption)))
    End If
    Validate = CCRaiseEvent(CCSEvents, "OnValidate", Me)
  End Function

  Function GetParsedValue(ParsingValue, MaskFormat)
    Dim Result

    Result = CCSConverter.StringToType(DataType, ParsingValue, MaskFormat)
    If CCSConverter.ParseError Then
      If DataType = ccsDate AND (IsArray(Format) OR IsArray(CCSConverter.DateFormat)) Then
        If IsArray(Format) Then _
          Errors.addError(CCSRunTimeMessages.GetMessage("IncorrectFormat", Array("FieldName", Caption, "Format", Join(Format, "")))) _
        Else _
          Errors.addError(CCSRunTimeMessages.GetMessage("IncorrectFormat", Array("FieldName", Caption, "Format", Join(CCSConverter.DateFormat, ""))))
      Else
        Errors.addError(CCSRunTimeMessages.GetMessage("IncorrectValue", Array("FieldName", Caption)))
      End If
    End If

    GetParsedValue = Result
  End Function

  Property Get Link()
    Dim Result

    If Parameters = "" Then
      Result = mPage
    Else
      Result = mPage & "?" & Parameters
    End If

    Link = Result
  End Property

  Property Let Link(newLink)
    Dim parsedLink
    If CStr(newLink) = "" Then
      mPage = ""
      Parameters = ""
    Else
      parsedLink = Split(newLink, "?")
      mPage = parsedLink(0)
      If UBound(parsedLink) = 1 Then 
        Parameters = parsedLink(1) 
      Else
        Parameters = ""
      End If
    End If
  End Property

  Property Get Page()
    Page = mPage
  End Property

  Property Let Page(newPage)
    mPage = newPage
  End Property

  Function GetFormattedValue(MaskFormat)
    GetFormattedValue = CCSConverter.TypeToString(DataType, VarValue, MaskFormat)
  End Function

  Sub Show(Template)
    Dim NeedShow, sTmpValue

    Set TemplateBlock = Template.Block(ControlTypeName & " " & Name)

    If TemplateBlock Is Nothing Then
      Set TemplateBlock = Template
      NeedShow = False
    Else
      NeedShow = True
      TemplateBlock.HTML = ""
    End If
    
    CCSEventResult = CCRaiseEvent(CCSEvents, "BeforeShow", Me)

    If NOT Visible Then
      TemplateBlock.Variable(Name)=""
      Exit Sub
    End If


    If IsEmpty(ExternalName) Then
      TemplateBlock.Variable(Name & "_Name") = Name
    Else
      TemplateBlock.Variable(Name & "_Name") = ExternalName
    End If

    If IsEmpty(TextValue) Then 
      TextValue = GetFormattedValue(Format)
    End If

    Select Case ControlType
      Case ccsLabel, ccsTextBox, ccsTextArea, ccsHidden
        If HTML Then
          TemplateBlock.Variable(Name) = TextValue
        Else
          sTmpValue = Server.HTMLEncode(TextValue)
          If ControlType = ccsLabel Then 
            sTmpValue = Replace(sTmpValue, vbCrLf, "<BR>")
          End If
          TemplateBlock.Variable(Name) = sTmpValue
        End If
      Case ccsImage
          sTmpValue = Server.HTMLEncode(TextValue)
          If ControlType = ccsLabel Then 
            sTmpValue = Replace(sTmpValue, vbCrLf, "<BR>")
          End If
          TemplateBlock.Variable(Name) = sTmpValue
      Case ccsLink
        If HTML Then 
          TemplateBlock.Variable(Name) = TextValue 
        Else 
          TemplateBlock.Variable(Name) = Replace(Server.HTMLEncode(TextValue), vbCrLf, "<BR>")
        End If
        TemplateBlock.Variable(Name & "_Src") = Me.Link
      Case ccsImageLink
        TemplateBlock.Variable(Name & "_Src") = Server.HTMLEncode(TextValue) 
        TemplateBlock.Variable(Name) = Me.Link
      Case ccsCheckBox
        If State Then 
          TemplateBlock.Variable(Name) = "CHECKED" 
        Else
          TemplateBlock.Variable(Name) = ""
        End If
    End Select
    If NeedShow Then TemplateBlock.Show
    Set TemplateBlock = Nothing
  End Sub

  Property Let Value(NewValue)
    VarValue = Empty
    TextValue = Empty

    VarValue = CCSConverter.VBSConvert(DataType, NewValue)

    If ControlType = ccsCheckBox Then
      If DataType = ccsBoolean Then
        If IsEmpty(NewValue) Or (NewValue="") Then
          State = False
        Else
          State = VarValue
        End If
      Else
        if DataType = ccsDate Then
          State = (VarValue = CDate(CheckedValue))
        Else
          State = (VarValue = CheckedValue)
        End if
      End If
    End If

  End Property

  Property Get Value()
    If ControlType = ccsCheckBox Then
      If IsEmpty(State) Then 
        Value = UncheckedValue 
      Else 
        Value = IIf(State, CheckedValue, UncheckedValue)
      End If
    Else
        Value = VarValue
    End If
  End Property

  Property Let Text(NewText)
    VarValue = Empty
    TextValue = NewText
    If ControlType = ccsCheckBox Then
      VarValue = IIf(IsEmpty(NewText), UncheckedValue, CheckedValue)
      State = (VarValue = CheckedValue)
    Else 
      VarValue = GetParsedValue(TextValue, Format)
    End If
  End Property

  Property Get Text()
    If IsEmpty(TextValue) Then 
      TextValue = GetFormattedValue(Format)
    End If
    Text = TextValue
  End Property

End Class
'End clsControl Class

'CCCreateField Function @0-A187BD87
Function CCCreateField(Name, DBFieldName, DataType, DBFormat, DataSource)
	Dim Field
	Set Field = New clsField
	With Field
		.Name = Name
		.DBFieldName = DBFieldName
		.DataType = DataType
		.DBFormat = DBFormat
		Set .DataSource = DataSource
	End With
	Set CCCreateField = Field
End Function
'End CCCreateField Function

'clsField Class @0-AEE3D759
Class clsField
  Public DataType
  Public DBFormat
  Public Name
  Public DBFieldName
  Public Errors

  Private mDataSource
  Private mConverter
  Private mValue
  Private mSQLText

  Private Sub Class_Initialize()
    mValue = Empty
    mSQLText = Empty
    DataType = ccsText
    Set Errors = New clsErrors
  End Sub
  
  Private Sub Class_Terminate()
    Set Errors = Nothing
  End Sub

  Public Function GetParsedValue(ParsingValue, MaskFormat)
    Dim Result, ValueType
    Result = Empty

    If NOT IsEmpty(ParsingValue) Then
      ValueType = VarType(ParsingValue)
      If ValueType = vbString Or (DataType=ccsBoolean And (ValueType>=2 And ValueType<=5)) Then
        Result = mConverter.StringToType(DataType, ParsingValue, MaskFormat)
      Else
        Result = mConverter.VBSConvert(DataType, ParsingValue)
      End If
      If mConverter.ParseError Then
        Errors.addError(CCSRunTimeMessages.GetMessage("IncorrectValue", Array("FieldName", Name)))
      End If
    End If
    GetParsedValue = Result
  End Function

  Public Function GetFormattedValue(MaskFormat)
    Dim Result
    Result = CCSConverter.TypeToString(DataType, mValue, MaskFormat)
    Select Case DataType
      Case ccsText, ccsMemo
        If CStr(Result) <> "" Then Result = mDataSource.DataSource.Connection.EscapeChars(Result)
    End Select
    GetFormattedValue = Result
  End Function

  Public Property Let Value(vData)
    mSQLText = Empty
    mValue = mConverter.VBSConvert(DataType, vData)
  End Property

  Public Default Property Get Value()
    Dim RS, Result, ResultType

    Result = mValue
    If IsObject(mDataSource.Recordset) Then
      Set RS = mDataSource.Recordset
      If RS.State = adStateOpen Then
        If NOT RS.EOF Then _
          Result = CCGetValue(RS, DBFieldName) 
      End If
      Result = GetParsedValue(Result, DBFormat)
    End If
    Value = Result
  End Property

  Public Property Let SQLText(vData)
    mSQLText = vData
  End Property

  Public Property Get SQLText()
    If IsEmpty(mSQLText) Then 
      mSQLText = GetFormattedValue(DBFormat)
    End If
    SQLText = mSQLText
  End Property
  
  Public Property Set DataSource(oRef)
    Set mDataSource = oRef
    If IsObject(mDataSource.Connection) Then
      Set mConverter = mDataSource.Connection.Converter
    Else
      Set mConverter = CCSConverter
    End If
  End Property

  Public Property Get DataSource()
    Set DataSource = mDataSource
  End Property

End Class
'End clsField Class

'clsFileElement Class @0-CBEFE57E
Class clsFileElement
    Private mvarName
    Private mvarUploadObject
    Private mvarFileObject
    Private mvarSize
    Private mvarFileName

    Private Sub Class_Initialize()
        Set mvarUploadObject = Nothing
        Set mvarFileObject = Nothing
        mvarFileName = ""
        mvarSize = 0
    End Sub
    
    Private Sub Class_Terminate()
        Set mvarUploadObject = Nothing
        Set mvarFileObject = Nothing
    End Sub

    Public Property Set UploadObject(NewObject)
        Set mvarUploadObject = NewObject
    End Property

    Public Property Get UploadObject()
        Set UploadObject = mvarUploadObject
    End Property

    Public Property Get FileObject()
        Set FileObject = mvarFileObject
    End Property

    Public Property Let Name(ParameterName)
        If mvarUploadObject is Nothing Then Exit Property
        mvarName = ParameterName
        Set mvarFileObject = mvarUploadObject.Files(ParameterName)
        If Not mvarFileObject is Nothing Then 
            mvarFileName = mvarFileObject.FileName
            mvarSize = mvarFileObject.Size
        End If
    End Property

    Public Property Get Name()
        Name = mvarName
    End Property

    Public Property Get FileExists()
        If Not mvarFileObject is Nothing Then FileExists = (mvarFileName <> "") Else FileExists = False
    End Property

    Public Property Get Size()
        Size = mvarSize
    End Property

    Public Property Get FileName()
        FileName = mvarFileName
    End Property

    Public Function Save(NewFileName)
        Save = False
        If mvarFileObject is Nothing Then Exit Function
        mvarFileObject.SaveAs NewFileName
        Save = True
    End Function

End Class

'End clsFileElement Class

'clsFormElement Class @0-55A85CA9
Class clsFormElement
    Private mvarName
    Private mvarUploadObject
    Private mvarCount
    Private mvarValue

    Private Sub Class_Initialize()
        Set mvarUploadObject = Nothing
    End Sub
    
    Private Sub Class_Terminate()
        Set mvarUploadObject = Nothing
    End Sub

    Public Property Set UploadObject(NewObject)
        Set mvarUploadObject = NewObject
    End Property

    Public Property Get UploadObject()
        Set UploadObject = mvarUploadObject
    End Property

    Public Property Get Count()
        Count = mvarCount
    End Property

    Public Property Get Item(Index)
        Item = Empty
    End Property

    Public Property Let Name(ParameterName)
        If mvarUploadObject is Nothing Then Exit Property
        
        mvarValue = mvarUploadObject.Form(ParameterName).Value
        mvarCount = IIf(IsEmpty(mvarValue), 0, 1)
        mvarName = ParameterName
    End Property

    Public Property Get Name()
        Name = mvarName
    End Property

    Public Default Property Get Value() 
        Value = mvarValue
    End Property

End Class

'End clsFormElement Class

'clsUploadControl Class @0-12BA25AF
Class clsUploadControl
    Private mvarUploadObject
    Private mvarFilesCount
    Private mvarFileElements
    Private mvarFormElements

    Private Sub Class_Initialize()
        mvarFilesCount = 0
        Set mvarUploadObject = Nothing
        Set mvarFileElements = CreateObject("Scripting.Dictionary")
        Set mvarFormElements = CreateObject("Scripting.Dictionary")

        On Error Resume Next

        Set mvarUploadObject = Server.CreateObject("Persits.Upload")
        mvarUploadObject.IgnoreNoPost = True

        mvarFilesCount = mvarUploadObject.Save
        If Err.Number <> 0 Then
            Response.Write "Die Persits Upload-Komponente ""Persits"" wurde nicht gefunden. Wählen Sie eine andere oder installieren Sie die Komponente."
            Response.End
        End If
        On Error Goto 0
    End Sub

    Private Sub Class_Terminate()
        mvarFileElements.RemoveAll
        Set mvarFileElements = Nothing
        mvarFormElements.RemoveAll
        Set mvarFormElements = Nothing
        Set mvarUploadObject = Nothing
    End Sub

    Public Property Get FilesCount()
      FilesCount = mvarFilesCount
    End Property

    Public Property Get Form(ParameterName)
        Dim FormElement
        If Not mvarFormElements.Exists(LCase(ParameterName)) Then
            Set FormElement = new clsFormElement
            Set FormElement.UploadObject = mvarUploadObject
            FormElement.Name = ParameterName
            mvarFormElements.Add LCase(ParameterName), FormElement
        Else
            Set FormElement = mvarFormElements.Item(LCase(ParameterName))
        End If
        Set Form = FormElement
    End Property

    Public Property Get Files(ParameterName)
      Dim FileElement
      If Not mvarFileElements.Exists(LCase(ParameterName)) Then
        Set FileElement = new clsFileElement
        Set FileElement.UploadObject = mvarUploadObject
        FileElement.Name = ParameterName
        mvarFileElements.Add LCase(ParameterName), FileElement
      Else
        Set FileElement = mvarFileElements.Item(LCase(ParameterName))
      End If
      Set Files = FileElement
    End Property
End Class

'End clsUploadControl Class

'CCCreateFileUpload Function @0-A734B792
Function CCCreateFileUpload(Name,Caption,TemporaryFolder,FileFolder,AllowedFileMasks,DisallowedFileMasks,FileSizeLimit,Required)
    Dim FileUpload
    Set FileUpload = New clsFileUpload

    With FileUpload
        .Name                = Name
        .DeleteControlName   = Name & "_Delete"
        .Caption             = Caption
        .TemporaryFolder     = TemporaryFolder & "\"
        .FileFolder          = FileFolder & "\"
        .AllowedFileMasks    = AllowedFileMasks
        .DisallowedFileMasks = DisallowedFileMasks
        .FileSizeLimit       = FileSizeLimit
        .Required            = Required
    End With

    Set CCCreateFileUpload = FileUpload
End Function
'End CCCreateFileUpload Function

'clsFileUpload Class @0-3C10B0C8
Class clsFileUpload
  Public Name
  Public CCSEvents
  Public Visible
  Public ExternalName
  Public Errors
  Public Caption
  Public Required
  Public TemplateBlock

  Public AllowedFileMasks
  Public DisallowedFileMasks
  Public FileSizeLimit

  Public IsUploaded
  Public FileSize
  Public fso
  Public DeleteControlName
  Public ExternalDeleteControlName

  Private VarTemporaryFolder
  Private VarFileFolder
  Private VarValue
  Private VarText
  Private StateArray
  Private IsCCSName

  Private CCSEventResult

  Private Sub Class_Initialize()
    Set CCSEvents = CreateObject("Scripting.Dictionary")
    Set fso       = CreateObject("Scripting.FileSystemObject")

    Set Errors    = New clsErrors

    ExternalName  = Empty
    Visible       = True
    IsUploaded    = False
    FileSize      = 0
    ReDim StateArray(1)
    StateArray(0) = Empty
    StateArray(1) = Empty
    IsCCSName=True
  End Sub

  Private Sub Class_Terminate()
    CCSEvents.RemoveAll
    Set CCSEvents = Nothing
    Set Errors    = Nothing
    Set fso       = Nothing
  End Sub

  Public Function Upload(CurrentRow)
  On Error Resume Next
    Dim f, FieldName, NewFileName
    If Not IsEmpty(CurrentRow) Then 
      ExternalName = Name & "_" & CStr(CurrentRow)
      ExternalDeleteControlName = Name & "_Delete_" & CStr(CurrentRow)
    End If

    If CCGetRequestParam("ccsForm",ccsGet) <> "" Then
      SetState CCGetRequestParam(IIf(Not IsEmpty(ExternalName), ExternalName, Name), ccsPost)
      Value = StateArray(0)
    End If

    If UploadedFilesCount > 0 Then
      If Not IsEmpty(objUpload.Files(IIf(Not IsEmpty(ExternalName), ExternalName, Name) & "_File")) Then _
        Set f = objUpload.Files(IIf(Not IsEmpty(ExternalName), ExternalName, Name) & "_File")
      If Not IsEmpty(f) Then
        If f.FileExists Then
          FileSize = f.Size
          NewFileName = GetValidFileName(f.FileName) & f.FileName
          CCSEventResult = CCRaiseEvent(CCSEvents, "OnRenameFile", Me)
          If TypeName(CCSEventResult)="String" And CStr(CCSEventResult)<>"" Then NewFileName = CCSEventResult
          f.Save VarTemporaryFolder & NewFileName
          If Not Err.Number = 0 Then 
            If Not CStr(Caption) = "" Then FieldName = Caption Else FieldName = Name
            Response.Write CCSRunTimeMessages.GetMessage("UploadingTempFolderError",Array("FieldName",FieldName, "Error", CStr(Err.Source) & ", " & CStr(Err.Description)))
            Response.End
          End If
          StateArray(1) = NewFileName
          If Not IsEmpty(StateArray(0)) And StateArray(1) <> StateArray(0) Then DeleteFile
          Value = NewFileName
        Else
          If IsEmpty(StateArray(0)) Then
            VarValue = ""
            FileSize = 0
          End If
        End If
      Else
        If IsEmpty(StateArray(0)) Then
          VarValue = ""
          FileSize = 0
        End If
        StateArray(1) = Empty
      End If
    End If

    If CCGetRequestParam(IIf(Not IsEmpty(ExternalDeleteControlName), ExternalDeleteControlName, DeleteControlName), ccsPost) <> "" Then DeleteFile

    If Not Err.Number = 0 Then 
      If Not CStr(Caption) = "" Then FieldName = Caption Else FieldName = Name
      Response.Write "Fehler beim Upload der im Feld " & FieldName & " angegebenen Datei. Fehler-Beschreibung: " & CStr(Err.Source) & ", " & CStr(Err.Description) & "."
      Response.End
    End If
  End Function

  Public Function GetFile(CurrentRow)
  On Error Resume Next
    Dim f, FieldName
    If Not IsEmpty(CurrentRow) Then 
      ExternalName = Name & "_" & CStr(CurrentRow)
      ExternalDeleteControlName = Name & "_Delete_" & CStr(CurrentRow)
    End If
    IsCCSName=True

    If CCGetRequestParam("ccsForm",ccsGet) <> "" Then
      SetState CCGetRequestParam(IIf(Not IsEmpty(ExternalName), ExternalName, Name), ccsPost)
      Text = StateArray(0)
      Value = Text
    End If

    If UploadedFilesCount > 0 Then
      If Not IsEmpty(objUpload.Files(IIf(Not IsEmpty(ExternalName), ExternalName, Name) & "_File")) Then _
        Set f = objUpload.Files(IIf(Not IsEmpty(ExternalName), ExternalName, Name) & "_File")
      If Not IsEmpty(f) Then
        If f.FileExists Then
          FileSize = f.Size
          Text = f.FileName
          IsCCSName = False
        Else
          If IsEmpty(StateArray(0)) Then
            Text = "" 
            FileSize = 0
          End If
        End If
      Else
        If IsEmpty(StateArray(0)) Then
          Text = "" 
          FileSize = 0
        End If
      End If
    End If

    If Not Err.Number = 0 Then 
      If Not CStr(Caption) = "" Then FieldName = Caption Else FieldName = Name
      Response.Write "Fehler beim Upload der im Feld " & FieldName & " angegebenen Datei. Fehler-Beschreibung: " & CStr(Err.Source) & ", " & CStr(Err.Description) & "."
      Response.End
    End If
  End Function

  Public Function MoveFromTempFolder
  On Error Resume Next
    Dim FieldName
    CCSEventResult = CCRaiseEvent(CCSEvents, "BeforeProcessFile", Me)
    If (fso.FileExists(VarTemporaryFolder & VarValue)) Then
      fso.MoveFile VarTemporaryFolder & VarValue, VarFileFolder & VarValue
      StateArray(0) = VarValue
      StateArray(1) = VarValue
    End If
    CCSEventResult = CCRaiseEvent(CCSEvents, "AfterProcessFile", Me)
    If Not Err.Number = 0 Then 
      If Not CStr(Caption) = "" Then FieldName = Caption Else FieldName = Name
      Response.Write "Fehler beim Upload der im Feld " & FieldName & " angegebenen Datei. Fehler-Beschreibung: " & CStr(Err.Source) & ", " & CStr(Err.Description) & "."
      Response.End
    End If
  End Function

  Public Function DeleteFile()
  On Error Resume Next
    Dim FieldName, FileName
    CCSEventResult = CCRaiseEvent(CCSEvents, "BeforeDeleteFile", Me)
    FileName = VarValue
    If IsEmpty(FileName) Then FileName = VarText
    If (fso.FileExists(VarTemporaryFolder & FileName)) Then
      fso.DeleteFile VarTemporaryFolder & FileName, True
      VarValue = ""
    End If
    If (fso.FileExists(VarFileFolder & FileName)) Then
      fso.DeleteFile VarFileFolder & FileName, True
      VarValue = ""
    End If
    CCSEventResult = CCRaiseEvent(CCSEvents, "AfterDeleteFile", Me)
    If Not Err.Number = 0 Then 
      If Not CStr(Caption) = "" Then FieldName = Caption Else FieldName = Name
      Response.Write "Fehler beim Upload der im Feld " & FieldName & " angegebenen Datei. Fehler-Beschreibung: " & CStr(Err.Source) & ", " & CStr(Err.Description) & "."
      Response.End
    End If
  End Function

  Property Let TemporaryFolder(NewText)
    Dim FieldName, regEx
    VarTemporaryFolder = NewText
    If UCase(Left(NewText, 5)) = "%TEMP" Then 
      VarTemporaryFolder = fso.GetSpecialFolder(2) & Mid(NewText, 6)
    End If
    If NewText = "" Then 
      VarTemporaryFolder = Server.MapPath(".\") & "\"
    End If
    
    Set regEx = New RegExp
    regEx.Pattern = "^[a-z]:.*"
    regEx.IgnoreCase = True
    If Not regEx.Test(VarTemporaryFolder) Then VarTemporaryFolder = Server.MapPath(VarTemporaryFolder) & "\"

    If Not fso.FolderExists(VarTemporaryFolder) Then
      If Not CStr(Caption) = "" Then FieldName = Caption Else FieldName = Name
      Response.Write "Der Upload der im Feld " & CStr(FieldName) & " angegebenen Datei ist nicht möglich - der temporäre Upload-Ordner existiert nicht."
      Response.End
    End If
  End Property

  Property Get TemporaryFolder()
    TemporaryFolder = VarTemporaryFolder
  End Property

  Property Let FileFolder(NewText)
    Dim FieldName, regEx
    VarFileFolder = NewText
    If UCase(Left(NewText, 5)) = "%TEMP" Then 
      VarFileFolder = fso.GetSpecialFolder(2) & Mid(NewText, 6)
    End If

    Set regEx = New RegExp
    regEx.Pattern = "^[a-z]:.*"
    regEx.IgnoreCase = True
    If Not regEx.Test(VarFileFolder) Then VarFileFolder = Server.MapPath(VarFileFolder) & "\"

    If Not fso.FolderExists(VarFileFolder) Then
      If Not CStr(Caption) = "" Then FieldName = Caption Else FieldName = Name
      Response.Write "Der Upload der im Feld " & CStr(FieldName) & " angegebenen Datei ist nicht möglich - der Upload-Ordner existiert nicht."
      Response.End
    End If
  End Property

  Property Get FileFolder()
    FileFolder = CStr(VarFileFolder)
  End Property

  Property Let Value(NewValue)
  On Error Resume Next
    Dim f, FieldName

    If Not IsEmpty(NewValue) Then
      If Len(NewValue) > 0 Then

        If (fso.FileExists(VarTemporaryFolder & NewValue)) Then
          VarValue   = NewValue
          VarText  = VarValue
          StateArray(0) = NewValue
          StateArray(1) = Empty
          IsUploaded = True
          Set f = fso.GetFile(VarTemporaryFolder & NewValue)
          FileSize = f.Size
          VarText = f.Path

        ElseIf (fso.FileExists(VarFileFolder & NewValue)) Then

          VarValue   = NewValue
          VarText  = VarValue
          StateArray(0) = NewValue
          StateArray(1) = Empty
          IsUploaded = True
          Set f = fso.GetFile(VarFileFolder & NewValue)
          FileSize = f.Size

        End If

      End If
    End If    
    If Not IsEmpty(ExternalName) And NewValue = "" Then
      VarValue = ""
      VarText = ""
      StateArray(0) = Empty
      StateArray(1) = Empty
      IsUploaded = False
      FileSize = 0
    End If

    If Not Err.Number = 0 Then 
      If Not CStr(Caption) = "" Then FieldName = Caption Else FieldName = Name
      Response.Write "Fehler beim Upload der im Feld " & FieldName & " angegebenen Datei. Fehler-Beschreibung: " & CStr(Err.Source) & ", " & CStr(Err.Description) & "."
      Response.End
    End If
  End Property

  Property Get Value()
    Value = VarValue
  End Property

  Property Let Text(NewText)
    Dim f
    VarText = NewText
  End Property

  Property Get Text()
    Text = CStr(VarText)
  End Property

  Public Function GetValidFileName(FileName)
  On Error Resume Next
    Dim dta, tm, index, prefix, FieldName
    dta = Date()
    tm = time()
    index = 0

    Do
      prefix = Year(dta) & Month(dta) & Day(dta) & Hour(tm) & Minute(tm) & Second(tm) & CStr(index) & "."
      index = index + 1
    Loop While fso.FileExists(VarTemporaryFolder & prefix & FileName) Or fso.FileExists(VarFileFolder & prefix & FileName)

    GetValidFileName = prefix

    If Not Err.Number = 0 Then 
      If Not CStr(Caption) = "" Then FieldName = Caption Else FieldName = Name
      Response.Write "Fehler beim Upload der im Feld " & FieldName & " angegebenen Datei. Fehler-Beschreibung: " & CStr(Err.Source) & ", " & CStr(Err.Description) & "."
      Response.End
    End If
  End Function

  Public Function GetOriginFileName(FileName)
    Dim nPos
    nPos = InStr(FileName,".")
    If nPos > 0 Then
      GetOriginFileName = Mid(FileName,nPos+1)
    Else 
      GetOriginFileName = FileName
    End If
  End Function

  Function Validate()
    Dim FieldName,oVarText
    If Required And CStr(VarText) = "" Then
      If Not CStr(Caption) = "" Then FieldName = Caption Else FieldName = Name
      Errors.addError("Die im Feld " & FieldName & " bennante Datei fehlt.")
    End If
    oVarText = IIF(IsUploaded And IsCCSName,GetOriginFileName(VarText),VarText)
    If Not CStr(Text) = "" And DisallowedFileMasks <> "" And CCRegExpTest(oVarText, "^" & Replace(Replace(Replace(Replace(DisallowedFileMasks, ".", "\."), "?", "."), "*", ".*"), ";", "$|^") & "$", True, True) And Errors.Count = 0 Then

      If Not CStr(Caption) = "" Then FieldName = Caption Else FieldName = Name
      Errors.addError("Der im Feld " & FieldName & " eingegebene Dateityp ist nicht erlaubt.")
    End If
    If Not CStr(Text) = "" And AllowedFileMasks <> "" And AllowedFileMasks <> "*" And Not CCRegExpTest(oVarText, "^" & Replace(Replace(Replace(Replace(AllowedFileMasks,".", "\."), "?", "."), "*", ".*"), ";", "$|^") & "$", True, True) And Errors.Count = 0 Then
          If Not CStr(Caption) = "" Then FieldName = Caption Else FieldName = Name
      Errors.addError("Der im Feld " & FieldName & " eingegebene Dateityp ist nicht erlaubt.")
    End If
    If Not IsUploaded And FileSize > FileSizeLimit And Errors.Count = 0 Then
      If Not CStr(Caption) = "" Then FieldName = Caption Else FieldName = Name
      Errors.addError("Die im Feld " & FieldName & " eingegebene Dateigröße ist zu groß.")
    End If
    If Errors.Count > 0 And fso.FileExists(VarTemporaryFolder & VarText) Then DeleteFile
    Validate = CCRaiseEvent(CCSEvents, "OnValidate", Me)
  End Function

  Sub Show(Template)
    Dim TemplateBlock, UploadBlock, InfoBlock, DeleteControlBlock

    CCSEventResult = CCRaiseEvent(CCSEvents, "BeforeShow", Me)

    If Visible Then

      Set TemplateBlock      = Template.Block("FileUpload " & Name)
      Set UploadBlock        = TemplateBlock.Block("Upload")
      Set InfoBlock          = TemplateBlock.Block("Info")
      Set DeleteControlBlock = TemplateBlock.Block("DeleteControl")

      If Not (TemplateBlock Is Nothing) Then
          
          If IsEmpty(ExternalName) Then
            TemplateBlock.Variable("ControlName") = Name
          Else
            TemplateBlock.Variable("ControlName") = ExternalName
          End If
          TemplateBlock.Variable("State") = GetState()

          If (Not IsUploaded Or Required) And Not (UploadBlock Is Nothing) Then
            If IsEmpty(ExternalName) Then
              UploadBlock.Variable("FileControl") = Name & "_File"
            Else
              UploadBlock.Variable("FileControl") = ExternalName & "_File"
            End If
            UploadBlock.Parse ccsParseOverwrite
            InfoBlock.Visible = False
            DeleteControlBlock.Visible = False
          End If

          If IsUploaded And Not (InfoBlock Is Nothing) Then
            InfoBlock.Variable("FileName")      = GetOriginFileName(Server.HTMLEncode(VarValue))
            InfoBlock.Variable("FileSize")      = FileSize
            InfoBlock.Parse ccsParseOverwrite
            UploadBlock.Visible = Required
          End If

          If IsUploaded And Not Required And Not (DeleteControlBlock Is Nothing) Then
            If IsEmpty(ExternalDeleteControlName) Then
              DeleteControlBlock.Variable("DeleteControl") = DeleteControlName
            Else
              DeleteControlBlock.Variable("DeleteControl") = ExternalDeleteControlName
            End If
            DeleteControlBlock.Parse ccsParseOverwrite
            UploadBlock.Visible = Required
          End If

          TemplateBlock.Parse ccsParseOverwrite
      End if

    End If
  End Sub

  Function OnClick()
    OnClick = CCRaiseEvent(CCSEvents, "OnClick", Me)
  End Function

  Private Function GenerateStateKey()
    Dim dta, tm, random_number
    dta = Date()
    tm = time()
    Randomize
    random_number = Abs(Int((2147483647 + 2147483648 + 1) * Rnd - 2147483648))
    GenerateStateKey = CStr(random_number) & Day(dta) & Hour(tm) & Minute(tm) & Second(tm)
  End Function

  Private Function GetState()
    Dim ControlStateKey
    If StateArray(0) = Empty Then StateArray(0) = Value
    ControlStateKey = GenerateStateKey()
    Session(ControlStateKey) = StateArray
    GetState = ControlStateKey
  End Function

  Private Function SetState(value)  
    If IsArray(Session(value)) Then
      StateArray(0) = Session(value)(0)
      StateArray(1) = Session(value)(1)
    Else
      StateArray(0) = Empty
      StateArray(1) = Empty
    End If
  End Function

End Class

'End clsFileUpload Class

'CCCreateButton Function @0-E8E95E8F
Function CCCreateButton(Name)
    Dim Button
    Set Button = New clsButton
    Button.Name = Name
    Set CCCreateButton = Button
End Function
'End CCCreateButton Function

'clsButton Class @0-FE2F9E8E
Class clsButton
  Public Name
  Public CCSEvents
  Public Visible
  Public ExternalName

  Private CCSEventResult

  Private Sub Class_Initialize()
    Set CCSEvents = CreateObject("Scripting.Dictionary")
    ExternalName = Empty
    Visible = True
  End Sub

  Private Sub Class_Terminate()
    Set CCSEvents = Nothing
  End Sub

  Sub Show(Template)

    CCSEventResult = CCRaiseEvent(CCSEvents, "BeforeShow", Me)

    If Visible Then

      If Template.BlockExists("Button " & Name, "block") Then 
        Template.Block("Button " & Name).Variable("Button_Name") = Name
        Template.Block("Button " & Name).Parse ccsParseOverwrite
      End If

    End If
  End Sub

  Function OnClick()
    OnClick = CCRaiseEvent(CCSEvents, "OnClick", Me)
  End Function
End Class

'End clsButton Class

'CCCreateDatePicker Function @0-C5EDAC24
Function CCCreateDatePicker(Name, FormName, ControlName)
  Dim DatePicker
  Set DatePicker = New clsDatePicker
  With DatePicker
    .Name = Name
    .FormName = FormName
    .ControlName = ControlName
  End With
  Set CCCreateDatePicker = DatePicker
End Function
'End CCCreateDatePicker Function

'clsDatePicker Class @0-B0B324C1
Class clsDatePicker
  Public Name
  Public ExternalName
  Public FormName
  Public ControlName
  Public ExternalControlName
  Public Visible

  Private Sub Class_Initialize()
    ExternalName = Empty
    ExternalControlName = Empty
    Visible = True
  End Sub

  Sub Show(Template)
    Dim TemplateBlock
    If Visible Then
      Set TemplateBlock = Template.Block("DatePicker " & Name)
      If Template.BlockExists("DatePicker " & Name, "block") Then 
        TemplateBlock.Variable("Name") = CStr(FormName) & "_" & CStr(Name)
        TemplateBlock.Variable("FormName") = CStr(FormName)
        If IsEmpty(ExternalControlName) Then
          TemplateBlock.Variable("DateControl") = CStr(ControlName)
        Else
          TemplateBlock.Variable("DateControl") = CStr(ExternalControlName)
        End If
        TemplateBlock.Parse ccsParseOverwrite
      End If
    End If
  End Sub

End Class
'End clsDatePicker Class

'CCCreateList Function @0-54E52904
Function CCCreateList(ControlType, Name, Caption, DataType, InitValue, DataSource)
    Dim Control
    Set Control = New clsListControl
    With Control
        .Name = Name
        .ControlType = ControlType
        .Caption = Caption
        .DataType = DataType
        .ControlTypeName = ccsControlTypes(ControlType)
        If IsArray(InitValue) Then
            .MultipleValues = InitValue
        Else
            .Text = InitValue
        End If
        If IsObject(DataSource) Then 
            Set .DataSource = DataSource
        End If
    End With
    Set CCCreateList = Control
End Function
'End CCCreateList Function

'clsListControl Class @0-3FC4C78F
Class clsListControl
  Private Control
  Private DataTypeValue

  Public CCSEvents
  Public DataSource
  Public Recordset
  Public Errors
  Public Name
  Public ControlType
  Public Caption
  Public Required
  Public TemplateBlock
  Public Visible
  Public HTML
  Public MultipleValues
  Public IsMultiple
  Public ExternalName
  Public ControlTypeName

  Public TextColumn
  Public BoundColumn
  Private CCSEventResult
  Private mPopulatingType

  Public IsPopulated
  Public ItemsList()
  Public KeysList()
  Public ItemsCount


  Private Sub Class_Initialize()
    Required = False
    BoundColumn = 0
    TextColumn = 1
    Visible = True
    PopulatingType = ccsStringConcats 
    HTML = False
    ExternalName = Empty
    IsPopulated = False
    ItemsCount = 0

    Set Control = New clsControl
    Set CCSEvents = CreateObject("Scripting.Dictionary")
    Set Errors = New clsErrors
  End Sub

  Private Sub Class_Terminate()
    Set Control = Nothing
    Set Errors = Nothing
    Set DataSource = Nothing
    Set Recordset = Nothing
    Set CCSEvents = Nothing
  End Sub

  Public Function AddValue(NewValue)
    Dim NumberOfValues
    NumberOfValues = Ubound(MultipleValues)
    ReDim Preserve MultipleValues(NumberOfValues + 1)
    MultipleValues(NumberOfValues + 1) = NewValue
  End Function

  Public Function HasMultipleValues
    If IsArray(MultipleValues) Then
      HasMultipleValues = (Ubound(MultipleValues) > 0)
    Else
      HasMultipleValues = False
    End If
  End Function

  Property Let Value(NewValue)
    If IsMultiple Then
      If HasMultipleValues Then
        MultipleValues(1) = NewValue
      Else
        AddValue NewValue
      End If
    End If
    Control.Value = NewValue
  End Property

  Property Get Value()
    If IsMultiple And HasMultipleValues Then
      Value = MultipleValues(1)
    Else
      Value = Control.Value
    End If
  End Property

  Public Property Let PopulatingType(vType)
      mPopulatingType = vType
  End Property

  Public Property Get PopulatingType()
      PopulatingType = mPopulatingType
  End Property

  Property Let DataType(NewDataType)
    DataTypeValue = NewDataType
    Control.DataType = DataTypeValue
  End Property

  Property Get DataType()
    DataType = DataTypeValue 
  End Property

  Property Get SQLValue()
    SQLValue = Control.SQLValue
  End Property

  Function Validate()
    Dim FieldName,Passed

    If Required Then
      If IsMultiple Then
        Passed = (Ubound(MultipleValues) = 0)
      Else
        Passed = (CStr(Control.Value) = "") 
      End If

      If Passed Then
        If Not CStr(Caption) = "" Then FieldName = Caption Else FieldName = Name
        Errors.addError(CCSRunTimeMessages.GetMessage("RequiredField", Array("FieldName", FieldName)))
      End If

    End If
    Validate = CCRaiseEvent(CCSEvents, "OnValidate", Me)
  End Function


  Public Sub RePopulate 
    Dim cmdErrors, MaxBound, i
    Dim RSFields

    If NOT IsObject(DataSource) Then Exit Sub 

    Set cmdErrors = new clsErrors
    Set Recordset = DataSource.Exec(cmdErrors)

    Set RSFields = new clsFields
    RSFields.AddFields Array(CCCreateField("BoundColumn", BoundColumn, DataTypeValue, Empty, Recordset), _ 
      CCCreateField("TextColumn", TextColumn, ccsText, Empty, Recordset))

    Set Recordset.FieldsCollection = RSFields

    If cmdErrors.Count > 0 Then
      Dim ErrorString
      If ControlType = ccsRadioButton Then
        ErrorString = "RadioButton " & Name
      ElseIf ControlType = ccsListBox Then
        ErrorString = "ListBox " & Name
      Else
        ErrorString = "CheckBoxList" & Name
      End If
      PrintDBError CCToHTML(ErrorString), "", cmdErrors.ToString()
    Else
      MaxBound = 25: i = 1
      ReDim ItemsList(MaxBound)
      ReDim KeysList (MaxBound)

      While NOT Recordset.EOF

        If i >= MaxBound Then
          MaxBound = MaxBound + 25
          ReDim Preserve ItemsList(MaxBound)
          ReDim Preserve KeysList (MaxBound)
        End If

        ItemsList(i) = Recordset.Fields("TextColumn")
        KeysList(i)  = Recordset.Fields("BoundColumn")

        i = i + 1
        Recordset.MoveNext
      Wend
    End If

    Recordset.Close

    IsPopulated = True
    ItemsCount = i - 1
    Set cmdErrors = Nothing

  End Sub

  Sub Show(Template)
    Dim Result, Selected, Recordset, ResultBuffer, i, j
    Dim cmdErrors
    Dim NeedShow

    If NOT IsObject(DataSource) Then Exit Sub
    If Not IsPopulated Then RePopulate()

    Set TemplateBlock = Template.Block(ControlTypeName & " " & Name)
    NeedShow = NOT (TemplateBlock Is Nothing)
    If ControlType = ccsListBox Then
      If NOT NeedShow Then _
        Set TemplateBlock = Template
    End If

    If IsEmpty(ExternalName) Then
      TemplateBlock.Variable(Name & "_Name") = Name
    Else
      TemplateBlock.Variable(Name & "_Name") = ExternalName
    End If
   
    CCSEventResult = CCRaiseEvent(CCSEvents, "BeforeShow", Me)

    If NOT Visible Then
      If NeedShow Then TemplateBlock.Clear
      Exit Sub
    End If

    If ControlType = ccsRadioButton or ControlType = ccsCheckBoxList Then 
      TemplateBlock.Clear

      For j = 1 To ItemsCount
        Selected = ""
        If IsMultiple Then
          For i = 1 To Ubound(MultipleValues)
            If UCase(CStr(KeysList(j))) = UCase(CStr(MultipleValues(i))) Then 
              Selected = " CHECKED"
            End If
          Next
        Else
          If UCase(CStr(KeysList(j))) = UCase(CStr(Value)) Then 
            Selected = " CHECKED"
          End If
        End If
        TemplateBlock.Variable("Value") = CCSConverter.TypeToString(DataType, KeysList(j), Empty)
        TemplateBlock.Variable("Check") = Selected
        If HTML Then
          TemplateBlock.Variable("Description") = CStr(ItemsList(j))
        Else
          TemplateBlock.Variable("Description") = Server.HTMLEncode(CStr(ItemsList(j)))
        End If
        TemplateBlock.Parse True
      Next

    ElseIf ControlType = ccsListBox Then

      Set ResultBuffer = new clsStringBuffer
      Result = ""

      If mPopulatingType = ccsStringConcats Then

        For j = 1 To ItemsCount
          Selected = ""

          If IsMultiple Then
            For i = 1 To Ubound(MultipleValues)
              If UCase(CStr(KeysList(j))) = UCase(CStr(MultipleValues(i))) Then 
                Selected = " SELECTED"
                Exit For
              End If
            Next
          Else
            If UCase(CStr(KeysList(j))) = UCase(CStr(Value)) Then 
              Selected = " SELECTED"
            End If
          End If
          Result = Result & "<OPTION VALUE=""" _
            & CCSConverter.TypeToString(DataType, KeysList(j), Empty) _
            & """" & Selected & ">" & ItemsList(j) & "</OPTION>" & vbNewLine
        Next
      Else
        For j = 1 To ItemsCount
          Selected = ""
          If IsMultiple Then
            For i = 1 To Ubound(MultipleValues)
              If UCase(CStr(KeysList(j))) = UCase(CStr(MultipleValues(i))) Then 
                Selected = " SELECTED"
                Exit For
              End If
            Next
          Else
            If UCase(CStr(KeysList(j))) = UCase(CStr(Value)) Then 
              Selected = " SELECTED"
            End If
          End If
          ResultBuffer.Append "<OPTION VALUE=""" _
            & CCSConverter.TypeToString(DataType, KeysList(j), Empty) _
            & """" & Selected & ">" & ItemsList(j) & "</OPTION>" & vbNewLine
        Next
        Result = ResultBuffer.ToString
      End If
      TemplateBlock.Variable(Name & "_Options") = Result
      If NeedShow Then TemplateBlock.Show
    End If
    Set TemplateBlock = Nothing
  End Sub

  Property Get Text()
    Text = Control.Text
  End Property

  Property Let Text(NewText)
    Control.Text = NewText
  End Property

  Property Get SQLText()
    SQLText = Control.SQLText
  End Property

  Property Let SQLText(NewSQLText)
    Control.SQLText = NewSQLText
  End Property

End Class
'End clsListControl Class

'clsErrors Class @0-DC79566E
Class clsErrors
  Private ErrorsCount
  Private Errors
  Public ErrorDelimiter

  Private Sub Class_Initialize()
    Clear
    ErrorDelimiter = "<br>"
  End Sub

  Sub AddError(Description)
    If NOT(CStr(Description) = "") Then
      ReDim Preserve Errors(ErrorsCount)
      Errors(ErrorsCount) = Description
      ErrorsCount = ErrorsCount + 1
    End If
  End Sub

  Sub AddErrors(objErrors)
    Dim I
    For I = 0 To objErrors.Count - 1
      AddError(objErrors.ErrorByNumber(I))
    Next
  End Sub

  Sub Clear()
    ErrorsCount = 0
    ReDim Errors(1)
  End Sub

  Property Get Count()
    Count = ErrorsCount
  End Property

  Property Get ErrorByNumber(ErrorNumber)
    If ErrorNumber > ErrorsCount OR ErrorNumber < 0 Then 
      Err.Raise 4001, "Error class, ErrorByNumber function. Parameter out of range."
    End If
    ErrorByNumber = Errors(ErrorNumber)
  End Property

  Property Get ToString()
    If ErrorsCount > 0 Then
      ToString = Join(Errors, ErrorDelimiter) & ErrorDelimiter
    Else
      ToString = ""
    End If
  End Property

End Class
'End clsErrors Class

'CCCreateDataSource Function @0-07E5CF26
Function CCCreateDataSource(DataSourceType, Connection, CommandSource)
  Dim Cmd
  
  Set Cmd = New clsCommand
  If DataSourceType <> dsListOfValues Then
    Set Cmd.Connection = Connection
    Set Cmd.WhereParameters.Connection = Connection
  End If
  Cmd.CommandType = DataSourceType
  Cmd.CommandOperation = cmdOpen
  Cmd.ActivePage = -1

  Select Case DataSourceType
    Case dsTable
      Cmd.SQL = CommandSource(0)
      Cmd.Where = CommandSource(1)
      Cmd.OrderBy = CommandSource(2)
    Case dsSQL
      Cmd.SQL = CommandSource
    Case dsProcedure
      Set Cmd.SQL = CommandSource
    Case dsListOfValues
      Cmd.LOV = CommandSource
  End Select
  Set CCCreateDataSource = Cmd
End Function
'End CCCreateDataSource Function

'clsEmptyDataSource Class @0-79DF4DE2
Class clsEmptyDataSource

  Public Errors
  Public CCSEvents

  Private Sub Class_Initialize()
    Set CCSEvents = CreateObject("Scripting.Dictionary")
    Set Errors = New clsErrors
  End Sub

  Private Sub Class_Terminate()
    Set CCSEvents = Nothing
    Set Errors = Nothing
  End Sub

  Function Open(Cmd)
    Set Open = Me
  End Function

  Property Get EOF()
    EOF = True
  End Property

  Property Get State()
    State = adStateClosed
  End Property

  Property Get Fields(Name)
    Fields = Empty
  End Property
End Class

'End clsEmptyDataSource Class

'clsDataSource Class @0-91D5AB91
Class clsDataSource

  Public DataSourceType
  Public DataSource
  Public Errors, Connection, Parameters, CCSEvents
  Public Recordset
  Public PageSize
  Public Command

  Private mRecordCount
  Public Order

  Private objFields
  Private AbsolutePage
  Private builtSQL
  Private Opened
  Private MemoFields

  Private Sub Class_Initialize()
    Set CCSEvents = CreateObject("Scripting.Dictionary")
    Set MemoFields = CreateObject("Scripting.Dictionary") 
    Set Errors = New clsErrors
    Set Parameters = New clsSQLParameters
    Set Parameters.DataSource = Me
    AbsolutePage = 0
    RecordCount = -1
    Opened = False
  End Sub

  Sub Close()
    If Recordset.State = adStateOpen Then 
      Recordset.Close
    End If
    Opened = False
    Set Recordset = Nothing
  End Sub

  Function GetData(Pages)
    If Pages = 0 Then
      Set GetData = Recordset
    End If
  End Function

  Property Get Fields(Name)
    If IsNumeric(Name) Then
      Fields = CCGetValue(Recordset, CInt(Name))
    ElseIf IsObject(objFields) Then
      If Not objFields is Nothing Then
        If objFields.Exists(Name) Then
          If MemoFields.Exists(objFields(Name).DBFieldName) Then
            Fields = MemoFields(objFields(Name).DBFieldName)
          Else
            Fields = objFields(Name).Value
            If objFields(Name).DataType = ccsMemo Then
              MemoFields.Add objFields(Name).DBFieldName, Fields
            End If
          End If
        Else
          Fields = CCGetValue(Recordset, Name)
        End If
      Else
        Fields = CCGetValue(Recordset, Name)
      End If
    Else
      Fields = CCGetValue(Recordset, Name)
    End If
  End Property


  Property Set FieldsCollection(NewFieldsCollection)
    Set objFields = NewFieldsCollection
    If Not objFields Is Nothing Then
      objFields.InitEnum
      While Not objFields.EndOfEnum
        Set objFields.NextItem.DataSource = Me
      Wend
    End If
  End Property
  
  Property Get EOF()
    EOF = Recordset.EOF
  End Property

  Property Get State()
    If IsObject(Recordset) Then
      State = Recordset.State
    Else
      State = False
    End If
  End Property

  Sub MoveNext()
    Recordset.MoveNext
    MemoFields.RemoveAll
  End Sub

  Sub MoveFirst()
    Recordset.MoveFirst
    MemoFields.RemoveAll
  End Sub

  Function GetOrder(DefaultSorting, Sorter, Direction, MapArray)
    Dim OrderValue, I, ActiveSorter

    If NOT IsEmpty(Sorter) Then
      ' Select sorted column
      I = 0
      Do While I <= UBound(MapArray)
        If MapArray(I)(0) = Sorter Then
          ActiveSorter = I
          Exit Do
        End If
        I = I + 1
      Loop
      If NOT IsEmpty(ActiveSorter) Then
        If NOT IsEmpty(Direction) AND (Direction = "ASC" OR Direction = "DESC") Then
          If Direction = "ASC" Then
            OrderValue = MapArray(ActiveSorter)(1)
          ElseIf Direction = "DESC" Then
            OrderValue = MapArray(ActiveSorter)(2)
          End If
          If OrderValue = "" Then 
            OrderValue = MapArray(ActiveSorter)(1) & " DESC"
          End If
        Else
          OrderValue = MapArray(ActiveSorter)(1)
        End If
      End If
    End If
    If Len(OrderValue) > 0 Then
      Order = OrderValue
    Else
      Order = DefaultSorting
    End If
    GetOrder = Order
  End Function

  Public Property Let RecordCount(vData)
    mRecordCount = vData
  End Property

  Public Property Get RecordCount()
    If mRecordCount < 0 Then 
      mRecordCount = Command.ExecuteCount
    End If
    RecordCount = mRecordCount
  End Property

  Function MoveToPage(Page)
    Dim PageCounter
    Dim RecordCounter

    If Recordset.State = adStateOpen Then
      PageCounter = 1
      RecordCounter = 1
      While NOT Recordset.EOF AND PageCounter < Page
        If RecordCounter MOD Command.PageSize = 0 Then 
          PageCounter = PageCounter + 1
        End If

        RecordCounter = RecordCounter + 1
        Recordset.MoveNext
      Wend
    End If
    Command.ActivePage = PageCounter
  End Function

  Function PageCount()
    Dim Result
    If Command.PageSize > 0 Then
      Result = RecordCount \ Command.PageSize
      If (RecordCount MOD Command.PageSize) > 0 Then 
        Result = Result + 1
      End If
    Else
      Result = 1
    End If
    PageCount = Result
  End Function

  Private Sub Class_Terminate()
    Set Command = Nothing
    Set Errors = Nothing
    Set Parameters = Nothing
    Set CCSEvents = Nothing
  End Sub

End Class

'End clsDataSource Class

'clsCommand Class @0-A8F5925B
Class clsCommand

  Private mCommandType
  Private mCommandOperation
  Private mPrepared

  Private mSQL
  Private mCountSQL
  Private mWhere
  Private mOrderBy
  Private mLOV
  Private mSP
  
  Private mPageSize
  Private mActivePage

  Public Errors, Connection, CCSEvents
  Public WhereParameters, Parameters
  Public CommandParameters
  Public Options
  Private IsNeedMoveToPage

  Private Sub Class_Initialize()
    Set CCSEvents = CreateObject("Scripting.Dictionary")
    Set WhereParameters = New clsSQLParameters
    Set WhereParameters.ParameterSources = CreateObject("Scripting.Dictionary")
    Set Parameters = New clsSQLParameters
    Set Parameters.ParameterSources = CreateObject("Scripting.Dictionary")
    Set Options = CreateObject("Scripting.Dictionary")
    ActivePage = 0
    Prepared = False
    IsNeedMoveToPage=True
  End Sub

  Public Function Exec(Err)
    Set Errors = Err
    Select Case CommandOperation
      Case cmdOpen
        Set Exec = DoOpen
      Case cmdExec
        DoExec
    End Select
  End Function

  Private Function OpenRecordset(sSQL,isCountSQL)
    Dim Command
    Dim Recordset

    If Not isCountSQL And Options.Count>0 Then
      Dim Page : Page=IIF(mActivePage>0,mActivePage,1)
      Dim Size : Size=IIF(mPageSize>0,mPageSize,1)
      If Options.Exists("TOP") Then 
           sSQL=Replace(sSQL,"{SqlParam_endRecord}", Page * Size , 1, 1)
      End If
      If Options.Exists("LIMIT MYSQL") Then
           sSQL = sSQL & " LIMIT " & (Page - 1) * Size  & " , " & Size
           IsNeedMoveToPage=False
      End If
      If Options.Exists("LIMIT POSTGRES") Then
           sSQL = sSQL & " LIMIT " & Size  & " OFFSET " & (Page - 1) * Size
           IsNeedMoveToPage=False
      End If
    End If

    Set Command = CreateObject("ADODB.Command")
    Command.CommandType = adCmdText
    Command.CommandText = sSQL
    Set Command.ActiveConnection = Connection.Connection
    Set Recordset = Connection.Execute(Command)
    
    If Connection.Errors.Count > 0 Then 
      Errors.AddError Connection.Errors.ToString & Errors.ErrorDelimiter
    End If

    Set OpenRecordset = Recordset
    Set Command = Nothing
  End Function

  Private Function ParseParams(sSQL, Params)
    Dim I
    Dim NewSQL
    Dim ParamKeys
    Dim ParamItems
    
    NewSQL = sSQL
    If CommandType = dsSQL Then
      If Not Params is Nothing Then
        ParamItems = Params.ParametersList.Items
        ParamKeys = Params.ParametersList.Keys
        For I = 0 To UBound(ParamItems)
         NewSQL = Replace(NewSQL, "{" & ParamKeys(I) & "}", ParamItems(I).SQLText)
        Next
      End If
    End If
    ParseParams = NewSQL
  End Function

  Private Function DoOpen()
    Dim Command
    Dim builtSQL
    Dim DataSource
    Dim CountRecordset
    Dim ResultRecordset
    Dim CCSEventResult
    Dim ParameterValue
    Dim Parameter

    Set DataSource = new clsDataSource
    If IsObject(Connection) Then _
      Set DataSource.Connection = Connection
    Set DataSource.Command = Me
    
    Select Case CommandType
      Case dsTable, dsSQL
        CCSEventResult = CCRaiseEvent(CCSEvents, "BeforeBuildSelect", Me)
        builtSQL = ParseParams(SQL & IIf(Len(Where) > 0, " WHERE " & Where, "") & IIf(Len(OrderBy) > 0, " ORDER BY " & OrderBy, ""), WhereParameters)
        CCSEventResult = CCRaiseEvent(CCSEvents, "BeforeExecuteSelect", Me)
        Set DataSource.Recordset = OpenRecordset(builtSQL,False)
        If ActivePage > 0 And IsNeedMoveToPage Then 
          DataSource.MoveToPage ActivePage
        End If

        CCSEventResult = CCRaiseEvent(CCSEvents, "AfterExecuteSelect", Me)
        If Errors.Count > 0 Then 
          DataSource.Errors.AddErrors Errors
        End If
        Set DoOpen = DataSource

      Case dsProcedure
        CCSEventResult = CCRaiseEvent(CCSEvents, "BeforeBuildSelect", Me)
        Set Command = CreateSP()
        CCSEventResult = CCRaiseEvent(CCSEvents, "BeforeExecuteSelect", Me)
        Set DataSource.Recordset = Connection.Execute(Command)

        If ActivePage > 0 Then
          DataSource.MoveToPage ActivePage
        End If
     
        Do Until DataSource.Recordset Is Nothing
           If DataSource.Recordset.Fields.Count >0 Then Exit Do
           Set DataSource.Recordset = DataSource.Recordset.NextRecordset
        Loop

        If Connection.Errors.Count > 0 Then 
          DataSource.Errors.AddError Connection.Errors.ToString & Errors.ErrorDelimiter
        End If

        Set Command = Nothing
        Set DoOpen = DataSource
      Case dsListOfValues
        Dim I
        CCSEventResult = CCRaiseEvent(CCSEvents, "BeforeBuildSelect", Me)
        Set DataSource.Recordset = CreateObject("ADODB.Recordset")
        DataSource.Recordset.Fields.Append "bound", adBSTR, 256, adFldCacheDeferred + adFldUpdatable
        DataSource.Recordset.Fields.Append "text", adBSTR, 256, adFldCacheDeferred + adFldUpdatable
        CCSEventResult = CCRaiseEvent(CCSEvents, "BeforeExecuteSelect", Me)
        DataSource.Recordset.Open
        For I = 0 To UBound(mLOV(0))
          DataSource.Recordset.AddNew
          DataSource.Recordset.Fields("bound").Value = mLOV(0)(I)
          DataSource.Recordset.Fields("text").Value = mLOV(1)(I)
        Next
        DataSource.Recordset.Update
        DataSource.Recordset.MoveFirst
        CCSEventResult = CCRaiseEvent(CCSEvents, "AfterExecuteSelect", Me)
        Set DoOpen = DataSource
    End Select
  End Function

  Public Function ExecuteCount()
    Dim Result: Result = 0
    Dim builtSQL: builtSQL = ""
    Dim CountRecordset

    If Len(CountSQL) > 0 Then
      builtSQL = ParseParams(CountSQL & IIf(Len(Where) > 0, " WHERE " & Where, ""), WhereParameters)
      Set CountRecordset = OpenRecordset(builtSQL,True)
      If CountRecordset.State = adStateOpen Then 
        Result = CLng(CountRecordset.Fields(0).Value)
      End If
      Set CountRecordset = Nothing
    End If
    ExecuteCount = Result
  End Function

  Private Function CreateSP()
    Dim Command, I, ParameterValue, Parameter, Sources

    Set Command = Server.CreateObject("ADODB.Command")
    Set Command.ActiveConnection = Connection.Connection
    Command.CommandType = adCmdStoredProc
    Command.CommandText = mSP
    If IsArray(CommandParameters) Then
      Set Sources = Parameters.ParameterSources
      For I = 0 To UBound(CommandParameters)
        ParameterValue = Sources(CommandParameters(I)(1))
        If IsEmpty(ParameterValue) Then 
          ParameterValue = CommandParameters(I)(7)
        End If
        If IsEmpty(ParameterValue) Then 
          ParameterValue = Null
        End If
        Set Parameter = Command.CreateParameter(CommandParameters(I)(0), CommandParameters(I)(2), CommandParameters(I)(3), CommandParameters(I)(4), ParameterValue)
        If Parameter.Type = adNumeric Then
          Parameter.NumericScale = CommandParameters(I)(5)
          Parameter.Precision = CommandParameters(I)(6)
        End If
        Command.Parameters.Append Parameter
      Next
      Set Sources = Nothing
    End If
    Set CreateSP = Command
  End Function

  Private Sub DoExec
    Dim Command, I
    Dim builtSQL
    Dim ParameterValue, ParameterLength

    If CommandType = dsProcedure Then
      Set Command = CreateSP()
    Else
      Set Command = CreateObject("ADODB.Command")
      Command.CommandType = adCmdText

      builtSQL = SQL
      If CommandType = dsSQL Then
        builtSQL = ParseParams(builtSQL, WhereParameters)
        builtSQL = ParseParams(builtSQL, Parameters)
      Else
        If IsArray(CommandParameters) Then
          For I = 0 To UBound(CommandParameters)
            If IsEmpty(CommandParameters(I)(4)) Then 
              ParameterValue = Null 
              ParameterLength = 1
            Else 
              ParameterValue = CommandParameters(I)(4)
              ParameterLength=CommandParameters(I)(3)
            End If
            Command.Parameters.Append Command.CreateParameter(CommandParameters(I)(0), CommandParameters(I)(1), CommandParameters(I)(2), ParameterLength, ParameterValue)
          Next
        End If
      End If

      Command.CommandText = builtSQL
      Command.Prepared = Prepared

      Set Command.ActiveConnection = Connection.Connection
    End If
    Connection.Execute(Command)
    
    If Connection.Errors.Count > 0 Then 
      Errors.AddError Connection.Errors.ToString & Errors.ErrorDelimiter
    End If

    Set Command = Nothing
  End Sub

  Public Property Let ActivePage(vData)
      mActivePage = vData
  End Property

  Public Property Get ActivePage()
      ActivePage = mActivePage
  End Property

  Public Property Let PageSize(vData)
      mPageSize = vData
  End Property

  Public Property Get PageSize()
      PageSize = mPageSize
  End Property

  Public Property Let CommandOperation(vData)
      mCommandOperation = vData
  End Property

  Public Property Get CommandOperation()
      CommandOperation = mCommandOperation
  End Property

  Public Property Let LOV(vData)
      mLOV = vData
  End Property

  Public Property Get LOV()
      LOV = mLOV
  End Property

  Public Property Let SP(vData)
      mSP = vData
  End Property

  Public Property Get SP()
      SP = mSP
  End Property

  Public Property Let CountSQL(vData)
      mCountSQL = vData
  End Property

  Public Property Get CountSQL()
      CountSQL = mCountSQL
  End Property

  Public Property Let SQL(vData)
      mSQL = vData
  End Property

  Public Property Get SQL()
      SQL = mSQL
  End Property

  Public Property Let Prepared(vData)
      mPrepared = vData
  End Property

  Public Property Get Prepared()
      Prepared = mPrepared
  End Property

  Public Property Let CommandType(vData)
      mCommandType = vData
  End Property

  Public Property Get CommandType()
      CommandType = mCommandType
  End Property

  Public Property Let OrderBy(vData)
      mOrderBy = vData
  End Property

  Public Property Get OrderBy()
      OrderBy = mOrderBy
  End Property

  Public Property Let Order(vData)
      mOrderBy = vData
  End Property

  Public Property Get Order()
      Order = mOrderBy
  End Property

  Public Property Let Where(vData)
      mWhere = vData
  End Property

  Public Property Get Where()
      Where = mWhere
  End Property

  Public Sub Class_Terminate()
    Set Options = Nothing
    Set CCSEvents = Nothing
  End Sub

End Class

'End clsCommand Class

'clsConverter Class @0-5DD64A8C
Class clsConverter
  Private mDateFormat
  Private mBooleanFormat
  Private mIntegerFormat
  Private mFloatFormat
  Private mParseError

  Private Sub Class_Initialize()
    mParseError = False
  End Sub

  Property Let DateFormat(newDateFormat)
    mDateFormat = newDateFormat
  End Property

  Property Get DateFormat()
    DateFormat = mDateFormat
  End Property

  Property Let BooleanFormat(newFormat)
    mBooleanFormat = newFormat
  End Property

  Property Get BooleanFormat()
    BooleanFormat = mBooleanFormat
  End Property

  Property Let IntegerFormat(newFormat)
    mIntegerFormat = newFormat
  End Property

  Property Get IntegerFormat()
    IntegerFormat = mIntegerFormat
  End Property

  Property Let FloatFormat(newFormat)
    mFloatFormat = newFormat
  End Property

  Property Get FloatFormat()
    FloatFormat = mFloatFormat
  End Property

  Property Get ParseError()
    ParseError = mParseError
  End Property

  Public Function VBSConvert(DataType, Value)
    Dim Result

    mParseError = False
    Result = Empty

    If IsEmpty(Value) Then
      VBSConvert = Result
      Exit Function
    End If
    
    On Error Resume Next
    Select Case DataType
      Case ccsDate
        Result = CDate(Value)
      Case ccsBoolean
        Result = CBool(Value)
      Case ccsInteger
        Result = CLng(Value)
      Case ccsFloat
        Result = CDbl(Value)
      Case ccsText, ccsMemo
        Result = CStr(Value)
    End Select
    If Err.Number <> 0 Then _
      mParseError = True
    On Error Goto 0
    VBSConvert = Result
  End Function

  Public Function StringToType(DataType, Value, Format)
    Dim CurrentFormat
    Dim Result

    mParseError = False
    Result = Empty
    If IsEmpty(Value) Then
      StringToType = Result
      Exit Function
    End If
    If IsEmpty(Format) Then
      Select Case DataType
        Case ccsDate
          CurrentFormat = mDateFormat
        Case ccsBoolean
          CurrentFormat = mBooleanFormat
        Case ccsInteger
          CurrentFormat = mIntegerFormat
        Case ccsFloat
          CurrentFormat = mFloatFormat
      End Select
    Else
      CurrentFormat = Format
    End If

    On Error Resume Next
    Select Case DataType
      Case ccsDate
        Result = CCParseDate(Value, CurrentFormat)
      Case ccsBoolean
        Result = CCParseBoolean(Value, CurrentFormat)
      Case ccsInteger
        Result = CCParseInteger(Value, CurrentFormat)
      Case ccsFloat
        Result = CCParseFloat(Value, CurrentFormat)
      Case ccsText, ccsMemo
        Result = CStr(Value)
    End Select
    If Err.Number <> 0 Then _
      mParseError = True
    On Error Goto 0
    StringToType = Result
  End Function

  Public Function TypeToString(DataType, Value, Format)
    Dim CurrentFormat
    Dim Result
    Dim VarDataType
    Dim CurrentDataType

    VarDataType = VarType(Value)
    Select Case VarDataType
      Case vbInteger, vbLong, vbByte:
        CurrentDataType = ccsInteger
      Case vbSingle, vbDouble, vbCurrency, vbDecimal:
        CurrentDataType = ccsFloat
      Case vbDate:
        CurrentDataType = ccsDate
      Case vbBoolean:
        CurrentDataType = ccsBoolean
      Case vbString:
        CurrentDataType = ccsText
      Case vbArray, vbDataObject, vbVariant, vbError, vbObject, vbNull:
        Err.Raise 1057, "Type mismatch"
    End Select
    If DataType = ccsMemo AND CurrentDataType = ccsText Then _
       CurrentDataType = ccsMemo
    If (VarDataType <> vbEmpty) AND (CurrentDataType <> DataType) Then _
        Err.Raise 1057, "Type mismatch"

    If IsEmpty(Format) Then
      Select Case DataType
        Case ccsDate
          CurrentFormat = mDateFormat
        Case ccsBoolean
          CurrentFormat = mBooleanFormat
        Case ccsInteger
          CurrentFormat = mIntegerFormat
        Case ccsFloat
          CurrentFormat = mFloatFormat
      End Select
    Else
      CurrentFormat = Format
    End If

    Select Case DataType
      Case ccsDate
        Result = CCFormatDate(Value, CurrentFormat)
      Case ccsBoolean
        Result = CCFormatBoolean(Value, CurrentFormat)
      Case ccsInteger
        Result = CCFormatNumber(Value, CurrentFormat)
      Case ccsFloat
        Result = CCFormatNumber(Value, CurrentFormat)
      Case ccsText, ccsMemo
        Result = CStr(Value)
    End Select
    TypeToString = Result
  End Function
End Class
'End clsConverter Class

'clsRunTimeMessages Class @0-E0F50F10
Class clsRunTimeMessages
  Private mMessages

  Private Sub Class_Initialize()
    Set mMessages = Server.CreateObject("Scripting.Dictionary")
    mMessages.Add "IncorrectFormat", "Der Wert im Feld {FieldName} ist nicht gültig. Benutzen Sie folgendes Format: {Format}."
    mMessages.Add "IncorrectValue", "Im Feld {FieldName} wurde kein gültiger Wert eingegeben."
    mMessages.Add "RequiredField", "Sie müssen im Feld {FieldName} einen Wert eingeben."
    mMessages.Add "CustomOperationError_MissingParameters", "Es fehlen einer oder mehrere Parameter für UPDATE/DELETE. Die Einstellungen sind nicht ausreichend."
    mMessages.Add "UploadingTempFolderError", "Fehler beim Upload der im Feld {FieldName} angegebenen Datei in das temporäre Verzeichnis. Fehler-Beschreibung: {Error}."
    mMessages.Add "GridPageSizeError", "(CCS06) Falsche Seitengröße."
    mMessages.Add "GridPageNumberError", "Falsche Seitennummer."
    mMessages.Add "DatabaseCommandError", "Datenbankfehler beim Ausführen des Kommandos."
    mMessages.Add "OperationError", "{Operation} kann nicht ausgeführt werden. Einer oder mehrere Parameter sind nicht spezifiziert."
  End Sub

  Function GetMessage(MsgID, Params)
    Dim Result, I
    Result = ""

    If mMessages.Exists(MsgID) Then
      Result = mMessages(MsgID)
      If IsArray(Params) Then
        For I = 0 To UBound(Params) Step 2
          Result = Replace(Result, "{" & Params(I) & "}", Params(I+1))
        Next
      End If
    End If
    GetMessage = Result
  End Function

  Private Sub Class_Terminate()
    Set mMessages = Nothing
  End Sub
End Class
'End clsRunTimeMessages Class

'clsStringBuffer @0-0A3F192B
Class clsStringBuffer
  Private incremetRate
  Private itemCount 
  Private items
  
  Private Sub Class_Initialize()
    incremetRate = 50
    itemCount = 0
    ReDim items(incremetRate)
  End Sub
  
  Public Sub Append(ByVal strValue)
    If itemCount > UBound(items) Then
      ReDim Preserve items(UBound(items) + incremetRate)
    End If
    
    items(itemCount) = strValue
    itemCount = itemCount + 1
  End Sub
  
  Public Function ToString() 
    ToString = Join(items, "")
  End Function

End Class

'End clsStringBuffer


%>