Pepito
|
| Posted: 03/05/2003, 4:27 AM |
|
Hello Everyone, I uploaded a css project (that runs great on IIS at my
machine) to a free server (brinkster). I can properly see on a browser
*.html files but not the same file *.asp....error 500...
any hint?
check it out at http://www10.brinkster.com/mariosbm/code/Empleados_list.html
http://www10.brinkster.com/mariosbm/code/Empleados_list.asp
your help is greatly appreciated...I 'not a programmer but would like to set
a site of this kind
Thanks
|
|
|
 |
NetFocus.biz
|
| Posted: 03/05/2003, 5:30 AM |
|
Hi Pepito
The problem is that your app can't find the database:
Microsoft JET Database Engine error '80004005'
'C:\Documents and Settings\M\My Documents\web solutions\New
Folder\NewProject6\GardenCo.mdb' is not a valid path. Make sure that the
path name is spelled correctly and that you are connected to the server on
which the file resides.
/mariosbm/code/Common.asp, line 117
You'll have to update the path in your Common.asp to point to the new
location on the server
Regards
Alistair McFadyen
Managing Director
NetFocus Solutions Ltd
2 Cockburn Place
Riverside Business Park
Irvine, Ayrshire, KA11 5DA
Tel: +44 (0) 1294 318701
Fax: +44 (0) 1294 316580
Internet: www.netfocus.biz
"Pepito" <dfga@kk.com> wrote in message
news:b44qfl$ltg$1@news.codecharge.com...
> Hello Everyone, I uploaded a css project (that runs great on IIS at my
> machine) to a free server (brinkster). I can properly see on a browser
> *.html files but not the same file *.asp....error 500...
>
> any hint?
>
> check it out at
http://www10.brinkster.com/mariosbm/code/Empleados_list.html
> http://www10.brinkster.com/mariosbm/code/Empleados_list.asp
>
> your help is greatly appreciated...I 'not a programmer but would like to
set
> a site of this kind
>
> Thanks
>
>
>
|
|
|
|
Sixto Luis Santos
|
| Posted: 03/05/2003, 7:12 AM |
|
Pepito (José??),
You must remove the friendly error messages in IE to get a more
comprehensive error. In IE, go to the Tools menu, select Internet Options,
select the Advance tab, and remove the checkmark from Show Friendly HTTP
Messages.
Regards,
Sixto
"Pepito" <dfga@kk.com> wrote in message
news:b44qfl$ltg$1@news.codecharge.com...
> Hello Everyone, I uploaded a css project (that runs great on IIS at my
> machine) to a free server (brinkster). I can properly see on a browser
> *.html files but not the same file *.asp....error 500...
>
> any hint?
>
> check it out at
http://www10.brinkster.com/mariosbm/code/Empleados_list.html
> http://www10.brinkster.com/mariosbm/code/Empleados_list.asp
>
> your help is greatly appreciated...I 'not a programmer but would like to
set
> a site of this kind
>
> Thanks
>
>
>
|
|
|
|
Pepito
|
| Posted: 03/05/2003, 7:48 AM |
|
Thanks for your responses:
1) I already turn off the friendly error showing,
2) I am playing with changing the path as Alistair kindly suggested..
However, I am messing the code  ...
well....the database is here
http://mariosbm.www4.dotnetplayground.com/code/GardenCo.mdb
the page is here
http://mariosbm.www4.dotnetplayground.com/code/Empleados_list.asp (you can
see the html here
http://mariosbm.www4.dotnetplayground.com/code/Empleados_list.html)
so, if the problem is here:
"Microsoft JET Database Engine error '80004005'
'C:\Documents and Settings\M\My Documents\web solutions\New
Folder\NewProject6\GardenCo.mdb' is not a valid path. Make sure that the
path name is spelled correctly and that you are connected to the server on
which the file resides.
/mariosbm/code/Common.asp, line 117"
Should I write instead of C:\...etc this: \code\GardenCo.mdb ?? that is not
working also....
here is the old code:
<%
Option Explicit
'Include Files @0-0F8FBEEB
%>
<!-- #INCLUDE FILE="Adovbs.asp" -->
<!-- #INCLUDE FILE="Classes.asp" -->
<%
'End Include Files
'Script Engine Version Check @0-A118D8E9
If ScriptEngineMajorVersion < 5 Then
Response.Write "Sorry. This program requires VBScript 5.1 to run.<br>You
may upgrade your VBScript at
http://www.microsoft.com/msdownload/vbscript/scripting.asp.";
Response.End
Else
If ScriptEngineMajorVersion & ":" & ScriptEngineMinorVersion = "5:0"
Then
Response.Write "Due to a bug in VBScript 5.0, this program would
crash your server. See
http://support.microsoft.com/default.aspx?scid=kb;EN-US...<br>"; & _
"Upgrade your VBScript at
http://www.microsoft.com/msdownload/vbscript/scripting.asp.";
Response.End
End If
End If
'End Script Engine Version Check
'Initialize Common Variables @0-EB7D5995
Dim CCSDateConstants
Dim ServerURL
Dim SecureURL
Dim TemplatesRepository
Dim EventCaller
Set TemplatesRepository = New clsCache_FileSystem
ServerURL = "http://localhost/NewProject5/"
Set CCSDateConstants = New clsCCSDateConstants
Class clsCCSDateConstants
Public Weekdays
Public ShortWeekdays
Public Months
Public ShortMonths
Public DateMasks
Private Sub Class_Initialize()
ShortWeekdays = Array("Sun", "Mon", "Tue", "Wed", "Thu", "Fri",
"Sat")
Weekdays = Array("Sunday", "Monday", "Tuesday", "Wednesday",
"Thursday", "Friday", "Saturday")
ShortMonths = Array("Jan", "Feb", "Mar", "Apr", "May", "Jun",
"Jul", "Aug", "Sep", "Oct", "Nov", "Dec")
Months = Array("January", "February", "March", "April", "May",
"June", "July", "August", "September", "October", "November", "December")
Set DateMasks = CreateObject("Scripting.Dictionary")
DateMasks("d") = 0
DateMasks("dd") = 2
DateMasks("m") = 0
DateMasks("mm") = 2
DateMasks("mmm") = 3
DateMasks("mmmm") = 0
DateMasks("yy") = 2
DateMasks("yyyy") = 4
DateMasks("h") = 0
DateMasks("hh") = 2
DateMasks("H") = 0
DateMasks("HH") = 2
DateMasks("n") = 0
DateMasks("nn") = 2
DateMasks("s") = 0
DateMasks("ss") = 2
DateMasks("am/pm") = 2
DateMasks("AM/PM") = 2
DateMasks("A/P") = 1
DateMasks("a/p") = 1
DateMasks("w") = 0
DateMasks("q") = 0
End Sub
Private Sub Class_Terminate()
Set DateMasks = Nothing
End Sub
End Class
Const ccsInteger = 1
Const ccsFloat = 2
Const ccsText = 3
Const ccsDate = 4
Const ccsBoolean = 5
Const ccsMemo = 6
Const ccsGet = 1
Const ccsPost = 2
'End Initialize Common Variables
'Connection1 Connection Class @-2D543FFD
Class clsDBConnection1
Public ConnectionString
Public User
Public Password
Public DateFormat
Public BooleanFormat
Public LastSQL
Public Errors
Private objConnection
Private blnState
Private Sub Class_Initialize()
ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;User
ID=Admin;Data Source=C:\Documents and Settings\M\My Documents\web
solutions\New Folder\NewProject5\GardenCo.mdb;Persist Security Info=False"
User = "Admin"
Password = ""
DateFormat = Empty
BooleanFormat = Empty
Set objConnection = Server.CreateObject("ADODB.Connection")
Set Errors = New clsErrors
End Sub
Sub Open()
On Error Resume Next
objConnection.Errors.Clear
objConnection.Open ConnectionString, User, Password
If Err.Number <> 0 then
Response.Write "<div><h2>Unable to establish connection to
database.</h2>"
Response.Write "<ul><li>Error information:<br>"
Response.Write Err.Source & " (0x" & Hex(Err.Number) & ")<br>"
Response.Write Err.Description & "</li>"
If Err.Number = -2147467259 then _
Response.Write "<li>More information:<br>The database cannot be
opened, most likely due to insufficient security set on your database folder
or file.</li>"
Response.Write "</ul></div>"
Response.End
End If
End Sub
Sub Close()
objConnection.Close
End Sub
Function Execute(varCMD)
Dim ErrorMessage, objResult
Errors.Clear
Set objResult = Server.CreateObject("ADODB.Recordset")
objResult.CursorType = adOpenForwardOnly
objResult.LockType = adLockReadOnly
If TypeName(varCMD) = "Command" Then
Set varCMD.ActiveConnection = objConnection
Set objResult.Source = varCMD
LastSQL = varCMD.CommandText
Else
Set objResult.ActiveConnection = objConnection
objResult.Source = varCMD
LastSQL = varCMD
End If
On Error Resume Next
objResult.Open
Errors.AddError CCProcessError(objConnection)
On Error Goto 0
Set Execute = objResult
End Function
Property Get Connection()
Set Connection = objConnection
End Property
Property Get State()
State = objConnection.State
End Property
Function ToSQL(Value, ValueType)
If CStr(Value) = "" OR IsEmpty(Value) Then
ToSQL = "Null"
Else
If ValueType = ccsInteger or ValueType = ccsFloat Then
ToSQL = Replace(Value, ",", ".")
ElseIf ValueType = ccsDate Then
ToSQL = "'" & Replace(Value, "'", "''") & "'"
Else
ToSQL = "'" & Replace(Value, "'", "''") & "'"
End If
End If
End Function
End Class
'End Connection1 Connection Class
'IIf @0-535EAADD
Function IIf(Expression, TrueResult, FalseResult)
If CBool(Expression) Then _
IIf = TrueResult _
Else _
IIf = FalseResult
End Function
'End IIf
'Print @0-065FC167
Sub Print(Value)
Response.Write CStr(Value)
End Sub
'End Print
'CCRaiseEvent @0-E59A6846
Function CCRaiseEvent(Events, EventName, Caller)
Set EventCaller = Caller
Dim Result : Result = Events(EventName)
Set EventCaller = Nothing
If VarType(Result) = vbEmpty Then _
Result = True
CCRaiseEvent = Result
End Function
'End CCRaiseEvent
'CCFormatError @0-21121FA6
Function CCFormatError(Title, Errors)
Dim Result, I
Result = "<p><b>Source:</b> " & Title & "<br>"
For I = 0 To Errors.Count - 1
Result = Result & "<b>Error:</b> " & Errors.ErrorByNumber(I)
Next
Result = Result & "</p>"
CCFormatError = Result
End Function
'End CCFormatError
'CCOpenRS @0-9E4633EC
Function CCOpenRS(RecordSet, SQL, Connection, ShowError)
Dim ErrorMessage, Result
Result = Empty
Set RecordSet = Server.CreateObject("ADODB.Recordset")
On Error Resume Next
RecordSet.Open SQL, Connection, adOpenForwardOnly, adLockReadOnly,
adCmdText
ErrorMessage = CCProcessError(Connection)
If NOT IsEmpty(ErrorMessage) Then
If ShowError Then _
Result = "SQL: " & CommandObject.CommandText & "<br>" & "Error:
" & ErrorMessage & "<br>" _
Else _
Result = "Database error.<br>"
End If
On Error Goto 0
CCOpenRS = Result
End Function
'End CCOpenRS
'CCOpenRSFromCmd @0-A2A33ECF
Function CCOpenRSFromCmd(RecordSet, CommandObject, ShowError)
Dim ErrorMessage, Result
Result = Empty
Set RecordSet = Server.CreateObject("ADODB.Recordset")
On Error Resume Next
RecordSet.CursorType = adOpenForwardOnly
RecordSet.LockType = adLockReadOnly
RecordSet.Open CommandObject
ErrorMessage = CCProcessError(CommandObject.ActiveConnection)
If NOT IsEmpty(ErrorMessage) Then
If ShowError Then _
Result = "SQL: " & CommandObject.CommandText & "<br>" & "Error:
" & ErrorMessage & "<br>" _
Else _
Result = "Database error.<br>"
End If
On Error Goto 0
CCOpenRSFromCmd = Result
End Function
'End CCOpenRSFromCmd
'CCExecCmd @0-3DC993D0
Function CCExecCmd(CommandObject, ShowError)
Dim ErrorMessage, Result
Result = Empty
On Error Resume Next
CommandObject.Execute
ErrorMessage = CCProcessError(CommandObject.ActiveConnection)
If NOT IsEmpty(ErrorMessage) Then
If ShowError Then _
Result = "SQL: " & CommandObject.CommandText & "<br>" & "Error:
" & ErrorMessage & "<br>" _
Else _
Result = "Database error.<br>"
End If
On Error Goto 0
CCExecCmd = Result
End Function
'End CCExecCmd
'CCExecSQL @0-24CC2822
Function CCExecSQL(SQL, Connection, ShowError)
Dim ErrorMessage, Result
Result = Empty
On Error Resume Next
Connection.Execute(SQL)
ErrorMessage = CCProcessError(Connection)
If NOT IsEmpty(ErrorMessage) Then
If ShowError Then _
Result = "SQL: " & SQL & "<br>" & "Error: " & ErrorMessage &
"<br>" _
Else _
Result = "Database error.<br>"
End If
On Error Goto 0
CCExecSQL = Result
End Function
'End CCExecSQL
'CCToHTML @0-44D2E9F4
Function CCToHTML(Value)
If IsNull(Value) Then Value = ""
CCToHTML = Server.HTMLEncode(Value)
End Function
'End CCToHTML
'CCToURL @0-23A93674
Function CCToURL(Value)
If IsNull(Value) Then Value = ""
CCToURL = Server.URLEncode(Value)
End Function
'End CCToURL
'CCGetValueHTML @0-30C69AED
Function CCGetValueHTML(RecordSet, FieldName)
CCGetValueHTML = CCToHTML(CCGetValue(RecordSet, FieldName))
End Function
'End CCGetValueHTML
'CCGetValue @0-C5915067
Function CCGetValue(RecordSet, FieldName)
Dim Result
On Error Resume Next
If RecordSet Is Nothing Then
CCGetValue = Empty
ElseIf (NOT RecordSet.EOF) AND (FieldName <> "") Then
Result = RecordSet(FieldName)
If IsNull(Result) Then _
Result = Empty
CCGetValue = Result
Else
CCGetValue = Empty
End If
On Error Goto 0
End Function
'End CCGetValue
'CCGetDate @0-4102C01B
Function CCGetDate(RecordSet, FieldName, arrDateFormat)
Dim Result
Result = CCGetValue(RecordSet, FieldName)
If Not IsEmpty(arrDateFormat) Then
If Not (VarType(Result) = vbDate OR VarType(Result) = vbEmpty) Then _
If CCValidateDate(Result, arrDateFormat) Then _
Result = CCParseDate(Result, arrDateFormat)
End If
CCGetDate = Result
End Function
'End CCGetDate
'CCGetBoolean @0-C64EED38
Function CCGetBoolean(RecordSet, FieldName, BooleanFormat)
Dim Result
Result = CCGetValue(RecordSet, FieldName)
CCGetBoolean = CCParseBoolean(Result, BooleanFormat)
End Function
'End CCGetBoolean
'CCGetParam @0-B1CC8211
Function CCGetParam(ParameterName, DefaultValue)
Dim ParameterValue : ParameterValue = ""
If Request.QueryString(ParameterName).Count > 0 Then
ParameterValue = Request.QueryString(ParameterName)
ElseIf Request.Form(ParameterName).Count > 0 Then
ParameterValue = Request.Form(ParameterName)
Else
ParameterValue = DefaultValue
End If
CCGetParam = ParameterValue
End Function
'End CCGetParam
'CCGetFromPost @0-B27302B2
Function CCGetFromPost(ParameterName, DefaultValue)
Dim ParameterValue : ParameterValue = Empty
ParameterValue = Request.Form(ParameterName)
If IsEmpty(ParameterValue) Then _
ParameterValue = DefaultValue
CCGetFromPost = ParameterValue
End Function
'End CCGetFromPost
'CCGetFromGet @0-F6BB8115
Function CCGetFromGet(ParameterName, DefaultValue)
Dim ParameterValue : ParameterValue = Empty
ParameterValue = Request.QueryString(ParameterName)
If IsEmpty(ParameterValue) Then _
ParameterValue = DefaultValue
CCGetFromGet = ParameterValue
End Function
'End CCGetFromGet
'CCToSQL @0-CA2C324A
Function CCToSQL(Value, ValueType)
If CStr(Value) = "" OR IsEmpty(Value) Then
CCToSQL = "Null"
Else
If ValueType = "Integer" or ValueType = "Float" Then
CCToSQL = Replace(CDbl(Value), ",", ".")
Else
CCToSQL = "'" & Replace(Value, "'", "''") & "'"
End If
End If
End Function
'End CCToSQL
'CCDLookUp @0-9125C206
Function CCDLookUp(ColumnName, TableName, Where, Connection)
Dim RecordSet
Dim Result
Dim SQL
Dim ErrorMessage
SQL = "SELECT " & ColumnName & " FROM " & TableName & IIf(IsEmpty(Where),
"", " WHERE " & Where)
Set RecordSet = Connection.Execute(SQL)
ErrorMessage = CCProcessError(Connection)
If NOT IsEmpty(ErrorMessage) Then
PrintDBError "CCDLookUp function", SQL, ErrorMessage
End If
On Error Goto 0
Result = CCGetValue(RecordSet, 0)
CCDLookUp = Result
End Function
'End CCDLookUp
'PrintDBError @0-3D5DDA9A
Sub PrintDBError(Source, SQL, ErrorMessage)
Dim CommandText
Dim SourceText
Dim ErrorText
If Source <> "" Then SourceText = "<b>Source:</b> " & Source & "<br>"
If SQL <> "" Then CommandText = "<b>Command Text:</b> " & SQL & "<br>"
If ErrorMessage <> "" Then ErrorText = "<b>Error description:</b> " &
ErrorMessage & "</div>"
Response.Write "<div style=""background-color: rgb(250, 250, 250); " & _
"border: solid 1px rgb(200, 200, 200);"">" & SourceText
Response.Write CommandText & ErrorText
End Sub
'End PrintDBError
'CCGetCheckBoxValue @0-ABCF54E0
Function CCGetCheckBoxValue(Value, CheckedValue, UncheckedValue, ValueType)
If isEmpty(Value) Then
If UncheckedValue = "" Then
CCGetCheckBoxValue = "Null"
Else
If ValueType = "Integer" or ValueType = "Float" Then
CCGetCheckBoxValue = UncheckedValue
Else
CCGetCheckBoxValue = "'" & Replace(UncheckedValue, "'", "''") & "'"
End If
End If
Else
If CheckedValue = "" Then
CCGetCheckBoxValue = "Null"
Else
If ValueType = "Integer" OR ValueType = "Float" Then
CCGetCheckBoxValue = CheckedValue
Else
CCGetCheckBoxValue = "'" & Replace(CheckedValue, "'", "''") & "'"
End If
End If
End If
End Function
'End CCGetCheckBoxValue
'CCGetValFromLOV @0-5041B9C1
Function CCGetValFromLOV(Value, ListOfValues)
Dim I
Dim Result : Result = ""
If (Ubound(ListOfValues) MOD 2) = 1 Then
For I = 0 To Ubound(ListOfValues) Step 2
If CStr(Value) = CStr(ListOfValues(I)) Then Result = ListOfValues(I +
1)
Next
End If
CCGetValFromLOV = Result
End Function
'End CCGetValFromLOV
'CCProcessError @0-A3A2654C
Function CCProcessError(Connection)
If Connection.Errors.Count > 0 Then
If TypeName(Connection) = "Connection" Then
CCProcessError = Connection.Errors(0).Description & " (" &
Connection.Errors(0).Source & ")"
Else
CCProcessError = Connection.Errors.ToString
End If
ElseIf NOT (Err.Description = "") Then
CCProcessError = Err.Description
Else
CCProcessError = Empty
End If
end Function
'End CCProcessError
'CCGetRequestParam @0-C154AA52
Function CCGetRequestParam(ParameterName, Method)
Dim ParameterValue
If Method = ccsGet Then
ParameterValue = Request.QueryString(ParameterName)
ElseIf Method = ccsPost Then
ParameterValue = Request.Form(ParameterName)
End If
If CStr(ParameterValue) = "" Then _
ParameterValue = Empty
CCGetRequestParam = ParameterValue
End Function
'End CCGetRequestParam
'CCGetQueryString @0-CBD7B22E
Function CCGetQueryString(CollectionName, RemoveParameters)
Dim QueryString, PostData
If CollectionName = "Form" Then
QueryString = CCCollectionToString(Request.Form, RemoveParameters)
ElseIf CollectionName = "QueryString" Then
QueryString = CCCollectionToString(Request.QueryString,
RemoveParameters)
ElseIf CollectionName = "All" Then
QueryString = CCCollectionToString(Request.QueryString,
RemoveParameters)
PostData = CCCollectionToString(Request.Form, RemoveParameters)
If Len(PostData) > 0 and Len(QueryString) > 0 Then _
QueryString = QueryString & "&" & PostData _
Else _
QueryString = QueryString & PostData
Else
Err.Raise 1050, "Common Functions. CCGetQueryString Function", _
"The CollectionName contains an illegal value."
End If
CCGetQueryString = QueryString
End Function
'End CCGetQueryString
'CCCollectionToString @0-57CAA4B7
Function CCCollectionToString(ParametersCollection, RemoveParameters)
Dim ItemName, ItemValue, Result, Remove, I
For Each ItemName In ParametersCollection
Remove = false
If IsArray(RemoveParameters) Then
For I = 0 To UBound(RemoveParameters)
If RemoveParameters(I) = ItemName Then
Remove = True
Exit For
End If
Next
End If
If Not Remove Then
For Each ItemValue In ParametersCollection(ItemName)
Result = Result & _
"&" & ItemName & "=" & Server.URLEncode(ItemValue)
Next
End If
Next
If Len(Result) > 0 Then _
Result = Mid(Result, 2)
CCCollectionToString = Result
End Function
'End CCCollectionToString
'CCAddZero @0-B5648418
Function CCAddZero(Value, ResultLength)
Dim CountZero, I
CountZero = ResultLength - Len(Value)
For I = 1 To CountZero
Value = "0" & Value
Next
CCAddZero = Value
End Function
'End CCAddZero
'CCGetAMPM @0-CB6EA5BF
Function CCGetAMPM(HoursNumber, AnteMeridiem, PostMeridiem)
If HoursNumber >= 0 And HoursNumber < 12 Then
CCGetAMPM = AnteMeridiem
Else
CCGetAMPM = PostMeridiem
End If
End Function
'End CCGetAMPM
'CC12Hour @0-12B00AFF
Function CC12Hour(HoursNumber)
If HoursNumber = 0 Then
HoursNumber = 12
ElseIf HoursNumber > 12 Then
HoursNumber = HoursNumber - 12
End If
CC12Hour = HoursNumber
End Function
'End CC12Hour
'CCDBFormatByType @0-531721B5
Function CCDBFormatByType(Variable)
Dim Result
If VarType(Variable) = vbString Then
If LCase(Variable) = "null" Then
Result = Variable
Else
Result = "'" & Variable & "'"
End If
Else
Result = CStr(Variable)
End If
CCDBFormatByType = Result
End Function
'End CCDBFormatByType
'CCFormatDate @0-9C44D5D4
Function CCFormatDate(DateToFormat, FormatMask)
Dim ResultArray(), I, Result
If VarType(DateToFormat) = vbEmpty Then
Result = Empty
ElseIf VarType(DateToFormat) <> vbDate Then
Err.Raise 4000, "CCFormatDate function. Type mismatch."
ElseIf IsEmpty(FormatMask) Then
Result = CStr(DateToFormat)
Else
ReDim ResultArray(UBound(FormatMask))
For I = 0 To UBound(FormatMask)
Select Case FormatMask(I)
Case "d" ResultArray(I) = Day(DateToFormat)
Case "w" ResultArray(I) = Weekday(DateToFormat)
Case "m" ResultArray(I) = Month(DateToFormat)
Case "q" ResultArray(I) = (Month(DateToFormat) + 3) \ 4
Case "y" ResultArray(I) = (DateDiff("d", "1/1" & "/" &
Year(DateToFormat), Month(DateToFormat) & "/" & Day(DateToFormat) & "/" &
Year(DateToFormat)) + 1)
Case "h" ResultArray(I) = CC12Hour(Hour(DateToFormat))
Case "H" ResultArray(I) = Hour(DateToFormat)
Case "n" ResultArray(I) = Minute(DateToFormat)
Case "s" ResultArray(I) = Second(DateToFormat)
Case "dd" ResultArray(I) = CCAddZero(Day(DateToFormat), 2)
Case "ww" ResultArray(I) = (DateDiff("ww", "1/1" & "/" &
Year(DateToFormat), Month(DateToFormat) & "/" & Day(DateToFormat) & "/" &
Year(DateToFormat)) + 1)
Case "mm" ResultArray(I) = CCAddZero(Month(DateToFormat), 2)
Case "yy" ResultArray(I) = Right(Year(DateToFormat), 2)
Case "hh" ResultArray(I) = CCAddZero(CC12Hour(Hour(DateToFormat)),
2)
Case "HH" ResultArray(I) = CCAddZero(Hour(DateToFormat), 2)
Case "nn" ResultArray(I) = CCAddZero(Minute(DateToFormat), 2)
Case "ss" ResultArray(I) = CCAddZero(Second(DateToFormat), 2)
Case "ddd" ResultArray(I) =
CCSDateConstants.ShortWeekdays(Weekday(DateToFormat) - 1)
Case "mmm" ResultArray(I) =
CCSDateConstants.ShortMonths(Month(DateToFormat) - 1)
Case "A/P" ResultArray(I) = CCGetAMPM(Hour(DateToFormat), "A", "P")
Case "a/p" ResultArray(I) = CCGetAMPM(Hour(DateToFormat), "a", "p")
Case "dddd" ResultArray(I) =
CCSDateConstants.Weekdays(Weekday(DateToFormat) - 1)
Case "mmmm" ResultArray(I) =
CCSDateConstants.Months(Month(DateToFormat) - 1)
Case "yyyy" ResultArray(I) = Year(DateToFormat)
Case "AM/PM" ResultArray(I) = CCGetAMPM(Hour(DateToFormat), "AM",
"PM")
Case "am/pm" ResultArray(I) = CCGetAMPM(Hour(DateToFormat), "am",
"pm")
Case "LongDate" ResultArray(I) = FormatDateTime(DateToFormat,
vbLongDate)
Case "LongTime" ResultArray(I) = FormatDateTime(DateToFormat,
vbLongTime)
Case "ShortDate" ResultArray(I) = FormatDateTime(DateToFormat,
vbShortDate)
Case "ShortTime" ResultArray(I) = FormatDateTime(DateToFormat,
vbShortTime)
Case "GeneralDate" ResultArray(I) = FormatDateTime(DateToFormat,
vbGeneralDate)
Case Else
If Left(FormatMask(I), 1) = "\" Then _
ResultArray(I) = Mid(FormatMask(I), 1) _
Else
ResultArray(I) = FormatMask(I)
End Select
Next
Result = Join(ResultArray, "")
End If
CCFormatDate = Result
End Function
'End CCFormatDate
'CCFormatBoolean @0-635596FD
Function CCFormatBoolean(BooleanValue, arrFormat)
Dim Result, TrueValue, FalseValue, EmptyValue
If IsEmpty(arrFormat) Then
Result = CStr(BooleanValue)
Else
TrueValue = arrFormat(0)
FalseValue = arrFormat(1)
EmptyValue = arrFormat(2)
If IsEmpty(BooleanValue) Then
Result = EmptyValue
Else
If BooleanValue Then _
Result = TrueValue _
Else _
Result = FalseValue
End If
End If
CCFormatBoolean = Result
End Function
'End CCFormatBoolean
'CCFormatNumber @0-67C259CA
Function CCFormatNumber(NumberToFormat, FormatArray)
Dim IsNegative
Dim IsExtendedFormat, IsDecimalSeparator, DecimalSeparator,
IsPeriodSeparator, PeriodSeparator
If IsEmpty(NumberToFormat) Then
CCFormatNumber = ""
Exit Function
End If
If IsArray(FormatArray) Then
IsExtendedFormat = FormatArray(0)
IsNegative = (NumberToFormat < 0)
NumberToFormat = ABS(NumberToFormat) * FormatArray(7)
If IsExtendedFormat Then ' Extended format
IsDecimalSeparator = FormatArray(1)
DecimalSeparator = FormatArray(2)
IsPeriodSeparator = FormatArray(3)
PeriodSeparator = FormatArray(4)
Dim BeforeDecimal, AfterDecimal
Dim ObligatoryBeforeDecimal, DigitsBeforeDecimal,
ObligatoryAfterDecimal, DigitsAfterDecimal
Dim I, Z
BeforeDecimal = FormatArray(5)
AfterDecimal = FormatArray(6)
If IsArray(BeforeDecimal) Then
For I = 0 To UBound(BeforeDecimal)
If BeforeDecimal(I) = "0" Then
ObligatoryBeforeDecimal = ObligatoryBeforeDecimal + 1
DigitsBeforeDecimal = DigitsBeforeDecimal + 1
ElseIf BeforeDecimal(I) = "#" Then
DigitsBeforeDecimal = DigitsBeforeDecimal + 1
End If
Next
End If
If IsArray(AfterDecimal) Then
For I = 0 To UBound(AfterDecimal)
If AfterDecimal(I) = "0" Then
ObligatoryAfterDecimal = ObligatoryAfterDecimal + 1
DigitsAfterDecimal = DigitsAfterDecimal + 1
ElseIf AfterDecimal(I) = "#" Then
DigitsAfterDecimal = DigitsAfterDecimal + 1
End If
Next
End If
Dim NumDigitsAfterDecimal, Result, DefaultValue
If ObligatoryAfterDecimal = 0 And DigitsAfterDecimal = 1 Then
NumDigitsAfterDecimal = -1
ElseIf Not IsDecimalSeparator Then
NumDigitsAfterDecimal = 0
Else
NumDigitsAfterDecimal = DigitsAfterDecimal
End If
NumberToFormat = FormatNumber(NumberToFormat, DigitsAfterDecimal,
False, False, False)
Dim DefaultDecimal : DefaultDecimal = Mid(FormatNumber(10001/10, 1,
True, False, True), 6, 1)
Dim LeftPart, RightPart
If Not InStr(CStr(NumberToFormat), DefaultDecimal) = 0 Then
Dim NumberParts : NumberParts = Split(CStr(NumberToFormat),
DefaultDecimal)
LeftPart = CStr(NumberParts(0))
RightPart = CStr(NumberParts(1))
Else
LeftPart = CStr(NumberToFormat)
End If
Dim J : J = Len(LeftPart)
If IsDecimalSeparator And DecimalSeparator = "" Then
DefaultValue = CStr(FormatNumber(10001/10, 1, True, False, True))
DecimalSeparator = Mid(DefaultValue, 6, 1)
End If
If IsPeriodSeparator And PeriodSeparator = "" Then
DefaultValue = CStr(FormatNumber(10001/10, 1, True, False, True))
PeriodSeparator = Mid(DefaultValue, 2, 1)
End If
If IsArray(BeforeDecimal) Then
Dim RankNumber : RankNumber = 0
For I = UBound(BeforeDecimal) To 0 Step -1
If BeforeDecimal(i) = "#" Or BeforeDecimal(i) = "0" Then
If DigitsBeforeDecimal = 1 And J > 1 Then
If Not IsPeriodSeparator Then
Result = Left(LeftPart, j) & Result
Else
For z = J To 1 Step -1
RankNumber = RankNumber + 1
If RankNumber Mod 3 = 1 And RankNumber - 3 > 0 Then
Result = Mid(LeftPart, z, 1) & PeriodSeparator & Result
Else
Result = Mid(LeftPart, z, 1) & Result
End If
Next
End If
ElseIf J > 0 Then
RankNumber = RankNumber + 1
If RankNumber Mod 3 = 1 And RankNumber - 3 > 0 And
IsPeriodSeparator Then
Result = Mid(LeftPart, j, 1) & PeriodSeparator & Result
Else
Result = Mid(LeftPart, j, 1) & Result
End If
J = J - 1
ObligatoryBeforeDecimal = ObligatoryBeforeDecimal - 1
DigitsBeforeDecimal = DigitsBeforeDecimal - 1
Else
If ObligatoryBeforeDecimal > 0 Then
RankNumber = RankNumber + 1
If RankNumber Mod 3 = 1 And RankNumber - 3 > 0 And
IsPeriodSeparator Then
Result = "0" & PeriodSeparator & Result
Else
Result = "0" & Result
End If
ObligatoryBeforeDecimal = ObligatoryBeforeDecimal - 1
DigitsBeforeDecimal = DigitsBeforeDecimal - 1
End If
End If
Else
BeforeDecimal(I) = Replace(BeforeDecimal(I), "##", "#")
BeforeDecimal(I) = Replace(BeforeDecimal(I), "00", "0")
Result = BeforeDecimal(I) & Result
End If
Next
End If
' Left part after decimal
Dim RightResult : RightResult = ""
If IsArray(AfterDecimal) Then
Dim IsZero : IsZero = True
For I = UBound(AfterDecimal) To 0 Step -1
If AfterDecimal(I) = "#" Or AfterDecimal(I) = "0" Then
If DigitsAfterDecimal > ObligatoryAfterDecimal Then
If Not Mid(RightPart, DigitsAfterDecimal, 1) = "0" Then IsZero
= False
If Not IsZero Then _
RightResult = Mid(RightPart, DigitsAfterDecimal, 1) &
RightResult
DigitsAfterDecimal = DigitsAfterDecimal - 1
Else
RightResult = Mid(RightPart, DigitsAfterDecimal, 1) &
RightResult
DigitsAfterDecimal = DigitsAfterDecimal - 1
End If
Else
AfterDecimal(I) = Replace(AfterDecimal(I), "##", "#")
AfterDecimal(I) = Replace(AfterDecimal(I), "00", "0")
RightResult = AfterDecimal(I) & RightResult
End If
Next
End If
If IsDecimalSeparator AND Len(RightResult) > 0 Then _
Result = Result & DecimalSeparator & RightResult
If NOT FormatArray(10) AND IsNegative Then _
Result = "-" & Result
Result = Result & RightResult
Else ' Simple format
If Not FormatArray(3) AND IsNegative Then _
Result = "-" & FormatArray(5) & FormatNumber(NumberToFormat,
FormatArray(1), FormatArray(2), False, FormatArray(4)) & FormatArray(6) _
Else _
Result = FormatArray(5) & FormatNumber(NumberToFormat,
FormatArray(1), FormatArray(2), False, FormatArray(4)) & FormatArray(6)
End If
If Not FormatArray(8) Then Result = Server.HTMLEncode(Result)
If Not CStr(FormatArray(9)) = "" Then _
Result = "<FONT COLOR=""" & FormatArray(9) & """>" & Result &
"</FONT>"
Else
Result = NumberToFormat
End If
CCFormatNumber = Result
End Function
'End CCFormatNumber
'CCParseBoolean @0-33711A62
Function CCParseBoolean(Value, FormatMask)
Dim Result
Result = Empty
If VarType(Value) = vbBoolean Then
Result = Value
Else
If IsEmpty(FormatMask) Then
Result = CBool(Value)
Else
If IsEmpty(Value) Then
If CStr(FormatMask(0)) = "null" Then _
Result = True
If CStr(FormatMask(1)) = "null" Then _
Result = False
Else
If CStr(Value) = CStr(FormatMask(0)) Then
Result = True
ElseIf CStr(Value) = CStr(FormatMask(1)) Then
Result = False
End If
End If
End If
End If
CCParseBoolean = Result
End Function
'End CCParseBoolean
'CCParseDate @0-0D3D1ED4
Function CCParseDate(ParsingDate, FormatMask)
Dim ResultDate, ResultDateArray(8)
Dim MaskPart, MaskLength, TokenLength
Dim IsError
Dim DatePosition, MaskPosition
Dim Delimiter, BeginDelimiter
Dim MonthNumber, MonthName, MonthArray
Dim DatePart
Dim IS_DATE_POS, YEAR_POS, MONTH_POS, DAY_POS, IS_TIME_POS, HOUR_POS,
MINUTE_POS, SECOND_POS
IS_DATE_POS = 0 : YEAR_POS = 1 : MONTH_POS = 2 : DAY_POS = 3
IS_TIME_POS = 4 : HOUR_POS = 5 : MINUTE_POS = 6 : SECOND_POS = 7
If IsEmpty(FormatMask) Then
If CStr(ParsingDate) = "" Then _
ResultDate = Empty _
Else _
ResultDate = CDate(ParsingDate)
ElseIf (FormatMask(0) = "GeneralDate" Or FormatMask(0) = "LongDate" _
Or FormatMask(0) = "ShortDate" Or FormatMask(0) = "LongTime" _
Or FormatMask(0) = "ShortTime") And Not CStr(ParsingDate) = "" Then
ResultDate = CDate(ParsingDate)
ElseIf CStr(ParsingDate) = "" Then
ResultDate = Empty
Else
DatePosition = 1
MaskPosition = 0
MaskLength = UBound(FormatMask)
IsError = False
' Default date
ResultDateArray(IS_DATE_POS) = False
ResultDateArray(IS_TIME_POS) = False
ResultDateArray(YEAR_POS) = 0 : ResultDateArray(MONTH_POS) = 12 :
ResultDateArray(DAY_POS) = 1
ResultDateArray(HOUR_POS) = 0 : ResultDateArray(MINUTE_POS) = 0 :
ResultDateArray(SECOND_POS) = 0
While (MaskPosition <= MaskLength) AND NOT IsError
MaskPart = FormatMask(MaskPosition)
If CCSDateConstants.DateMasks.Exists(MaskPart) Then
TokenLength = CCSDateConstants.DateMasks(MaskPart)
If TokenLength > 0 Then
DatePart = Mid(ParsingDate, DatePosition, TokenLength)
DatePosition = DatePosition + TokenLength
Else
If MaskPosition < MaskLength Then
Delimiter = FormatMask(MaskPosition + 1)
BeginDelimiter = InStr(DatePosition, ParsingDate, Delimiter)
If BeginDelimiter = 0 Then
Err.Raise 4000, "ParseDate function: The number doesn't match
the mask."
Else
DatePart = Mid(ParsingDate, DatePosition, BeginDelimiter -
DatePosition)
DatePosition = BeginDelimiter
End If
Else
DatePart = Mid(ParsingDate, DatePosition)
End If
End If
Select Case MaskPart
Case "d", "dd"
ResultDateArray(DAY_POS) = CInt(DatePart)
ResultDateArray(IS_DATE_POS) = True
Case "m", "mm"
ResultDateArray(MONTH_POS) = CInt(DatePart)
ResultDateArray(IS_DATE_POS) = True
Case "mmm", "mmmm"
MonthNumber = 0
MonthName = UCase(DatePart)
If MaskPart = "mmm" Then _
MonthArray = CCSDateConstants.ShortMonths _
Else _
MonthArray = CCSDateConstants.Months
While MonthNumber < 11 AND UCase(MonthArray(MonthNumber)) <>
MonthName
MonthNumber = MonthNumber + 1
Wend
If MonthNumber = 11 Then
If UCase(MonthArray(11)) <> MonthName Then _
Err.Raise 4000, "ParseDate function: The number doesn't
match the mask."
End If
ResultDateArray(MONTH_POS) = MonthNumber + 1
ResultDateArray(IS_DATE_POS) = True
Case "yy", "yyyy"
ResultDateArray(YEAR_POS) = CInt(DatePart)
ResultDateArray(IS_DATE_POS) = True
Case "h", "hh"
If CInt(DatePart) = 12 Then _
ResultDateArray(HOUR_POS) = 0 _
Else _
ResultDateArray(HOUR_POS) = CInt(DatePart)
ResultDateArray(IS_TIME_POS) = True
Case "H", "HH"
ResultDateArray(HOUR_POS) = CInt(DatePart)
ResultDateArray(IS_TIME_POS) = True
Case "n", "nn"
ResultDateArray(MINUTE_POS) = CInt(DatePart)
ResultDateArray(IS_TIME_POS) = True
Case "s", "ss"
ResultDateArray(SECOND_POS) = CInt(DatePart)
ResultDateArray(IS_TIME_POS) = True
Case "am/pm", "a/p", "AM/PM", "A/P"
If Left(LCase(DatePart), 1) = "p" Then
ResultDateArray(HOUR_POS) = ResultDateArray(HOUR_POS) + 12
ElseIf Left(LCase(DatePart), 1) = "a" Then
ResultDateArray(HOUR_POS) = ResultDateArray(HOUR_POS)
End If
ResultDateArray(IS_TIME_POS) = True
Case "w", "q"
' Do Nothing
End Select
Else
DatePosition = DatePosition + Len(FormatMask(MaskPosition))
End If
MaskPosition = MaskPosition + 1
Wend
If ResultDateArray(IS_TIME_POS) AND ResultDateArray(IS_TIME_POS) Then
ResultDate = DateSerial(ResultDateArray(YEAR_POS),
ResultDateArray(MONTH_POS), ResultDateArray(DAY_POS)) _
+ TimeSerial(ResultDateArray(HOUR_POS), ResultDateArray(MINUTE_POS),
ResultDateArray(SECOND_POS))
ElseIf ResultDateArray(IS_TIME_POS) Then
ResultDate = TimeSerial(ResultDateArray(HOUR_POS),
ResultDateArray(MINUTE_POS), ResultDateArray(SECOND_POS))
ElseIf ResultDateArray(IS_DATE_POS) Then
ResultDate = DateSerial(ResultDateArray(YEAR_POS),
ResultDateArray(MONTH_POS), ResultDateArray(DAY_POS))
End If
End If
CCParseDate = ResultDate
End Function
'End CCParseDate
'CCParseNumber @0-BDE16F1E
Function CCParseNumber(NumberValue, FormatArray, DataType)
Dim Result, NumberValueType
NumberValueType = VarType(NumberValue)
If NumberValueType = vbInteger OR NumberValueType = vbLong _
OR NumberValueType = vbSingle OR NumberValueType = vbSingle _
OR NumberValueType = vbCurrency OR NumberValueType = vbDecimal _
OR NumberValueType = vbByte Then
If DataType = ccsInteger Then
Result = CLng(NumberValue)
ElseIf DataType = ccsFloat Then
Result = CDbl(NumberValue)
End If
Else
If Not CStr(NumberValue) = "" Then
Dim DefaultValue, DefaultDecimal
Dim DecimalSeparator, PeriodSeparator
DecimalSeparator = "" : PeriodSeparator = ""
If IsArray(FormatArray) Then
If FormatArray(0) Then
DecimalSeparator = FormatArray(2)
PeriodSeparator = FormatArray(4)
End If
End If
If Not CStr(DecimalSeparator) = "" Then
DefaultValue = CStr(FormatNumber(10001/10, 1, True, False, True))
DefaultDecimal = Mid(DefaultValue, 6, 1)
NumberValue = Replace(NumberValue, DecimalSeparator, DefaultDecimal)
End If
If Not CStr(PeriodSeparator) = "" Then NumberValue =
Replace(NumberValue, PeriodSeparator, "")
If DataType = ccsInteger Then
Result = CLng(NumberValue)
ElseIf DataType = ccsFloat Then
Result = CDbl(NumberValue)
End If
Else
Result = Empty
End If
End If
CCParseNumber = Result
End Function
'End CCParseNumber
'CCParseInteger @0-42815927
Function CCParseInteger(NumberValue, FormatArray)
CCParseInteger = CCParseNumber(NumberValue, FormatArray, ccsInteger)
End Function
'End CCParseInteger
'CCParseFloat @0-56667DF0
Function CCParseFloat(NumberValue, FormatArray)
CCParseFloat = CCParseNumber(NumberValue, FormatArray, ccsFloat)
End Function
'End CCParseFloat
'CCValidateDate @0-D0BEB752
Function CCValidateDate(ValidatingDate, FormatMask)
Dim MaskPosition, I, Result, OneChar, IsSeparator
Dim RegExpPattern, RegExpObject, Matches
IsSeparator = False
If ValidatingDate = "" OR IsEmpty(ValidatingDate) Then
Result = True
ElseIf IsEmpty(FormatMask) Then
Result = IsDate(ValidatingDate)
ElseIf FormatMask(0) = "GeneralDate" Or FormatMask(0) = "LongDate" _
Or FormatMask(0) = "ShortDate" Or FormatMask(0) = "LongTime" _
Or FormatMask(0) = "ShortTime" Then
Result = IsDate(ValidatingDate)
Else
For MaskPosition = 0 To UBound(FormatMask)
If NOT IsSeparator Then
Select Case FormatMask(MaskPosition)
Case "d", "m", "h", "n", "s", "w", "q", "H"
RegExpPattern = RegExpPattern + "\d{1,2}.+"
IsSeparator = True
Case "dd", "mm", "yy", "hh", "nn", "ss", "HH"
RegExpPattern = RegExpPattern + "\d{2}"
Case "yyyy"
RegExpPattern = RegExpPattern + "\d{4}"
Case "mmm"
RegExpPattern = RegExpPattern + "(" &
Join(CCSDateConstants.ShortMonths, "|") & ")"
Case "mmmm"
RegExpPattern = RegExpPattern + "(" &
Join(CCSDateConstants.Months, "|") & ")"
Case "am/pm"
RegExpPattern = RegExpPattern + "[ap]m"
Case "AM/PM"
RegExpPattern = RegExpPattern + "[AP]M"
Case "a/p"
RegExpPattern = RegExpPattern + "[ap]"
Case "A/P"
RegExpPattern = RegExpPattern + "[AP]"
Case Else
For I = 1 To Len(FormatMask(MaskPosition))
OneChar = Mid(FormatMask(MaskPosition), I, 1)
If InStr("bBdDfnrsStvwW\", OneChar) = 0 Then _
OneChar = "\" + OneChar
RegExpPattern = RegExpPattern + OneChar
Next
End Select
Else
IsSeparator = False
For I = 2 To Len(FormatMask(MaskPosition))
OneChar = Mid(FormatMask(MaskPosition), I, 1)
If InStr("bBdDfnrsStvwW\", OneChar) = 0 Then _
OneChar = "\" + OneChar
RegExpPattern = RegExpPattern + OneChar
Next
End If
Next
Set RegExpObject = New RegExp
RegExpObject.IgnoreCase = False
RegExpObject.Global = True
RegExpObject.Pattern = RegExpPattern
Set Matches = RegExpObject.Execute(ValidatingDate)
Result = CBool(Matches.Count = 1)
Set Matches = Nothing
Set RegExpObject = Nothing
End If
CCValidateDate = Result
End Function
'End CCValidateDate
'CCValidateNumber @0-08089509
Function CCValidateNumber(NumberValue, FormatArray)
Dim Result, NumberValueType
NumberValueType = VarType(NumberValue)
If NumberValueType = vbInteger OR NumberValueType = vbLong _
OR NumberValueType = vbSingle OR NumberValueType = vbSingle _
OR NumberValueType = vbCurrency OR NumberValueType = vbDecimal _
OR NumberValueType = vbByte Then
Result = True
Else
If Not CStr(NumberValue) = "" Then
Dim DefaultValue, DefaultDecimal
Dim DecimalSeparator, PeriodSeparator
DecimalSeparator = "" : PeriodSeparator = ""
If IsArray(FormatArray) Then
If FormatArray(0) Then
DecimalSeparator = FormatArray(2)
PeriodSeparator = FormatArray(4)
End If
End If
If Not CStr(DecimalSeparator) = "" Then
DefaultValue = CStr(FormatNumber(10001/10, 1, True, False, True))
DefaultDecimal = Mid(DefaultValue, 6, 1)
NumberValue = Replace(NumberValue, DecimalSeparator, DefaultDecimal)
End If
If Not CStr(PeriodSeparator) = "" Then NumberValue =
Replace(NumberValue, PeriodSeparator, "")
Result = IsNumeric(NumberValue)
Else
Result = True
End If
End If
CCValidateNumber = Result
End Function
'End CCValidateNumber
'CCValidateBoolean @0-B8DE2060
Function CCValidateBoolean(Value, FormatMask)
Dim Result: Result = False
If VarType(Value) = vbBoolean Then
Result = True
Else
If IsEmpty(FormatMask) Then
On Error Resume Next
Result = CBool(Value)
Result = Not(Err > 0)
Else
If IsEmpty(Value) Or CStr(Value) = "" Then
Result = (CStr(FormatMask(0)) = "null") Or (CStr(FormatMask(0)) =
"Undefined") Or (CStr(FormatMask(0)) = "")
Result = Result Or (CStr(FormatMask(1)) = "null") Or
(CStr(FormatMask(1)) = "Undefined") Or (CStr(FormatMask(1)) = "")
If UBound(FormatMask) = 2 Then _
Result = Result Or (CStr(FormatMask(2)) = "null") Or
(CStr(FormatMask(2)) = "Undefined") Or (CStr(FormatMask(2)) = "")
Else
Result = (CStr(Value) = CStr(FormatMask(0))) Or (CStr(Value) =
CStr(FormatMask(1)))
If UBound(FormatMask) = 2 Then _
Result = Result Or (CStr(Value) = CStr(FormatMask(2)))
End If
End If
End If
CCValidateBoolean = Result
End Function
'End CCValidateBoolean
'CCAddParam @0-6D59DAA5
Function CCAddParam(QueryString, ParameterName, ParameterValue)
Dim Result
Result = Replace("&" & QueryString, "&" & ParameterName & "=" &
Server.URLEncode(Request.QueryString(ParameterName)), "")
Result = Result & "&" & ParameterName & "=" &
Server.URLEncode(ParameterValue)
Result = Replace(Result, "&&", "&")
If Left(Result, 1) = "&" Then Result = Mid(Result, 2)
CCAddParam = Result
End Function
'End CCAddParam
'CCRemoveParam @0-64B4FAAF
Function CCRemoveParam(QueryString, ParameterName)
Dim Result
Result = Replace(QueryString, ParameterName & "=" &
Server.URLEncode(Request.QueryString(ParameterName)), "")
Result = Replace(Result, "&&", "&")
If Left(Result, 1) = "&" Then Result = Mid(Result, 2)
CCRemoveParam = Result
End Function
'End CCRemoveParam
'CCRegExpTest @0-9EAA5A2D
Function CCRegExpTest(TestValue, RegExpMask, IgnoreCase, GlobalTest)
Dim Result
If Not CStr(TestValue) = "" Then
Dim RegExpObject
Set RegExpObject = New RegExp
RegExpObject.Pattern = RegExpMask
RegExpObject.IgnoreCase = IgnoreCase
RegExpObject.Global = GlobalTest
Result = RegExpObject.Test(CStr(TestValue))
Set RegExpObject = Nothing
Else
Result = True
End If
CCRegExpTest = Result
End Function
'End CCRegExpTest
'CCRegExpTest @0-4BE3AE1D
Sub CheckSSL()
If Not UCase(Request.ServerVariables("HTTPS")) = "ON" Then
Response.Write "SSL connection error. This page can be accessed only via
secured connection."
Response.End
End If
End Sub
'End CCRegExpTest
'CCGetUserLogin @0-4306ED6C
Function CCGetUserLogin()
CCGetUserLogin = Session("UserLogin")
End Function
'End CCGetUserLogin
'CCSecurityRedirect @0-790A88DF
Sub CCSecurityRedirect(GroupsAccess, URL)
Dim ErrorType
Dim Link
ErrorType = CCSecurityAccessCheck(GroupsAccess)
If NOT (ErrorType = "success") Then
If IsEmpty(URL) Then _
Link = ServerURL & "Login.asp" _
Else _
Link = URL
Response.Redirect(Link & "?ret_link=" & _
Server.URLEncode(Request.ServerVariables("SCRIPT_NAME") & _
"?" & CCRemoveParam(Request.ServerVariables("QUERY_STRING"),
"ccsForm")) & "&type=" & ErrorType)
End If
End Sub
'End CCSecurityRedirect
'CCGetUserID @0-449B3B19
Function CCGetUserID()
CCGetUserID = Session("UserID")
End Function
'End CCGetUserID
'CCSecurityAccessCheck @0-8A7701BE
Function CCSecurityAccessCheck(GroupsAccess)
Dim ErrorType
Dim GroupID
ErrorType = "success"
If IsEmpty(CCGetUserID()) Then
ErrorType = "notLogged"
Else
GroupID = CCGetGroupID()
If IsEmpty(GroupID) Then
ErrorType = "groupIDNotSet"
Else
If NOT CCUserInGroups(GroupID, GroupsAccess) Then
ErrorType = "illegalGroup"
End If
End If
End If
CCSecurityAccessCheck = ErrorType
End Function
'End CCSecurityAccessCheck
'CCGetGroupID @0-B2650479
Function CCGetGroupID()
CCGetGroupID = Session("GroupID")
End Function
'End CCGetGroupID
'CCUserInGroups @0-4332AEA7
Function CCUserInGroups(GroupID, GroupsAccess)
Dim Result
Dim GroupNumber
If NOT IsEmpty(GroupsAccess) Then
GroupNumber = CLng(GroupID)
While NOT Result AND GroupNumber > 0
Result = NOT (InStr(";" & GroupsAccess & ";", ";" & GroupNumber & ";") = 0)
GroupNumber = GroupNumber - 1
Wend
Else
Result = True
End If
CCUserInGroups = Result
End Function
'End CCUserInGroups
'CCLoginUser @0-6D3FEC5B
Function CCLoginUser(Login, Password)
Dim Result
Dim SQL
Dim RecordSet
Dim Connection
Set Connection = New clsDBConnection1
Connection.Open
SQL = "SELECT id_empleado, group FROM Empleados WHERE emp_login='" &
Replace(Login, "'", "''") & "' AND emp_password='" & Replace(Password, "'",
"''") & "'"
Set RecordSet = Connection.Execute(SQL)
Result = NOT RecordSet.EOF
If Result Then
Session("UserID") = RecordSet("id_empleado")
Session("UserLogin") = Login
Session("GroupID") = RecordSet("group")
End If
RecordSet.Close
Set RecordSet = Nothing
Connection.Close
Set Connection = Nothing
CCLoginUser = Result
End Function
'End CCLoginUser
'CCLogoutUser @0-DB93CE50
Sub CCLogoutUser()
Session("UserID") = Empty
Session("UserLogin") = Empty
Session("GroupID") = Empty
End Sub
'End CCLogoutUser
%>
Any help will be greatly appreciated...
"Pepito" <dfga@kk.com> wrote in message
news:b44qfl$ltg$1@news.codecharge.com...
> Hello Everyone, I uploaded a css project (that runs great on IIS at my
> machine) to a free server (brinkster). I can properly see on a browser
> *.html files but not the same file *.asp....error 500...
>
> any hint?
>
> check it out at
http://www10.brinkster.com/mariosbm/code/Empleados_list.html
> http://www10.brinkster.com/mariosbm/code/Empleados_list.asp
>
> your help is greatly appreciated...I 'not a programmer but would like to
set
> a site of this kind
>
> Thanks
>
>
>
|
|
|
|
NetFocus.biz
|
| Posted: 03/05/2003, 8:08 AM |
|
Hi
You need to know the file path to the database. You can find this out using
the server.mappath method. You can take the attached small file and copy it
to the same folder as your database, then go to
http://www10.brinkster.com/mariosbm/code/getpath.asp
you should then see a result like this in your browser:
c:\inetpub\wwwroot\test\getpath.asp
which will tell you how to refer to the database in Common.asp (in this case
c:\inetpub\wwwroot\test\GardenCo.mdb).
Hope this helps
Alistair
--
Managing Director
NetFocus Solutions Ltd
2 Cockburn Place
Riverside Business Park
Irvine, Ayrshire, KA11 5DA
Tel: +44 (0) 1294 318701
Fax: +44 (0) 1294 316580
Internet: www.netfocus.biz
"Pepito" <pepitxispi@yahoo.com> wrote in message
news:b4568c$fu3$1@news.codecharge.com...
> Thanks for your responses:
>
> 1) I already turn off the friendly error showing,
> 2) I am playing with changing the path as Alistair kindly suggested..
>
> However, I am messing the code ...
> well....the database is here
> http://mariosbm.www4.dotnetplayground.com/code/GardenCo.mdb
> the page is here
> http://mariosbm.www4.dotnetplayground.com/code/Empleados_list.asp (you can
> see the html here
> http://mariosbm.www4.dotnetplayground.com/code/Empleados_list.html)
> so, if the problem is here:
> "Microsoft JET Database Engine error '80004005'
>
> 'C:\Documents and Settings\M\My Documents\web solutions\New
> Folder\NewProject6\GardenCo.mdb' is not a valid path. Make sure that the
> path name is spelled correctly and that you are connected to the server on
> which the file resides.
>
> /mariosbm/code/Common.asp, line 117"
>
> Should I write instead of C:\...etc this: \code\GardenCo.mdb ?? that is
not
> working also....
>
> here is the old code:
>
> <%
> Option Explicit
>
> 'Include Files @0-0F8FBEEB
> %>
> <!-- #INCLUDE FILE="Adovbs.asp" -->
> <!-- #INCLUDE FILE="Classes.asp" -->
> <%
> 'End Include Files
>
> 'Script Engine Version Check @0-A118D8E9
> If ScriptEngineMajorVersion < 5 Then
> Response.Write "Sorry. This program requires VBScript 5.1 to
run.<br>You
> may upgrade your VBScript at
> http://www.microsoft.com/msdownload/vbscript/scripting.asp.";
> Response.End
> Else
> If ScriptEngineMajorVersion & ":" & ScriptEngineMinorVersion = "5:0"
> Then
> Response.Write "Due to a bug in VBScript 5.0, this program would
> crash your server. See
> http://support.microsoft.com/default.aspx?scid=kb;EN-US...<br>"; & _
> "Upgrade your VBScript at
> http://www.microsoft.com/msdownload/vbscript/scripting.asp.";
> Response.End
> End If
> End If
> 'End Script Engine Version Check
>
> 'Initialize Common Variables @0-EB7D5995
> Dim CCSDateConstants
> Dim ServerURL
> Dim SecureURL
> Dim TemplatesRepository
> Dim EventCaller
>
> Set TemplatesRepository = New clsCache_FileSystem
> ServerURL = "http://localhost/NewProject5/"
> Set CCSDateConstants = New clsCCSDateConstants
>
> Class clsCCSDateConstants
>
> Public Weekdays
> Public ShortWeekdays
> Public Months
> Public ShortMonths
> Public DateMasks
>
> Private Sub Class_Initialize()
> ShortWeekdays = Array("Sun", "Mon", "Tue", "Wed", "Thu", "Fri",
> "Sat")
> Weekdays = Array("Sunday", "Monday", "Tuesday", "Wednesday",
> "Thursday", "Friday", "Saturday")
> ShortMonths = Array("Jan", "Feb", "Mar", "Apr", "May", "Jun",
> "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")
> Months = Array("January", "February", "March", "April", "May",
> "June", "July", "August", "September", "October", "November", "December")
> Set DateMasks = CreateObject("Scripting.Dictionary")
> DateMasks("d") = 0
> DateMasks("dd") = 2
> DateMasks("m") = 0
> DateMasks("mm") = 2
> DateMasks("mmm") = 3
> DateMasks("mmmm") = 0
> DateMasks("yy") = 2
> DateMasks("yyyy") = 4
> DateMasks("h") = 0
> DateMasks("hh") = 2
> DateMasks("H") = 0
> DateMasks("HH") = 2
> DateMasks("n") = 0
> DateMasks("nn") = 2
> DateMasks("s") = 0
> DateMasks("ss") = 2
> DateMasks("am/pm") = 2
> DateMasks("AM/PM") = 2
> DateMasks("A/P") = 1
> DateMasks("a/p") = 1
> DateMasks("w") = 0
> DateMasks("q") = 0
> End Sub
>
> Private Sub Class_Terminate()
> Set DateMasks = Nothing
> End Sub
>
> End Class
>
> Const ccsInteger = 1
> Const ccsFloat = 2
> Const ccsText = 3
> Const ccsDate = 4
> Const ccsBoolean = 5
> Const ccsMemo = 6
>
> Const ccsGet = 1
> Const ccsPost = 2
> 'End Initialize Common Variables
>
> 'Connection1 Connection Class @-2D543FFD
> Class clsDBConnection1
>
> Public ConnectionString
> Public User
> Public Password
> Public DateFormat
> Public BooleanFormat
> Public LastSQL
> Public Errors
>
> Private objConnection
> Private blnState
>
> Private Sub Class_Initialize()
> ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;User
> ID=Admin;Data Source=C:\Documents and Settings\M\My Documents\web
> solutions\New Folder\NewProject5\GardenCo.mdb;Persist Security Info=False"
> User = "Admin"
> Password = ""
> DateFormat = Empty
> BooleanFormat = Empty
> Set objConnection = Server.CreateObject("ADODB.Connection")
> Set Errors = New clsErrors
> End Sub
>
> Sub Open()
> On Error Resume Next
> objConnection.Errors.Clear
> objConnection.Open ConnectionString, User, Password
> If Err.Number <> 0 then
> Response.Write "<div><h2>Unable to establish connection to
> database.</h2>"
> Response.Write "<ul><li>Error information:<br>"
> Response.Write Err.Source & " (0x" & Hex(Err.Number) & ")<br>"
> Response.Write Err.Description & "</li>"
> If Err.Number = -2147467259 then _
> Response.Write "<li>More information:<br>The database cannot
be
> opened, most likely due to insufficient security set on your database
folder
> or file.</li>"
> Response.Write "</ul></div>"
> Response.End
> End If
> End Sub
>
> Sub Close()
> objConnection.Close
> End Sub
>
> Function Execute(varCMD)
> Dim ErrorMessage, objResult
> Errors.Clear
> Set objResult = Server.CreateObject("ADODB.Recordset")
> objResult.CursorType = adOpenForwardOnly
> objResult.LockType = adLockReadOnly
> If TypeName(varCMD) = "Command" Then
> Set varCMD.ActiveConnection = objConnection
> Set objResult.Source = varCMD
> LastSQL = varCMD.CommandText
> Else
> Set objResult.ActiveConnection = objConnection
> objResult.Source = varCMD
> LastSQL = varCMD
> End If
> On Error Resume Next
> objResult.Open
> Errors.AddError CCProcessError(objConnection)
> On Error Goto 0
> Set Execute = objResult
> End Function
>
> Property Get Connection()
> Set Connection = objConnection
> End Property
>
> Property Get State()
> State = objConnection.State
> End Property
>
> Function ToSQL(Value, ValueType)
> If CStr(Value) = "" OR IsEmpty(Value) Then
> ToSQL = "Null"
> Else
> If ValueType = ccsInteger or ValueType = ccsFloat Then
> ToSQL = Replace(Value, ",", ".")
> ElseIf ValueType = ccsDate Then
> ToSQL = "'" & Replace(Value, "'", "''") & "'"
> Else
> ToSQL = "'" & Replace(Value, "'", "''") & "'"
> End If
> End If
> End Function
>
>
> End Class
> 'End Connection1 Connection Class
>
> 'IIf @0-535EAADD
> Function IIf(Expression, TrueResult, FalseResult)
> If CBool(Expression) Then _
> IIf = TrueResult _
> Else _
> IIf = FalseResult
> End Function
> 'End IIf
>
> 'Print @0-065FC167
> Sub Print(Value)
> Response.Write CStr(Value)
> End Sub
> 'End Print
>
> 'CCRaiseEvent @0-E59A6846
> Function CCRaiseEvent(Events, EventName, Caller)
> Set EventCaller = Caller
> Dim Result : Result = Events(EventName)
> Set EventCaller = Nothing
> If VarType(Result) = vbEmpty Then _
> Result = True
> CCRaiseEvent = Result
> End Function
> 'End CCRaiseEvent
>
> 'CCFormatError @0-21121FA6
> Function CCFormatError(Title, Errors)
> Dim Result, I
> Result = "<p><b>Source:</b> " & Title & "<br>"
> For I = 0 To Errors.Count - 1
> Result = Result & "<b>Error:</b> " & Errors.ErrorByNumber(I)
> Next
> Result = Result & "</p>"
> CCFormatError = Result
> End Function
> 'End CCFormatError
>
> 'CCOpenRS @0-9E4633EC
> Function CCOpenRS(RecordSet, SQL, Connection, ShowError)
> Dim ErrorMessage, Result
> Result = Empty
> Set RecordSet = Server.CreateObject("ADODB.Recordset")
> On Error Resume Next
> RecordSet.Open SQL, Connection, adOpenForwardOnly, adLockReadOnly,
> adCmdText
> ErrorMessage = CCProcessError(Connection)
> If NOT IsEmpty(ErrorMessage) Then
> If ShowError Then _
> Result = "SQL: " & CommandObject.CommandText & "<br>" &
"Error:
> " & ErrorMessage & "<br>" _
> Else _
> Result = "Database error.<br>"
> End If
> On Error Goto 0
> CCOpenRS = Result
> End Function
> 'End CCOpenRS
>
> 'CCOpenRSFromCmd @0-A2A33ECF
> Function CCOpenRSFromCmd(RecordSet, CommandObject, ShowError)
> Dim ErrorMessage, Result
> Result = Empty
> Set RecordSet = Server.CreateObject("ADODB.Recordset")
> On Error Resume Next
> RecordSet.CursorType = adOpenForwardOnly
> RecordSet.LockType = adLockReadOnly
> RecordSet.Open CommandObject
> ErrorMessage = CCProcessError(CommandObject.ActiveConnection)
> If NOT IsEmpty(ErrorMessage) Then
> If ShowError Then _
> Result = "SQL: " & CommandObject.CommandText & "<br>" &
"Error:
> " & ErrorMessage & "<br>" _
> Else _
> Result = "Database error.<br>"
> End If
> On Error Goto 0
> CCOpenRSFromCmd = Result
> End Function
> 'End CCOpenRSFromCmd
>
> 'CCExecCmd @0-3DC993D0
> Function CCExecCmd(CommandObject, ShowError)
> Dim ErrorMessage, Result
> Result = Empty
> On Error Resume Next
> CommandObject.Execute
> ErrorMessage = CCProcessError(CommandObject.ActiveConnection)
> If NOT IsEmpty(ErrorMessage) Then
> If ShowError Then _
> Result = "SQL: " & CommandObject.CommandText & "<br>" &
"Error:
> " & ErrorMessage & "<br>" _
> Else _
> Result = "Database error.<br>"
> End If
> On Error Goto 0
> CCExecCmd = Result
> End Function
> 'End CCExecCmd
>
> 'CCExecSQL @0-24CC2822
> Function CCExecSQL(SQL, Connection, ShowError)
> Dim ErrorMessage, Result
> Result = Empty
> On Error Resume Next
> Connection.Execute(SQL)
> ErrorMessage = CCProcessError(Connection)
> If NOT IsEmpty(ErrorMessage) Then
> If ShowError Then _
> Result = "SQL: " & SQL & "<br>" & "Error: " & ErrorMessage &
> "<br>" _
> Else _
> Result = "Database error.<br>"
> End If
> On Error Goto 0
> CCExecSQL = Result
> End Function
> 'End CCExecSQL
>
> 'CCToHTML @0-44D2E9F4
> Function CCToHTML(Value)
> If IsNull(Value) Then Value = ""
> CCToHTML = Server.HTMLEncode(Value)
> End Function
> 'End CCToHTML
>
> 'CCToURL @0-23A93674
> Function CCToURL(Value)
> If IsNull(Value) Then Value = ""
> CCToURL = Server.URLEncode(Value)
> End Function
> 'End CCToURL
>
> 'CCGetValueHTML @0-30C69AED
> Function CCGetValueHTML(RecordSet, FieldName)
> CCGetValueHTML = CCToHTML(CCGetValue(RecordSet, FieldName))
> End Function
> 'End CCGetValueHTML
>
> 'CCGetValue @0-C5915067
> Function CCGetValue(RecordSet, FieldName)
> Dim Result
> On Error Resume Next
> If RecordSet Is Nothing Then
> CCGetValue = Empty
> ElseIf (NOT RecordSet.EOF) AND (FieldName <> "") Then
> Result = RecordSet(FieldName)
> If IsNull(Result) Then _
> Result = Empty
> CCGetValue = Result
> Else
> CCGetValue = Empty
> End If
> On Error Goto 0
> End Function
> 'End CCGetValue
>
> 'CCGetDate @0-4102C01B
> Function CCGetDate(RecordSet, FieldName, arrDateFormat)
> Dim Result
> Result = CCGetValue(RecordSet, FieldName)
> If Not IsEmpty(arrDateFormat) Then
> If Not (VarType(Result) = vbDate OR VarType(Result) = vbEmpty) Then _
> If CCValidateDate(Result, arrDateFormat) Then _
> Result = CCParseDate(Result, arrDateFormat)
> End If
> CCGetDate = Result
> End Function
> 'End CCGetDate
>
> 'CCGetBoolean @0-C64EED38
> Function CCGetBoolean(RecordSet, FieldName, BooleanFormat)
> Dim Result
> Result = CCGetValue(RecordSet, FieldName)
> CCGetBoolean = CCParseBoolean(Result, BooleanFormat)
> End Function
> 'End CCGetBoolean
>
> 'CCGetParam @0-B1CC8211
> Function CCGetParam(ParameterName, DefaultValue)
> Dim ParameterValue : ParameterValue = ""
> If Request.QueryString(ParameterName).Count > 0 Then
> ParameterValue = Request.QueryString(ParameterName)
> ElseIf Request.Form(ParameterName).Count > 0 Then
> ParameterValue = Request.Form(ParameterName)
> Else
> ParameterValue = DefaultValue
> End If
> CCGetParam = ParameterValue
> End Function
> 'End CCGetParam
>
> 'CCGetFromPost @0-B27302B2
> Function CCGetFromPost(ParameterName, DefaultValue)
> Dim ParameterValue : ParameterValue = Empty
> ParameterValue = Request.Form(ParameterName)
> If IsEmpty(ParameterValue) Then _
> ParameterValue = DefaultValue
> CCGetFromPost = ParameterValue
> End Function
> 'End CCGetFromPost
>
> 'CCGetFromGet @0-F6BB8115
> Function CCGetFromGet(ParameterName, DefaultValue)
> Dim ParameterValue : ParameterValue = Empty
> ParameterValue = Request.QueryString(ParameterName)
> If IsEmpty(ParameterValue) Then _
> ParameterValue = DefaultValue
> CCGetFromGet = ParameterValue
> End Function
> 'End CCGetFromGet
>
> 'CCToSQL @0-CA2C324A
> Function CCToSQL(Value, ValueType)
> If CStr(Value) = "" OR IsEmpty(Value) Then
> CCToSQL = "Null"
> Else
> If ValueType = "Integer" or ValueType = "Float" Then
> CCToSQL = Replace(CDbl(Value), ",", ".")
> Else
> CCToSQL = "'" & Replace(Value, "'", "''") & "'"
> End If
> End If
> End Function
> 'End CCToSQL
>
> 'CCDLookUp @0-9125C206
> Function CCDLookUp(ColumnName, TableName, Where, Connection)
> Dim RecordSet
> Dim Result
> Dim SQL
> Dim ErrorMessage
> SQL = "SELECT " & ColumnName & " FROM " & TableName &
IIf(IsEmpty(Where),
> "", " WHERE " & Where)
> Set RecordSet = Connection.Execute(SQL)
> ErrorMessage = CCProcessError(Connection)
> If NOT IsEmpty(ErrorMessage) Then
> PrintDBError "CCDLookUp function", SQL, ErrorMessage
> End If
> On Error Goto 0
> Result = CCGetValue(RecordSet, 0)
> CCDLookUp = Result
> End Function
> 'End CCDLookUp
>
> 'PrintDBError @0-3D5DDA9A
> Sub PrintDBError(Source, SQL, ErrorMessage)
> Dim CommandText
> Dim SourceText
> Dim ErrorText
>
> If Source <> "" Then SourceText = "<b>Source:</b> " & Source & "<br>"
> If SQL <> "" Then CommandText = "<b>Command Text:</b> " & SQL & "<br>"
> If ErrorMessage <> "" Then ErrorText = "<b>Error description:</b> " &
> ErrorMessage & "</div>"
>
> Response.Write "<div style=""background-color: rgb(250, 250, 250); " & _
> "border: solid 1px rgb(200, 200, 200);"">" & SourceText
> Response.Write CommandText & ErrorText
> End Sub
> 'End PrintDBError
>
> 'CCGetCheckBoxValue @0-ABCF54E0
> Function CCGetCheckBoxValue(Value, CheckedValue, UncheckedValue,
ValueType)
> If isEmpty(Value) Then
> If UncheckedValue = "" Then
> CCGetCheckBoxValue = "Null"
> Else
> If ValueType = "Integer" or ValueType = "Float" Then
> CCGetCheckBoxValue = UncheckedValue
> Else
> CCGetCheckBoxValue = "'" & Replace(UncheckedValue, "'", "''") &
"'"
> End If
> End If
> Else
> If CheckedValue = "" Then
> CCGetCheckBoxValue = "Null"
> Else
> If ValueType = "Integer" OR ValueType = "Float" Then
> CCGetCheckBoxValue = CheckedValue
> Else
> CCGetCheckBoxValue = "'" & Replace(CheckedValue, "'", "''") & "'"
> End If
> End If
> End If
> End Function
> 'End CCGetCheckBoxValue
>
> 'CCGetValFromLOV @0-5041B9C1
> Function CCGetValFromLOV(Value, ListOfValues)
> Dim I
> Dim Result : Result = ""
> If (Ubound(ListOfValues) MOD 2) = 1 Then
> For I = 0 To Ubound(ListOfValues) Step 2
> If CStr(Value) = CStr(ListOfValues(I)) Then Result = ListOfValues(I
+
> 1)
> Next
> End If
> CCGetValFromLOV = Result
> End Function
> 'End CCGetValFromLOV
>
> 'CCProcessError @0-A3A2654C
> Function CCProcessError(Connection)
> If Connection.Errors.Count > 0 Then
> If TypeName(Connection) = "Connection" Then
> CCProcessError = Connection.Errors(0).Description & " (" &
> Connection.Errors(0).Source & ")"
> Else
> CCProcessError = Connection.Errors.ToString
> End If
> ElseIf NOT (Err.Description = "") Then
> CCProcessError = Err.Description
> Else
> CCProcessError = Empty
> End If
> end Function
> 'End CCProcessError
>
> 'CCGetRequestParam @0-C154AA52
> Function CCGetRequestParam(ParameterName, Method)
> Dim ParameterValue
>
> If Method = ccsGet Then
> ParameterValue = Request.QueryString(ParameterName)
> ElseIf Method = ccsPost Then
> ParameterValue = Request.Form(ParameterName)
> End If
> If CStr(ParameterValue) = "" Then _
> ParameterValue = Empty
>
> CCGetRequestParam = ParameterValue
> End Function
> 'End CCGetRequestParam
>
> 'CCGetQueryString @0-CBD7B22E
> Function CCGetQueryString(CollectionName, RemoveParameters)
> Dim QueryString, PostData
>
> If CollectionName = "Form" Then
> QueryString = CCCollectionToString(Request.Form, RemoveParameters)
> ElseIf CollectionName = "QueryString" Then
> QueryString = CCCollectionToString(Request.QueryString,
> RemoveParameters)
> ElseIf CollectionName = "All" Then
> QueryString = CCCollectionToString(Request.QueryString,
> RemoveParameters)
> PostData = CCCollectionToString(Request.Form, RemoveParameters)
> If Len(PostData) > 0 and Len(QueryString) > 0 Then _
> QueryString = QueryString & "&" & PostData _
> Else _
> QueryString = QueryString & PostData
> Else
> Err.Raise 1050, "Common Functions. CCGetQueryString Function", _
> "The CollectionName contains an illegal value."
> End If
>
> CCGetQueryString = QueryString
> End Function
> 'End CCGetQueryString
>
> 'CCCollectionToString @0-57CAA4B7
> Function CCCollectionToString(ParametersCollection, RemoveParameters)
> Dim ItemName, ItemValue, Result, Remove, I
>
> For Each ItemName In ParametersCollection
> Remove = false
> If IsArray(RemoveParameters) Then
> For I = 0 To UBound(RemoveParameters)
> If RemoveParameters(I) = ItemName Then
> Remove = True
> Exit For
> End If
> Next
> End If
> If Not Remove Then
> For Each ItemValue In ParametersCollection(ItemName)
> Result = Result & _
> "&" & ItemName & "=" & Server.URLEncode(ItemValue)
> Next
> End If
> Next
>
> If Len(Result) > 0 Then _
> Result = Mid(Result, 2)
> CCCollectionToString = Result
> End Function
> 'End CCCollectionToString
>
> 'CCAddZero @0-B5648418
> Function CCAddZero(Value, ResultLength)
> Dim CountZero, I
>
> CountZero = ResultLength - Len(Value)
> For I = 1 To CountZero
> Value = "0" & Value
> Next
> CCAddZero = Value
> End Function
> 'End CCAddZero
>
> 'CCGetAMPM @0-CB6EA5BF
> Function CCGetAMPM(HoursNumber, AnteMeridiem, PostMeridiem)
> If HoursNumber >= 0 And HoursNumber < 12 Then
> CCGetAMPM = AnteMeridiem
> Else
> CCGetAMPM = PostMeridiem
> End If
> End Function
> 'End CCGetAMPM
>
> 'CC12Hour @0-12B00AFF
> Function CC12Hour(HoursNumber)
> If HoursNumber = 0 Then
> HoursNumber = 12
> ElseIf HoursNumber > 12 Then
> HoursNumber = HoursNumber - 12
> End If
> CC12Hour = HoursNumber
> End Function
> 'End CC12Hour
>
> 'CCDBFormatByType @0-531721B5
> Function CCDBFormatByType(Variable)
> Dim Result
> If VarType(Variable) = vbString Then
> If LCase(Variable) = "null" Then
> Result = Variable
> Else
> Result = "'" & Variable & "'"
> End If
> Else
> Result = CStr(Variable)
> End If
> CCDBFormatByType = Result
> End Function
>
> 'End CCDBFormatByType
>
> 'CCFormatDate @0-9C44D5D4
> Function CCFormatDate(DateToFormat, FormatMask)
> Dim ResultArray(), I, Result
> If VarType(DateToFormat) = vbEmpty Then
> Result = Empty
> ElseIf VarType(DateToFormat) <> vbDate Then
> Err.Raise 4000, "CCFormatDate function. Type mismatch."
> ElseIf IsEmpty(FormatMask) Then
> Result = CStr(DateToFormat)
> Else
> ReDim ResultArray(UBound(FormatMask))
> For I = 0 To UBound(FormatMask)
> Select Case FormatMask(I)
> Case "d" ResultArray(I) = Day(DateToFormat)
> Case "w" ResultArray(I) = Weekday(DateToFormat)
> Case "m" ResultArray(I) = Month(DateToFormat)
> Case "q" ResultArray(I) = (Month(DateToFormat) + 3) \ 4
> Case "y" ResultArray(I) = (DateDiff("d", "1/1" & "/" &
> Year(DateToFormat), Month(DateToFormat) & "/" & Day(DateToFormat) & "/" &
> Year(DateToFormat)) + 1)
> Case "h" ResultArray(I) = CC12Hour(Hour(DateToFormat))
> Case "H" ResultArray(I) = Hour(DateToFormat)
> Case "n" ResultArray(I) = Minute(DateToFormat)
> Case "s" ResultArray(I) = Second(DateToFormat)
> Case "dd" ResultArray(I) = CCAddZero(Day(DateToFormat), 2)
> Case "ww" ResultArray(I) = (DateDiff("ww", "1/1" & "/" &
> Year(DateToFormat), Month(DateToFormat) & "/" & Day(DateToFormat) & "/" &
> Year(DateToFormat)) + 1)
> Case "mm" ResultArray(I) = CCAddZero(Month(DateToFormat), 2)
> Case "yy" ResultArray(I) = Right(Year(DateToFormat), 2)
> Case "hh" ResultArray(I) = CCAddZero(CC12Hour(Hour(DateToFormat)),
> 2)
> Case "HH" ResultArray(I) = CCAddZero(Hour(DateToFormat), 2)
> Case "nn" ResultArray(I) = CCAddZero(Minute(DateToFormat), 2)
> Case "ss" ResultArray(I) = CCAddZero(Second(DateToFormat), 2)
> Case "ddd" ResultArray(I) =
> CCSDateConstants.ShortWeekdays(Weekday(DateToFormat) - 1)
> Case "mmm" ResultArray(I) =
> CCSDateConstants.ShortMonths(Month(DateToFormat) - 1)
> Case "A/P" ResultArray(I) = CCGetAMPM(Hour(DateToFormat), "A",
"P")
> Case "a/p" ResultArray(I) = CCGetAMPM(Hour(DateToFormat), "a",
"p")
> Case "dddd" ResultArray(I) =
> CCSDateConstants.Weekdays(Weekday(DateToFormat) - 1)
> Case "mmmm" ResultArray(I) =
> CCSDateConstants.Months(Month(DateToFormat) - 1)
> Case "yyyy" ResultArray(I) = Year(DateToFormat)
> Case "AM/PM" ResultArray(I) = CCGetAMPM(Hour(DateToFormat), "AM",
> "PM")
> Case "am/pm" ResultArray(I) = CCGetAMPM(Hour(DateToFormat), "am",
> "pm")
> Case "LongDate" ResultArray(I) = FormatDateTime(DateToFormat,
> vbLongDate)
> Case "LongTime" ResultArray(I) = FormatDateTime(DateToFormat,
> vbLongTime)
> Case "ShortDate" ResultArray(I) = FormatDateTime(DateToFormat,
> vbShortDate)
> Case "ShortTime" ResultArray(I) = FormatDateTime(DateToFormat,
> vbShortTime)
> Case "GeneralDate" ResultArray(I) = FormatDateTime(DateToFormat,
> vbGeneralDate)
> Case Else
> If Left(FormatMask(I), 1) = "\" Then _
> ResultArray(I) = Mid(FormatMask(I), 1) _
> Else
> ResultArray(I) = FormatMask(I)
> End Select
> Next
> Result = Join(ResultArray, "")
> End If
> CCFormatDate = Result
> End Function
> 'End CCFormatDate
>
> 'CCFormatBoolean @0-635596FD
> Function CCFormatBoolean(BooleanValue, arrFormat)
> Dim Result, TrueValue, FalseValue, EmptyValue
>
> If IsEmpty(arrFormat) Then
> Result = CStr(BooleanValue)
> Else
> TrueValue = arrFormat(0)
> FalseValue = arrFormat(1)
> EmptyValue = arrFormat(2)
> If IsEmpty(BooleanValue) Then
> Result = EmptyValue
> Else
> If BooleanValue Then _
> Result = TrueValue _
> Else _
> Result = FalseValue
> End If
> End If
> CCFormatBoolean = Result
> End Function
> 'End CCFormatBoolean
>
> 'CCFormatNumber @0-67C259CA
> Function CCFormatNumber(NumberToFormat, FormatArray)
> Dim IsNegative
> Dim IsExtendedFormat, IsDecimalSeparator, DecimalSeparator,
> IsPeriodSeparator, PeriodSeparator
>
> If IsEmpty(NumberToFormat) Then
> CCFormatNumber = ""
> Exit Function
> End If
>
> If IsArray(FormatArray) Then
> IsExtendedFormat = FormatArray(0)
> IsNegative = (NumberToFormat < 0)
> NumberToFormat = ABS(NumberToFormat) * FormatArray(7)
>
> If IsExtendedFormat Then ' Extended format
> IsDecimalSeparator = FormatArray(1)
> DecimalSeparator = FormatArray(2)
> IsPeriodSeparator = FormatArray(3)
> PeriodSeparator = FormatArray(4)
>
> Dim BeforeDecimal, AfterDecimal
> Dim ObligatoryBeforeDecimal, DigitsBeforeDecimal,
> ObligatoryAfterDecimal, DigitsAfterDecimal
> Dim I, Z
> BeforeDecimal = FormatArray(5)
> AfterDecimal = FormatArray(6)
> If IsArray(BeforeDecimal) Then
> For I = 0 To UBound(BeforeDecimal)
> If BeforeDecimal(I) = "0" Then
> ObligatoryBeforeDecimal = ObligatoryBeforeDecimal + 1
> DigitsBeforeDecimal = DigitsBeforeDecimal + 1
> ElseIf BeforeDecimal(I) = "#" Then
> DigitsBeforeDecimal = DigitsBeforeDecimal + 1
> End If
> Next
> End If
> If IsArray(AfterDecimal) Then
> For I = 0 To UBound(AfterDecimal)
> If AfterDecimal(I) = "0" Then
> ObligatoryAfterDecimal = ObligatoryAfterDecimal + 1
> DigitsAfterDecimal = DigitsAfterDecimal + 1
> ElseIf AfterDecimal(I) = "#" Then
> DigitsAfterDecimal = DigitsAfterDecimal + 1
> End If
> Next
> End If
>
> Dim NumDigitsAfterDecimal, Result, DefaultValue
> If ObligatoryAfterDecimal = 0 And DigitsAfterDecimal = 1 Then
> NumDigitsAfterDecimal = -1
> ElseIf Not IsDecimalSeparator Then
> NumDigitsAfterDecimal = 0
> Else
> NumDigitsAfterDecimal = DigitsAfterDecimal
> End If
> NumberToFormat = FormatNumber(NumberToFormat, DigitsAfterDecimal,
> False, False, False)
>
> Dim DefaultDecimal : DefaultDecimal = Mid(FormatNumber(10001/10, 1,
> True, False, True), 6, 1)
> Dim LeftPart, RightPart
> If Not InStr(CStr(NumberToFormat), DefaultDecimal) = 0 Then
> Dim NumberParts : NumberParts = Split(CStr(NumberToFormat),
> DefaultDecimal)
> LeftPart = CStr(NumberParts(0))
> RightPart = CStr(NumberParts(1))
> Else
> LeftPart = CStr(NumberToFormat)
> End If
>
> Dim J : J = Len(LeftPart)
>
> If IsDecimalSeparator And DecimalSeparator = "" Then
> DefaultValue = CStr(FormatNumber(10001/10, 1, True, False, True))
> DecimalSeparator = Mid(DefaultValue, 6, 1)
> End If
>
> If IsPeriodSeparator And PeriodSeparator = "" Then
> DefaultValue = CStr(FormatNumber(10001/10, 1, True, False, True))
> PeriodSeparator = Mid(DefaultValue, 2, 1)
> End If
>
> If IsArray(BeforeDecimal) Then
> Dim RankNumber : RankNumber = 0
> For I = UBound(BeforeDecimal) To 0 Step -1
> If BeforeDecimal(i) = "#" Or BeforeDecimal(i) = "0" Then
> If DigitsBeforeDecimal = 1 And J > 1 Then
> If Not IsPeriodSeparator Then
> Result = Left(LeftPart, j) & Result
> Else
> For z = J To 1 Step -1
> RankNumber = RankNumber + 1
> If RankNumber Mod 3 = 1 And RankNumber - 3 > 0 Then
> Result = Mid(LeftPart, z, 1) & PeriodSeparator &
Result
> Else
> Result = Mid(LeftPart, z, 1) & Result
> End If
> Next
> End If
> ElseIf J > 0 Then
> RankNumber = RankNumber + 1
> If RankNumber Mod 3 = 1 And RankNumber - 3 > 0 And
> IsPeriodSeparator Then
> Result = Mid(LeftPart, j, 1) & PeriodSeparator & Result
> Else
> Result = Mid(LeftPart, j, 1) & Result
> End If
> J = J - 1
> ObligatoryBeforeDecimal = ObligatoryBeforeDecimal - 1
> DigitsBeforeDecimal = DigitsBeforeDecimal - 1
> Else
> If ObligatoryBeforeDecimal > 0 Then
> RankNumber = RankNumber + 1
> If RankNumber Mod 3 = 1 And RankNumber - 3 > 0 And
> IsPeriodSeparator Then
> Result = "0" & PeriodSeparator & Result
> Else
> Result = "0" & Result
> End If
> ObligatoryBeforeDecimal = ObligatoryBeforeDecimal - 1
> DigitsBeforeDecimal = DigitsBeforeDecimal - 1
> End If
> End If
> Else
> BeforeDecimal(I) = Replace(BeforeDecimal(I), "##", "#")
> BeforeDecimal(I) = Replace(BeforeDecimal(I), "00", "0")
> Result = BeforeDecimal(I) & Result
> End If
> Next
> End If
>
> ' Left part after decimal
> Dim RightResult : RightResult = ""
> If IsArray(AfterDecimal) Then
> Dim IsZero : IsZero = True
> For I = UBound(AfterDecimal) To 0 Step -1
> If AfterDecimal(I) = "#" Or AfterDecimal(I) = "0" Then
> If DigitsAfterDecimal > ObligatoryAfterDecimal Then
> If Not Mid(RightPart, DigitsAfterDecimal, 1) = "0" Then
IsZero
> = False
> If Not IsZero Then _
> RightResult = Mid(RightPart, DigitsAfterDecimal, 1) &
> RightResult
> DigitsAfterDecimal = DigitsAfterDecimal - 1
> Else
> RightResult = Mid(RightPart, DigitsAfterDecimal, 1) &
> RightResult
> DigitsAfterDecimal = DigitsAfterDecimal - 1
> End If
> Else
> AfterDecimal(I) = Replace(AfterDecimal(I), "##", "#")
> AfterDecimal(I) = Replace(AfterDecimal(I), "00", "0")
> RightResult = AfterDecimal(I) & RightResult
> End If
> Next
> End If
>
> If IsDecimalSeparator AND Len(RightResult) > 0 Then _
> Result = Result & DecimalSeparator & RightResult
>
> If NOT FormatArray(10) AND IsNegative Then _
> Result = "-" & Result
>
> Result = Result & RightResult
> Else ' Simple format
> If Not FormatArray(3) AND IsNegative Then _
> Result = "-" & FormatArray(5) & FormatNumber(NumberToFormat,
> FormatArray(1), FormatArray(2), False, FormatArray(4)) & FormatArray(6) _
> Else _
> Result = FormatArray(5) & FormatNumber(NumberToFormat,
> FormatArray(1), FormatArray(2), False, FormatArray(4)) & FormatArray(6)
> End If
> If Not FormatArray(8) Then Result = Server.HTMLEncode(Result)
> If Not CStr(FormatArray(9)) = "" Then _
> Result = "<FONT COLOR=""" & FormatArray(9) & """>" & Result &
> "</FONT>"
> Else
> Result = NumberToFormat
> End If
> CCFormatNumber = Result
>
> End Function
> 'End CCFormatNumber
>
> 'CCParseBoolean @0-33711A62
> Function CCParseBoolean(Value, FormatMask)
> Dim Result
> Result = Empty
> If VarType(Value) = vbBoolean Then
> Result = Value
> Else
> If IsEmpty(FormatMask) Then
> Result = CBool(Value)
> Else
> If IsEmpty(Value) Then
> If CStr(FormatMask(0)) = "null" Then _
> Result = True
> If CStr(FormatMask(1)) = "null" Then _
> Result = False
> Else
> If CStr(Value) = CStr(FormatMask(0)) Then
> Result = True
> ElseIf CStr(Value) = CStr(FormatMask(1)) Then
> Result = False
> End If
> End If
> End If
> End If
> CCParseBoolean = Result
> End Function
> 'End CCParseBoolean
>
> 'CCParseDate @0-0D3D1ED4
> Function CCParseDate(ParsingDate, FormatMask)
> Dim ResultDate, ResultDateArray(8)
> Dim MaskPart, MaskLength, TokenLength
> Dim IsError
> Dim DatePosition, MaskPosition
> Dim Delimiter, BeginDelimiter
> Dim MonthNumber, MonthName, MonthArray
> Dim DatePart
>
> Dim IS_DATE_POS, YEAR_POS, MONTH_POS, DAY_POS, IS_TIME_POS, HOUR_POS,
> MINUTE_POS, SECOND_POS
>
> IS_DATE_POS = 0 : YEAR_POS = 1 : MONTH_POS = 2 : DAY_POS = 3
> IS_TIME_POS = 4 : HOUR_POS = 5 : MINUTE_POS = 6 : SECOND_POS = 7
>
>
> If IsEmpty(FormatMask) Then
> If CStr(ParsingDate) = "" Then _
> ResultDate = Empty _
> Else _
> ResultDate = CDate(ParsingDate)
> ElseIf (FormatMask(0) = "GeneralDate" Or FormatMask(0) = "LongDate" _
> Or FormatMask(0) = "ShortDate" Or FormatMask(0) = "LongTime" _
> Or FormatMask(0) = "ShortTime") And Not CStr(ParsingDate) = "" Then
> ResultDate = CDate(ParsingDate)
> ElseIf CStr(ParsingDate) = "" Then
> ResultDate = Empty
> Else
> DatePosition = 1
> MaskPosition = 0
> MaskLength = UBound(FormatMask)
> IsError = False
>
> ' Default date
> ResultDateArray(IS_DATE_POS) = False
> ResultDateArray(IS_TIME_POS) = False
> ResultDateArray(YEAR_POS) = 0 : ResultDateArray(MONTH_POS) = 12 :
> ResultDateArray(DAY_POS) = 1
> ResultDateArray(HOUR_POS) = 0 : ResultDateArray(MINUTE_POS) = 0 :
> ResultDateArray(SECOND_POS) = 0
>
> While (MaskPosition <= MaskLength) AND NOT IsError
> MaskPart = FormatMask(MaskPosition)
> If CCSDateConstants.DateMasks.Exists(MaskPart) Then
> TokenLength = CCSDateConstants.DateMasks(MaskPart)
> If TokenLength > 0 Then
> DatePart = Mid(ParsingDate, DatePosition, TokenLength)
> DatePosition = DatePosition + TokenLength
> Else
> If MaskPosition < MaskLength Then
> Delimiter = FormatMask(MaskPosition + 1)
> BeginDelimiter = InStr(DatePosition, ParsingDate, Delimiter)
> If BeginDelimiter = 0 Then
> Err.Raise 4000, "ParseDate function: The number doesn't
match
> the mask."
> Else
> DatePart = Mid(ParsingDate, DatePosition, BeginDelimiter -
> DatePosition)
> DatePosition = BeginDelimiter
> End If
> Else
> DatePart = Mid(ParsingDate, DatePosition)
> End If
> End If
> Select Case MaskPart
> Case "d", "dd"
> ResultDateArray(DAY_POS) = CInt(DatePart)
> ResultDateArray(IS_DATE_POS) = True
> Case "m", "mm"
> ResultDateArray(MONTH_POS) = CInt(DatePart)
> ResultDateArray(IS_DATE_POS) = True
> Case "mmm", "mmmm"
> MonthNumber = 0
> MonthName = UCase(DatePart)
> If MaskPart = "mmm" Then _
> MonthArray = CCSDateConstants.ShortMonths _
> Else _
> MonthArray = CCSDateConstants.Months
> While MonthNumber < 11 AND UCase(MonthArray(MonthNumber)) <>
> MonthName
> MonthNumber = MonthNumber + 1
> Wend
> If MonthNumber = 11 Then
> If UCase(MonthArray(11)) <> MonthName Then _
> Err.Raise 4000, "ParseDate function: The number doesn't
> match the mask."
> End If
> ResultDateArray(MONTH_POS) = MonthNumber + 1
> ResultDateArray(IS_DATE_POS) = True
> Case "yy", "yyyy"
> ResultDateArray(YEAR_POS) = CInt(DatePart)
> ResultDateArray(IS_DATE_POS) = True
> Case "h", "hh"
> If CInt(DatePart) = 12 Then _
> ResultDateArray(HOUR_POS) = 0 _
> Else _
> ResultDateArray(HOUR_POS) = CInt(DatePart)
> ResultDateArray(IS_TIME_POS) = True
> Case "H", "HH"
> ResultDateArray(HOUR_POS) = CInt(DatePart)
> ResultDateArray(IS_TIME_POS) = True
> Case "n", "nn"
> ResultDateArray(MINUTE_POS) = CInt(DatePart)
> ResultDateArray(IS_TIME_POS) = True
> Case "s", "ss"
> ResultDateArray(SECOND_POS) = CInt(DatePart)
> ResultDateArray(IS_TIME_POS) = True
> Case "am/pm", "a/p", "AM/PM", "A/P"
> If Left(LCase(DatePart), 1) = "p" Then
> ResultDateArray(HOUR_POS) = ResultDateArray(HOUR_POS) + 12
> ElseIf Left(LCase(DatePart), 1) = "a" Then
> ResultDateArray(HOUR_POS) = ResultDateArray(HOUR_POS)
> End If
> ResultDateArray(IS_TIME_POS) = True
> Case "w", "q"
> ' Do Nothing
> End Select
> Else
> DatePosition = DatePosition + Len(FormatMask(MaskPosition))
> End If
> MaskPosition = MaskPosition + 1
> Wend
> If ResultDateArray(IS_TIME_POS) AND ResultDateArray(IS_TIME_POS) Then
> ResultDate = DateSerial(ResultDateArray(YEAR_POS),
> ResultDateArray(MONTH_POS), ResultDateArray(DAY_POS)) _
> + TimeSerial(ResultDateArray(HOUR_POS),
ResultDateArray(MINUTE_POS),
> ResultDateArray(SECOND_POS))
> ElseIf ResultDateArray(IS_TIME_POS) Then
> ResultDate = TimeSerial(ResultDateArray(HOUR_POS),
> ResultDateArray(MINUTE_POS), ResultDateArray(SECOND_POS))
> ElseIf ResultDateArray(IS_DATE_POS) Then
> ResultDate = DateSerial(ResultDateArray(YEAR_POS),
> ResultDateArray(MONTH_POS), ResultDateArray(DAY_POS))
> End If
> End If
> CCParseDate = ResultDate
> End Function
> 'End CCParseDate
>
> 'CCParseNumber @0-BDE16F1E
> Function CCParseNumber(NumberValue, FormatArray, DataType)
> Dim Result, NumberValueType
> NumberValueType = VarType(NumberValue)
> If NumberValueType = vbInteger OR NumberValueType = vbLong _
> OR NumberValueType = vbSingle OR NumberValueType = vbSingle _
> OR NumberValueType = vbCurrency OR NumberValueType = vbDecimal _
> OR NumberValueType = vbByte Then
> If DataType = ccsInteger Then
> Result = CLng(NumberValue)
> ElseIf DataType = ccsFloat Then
> Result = CDbl(NumberValue)
> End If
> Else
> If Not CStr(NumberValue) = "" Then
> Dim DefaultValue, DefaultDecimal
> Dim DecimalSeparator, PeriodSeparator
> DecimalSeparator = "" : PeriodSeparator = ""
> If IsArray(FormatArray) Then
> If FormatArray(0) Then
> DecimalSeparator = FormatArray(2)
> PeriodSeparator = FormatArray(4)
> End If
> End If
> If Not CStr(DecimalSeparator) = "" Then
> DefaultValue = CStr(FormatNumber(10001/10, 1, True, False, True))
> DefaultDecimal = Mid(DefaultValue, 6, 1)
> NumberValue = Replace(NumberValue, DecimalSeparator,
DefaultDecimal)
> End If
> If Not CStr(PeriodSeparator) = "" Then NumberValue =
> Replace(NumberValue, PeriodSeparator, "")
> If DataType = ccsInteger Then
> Result = CLng(NumberValue)
> ElseIf DataType = ccsFloat Then
> Result = CDbl(NumberValue)
> End If
> Else
> Result = Empty
> End If
> End If
> CCParseNumber = Result
> End Function
> 'End CCParseNumber
>
> 'CCParseInteger @0-42815927
> Function CCParseInteger(NumberValue, FormatArray)
> CCParseInteger = CCParseNumber(NumberValue, FormatArray, ccsInteger)
> End Function
> 'End CCParseInteger
>
> 'CCParseFloat @0-56667DF0
> Function CCParseFloat(NumberValue, FormatArray)
> CCParseFloat = CCParseNumber(NumberValue, FormatArray, ccsFloat)
> End Function
> 'End CCParseFloat
>
> 'CCValidateDate @0-D0BEB752
> Function CCValidateDate(ValidatingDate, FormatMask)
> Dim MaskPosition, I, Result, OneChar, IsSeparator
> Dim RegExpPattern, RegExpObject, Matches
>
> IsSeparator = False
>
> If ValidatingDate = "" OR IsEmpty(ValidatingDate) Then
> Result = True
> ElseIf IsEmpty(FormatMask) Then
> Result = IsDate(ValidatingDate)
> ElseIf FormatMask(0) = "GeneralDate" Or FormatMask(0) = "LongDate" _
> Or FormatMask(0) = "ShortDate" Or FormatMask(0) = "LongTime" _
> Or FormatMask(0) = "ShortTime" Then
> Result = IsDate(ValidatingDate)
> Else
> For MaskPosition = 0 To UBound(FormatMask)
> If NOT IsSeparator Then
> Select Case FormatMask(MaskPosition)
> Case "d", "m", "h", "n", "s", "w", "q", "H"
> RegExpPattern = RegExpPattern + "\d{1,2}.+"
> IsSeparator = True
> Case "dd", "mm", "yy", "hh", "nn", "ss", "HH"
> RegExpPattern = RegExpPattern + "\d{2}"
> Case "yyyy"
> RegExpPattern = RegExpPattern + "\d{4}"
> Case "mmm"
> RegExpPattern = RegExpPattern + "(" &
> Join(CCSDateConstants.ShortMonths, "|") & ")"
> Case "mmmm"
> RegExpPattern = RegExpPattern + "(" &
> Join(CCSDateConstants.Months, "|") & ")"
> Case "am/pm"
> RegExpPattern = RegExpPattern + "[ap]m"
> Case "AM/PM"
> RegExpPattern = RegExpPattern + "[AP]M"
> Case "a/p"
> RegExpPattern = RegExpPattern + "[ap]"
> Case "A/P"
> RegExpPattern = RegExpPattern + "[AP]"
> Case Else
> For I = 1 To Len(FormatMask(MaskPosition))
> OneChar = Mid(FormatMask(MaskPosition), I, 1)
> If InStr("bBdDfnrsStvwW\", OneChar) = 0 Then _
> OneChar = "\" + OneChar
> RegExpPattern = RegExpPattern + OneChar
> Next
> End Select
> Else
> IsSeparator = False
> For I = 2 To Len(FormatMask(MaskPosition))
> OneChar = Mid(FormatMask(MaskPosition), I, 1)
> If InStr("bBdDfnrsStvwW\", OneChar) = 0 Then _
> OneChar = "\" + OneChar
> RegExpPattern = RegExpPattern + OneChar
> Next
> End If
> Next
> Set RegExpObject = New RegExp
> RegExpObject.IgnoreCase = False
> RegExpObject.Global = True
> RegExpObject.Pattern = RegExpPattern
> Set Matches = RegExpObject.Execute(ValidatingDate)
> Result = CBool(Matches.Count = 1)
> Set Matches = Nothing
> Set RegExpObject = Nothing
> End If
> CCValidateDate = Result
> End Function
> 'End CCValidateDate
>
> 'CCValidateNumber @0-08089509
> Function CCValidateNumber(NumberValue, FormatArray)
> Dim Result, NumberValueType
> NumberValueType = VarType(NumberValue)
> If NumberValueType = vbInteger OR NumberValueType = vbLong _
> OR NumberValueType = vbSingle OR NumberValueType = vbSingle _
> OR NumberValueType = vbCurrency OR NumberValueType = vbDecimal _
> OR NumberValueType = vbByte Then
> Result = True
> Else
> If Not CStr(NumberValue) = "" Then
> Dim DefaultValue, DefaultDecimal
> Dim DecimalSeparator, PeriodSeparator
> DecimalSeparator = "" : PeriodSeparator = ""
> If IsArray(FormatArray) Then
> If FormatArray(0) Then
> DecimalSeparator = FormatArray(2)
> PeriodSeparator = FormatArray(4)
> End If
> End If
> If Not CStr(DecimalSeparator) = "" Then
> DefaultValue = CStr(FormatNumber(10001/10, 1, True, False, True))
> DefaultDecimal = Mid(DefaultValue, 6, 1)
> NumberValue = Replace(NumberValue, DecimalSeparator,
DefaultDecimal)
> End If
> If Not CStr(PeriodSeparator) = "" Then NumberValue =
> Replace(NumberValue, PeriodSeparator, "")
> Result = IsNumeric(NumberValue)
> Else
> Result = True
> End If
> End If
> CCValidateNumber = Result
> End Function
> 'End CCValidateNumber
>
> 'CCValidateBoolean @0-B8DE2060
> Function CCValidateBoolean(Value, FormatMask)
> Dim Result: Result = False
>
> If VarType(Value) = vbBoolean Then
> Result = True
> Else
> If IsEmpty(FormatMask) Then
> On Error Resume Next
> Result = CBool(Value)
> Result = Not(Err > 0)
> Else
> If IsEmpty(Value) Or CStr(Value) = "" Then
> Result = (CStr(FormatMask(0)) = "null") Or (CStr(FormatMask(0)) =
> "Undefined") Or (CStr(FormatMask(0)) = "")
> Result = Result Or (CStr(FormatMask(1)) = "null") Or
> (CStr(FormatMask(1)) = "Undefined") Or (CStr(FormatMask(1)) = "")
> If UBound(FormatMask) = 2 Then _
> Result = Result Or (CStr(FormatMask(2)) = "null") Or
> (CStr(FormatMask(2)) = "Undefined") Or (CStr(FormatMask(2)) = "")
> Else
> Result = (CStr(Value) = CStr(FormatMask(0))) Or (CStr(Value) =
> CStr(FormatMask(1)))
> If UBound(FormatMask) = 2 Then _
> Result = Result Or (CStr(Value) = CStr(FormatMask(2)))
> End If
> End If
> End If
> CCValidateBoolean = Result
> End Function
> 'End CCValidateBoolean
>
> 'CCAddParam @0-6D59DAA5
> Function CCAddParam(QueryString, ParameterName, ParameterValue)
> Dim Result
>
> Result = Replace("&" & QueryString, "&" & ParameterName & "=" &
> Server.URLEncode(Request.QueryString(ParameterName)), "")
> Result = Result & "&" & ParameterName & "=" &
> Server.URLEncode(ParameterValue)
> Result = Replace(Result, "&&", "&")
> If Left(Result, 1) = "&" Then Result = Mid(Result, 2)
> CCAddParam = Result
> End Function
> 'End CCAddParam
>
> 'CCRemoveParam @0-64B4FAAF
> Function CCRemoveParam(QueryString, ParameterName)
> Dim Result
> Result = Replace(QueryString, ParameterName & "=" &
> Server.URLEncode(Request.QueryString(ParameterName)), "")
> Result = Replace(Result, "&&", "&")
> If Left(Result, 1) = "&" Then Result = Mid(Result, 2)
> CCRemoveParam = Result
> End Function
> 'End CCRemoveParam
>
> 'CCRegExpTest @0-9EAA5A2D
> Function CCRegExpTest(TestValue, RegExpMask, IgnoreCase, GlobalTest)
> Dim Result
> If Not CStr(TestValue) = "" Then
> Dim RegExpObject
> Set RegExpObject = New RegExp
> RegExpObject.Pattern = RegExpMask
> RegExpObject.IgnoreCase = IgnoreCase
> RegExpObject.Global = GlobalTest
> Result = RegExpObject.Test(CStr(TestValue))
> Set RegExpObject = Nothing
> Else
> Result = True
> End If
> CCRegExpTest = Result
> End Function
>
>
> 'End CCRegExpTest
>
> 'CCRegExpTest @0-4BE3AE1D
> Sub CheckSSL()
> If Not UCase(Request.ServerVariables("HTTPS")) = "ON" Then
> Response.Write "SSL connection error. This page can be accessed only
via
> secured connection."
> Response.End
> End If
> End Sub
>
> 'End CCRegExpTest
>
> 'CCGetUserLogin @0-4306ED6C
> Function CCGetUserLogin()
> CCGetUserLogin = Session("UserLogin")
> End Function
> 'End CCGetUserLogin
>
> 'CCSecurityRedirect @0-790A88DF
> Sub CCSecurityRedirect(GroupsAccess, URL)
> Dim ErrorType
> Dim Link
> ErrorType = CCSecurityAccessCheck(GroupsAccess)
> If NOT (ErrorType = "success") Then
> If IsEmpty(URL) Then _
> Link = ServerURL & "Login.asp" _
> Else _
> Link = URL
> Response.Redirect(Link & "?ret_link=" & _
> Server.URLEncode(Request.ServerVariables("SCRIPT_NAME") & _
> "?" & CCRemoveParam(Request.ServerVariables("QUERY_STRING"),
> "ccsForm")) & "&type=" & ErrorType)
> End If
> End Sub
> 'End CCSecurityRedirect
>
> 'CCGetUserID @0-449B3B19
> Function CCGetUserID()
> CCGetUserID = Session("UserID")
> End Function
> 'End CCGetUserID
>
> 'CCSecurityAccessCheck @0-8A7701BE
> Function CCSecurityAccessCheck(GroupsAccess)
> Dim ErrorType
> Dim GroupID
> ErrorType = "success"
> If IsEmpty(CCGetUserID()) Then
> ErrorType = "notLogged"
> Else
> GroupID = CCGetGroupID()
> If IsEmpty(GroupID) Then
> ErrorType = "groupIDNotSet"
> Else
> If NOT CCUserInGroups(GroupID, GroupsAccess) Then
> ErrorType = "illegalGroup"
> End If
> End If
> End If
> CCSecurityAccessCheck = ErrorType
> End Function
> 'End CCSecurityAccessCheck
>
> 'CCGetGroupID @0-B2650479
> Function CCGetGroupID()
> CCGetGroupID = Session("GroupID")
> End Function
> 'End CCGetGroupID
>
> 'CCUserInGroups @0-4332AEA7
> Function CCUserInGroups(GroupID, GroupsAccess)
> Dim Result
> Dim GroupNumber
> If NOT IsEmpty(GroupsAccess) Then
> GroupNumber = CLng(GroupID)
> While NOT Result AND GroupNumber > 0
> Result = NOT (InStr(";" & GroupsAccess & ";", ";" & GroupNumber & ";") =
0)
> GroupNumber = GroupNumber - 1
> Wend
> Else
> Result = True
> End If
> CCUserInGroups = Result
> End Function
> 'End CCUserInGroups
>
> 'CCLoginUser @0-6D3FEC5B
> Function CCLoginUser(Login, Password)
> Dim Result
> Dim SQL
> Dim RecordSet
> Dim Connection
>
> Set Connection = New clsDBConnection1
> Connection.Open
> SQL = "SELECT id_empleado, group FROM Empleados WHERE emp_login='" &
> Replace(Login, "'", "''") & "' AND emp_password='" & Replace(Password,
"'",
> "''") & "'"
> Set RecordSet = Connection.Execute(SQL)
> Result = NOT RecordSet.EOF
> If Result Then
> Session("UserID") = RecordSet("id_empleado")
> Session("UserLogin") = Login
> Session("GroupID") = RecordSet("group")
> End If
> RecordSet.Close
> Set RecordSet = Nothing
> Connection.Close
> Set Connection = Nothing
> CCLoginUser = Result
> End Function
> 'End CCLoginUser
>
> 'CCLogoutUser @0-DB93CE50
> Sub CCLogoutUser()
> Session("UserID") = Empty
> Session("UserLogin") = Empty
> Session("GroupID") = Empty
> End Sub
> 'End CCLogoutUser
>
>
> %>
>
> Any help will be greatly appreciated...
>
>
>
>
> "Pepito" <dfga@kk.com> wrote in message
>news:b44qfl$ltg$1@news.codecharge.com...
> > Hello Everyone, I uploaded a css project (that runs great on IIS at my
> > machine) to a free server (brinkster). I can properly see on a browser
> > *.html files but not the same file *.asp....error 500...
> >
> > any hint?
> >
> > check it out at
> http://www10.brinkster.com/mariosbm/code/Empleados_list.html
> > http://www10.brinkster.com/mariosbm/code/Empleados_list.asp
> >
> > your help is greatly appreciated...I 'not a programmer but would like to
> set
> > a site of this kind
> >
> > Thanks
> >
> >
> >
>
>
begin 666 getpath.asp
M/&AT;6P^#0H\:&5A9#X-"CPO:&5A9#X-"CQB;V1Y/@T*/"4-"G)E<W!O;G-E
M+G=R:71E(%-E<G9E<BY-87!0871H*")G971P871H+F%S<"(I#0HE/@T*/"]B
/;V1Y/@T*/"]H=&UL/@T*
`
end
|
|
|
|
Pepito
|
| Posted: 03/05/2003, 8:29 AM |
|
Sorry, Outlook does not allow me to see the attachment because it is
"potentially" unsafe...could you please zip or rar it?
Anyway, as the brinkers site is not good for uploading, I am trying
everything at this server..
the database is here
http://mariosbm.www4.dotnetplayground.com/code/GardenCo.mdb
the page is here
http://mariosbm.www4.dotnetplayground.com/code/Empleados_list.asp (you can
see the html here
http://mariosbm.www4.dotnetplayground.com/code/Empleados_list.html)
Thanks for your help!!!!
"NetFocus.biz" <amcfayen@netfocus.biz> wrote in message
news:b457e6$ipc$1@news.codecharge.com...
> Hi
>
> You need to know the file path to the database. You can find this out
using
> the server.mappath method. You can take the attached small file and copy
it
> to the same folder as your database, then go to
> http://www10.brinkster.com/mariosbm/code/getpath.asp
>
> you should then see a result like this in your browser:
>
> c:\inetpub\wwwroot\test\getpath.asp
>
> which will tell you how to refer to the database in Common.asp (in this
case
> c:\inetpub\wwwroot\test\GardenCo.mdb).
>
> Hope this helps
>
> Alistair
>
>
>
> --
> Managing Director
> NetFocus Solutions Ltd
> 2 Cockburn Place
> Riverside Business Park
> Irvine, Ayrshire, KA11 5DA
> Tel: +44 (0) 1294 318701
> Fax: +44 (0) 1294 316580
> Internet: www.netfocus.biz
>
> "Pepito" <pepitxispi@yahoo.com> wrote in message
>news:b4568c$fu3$1@news.codecharge.com...
> > Thanks for your responses:
> >
> > 1) I already turn off the friendly error showing,
> > 2) I am playing with changing the path as Alistair kindly suggested..
> >
> > However, I am messing the code ...
> > well....the database is here
> > http://mariosbm.www4.dotnetplayground.com/code/GardenCo.mdb
> > the page is here
> > http://mariosbm.www4.dotnetplayground.com/code/Empleados_list.asp (you
can
> > see the html here
> > http://mariosbm.www4.dotnetplayground.com/code/Empleados_list.html)
> > so, if the problem is here:
> > "Microsoft JET Database Engine error '80004005'
> >
> > 'C:\Documents and Settings\M\My Documents\web solutions\New
> > Folder\NewProject6\GardenCo.mdb' is not a valid path. Make sure that the
> > path name is spelled correctly and that you are connected to the server
on
> > which the file resides.
> >
> > /mariosbm/code/Common.asp, line 117"
> >
> > Should I write instead of C:\...etc this: \code\GardenCo.mdb ?? that is
> not
> > working also....
> >
> > here is the old code:
> >
> > <%
> > Option Explicit
> >
> > 'Include Files @0-0F8FBEEB
> > %>
> > <!-- #INCLUDE FILE="Adovbs.asp" -->
> > <!-- #INCLUDE FILE="Classes.asp" -->
> > <%
> > 'End Include Files
> >
> > 'Script Engine Version Check @0-A118D8E9
> > If ScriptEngineMajorVersion < 5 Then
> > Response.Write "Sorry. This program requires VBScript 5.1 to
> run.<br>You
> > may upgrade your VBScript at
> > http://www.microsoft.com/msdownload/vbscript/scripting.asp.";
> > Response.End
> > Else
> > If ScriptEngineMajorVersion & ":" & ScriptEngineMinorVersion = "5:0"
> > Then
> > Response.Write "Due to a bug in VBScript 5.0, this program would
> > crash your server. See
> > http://support.microsoft.com/default.aspx?scid=kb;EN-US...<br>"; &
_
> > "Upgrade your VBScript at
> > http://www.microsoft.com/msdownload/vbscript/scripting.asp.";
> > Response.End
> > End If
> > End If
> > 'End Script Engine Version Check
> >
> > 'Initialize Common Variables @0-EB7D5995
> > Dim CCSDateConstants
> > Dim ServerURL
> > Dim SecureURL
> > Dim TemplatesRepository
> > Dim EventCaller
> >
> > Set TemplatesRepository = New clsCache_FileSystem
> > ServerURL = "http://localhost/NewProject5/"
> > Set CCSDateConstants = New clsCCSDateConstants
> >
> > Class clsCCSDateConstants
> >
> > Public Weekdays
> > Public ShortWeekdays
> > Public Months
> > Public ShortMonths
> > Public DateMasks
> >
> > Private Sub Class_Initialize()
> > ShortWeekdays = Array("Sun", "Mon", "Tue", "Wed", "Thu", "Fri",
> > "Sat")
> > Weekdays = Array("Sunday", "Monday", "Tuesday", "Wednesday",
> > "Thursday", "Friday", "Saturday")
> > ShortMonths = Array("Jan", "Feb", "Mar", "Apr", "May", "Jun",
> > "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")
> > Months = Array("January", "February", "March", "April", "May",
> > "June", "July", "August", "September", "October", "November",
"December")
> > Set DateMasks = CreateObject("Scripting.Dictionary")
> > DateMasks("d") = 0
> > DateMasks("dd") = 2
> > DateMasks("m") = 0
> > DateMasks("mm") = 2
> > DateMasks("mmm") = 3
> > DateMasks("mmmm") = 0
> > DateMasks("yy") = 2
> > DateMasks("yyyy") = 4
> > DateMasks("h") = 0
> > DateMasks("hh") = 2
> > DateMasks("H") = 0
> > DateMasks("HH") = 2
> > DateMasks("n") = 0
> > DateMasks("nn") = 2
> > DateMasks("s") = 0
> > DateMasks("ss") = 2
> > DateMasks("am/pm") = 2
> > DateMasks("AM/PM") = 2
> > DateMasks("A/P") = 1
> > DateMasks("a/p") = 1
> > DateMasks("w") = 0
> > DateMasks("q") = 0
> > End Sub
> >
> > Private Sub Class_Terminate()
> > Set DateMasks = Nothing
> > End Sub
> >
> > End Class
> >
> > Const ccsInteger = 1
> > Const ccsFloat = 2
> > Const ccsText = 3
> > Const ccsDate = 4
> > Const ccsBoolean = 5
> > Const ccsMemo = 6
> >
> > Const ccsGet = 1
> > Const ccsPost = 2
> > 'End Initialize Common Variables
> >
> > 'Connection1 Connection Class @-2D543FFD
> > Class clsDBConnection1
> >
> > Public ConnectionString
> > Public User
> > Public Password
> > Public DateFormat
> > Public BooleanFormat
> > Public LastSQL
> > Public Errors
> >
> > Private objConnection
> > Private blnState
> >
> > Private Sub Class_Initialize()
> > ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;User
> > ID=Admin;Data Source=C:\Documents and Settings\M\My Documents\web
> > solutions\New Folder\NewProject5\GardenCo.mdb;Persist Security
Info=False"
> > User = "Admin"
> > Password = ""
> > DateFormat = Empty
> > BooleanFormat = Empty
> > Set objConnection = Server.CreateObject("ADODB.Connection")
> > Set Errors = New clsErrors
> > End Sub
> >
> > Sub Open()
> > On Error Resume Next
> > objConnection.Errors.Clear
> > objConnection.Open ConnectionString, User, Password
> > If Err.Number <> 0 then
> > Response.Write "<div><h2>Unable to establish connection to
> > database.</h2>"
> > Response.Write "<ul><li>Error information:<br>"
> > Response.Write Err.Source & " (0x" & Hex(Err.Number) &
")<br>"
> > Response.Write Err.Description & "</li>"
> > If Err.Number = -2147467259 then _
> > Response.Write "<li>More information:<br>The database cannot
> be
> > opened, most likely due to insufficient security set on your database
> folder
> > or file.</li>"
> > Response.Write "</ul></div>"
> > Response.End
> > End If
> > End Sub
> >
> > Sub Close()
> > objConnection.Close
> > End Sub
> >
> > Function Execute(varCMD)
> > Dim ErrorMessage, objResult
> > Errors.Clear
> > Set objResult = Server.CreateObject("ADODB.Recordset")
> > objResult.CursorType = adOpenForwardOnly
> > objResult.LockType = adLockReadOnly
> > If TypeName(varCMD) = "Command" Then
> > Set varCMD.ActiveConnection = objConnection
> > Set objResult.Source = varCMD
> > LastSQL = varCMD.CommandText
> > Else
> > Set objResult.ActiveConnection = objConnection
> > objResult.Source = varCMD
> > LastSQL = varCMD
> > End If
> > On Error Resume Next
> > objResult.Open
> > Errors.AddError CCProcessError(objConnection)
> > On Error Goto 0
> > Set Execute = objResult
> > End Function
> >
> > Property Get Connection()
> > Set Connection = objConnection
> > End Property
> >
> > Property Get State()
> > State = objConnection.State
> > End Property
> >
> > Function ToSQL(Value, ValueType)
> > If CStr(Value) = "" OR IsEmpty(Value) Then
> > ToSQL = "Null"
> > Else
> > If ValueType = ccsInteger or ValueType = ccsFloat Then
> > ToSQL = Replace(Value, ",", ".")
> > ElseIf ValueType = ccsDate Then
> > ToSQL = "'" & Replace(Value, "'", "''") & "'"
> > Else
> > ToSQL = "'" & Replace(Value, "'", "''") & "'"
> > End If
> > End If
> > End Function
> >
> >
> > End Class
> > 'End Connection1 Connection Class
> >
> > 'IIf @0-535EAADD
> > Function IIf(Expression, TrueResult, FalseResult)
> > If CBool(Expression) Then _
> > IIf = TrueResult _
> > Else _
> > IIf = FalseResult
> > End Function
> > 'End IIf
> >
> > 'Print @0-065FC167
> > Sub Print(Value)
> > Response.Write CStr(Value)
> > End Sub
> > 'End Print
> >
> > 'CCRaiseEvent @0-E59A6846
> > Function CCRaiseEvent(Events, EventName, Caller)
> > Set EventCaller = Caller
> > Dim Result : Result = Events(EventName)
> > Set EventCaller = Nothing
> > If VarType(Result) = vbEmpty Then _
> > Result = True
> > CCRaiseEvent = Result
> > End Function
> > 'End CCRaiseEvent
> >
> > 'CCFormatError @0-21121FA6
> > Function CCFormatError(Title, Errors)
> > Dim Result, I
> > Result = "<p><b>Source:</b> " & Title & "<br>"
> > For I = 0 To Errors.Count - 1
> > Result = Result & "<b>Error:</b> " & Errors.ErrorByNumber(I)
> > Next
> > Result = Result & "</p>"
> > CCFormatError = Result
> > End Function
> > 'End CCFormatError
> >
> > 'CCOpenRS @0-9E4633EC
> > Function CCOpenRS(RecordSet, SQL, Connection, ShowError)
> > Dim ErrorMessage, Result
> > Result = Empty
> > Set RecordSet = Server.CreateObject("ADODB.Recordset")
> > On Error Resume Next
> > RecordSet.Open SQL, Connection, adOpenForwardOnly, adLockReadOnly,
> > adCmdText
> > ErrorMessage = CCProcessError(Connection)
> > If NOT IsEmpty(ErrorMessage) Then
> > If ShowError Then _
> > Result = "SQL: " & CommandObject.CommandText & "<br>" &
> "Error:
> > " & ErrorMessage & "<br>" _
> > Else _
> > Result = "Database error.<br>"
> > End If
> > On Error Goto 0
> > CCOpenRS = Result
> > End Function
> > 'End CCOpenRS
> >
> > 'CCOpenRSFromCmd @0-A2A33ECF
> > Function CCOpenRSFromCmd(RecordSet, CommandObject, ShowError)
> > Dim ErrorMessage, Result
> > Result = Empty
> > Set RecordSet = Server.CreateObject("ADODB.Recordset")
> > On Error Resume Next
> > RecordSet.CursorType = adOpenForwardOnly
> > RecordSet.LockType = adLockReadOnly
> > RecordSet.Open CommandObject
> > ErrorMessage = CCProcessError(CommandObject.ActiveConnection)
> > If NOT IsEmpty(ErrorMessage) Then
> > If ShowError Then _
> > Result = "SQL: " & CommandObject.CommandText & "<br>" &
> "Error:
> > " & ErrorMessage & "<br>" _
> > Else _
> > Result = "Database error.<br>"
> > End If
> > On Error Goto 0
> > CCOpenRSFromCmd = Result
> > End Function
> > 'End CCOpenRSFromCmd
> >
> > 'CCExecCmd @0-3DC993D0
> > Function CCExecCmd(CommandObject, ShowError)
> > Dim ErrorMessage, Result
> > Result = Empty
> > On Error Resume Next
> > CommandObject.Execute
> > ErrorMessage = CCProcessError(CommandObject.ActiveConnection)
> > If NOT IsEmpty(ErrorMessage) Then
> > If ShowError Then _
> > Result = "SQL: " & CommandObject.CommandText & "<br>" &
> "Error:
> > " & ErrorMessage & "<br>" _
> > Else _
> > Result = "Database error.<br>"
> > End If
> > On Error Goto 0
> > CCExecCmd = Result
> > End Function
> > 'End CCExecCmd
> >
> > 'CCExecSQL @0-24CC2822
> > Function CCExecSQL(SQL, Connection, ShowError)
> > Dim ErrorMessage, Result
> > Result = Empty
> > On Error Resume Next
> > Connection.Execute(SQL)
> > ErrorMessage = CCProcessError(Connection)
> > If NOT IsEmpty(ErrorMessage) Then
> > If ShowError Then _
> > Result = "SQL: " & SQL & "<br>" & "Error: " & ErrorMessage &
> > "<br>" _
> > Else _
> > Result = "Database error.<br>"
> > End If
> > On Error Goto 0
> > CCExecSQL = Result
> > End Function
> > 'End CCExecSQL
> >
> > 'CCToHTML @0-44D2E9F4
> > Function CCToHTML(Value)
> > If IsNull(Value) Then Value = ""
> > CCToHTML = Server.HTMLEncode(Value)
> > End Function
> > 'End CCToHTML
> >
> > 'CCToURL @0-23A93674
> > Function CCToURL(Value)
> > If IsNull(Value) Then Value = ""
> > CCToURL = Server.URLEncode(Value)
> > End Function
> > 'End CCToURL
> >
> > 'CCGetValueHTML @0-30C69AED
> > Function CCGetValueHTML(RecordSet, FieldName)
> > CCGetValueHTML = CCToHTML(CCGetValue(RecordSet, FieldName))
> > End Function
> > 'End CCGetValueHTML
> >
> > 'CCGetValue @0-C5915067
> > Function CCGetValue(RecordSet, FieldName)
> > Dim Result
> > On Error Resume Next
> > If RecordSet Is Nothing Then
> > CCGetValue = Empty
> > ElseIf (NOT RecordSet.EOF) AND (FieldName <> "") Then
> > Result = RecordSet(FieldName)
> > If IsNull(Result) Then _
> > Result = Empty
> > CCGetValue = Result
> > Else
> > CCGetValue = Empty
> > End If
> > On Error Goto 0
> > End Function
> > 'End CCGetValue
> >
> > 'CCGetDate @0-4102C01B
> > Function CCGetDate(RecordSet, FieldName, arrDateFormat)
> > Dim Result
> > Result = CCGetValue(RecordSet, FieldName)
> > If Not IsEmpty(arrDateFormat) Then
> > If Not (VarType(Result) = vbDate OR VarType(Result) = vbEmpty) Then
_
> > If CCValidateDate(Result, arrDateFormat) Then _
> > Result = CCParseDate(Result, arrDateFormat)
> > End If
> > CCGetDate = Result
> > End Function
> > 'End CCGetDate
> >
> > 'CCGetBoolean @0-C64EED38
> > Function CCGetBoolean(RecordSet, FieldName, BooleanFormat)
> > Dim Result
> > Result = CCGetValue(RecordSet, FieldName)
> > CCGetBoolean = CCParseBoolean(Result, BooleanFormat)
> > End Function
> > 'End CCGetBoolean
> >
> > 'CCGetParam @0-B1CC8211
> > Function CCGetParam(ParameterName, DefaultValue)
> > Dim ParameterValue : ParameterValue = ""
> > If Request.QueryString(ParameterName).Count > 0 Then
> > ParameterValue = Request.QueryString(ParameterName)
> > ElseIf Request.Form(ParameterName).Count > 0 Then
> > ParameterValue = Request.Form(ParameterName)
> > Else
> > ParameterValue = DefaultValue
> > End If
> > CCGetParam = ParameterValue
> > End Function
> > 'End CCGetParam
> >
> > 'CCGetFromPost @0-B27302B2
> > Function CCGetFromPost(ParameterName, DefaultValue)
> > Dim ParameterValue : ParameterValue = Empty
> > ParameterValue = Request.Form(ParameterName)
> > If IsEmpty(ParameterValue) Then _
> > ParameterValue = DefaultValue
> > CCGetFromPost = ParameterValue
> > End Function
> > 'End CCGetFromPost
> >
> > 'CCGetFromGet @0-F6BB8115
> > Function CCGetFromGet(ParameterName, DefaultValue)
> > Dim ParameterValue : ParameterValue = Empty
> > ParameterValue = Request.QueryString(ParameterName)
> > If IsEmpty(ParameterValue) Then _
> > ParameterValue = DefaultValue
> > CCGetFromGet = ParameterValue
> > End Function
> > 'End CCGetFromGet
> >
> > 'CCToSQL @0-CA2C324A
> > Function CCToSQL(Value, ValueType)
> > If CStr(Value) = "" OR IsEmpty(Value) Then
> > CCToSQL = "Null"
> > Else
> > If ValueType = "Integer" or ValueType = "Float" Then
> > CCToSQL = Replace(CDbl(Value), ",", ".")
> > Else
> > CCToSQL = "'" & Replace(Value, "'", "''") & "'"
> > End If
> > End If
> > End Function
> > 'End CCToSQL
> >
> > 'CCDLookUp @0-9125C206
> > Function CCDLookUp(ColumnName, TableName, Where, Connection)
> > Dim RecordSet
> > Dim Result
> > Dim SQL
> > Dim ErrorMessage
> > SQL = "SELECT " & ColumnName & " FROM " & TableName &
> IIf(IsEmpty(Where),
> > "", " WHERE " & Where)
> > Set RecordSet = Connection.Execute(SQL)
> > ErrorMessage = CCProcessError(Connection)
> > If NOT IsEmpty(ErrorMessage) Then
> > PrintDBError "CCDLookUp function", SQL, ErrorMessage
> > End If
> > On Error Goto 0
> > Result = CCGetValue(RecordSet, 0)
> > CCDLookUp = Result
> > End Function
> > 'End CCDLookUp
> >
> > 'PrintDBError @0-3D5DDA9A
> > Sub PrintDBError(Source, SQL, ErrorMessage)
> > Dim CommandText
> > Dim SourceText
> > Dim ErrorText
> >
> > If Source <> "" Then SourceText = "<b>Source:</b> " & Source & "<br>"
> > If SQL <> "" Then CommandText = "<b>Command Text:</b> " & SQL & "<br>"
> > If ErrorMessage <> "" Then ErrorText = "<b>Error description:</b> " &
> > ErrorMessage & "</div>"
> >
> > Response.Write "<div style=""background-color: rgb(250, 250, 250); " &
_
> > "border: solid 1px rgb(200, 200, 200);"">" & SourceText
> > Response.Write CommandText & ErrorText
> > End Sub
> > 'End PrintDBError
> >
> > 'CCGetCheckBoxValue @0-ABCF54E0
> > Function CCGetCheckBoxValue(Value, CheckedValue, UncheckedValue,
> ValueType)
> > If isEmpty(Value) Then
> > If UncheckedValue = "" Then
> > CCGetCheckBoxValue = "Null"
> > Else
> > If ValueType = "Integer" or ValueType = "Float" Then
> > CCGetCheckBoxValue = UncheckedValue
> > Else
> > CCGetCheckBoxValue = "'" & Replace(UncheckedValue, "'", "''") &
> "'"
> > End If
> > End If
> > Else
> > If CheckedValue = "" Then
> > CCGetCheckBoxValue = "Null"
> > Else
> > If ValueType = "Integer" OR ValueType = "Float" Then
> > CCGetCheckBoxValue = CheckedValue
> > Else
> > CCGetCheckBoxValue = "'" & Replace(CheckedValue, "'", "''") &
"'"
> > End If
> > End If
> > End If
> > End Function
> > 'End CCGetCheckBoxValue
> >
> > 'CCGetValFromLOV @0-5041B9C1
> > Function CCGetValFromLOV(Value, ListOfValues)
> > Dim I
> > Dim Result : Result = ""
> > If (Ubound(ListOfValues) MOD 2) = 1 Then
> > For I = 0 To Ubound(ListOfValues) Step 2
> > If CStr(Value) = CStr(ListOfValues(I)) Then Result =
ListOfValues(I
> +
> > 1)
> > Next
> > End If
> > CCGetValFromLOV = Result
> > End Function
> > 'End CCGetValFromLOV
> >
> > 'CCProcessError @0-A3A2654C
> > Function CCProcessError(Connection)
> > If Connection.Errors.Count > 0 Then
> > If TypeName(Connection) = "Connection" Then
> > CCProcessError = Connection.Errors(0).Description & " (" &
> > Connection.Errors(0).Source & ")"
> > Else
> > CCProcessError = Connection.Errors.ToString
> > End If
> > ElseIf NOT (Err.Description = "") Then
> > CCProcessError = Err.Description
> > Else
> > CCProcessError = Empty
> > End If
> > end Function
> > 'End CCProcessError
> >
> > 'CCGetRequestParam @0-C154AA52
> > Function CCGetRequestParam(ParameterName, Method)
> > Dim ParameterValue
> >
> > If Method = ccsGet Then
> > ParameterValue = Request.QueryString(ParameterName)
> > ElseIf Method = ccsPost Then
> > ParameterValue = Request.Form(ParameterName)
> > End If
> > If CStr(ParameterValue) = "" Then _
> > ParameterValue = Empty
> >
> > CCGetRequestParam = ParameterValue
> > End Function
> > 'End CCGetRequestParam
> >
> > 'CCGetQueryString @0-CBD7B22E
> > Function CCGetQueryString(CollectionName, RemoveParameters)
> > Dim QueryString, PostData
> >
> > If CollectionName = "Form" Then
> > QueryString = CCCollectionToString(Request.Form, RemoveParameters)
> > ElseIf CollectionName = "QueryString" Then
> > QueryString = CCCollectionToString(Request.QueryString,
> > RemoveParameters)
> > ElseIf CollectionName = "All" Then
> > QueryString = CCCollectionToString(Request.QueryString,
> > RemoveParameters)
> > PostData = CCCollectionToString(Request.Form, RemoveParameters)
> > If Len(PostData) > 0 and Len(QueryString) > 0 Then _
> > QueryString = QueryString & "&" & PostData _
> > Else _
> > QueryString = QueryString & PostData
> > Else
> > Err.Raise 1050, "Common Functions. CCGetQueryString Function", _
> > "The CollectionName contains an illegal value."
> > End If
> >
> > CCGetQueryString = QueryString
> > End Function
> > 'End CCGetQueryString
> >
> > 'CCCollectionToString @0-57CAA4B7
> > Function CCCollectionToString(ParametersCollection, RemoveParameters)
> > Dim ItemName, ItemValue, Result, Remove, I
> >
> > For Each ItemName In ParametersCollection
> > Remove = false
> > If IsArray(RemoveParameters) Then
> > For I = 0 To UBound(RemoveParameters)
> > If RemoveParameters(I) = ItemName Then
> > Remove = True
> > Exit For
> > End If
> > Next
> > End If
> > If Not Remove Then
> > For Each ItemValue In ParametersCollection(ItemName)
> > Result = Result & _
> > "&" & ItemName & "=" & Server.URLEncode(ItemValue)
> > Next
> > End If
> > Next
> >
> > If Len(Result) > 0 Then _
> > Result = Mid(Result, 2)
> > CCCollectionToString = Result
> > End Function
> > 'End CCCollectionToString
> >
> > 'CCAddZero @0-B5648418
> > Function CCAddZero(Value, ResultLength)
> > Dim CountZero, I
> >
> > CountZero = ResultLength - Len(Value)
> > For I = 1 To CountZero
> > Value = "0" & Value
> > Next
> > CCAddZero = Value
> > End Function
> > 'End CCAddZero
> >
> > 'CCGetAMPM @0-CB6EA5BF
> > Function CCGetAMPM(HoursNumber, AnteMeridiem, PostMeridiem)
> > If HoursNumber >= 0 And HoursNumber < 12 Then
> > CCGetAMPM = AnteMeridiem
> > Else
> > CCGetAMPM = PostMeridiem
> > End If
> > End Function
> > 'End CCGetAMPM
> >
> > 'CC12Hour @0-12B00AFF
> > Function CC12Hour(HoursNumber)
> > If HoursNumber = 0 Then
> > HoursNumber = 12
> > ElseIf HoursNumber > 12 Then
> > HoursNumber = HoursNumber - 12
> > End If
> > CC12Hour = HoursNumber
> > End Function
> > 'End CC12Hour
> >
> > 'CCDBFormatByType @0-531721B5
> > Function CCDBFormatByType(Variable)
> > Dim Result
> > If VarType(Variable) = vbString Then
> > If LCase(Variable) = "null" Then
> > Result = Variable
> > Else
> > Result = "'" & Variable & "'"
> > End If
> > Else
> > Result = CStr(Variable)
> > End If
> > CCDBFormatByType = Result
> > End Function
> >
> > 'End CCDBFormatByType
> >
> > 'CCFormatDate @0-9C44D5D4
> > Function CCFormatDate(DateToFormat, FormatMask)
> > Dim ResultArray(), I, Result
> > If VarType(DateToFormat) = vbEmpty Then
> > Result = Empty
> > ElseIf VarType(DateToFormat) <> vbDate Then
> > Err.Raise 4000, "CCFormatDate function. Type mismatch."
> > ElseIf IsEmpty(FormatMask) Then
> > Result = CStr(DateToFormat)
> > Else
> > ReDim ResultArray(UBound(FormatMask))
> > For I = 0 To UBound(FormatMask)
> > Select Case FormatMask(I)
> > Case "d" ResultArray(I) = Day(DateToFormat)
> > Case "w" ResultArray(I) = Weekday(DateToFormat)
> > Case "m" ResultArray(I) = Month(DateToFormat)
> > Case "q" ResultArray(I) = (Month(DateToFormat) + 3) \ 4
> > Case "y" ResultArray(I) = (DateDiff("d", "1/1" & "/" &
> > Year(DateToFormat), Month(DateToFormat) & "/" & Day(DateToFormat) & "/"
&
> > Year(DateToFormat)) + 1)
> > Case "h" ResultArray(I) = CC12Hour(Hour(DateToFormat))
> > Case "H" ResultArray(I) = Hour(DateToFormat)
> > Case "n" ResultArray(I) = Minute(DateToFormat)
> > Case "s" ResultArray(I) = Second(DateToFormat)
> > Case "dd" ResultArray(I) = CCAddZero(Day(DateToFormat), 2)
> > Case "ww" ResultArray(I) = (DateDiff("ww", "1/1" & "/" &
> > Year(DateToFormat), Month(DateToFormat) & "/" & Day(DateToFormat) & "/"
&
> > Year(DateToFormat)) + 1)
> > Case "mm" ResultArray(I) = CCAddZero(Month(DateToFormat), 2)
> > Case "yy" ResultArray(I) = Right(Year(DateToFormat), 2)
> > Case "hh" ResultArray(I) =
CCAddZero(CC12Hour(Hour(DateToFormat)),
> > 2)
> > Case "HH" ResultArray(I) = CCAddZero(Hour(DateToFormat), 2)
> > Case "nn" ResultArray(I) = CCAddZero(Minute(DateToFormat), 2)
> > Case "ss" ResultArray(I) = CCAddZero(Second(DateToFormat), 2)
> > Case "ddd" ResultArray(I) =
> > CCSDateConstants.ShortWeekdays(Weekday(DateToFormat) - 1)
> > Case "mmm" ResultArray(I) =
> > CCSDateConstants.ShortMonths(Month(DateToFormat) - 1)
> > Case "A/P" ResultArray(I) = CCGetAMPM(Hour(DateToFormat), "A",
> "P")
> > Case "a/p" ResultArray(I) = CCGetAMPM(Hour(DateToFormat), "a",
> "p")
> > Case "dddd" ResultArray(I) =
> > CCSDateConstants.Weekdays(Weekday(DateToFormat) - 1)
> > Case "mmmm" ResultArray(I) =
> > CCSDateConstants.Months(Month(DateToFormat) - 1)
> > Case "yyyy" ResultArray(I) = Year(DateToFormat)
> > Case "AM/PM" ResultArray(I) = CCGetAMPM(Hour(DateToFormat),
"AM",
> > "PM")
> > Case "am/pm" ResultArray(I) = CCGetAMPM(Hour(DateToFormat),
"am",
> > "pm")
> > Case "LongDate" ResultArray(I) = FormatDateTime(DateToFormat,
> > vbLongDate)
> > Case "LongTime" ResultArray(I) = FormatDateTime(DateToFormat,
> > vbLongTime)
> > Case "ShortDate" ResultArray(I) = FormatDateTime(DateToFormat,
> > vbShortDate)
> > Case "ShortTime" ResultArray(I) = FormatDateTime(DateToFormat,
> > vbShortTime)
> > Case "GeneralDate" ResultArray(I) = FormatDateTime(DateToFormat,
> > vbGeneralDate)
> > Case Else
> > If Left(FormatMask(I), 1) = "\" Then _
> > ResultArray(I) = Mid(FormatMask(I), 1) _
> > Else
> > ResultArray(I) = FormatMask(I)
> > End Select
> > Next
> > Result = Join(ResultArray, "")
> > End If
> > CCFormatDate = Result
> > End Function
> > 'End CCFormatDate
> >
> > 'CCFormatBoolean @0-635596FD
> > Function CCFormatBoolean(BooleanValue, arrFormat)
> > Dim Result, TrueValue, FalseValue, EmptyValue
> >
> > If IsEmpty(arrFormat) Then
> > Result = CStr(BooleanValue)
> > Else
> > TrueValue = arrFormat(0)
> > FalseValue = arrFormat(1)
> > EmptyValue = arrFormat(2)
> > If IsEmpty(BooleanValue) Then
> > Result = EmptyValue
> > Else
> > If BooleanValue Then _
> > Result = TrueValue _
> > Else _
> > Result = FalseValue
> > End If
> > End If
> > CCFormatBoolean = Result
> > End Function
> > 'End CCFormatBoolean
> >
> > 'CCFormatNumber @0-67C259CA
> > Function CCFormatNumber(NumberToFormat, FormatArray)
> > Dim IsNegative
> > Dim IsExtendedFormat, IsDecimalSeparator, DecimalSeparator,
> > IsPeriodSeparator, PeriodSeparator
> >
> > If IsEmpty(NumberToFormat) Then
> > CCFormatNumber = ""
> > Exit Function
> > End If
> >
> > If IsArray(FormatArray) Then
> > IsExtendedFormat = FormatArray(0)
> > IsNegative = (NumberToFormat < 0)
> > NumberToFormat = ABS(NumberToFormat) * FormatArray(7)
> >
> > If IsExtendedFormat Then ' Extended format
> > IsDecimalSeparator = FormatArray(1)
> > DecimalSeparator = FormatArray(2)
> > IsPeriodSeparator = FormatArray(3)
> > PeriodSeparator = FormatArray(4)
> >
> > Dim BeforeDecimal, AfterDecimal
> > Dim ObligatoryBeforeDecimal, DigitsBeforeDecimal,
> > ObligatoryAfterDecimal, DigitsAfterDecimal
> > Dim I, Z
> > BeforeDecimal = FormatArray(5)
> > AfterDecimal = FormatArray(6)
> > If IsArray(BeforeDecimal) Then
> > For I = 0 To UBound(BeforeDecimal)
> > If BeforeDecimal(I) = "0" Then
> > ObligatoryBeforeDecimal = ObligatoryBeforeDecimal + 1
> > DigitsBeforeDecimal = DigitsBeforeDecimal + 1
> > ElseIf BeforeDecimal(I) = "#" Then
> > DigitsBeforeDecimal = DigitsBeforeDecimal + 1
> > End If
> > Next
> > End If
> > If IsArray(AfterDecimal) Then
> > For I = 0 To UBound(AfterDecimal)
> > If AfterDecimal(I) = "0" Then
> > ObligatoryAfterDecimal = ObligatoryAfterDecimal + 1
> > DigitsAfterDecimal = DigitsAfterDecimal + 1
> > ElseIf AfterDecimal(I) = "#" Then
> > DigitsAfterDecimal = DigitsAfterDecimal + 1
> > End If
> > Next
> > End If
> >
> > Dim NumDigitsAfterDecimal, Result, DefaultValue
> > If ObligatoryAfterDecimal = 0 And DigitsAfterDecimal = 1 Then
> > NumDigitsAfterDecimal = -1
> > ElseIf Not IsDecimalSeparator Then
> > NumDigitsAfterDecimal = 0
> > Else
> > NumDigitsAfterDecimal = DigitsAfterDecimal
> > End If
> > NumberToFormat = FormatNumber(NumberToFormat, DigitsAfterDecimal,
> > False, False, False)
> >
> > Dim DefaultDecimal : DefaultDecimal = Mid(FormatNumber(10001/10,
1,
> > True, False, True), 6, 1)
> > Dim LeftPart, RightPart
> > If Not InStr(CStr(NumberToFormat), DefaultDecimal) = 0 Then
> > Dim NumberParts : NumberParts = Split(CStr(NumberToFormat),
> > DefaultDecimal)
> > LeftPart = CStr(NumberParts(0))
> > RightPart = CStr(NumberParts(1))
> > Else
> > LeftPart = CStr(NumberToFormat)
> > End If
> >
> > Dim J : J = Len(LeftPart)
> >
> > If IsDecimalSeparator And DecimalSeparator = "" Then
> > DefaultValue = CStr(FormatNumber(10001/10, 1, True, False,
True))
> > DecimalSeparator = Mid(DefaultValue, 6, 1)
> > End If
> >
> > If IsPeriodSeparator And PeriodSeparator = "" Then
> > DefaultValue = CStr(FormatNumber(10001/10, 1, True, False,
True))
> > PeriodSeparator = Mid(DefaultValue, 2, 1)
> > End If
> >
> > If IsArray(BeforeDecimal) Then
> > Dim RankNumber : RankNumber = 0
> > For I = UBound(BeforeDecimal) To 0 Step -1
> > If BeforeDecimal(i) = "#" Or BeforeDecimal(i) = "0" Then
> > If DigitsBeforeDecimal = 1 And J > 1 Then
> > If Not IsPeriodSeparator Then
> > Result = Left(LeftPart, j) & Result
> > Else
> > For z = J To 1 Step -1
> > RankNumber = RankNumber + 1
> > If RankNumber Mod 3 = 1 And RankNumber - 3 > 0 Then
> > Result = Mid(LeftPart, z, 1) & PeriodSeparator &
> Result
> > Else
> > Result = Mid(LeftPart, z, 1) & Result
> > End If
> > Next
> > End If
> > ElseIf J > 0 Then
> > RankNumber = RankNumber + 1
> > If RankNumber Mod 3 = 1 And RankNumber - 3 > 0 And
> > IsPeriodSeparator Then
> > Result = Mid(LeftPart, j, 1) & PeriodSeparator & Result
> > Else
> > Result = Mid(LeftPart, j, 1) & Result
> > End If
> > J = J - 1
> > ObligatoryBeforeDecimal = ObligatoryBeforeDecimal - 1
> > DigitsBeforeDecimal = DigitsBeforeDecimal - 1
> > Else
> > If ObligatoryBeforeDecimal > 0 Then
> > RankNumber = RankNumber + 1
> > If RankNumber Mod 3 = 1 And RankNumber - 3 > 0 And
> > IsPeriodSeparator Then
> > Result = "0" & PeriodSeparator & Result
> > Else
> > Result = "0" & Result
> > End If
> > ObligatoryBeforeDecimal = ObligatoryBeforeDecimal - 1
> > DigitsBeforeDecimal = DigitsBeforeDecimal - 1
> > End If
> > End If
> > Else
> > BeforeDecimal(I) = Replace(BeforeDecimal(I), "##", "#")
> > BeforeDecimal(I) = Replace(BeforeDecimal(I), "00", "0")
> > Result = BeforeDecimal(I) & Result
> > End If
> > Next
> > End If
> >
> > ' Left part after decimal
> > Dim RightResult : RightResult = ""
> > If IsArray(AfterDecimal) Then
> > Dim IsZero : IsZero = True
> > For I = UBound(AfterDecimal) To 0 Step -1
> > If AfterDecimal(I) = "#" Or AfterDecimal(I) = "0" Then
> > If DigitsAfterDecimal > ObligatoryAfterDecimal Then
> > If Not Mid(RightPart, DigitsAfterDecimal, 1) = "0" Then
> IsZero
> > = False
> > If Not IsZero Then _
> > RightResult = Mid(RightPart, DigitsAfterDecimal, 1) &
> > RightResult
> > DigitsAfterDecimal = DigitsAfterDecimal - 1
> > Else
> > RightResult = Mid(RightPart, DigitsAfterDecimal, 1) &
> > RightResult
> > DigitsAfterDecimal = DigitsAfterDecimal - 1
> > End If
> > Else
> > AfterDecimal(I) = Replace(AfterDecimal(I), "##", "#")
> > AfterDecimal(I) = Replace(AfterDecimal(I), "00", "0")
> > RightResult = AfterDecimal(I) & RightResult
> > End If
> > Next
> > End If
> >
> > If IsDecimalSeparator AND Len(RightResult) > 0 Then _
> > Result = Result & DecimalSeparator & RightResult
> >
> > If NOT FormatArray(10) AND IsNegative Then _
> > Result = "-" & Result
> >
> > Result = Result & RightResult
> > Else ' Simple format
> > If Not FormatArray(3) AND IsNegative Then _
> > Result = "-" & FormatArray(5) & FormatNumber(NumberToFormat,
> > FormatArray(1), FormatArray(2), False, FormatArray(4)) & FormatArray(6)
_
> > Else _
> > Result = FormatArray(5) & FormatNumber(NumberToFormat,
> > FormatArray(1), FormatArray(2), False, FormatArray(4)) & FormatArray(6)
> > End If
> > If Not FormatArray(8) Then Result = Server.HTMLEncode(Result)
> > If Not CStr(FormatArray(9)) = "" Then _
> > Result = "<FONT COLOR=""" & FormatArray(9) & """>" & Result &
> > "</FONT>"
> > Else
> > Result = NumberToFormat
> > End If
> > CCFormatNumber = Result
> >
> > End Function
> > 'End CCFormatNumber
> >
> > 'CCParseBoolean @0-33711A62
> > Function CCParseBoolean(Value, FormatMask)
> > Dim Result
> > Result = Empty
> > If VarType(Value) = vbBoolean Then
> > Result = Value
> > Else
> > If IsEmpty(FormatMask) Then
> > Result = CBool(Value)
> > Else
> > If IsEmpty(Value) Then
> > If CStr(FormatMask(0)) = "null" Then _
> > Result = True
> > If CStr(FormatMask(1)) = "null" Then _
> > Result = False
> > Else
> > If CStr(Value) = CStr(FormatMask(0)) Then
> > Result = True
> > ElseIf CStr(Value) = CStr(FormatMask(1)) Then
> > Result = False
> > End If
> > End If
> > End If
> > End If
> > CCParseBoolean = Result
> > End Function
> > 'End CCParseBoolean
> >
> > 'CCParseDate @0-0D3D1ED4
> > Function CCParseDate(ParsingDate, FormatMask)
> > Dim ResultDate, ResultDateArray(8)
> > Dim MaskPart, MaskLength, TokenLength
> > Dim IsError
> > Dim DatePosition, MaskPosition
> > Dim Delimiter, BeginDelimiter
> > Dim MonthNumber, MonthName, MonthArray
> > Dim DatePart
> >
> > Dim IS_DATE_POS, YEAR_POS, MONTH_POS, DAY_POS, IS_TIME_POS, HOUR_POS,
> > MINUTE_POS, SECOND_POS
> >
> > IS_DATE_POS = 0 : YEAR_POS = 1 : MONTH_POS = 2 : DAY_POS = 3
> > IS_TIME_POS = 4 : HOUR_POS = 5 : MINUTE_POS = 6 : SECOND_POS = 7
> >
> >
> > If IsEmpty(FormatMask) Then
> > If CStr(ParsingDate) = "" Then _
> > ResultDate = Empty _
> > Else _
> > ResultDate = CDate(ParsingDate)
> > ElseIf (FormatMask(0) = "GeneralDate" Or FormatMask(0) = "LongDate" _
> > Or FormatMask(0) = "ShortDate" Or FormatMask(0) = "LongTime" _
> > Or FormatMask(0) = "ShortTime") And Not CStr(ParsingDate) = "" Then
> > ResultDate = CDate(ParsingDate)
> > ElseIf CStr(ParsingDate) = "" Then
> > ResultDate = Empty
> > Else
> > DatePosition = 1
> > MaskPosition = 0
> > MaskLength = UBound(FormatMask)
> > IsError = False
> >
> > ' Default date
> > ResultDateArray(IS_DATE_POS) = False
> > ResultDateArray(IS_TIME_POS) = False
> > ResultDateArray(YEAR_POS) = 0 : ResultDateArray(MONTH_POS) = 12 :
> > ResultDateArray(DAY_POS) = 1
> > ResultDateArray(HOUR_POS) = 0 : ResultDateArray(MINUTE_POS) = 0 :
> > ResultDateArray(SECOND_POS) = 0
> >
> > While (MaskPosition <= MaskLength) AND NOT IsError
> > MaskPart = FormatMask(MaskPosition)
> > If CCSDateConstants.DateMasks.Exists(MaskPart) Then
> > TokenLength = CCSDateConstants.DateMasks(MaskPart)
> > If TokenLength > 0 Then
> > DatePart = Mid(ParsingDate, DatePosition, TokenLength)
> > DatePosition = DatePosition + TokenLength
> > Else
> > If MaskPosition < MaskLength Then
> > Delimiter = FormatMask(MaskPosition + 1)
> > BeginDelimiter = InStr(DatePosition, ParsingDate, Delimiter)
> > If BeginDelimiter = 0 Then
> > Err.Raise 4000, "ParseDate function: The number doesn't
> match
> > the mask."
> > Else
> > DatePart = Mid(ParsingDate, DatePosition, BeginDelimiter -
> > DatePosition)
> > DatePosition = BeginDelimiter
> > End If
> > Else
> > DatePart = Mid(ParsingDate, DatePosition)
> > End If
> > End If
> > Select Case MaskPart
> > Case "d", "dd"
> > ResultDateArray(DAY_POS) = CInt(DatePart)
> > ResultDateArray(IS_DATE_POS) = True
> > Case "m", "mm"
> > ResultDateArray(MONTH_POS) = CInt(DatePart)
> > ResultDateArray(IS_DATE_POS) = True
> > Case "mmm", "mmmm"
> > MonthNumber = 0
> > MonthName = UCase(DatePart)
> > If MaskPart = "mmm" Then _
> > MonthArray = CCSDateConstants.ShortMonths _
> > Else _
> > MonthArray = CCSDateConstants.Months
> > While MonthNumber < 11 AND UCase(MonthArray(MonthNumber)) <>
> > MonthName
> > MonthNumber = MonthNumber + 1
> > Wend
> > If MonthNumber = 11 Then
> > If UCase(MonthArray(11)) <> MonthName Then _
> > Err.Raise 4000, "ParseDate function: The number doesn't
> > match the mask."
> > End If
> > ResultDateArray(MONTH_POS) = MonthNumber + 1
> > ResultDateArray(IS_DATE_POS) = True
> > Case "yy", "yyyy"
> > ResultDateArray(YEAR_POS) = CInt(DatePart)
> > ResultDateArray(IS_DATE_POS) = True
> > Case "h", "hh"
> > If CInt(DatePart) = 12 Then _
> > ResultDateArray(HOUR_POS) = 0 _
> > Else _
> > ResultDateArray(HOUR_POS) = CInt(DatePart)
> > ResultDateArray(IS_TIME_POS) = True
> > Case "H", "HH"
> > ResultDateArray(HOUR_POS) = CInt(DatePart)
> > ResultDateArray(IS_TIME_POS) = True
> > Case "n", "nn"
> > ResultDateArray(MINUTE_POS) = CInt(DatePart)
> > ResultDateArray(IS_TIME_POS) = True
> > Case "s", "ss"
> > ResultDateArray(SECOND_POS) = CInt(DatePart)
> > ResultDateArray(IS_TIME_POS) = True
> > Case "am/pm", "a/p", "AM/PM", "A/P"
> > If Left(LCase(DatePart), 1) = "p" Then
> > ResultDateArray(HOUR_POS) = ResultDateArray(HOUR_POS) + 12
> > ElseIf Left(LCase(DatePart), 1) = "a" Then
> > ResultDateArray(HOUR_POS) = ResultDateArray(HOUR_POS)
> > End If
> > ResultDateArray(IS_TIME_POS) = True
> > Case "w", "q"
> > ' Do Nothing
> > End Select
> > Else
> > DatePosition = DatePosition + Len(FormatMask(MaskPosition))
> > End If
> > MaskPosition = MaskPosition + 1
> > Wend
> > If ResultDateArray(IS_TIME_POS) AND ResultDateArray(IS_TIME_POS)
Then
> > ResultDate = DateSerial(ResultDateArray(YEAR_POS),
> > ResultDateArray(MONTH_POS), ResultDateArray(DAY_POS)) _
> > + TimeSerial(ResultDateArray(HOUR_POS),
> ResultDateArray(MINUTE_POS),
> > ResultDateArray(SECOND_POS))
> > ElseIf ResultDateArray(IS_TIME_POS) Then
> > ResultDate = TimeSerial(ResultDateArray(HOUR_POS),
> > ResultDateArray(MINUTE_POS), ResultDateArray(SECOND_POS))
> > ElseIf ResultDateArray(IS_DATE_POS) Then
> > ResultDate = DateSerial(ResultDateArray(YEAR_POS),
> > ResultDateArray(MONTH_POS), ResultDateArray(DAY_POS))
> > End If
> > End If
> > CCParseDate = ResultDate
> > End Function
> > 'End CCParseDate
> >
> > 'CCParseNumber @0-BDE16F1E
> > Function CCParseNumber(NumberValue, FormatArray, DataType)
> > Dim Result, NumberValueType
> > NumberValueType = VarType(NumberValue)
> > If NumberValueType = vbInteger OR NumberValueType = vbLong _
> > OR NumberValueType = vbSingle OR NumberValueType = vbSingle _
> > OR NumberValueType = vbCurrency OR NumberValueType = vbDecimal _
> > OR NumberValueType = vbByte Then
> > If DataType = ccsInteger Then
> > Result = CLng(NumberValue)
> > ElseIf DataType = ccsFloat Then
> > Result = CDbl(NumberValue)
> > End If
> > Else
> > If Not CStr(NumberValue) = "" Then
> > Dim DefaultValue, DefaultDecimal
> > Dim DecimalSeparator, PeriodSeparator
> > DecimalSeparator = "" : PeriodSeparator = ""
> > If IsArray(FormatArray) Then
> > If FormatArray(0) Then
> > DecimalSeparator = FormatArray(2)
> > PeriodSeparator = FormatArray(4)
> > End If
> > End If
> > If Not CStr(DecimalSeparator) = "" Then
> > DefaultValue = CStr(FormatNumber(10001/10, 1, True, False,
True))
> > DefaultDecimal = Mid(DefaultValue, 6, 1)
> > NumberValue = Replace(NumberValue, DecimalSeparator,
> DefaultDecimal)
> > End If
> > If Not CStr(PeriodSeparator) = "" Then NumberValue =
> > Replace(NumberValue, PeriodSeparator, "")
> > If DataType = ccsInteger Then
> > Result = CLng(NumberValue)
> > ElseIf DataType = ccsFloat Then
> > Result = CDbl(NumberValue)
> > End If
> > Else
> > Result = Empty
> > End If
> > End If
> > CCParseNumber = Result
> > End Function
> > 'End CCParseNumber
> >
> > 'CCParseInteger @0-42815927
> > Function CCParseInteger(NumberValue, FormatArray)
> > CCParseInteger = CCParseNumber(NumberValue, FormatArray, ccsInteger)
> > End Function
> > 'End CCParseInteger
> >
> > 'CCParseFloat @0-56667DF0
> > Function CCParseFloat(NumberValue, FormatArray)
> > CCParseFloat = CCParseNumber(NumberValue, FormatArray, ccsFloat)
> > End Function
> > 'End CCParseFloat
> >
> > 'CCValidateDate @0-D0BEB752
> > Function CCValidateDate(ValidatingDate, FormatMask)
> > Dim MaskPosition, I, Result, OneChar, IsSeparator
> > Dim RegExpPattern, RegExpObject, Matches
> >
> > IsSeparator = False
> >
> > If ValidatingDate = "" OR IsEmpty(ValidatingDate) Then
> > Result = True
> > ElseIf IsEmpty(FormatMask) Then
> > Result = IsDate(ValidatingDate)
> > ElseIf FormatMask(0) = "GeneralDate" Or FormatMask(0) = "LongDate" _
> > Or FormatMask(0) = "ShortDate" Or FormatMask(0) = "LongTime" _
> > Or FormatMask(0) = "ShortTime" Then
> > Result = IsDate(ValidatingDate)
> > Else
> > For MaskPosition = 0 To UBound(FormatMask)
> > If NOT IsSeparator Then
> > Select Case FormatMask(MaskPosition)
> > Case "d", "m", "h", "n", "s", "w", "q", "H"
> > RegExpPattern = RegExpPattern + "\d{1,2}.+"
> > IsSeparator = True
> > Case "dd", "mm", "yy", "hh", "nn", "ss", "HH"
> > RegExpPattern = RegExpPattern + "\d{2}"
> > Case "yyyy"
> > RegExpPattern = RegExpPattern + "\d{4}"
> > Case "mmm"
> > RegExpPattern = RegExpPattern + "(" &
> > Join(CCSDateConstants.ShortMonths, "|") & ")"
> > Case "mmmm"
> > RegExpPattern = RegExpPattern + "(" &
> > Join(CCSDateConstants.Months, "|") & ")"
> > Case "am/pm"
> > RegExpPattern = RegExpPattern + "[ap]m"
> > Case "AM/PM"
> > RegExpPattern = RegExpPattern + "[AP]M"
> > Case "a/p"
> > RegExpPattern = RegExpPattern + "[ap]"
> > Case "A/P"
> > RegExpPattern = RegExpPattern + "[AP]"
> > Case Else
> > For I = 1 To Len(FormatMask(MaskPosition))
> > OneChar = Mid(FormatMask(MaskPosition), I, 1)
> > If InStr("bBdDfnrsStvwW\", OneChar) = 0 Then _
> > OneChar = "\" + OneChar
> > RegExpPattern = RegExpPattern + OneChar
> > Next
> > End Select
> > Else
> > IsSeparator = False
> > For I = 2 To Len(FormatMask(MaskPosition))
> > OneChar = Mid(FormatMask(MaskPosition), I, 1)
> > If InStr("bBdDfnrsStvwW\", OneChar) = 0 Then _
> > OneChar = "\" + OneChar
> > RegExpPattern = RegExpPattern + OneChar
> > Next
> > End If
> > Next
> > Set RegExpObject = New RegExp
> > RegExpObject.IgnoreCase = False
> > RegExpObject.Global = True
> > RegExpObject.Pattern = RegExpPattern
> > Set Matches = RegExpObject.Execute(ValidatingDate)
> > Result = CBool(Matches.Count = 1)
> > Set Matches = Nothing
> > Set RegExpObject = Nothing
> > End If
> > CCValidateDate = Result
> > End Function
> > 'End CCValidateDate
> >
> > 'CCValidateNumber @0-08089509
> > Function CCValidateNumber(NumberValue, FormatArray)
> > Dim Result, NumberValueType
> > NumberValueType = VarType(NumberValue)
> > If NumberValueType = vbInteger OR NumberValueType = vbLong _
> > OR NumberValueType = vbSingle OR NumberValueType = vbSingle _
> > OR NumberValueType = vbCurrency OR NumberValueType = vbDecimal _
> > OR NumberValueType = vbByte Then
> > Result = True
> > Else
> > If Not CStr(NumberValue) = "" Then
> > Dim DefaultValue, DefaultDecimal
> > Dim DecimalSeparator, PeriodSeparator
> > DecimalSeparator = "" : PeriodSeparator = ""
> > If IsArray(FormatArray) Then
> > If FormatArray(0) Then
> > DecimalSeparator = FormatArray(2)
> > PeriodSeparator = FormatArray(4)
> > End If
> > End If
> > If Not CStr(DecimalSeparator) = "" Then
> > DefaultValue = CStr(FormatNumber(10001/10, 1, True, False,
True))
> > DefaultDecimal = Mid(DefaultValue, 6, 1)
> > NumberValue = Replace(NumberValue, DecimalSeparator,
> DefaultDecimal)
> > End If
> > If Not CStr(PeriodSeparator) = "" Then NumberValue =
> > Replace(NumberValue, PeriodSeparator, "")
> > Result = IsNumeric(NumberValue)
> > Else
> > Result = True
> > End If
> > End If
> > CCValidateNumber = Result
> > End Function
> > 'End CCValidateNumber
> >
> > 'CCValidateBoolean @0-B8DE2060
> > Function CCValidateBoolean(Value, FormatMask)
> > Dim Result: Result = False
> >
> > If VarType(Value) = vbBoolean Then
> > Result = True
> > Else
> > If IsEmpty(FormatMask) Then
> > On Error Resume Next
> > Result = CBool(Value)
> > Result = Not(Err > 0)
> > Else
> > If IsEmpty(Value) Or CStr(Value) = "" Then
> > Result = (CStr(FormatMask(0)) = "null") Or (CStr(FormatMask(0))
=
> > "Undefined") Or (CStr(FormatMask(0)) = "")
> > Result = Result Or (CStr(FormatMask(1)) = "null") Or
> > (CStr(FormatMask(1)) = "Undefined") Or (CStr(FormatMask(1)) = "")
> > If UBound(FormatMask) = 2 Then _
> > Result = Result Or (CStr(FormatMask(2)) = "null") Or
> > (CStr(FormatMask(2)) = "Undefined") Or (CStr(FormatMask(2)) = "")
> > Else
> > Result = (CStr(Value) = CStr(FormatMask(0))) Or (CStr(Value) =
> > CStr(FormatMask(1)))
> > If UBound(FormatMask) = 2 Then _
> > Result = Result Or (CStr(Value) = CStr(FormatMask(2)))
> > End If
> > End If
> > End If
> > CCValidateBoolean = Result
> > End Function
> > 'End CCValidateBoolean
> >
> > 'CCAddParam @0-6D59DAA5
> > Function CCAddParam(QueryString, ParameterName, ParameterValue)
> > Dim Result
> >
> > Result = Replace("&" & QueryString, "&" & ParameterName & "=" &
> > Server.URLEncode(Request.QueryString(ParameterName)), "")
> > Result = Result & "&" & ParameterName & "=" &
> > Server.URLEncode(ParameterValue)
> > Result = Replace(Result, "&&", "&")
> > If Left(Result, 1) = "&" Then Result = Mid(Result, 2)
> > CCAddParam = Result
> > End Function
> > 'End CCAddParam
> >
> > 'CCRemoveParam @0-64B4FAAF
> > Function CCRemoveParam(QueryString, ParameterName)
> > Dim Result
> > Result = Replace(QueryString, ParameterName & "=" &
> > Server.URLEncode(Request.QueryString(ParameterName)), "")
> > Result = Replace(Result, "&&", "&")
> > If Left(Result, 1) = "&" Then Result = Mid(Result, 2)
> > CCRemoveParam = Result
> > End Function
> > 'End CCRemoveParam
> >
> > 'CCRegExpTest @0-9EAA5A2D
> > Function CCRegExpTest(TestValue, RegExpMask, IgnoreCase, GlobalTest)
> > Dim Result
> > If Not CStr(TestValue) = "" Then
> > Dim RegExpObject
> > Set RegExpObject = New RegExp
> > RegExpObject.Pattern = RegExpMask
> > RegExpObject.IgnoreCase = IgnoreCase
> > RegExpObject.Global = GlobalTest
> > Result = RegExpObject.Test(CStr(TestValue))
> > Set RegExpObject = Nothing
> > Else
> > Result = True
> > End If
> > CCRegExpTest = Result
> > End Function
> >
> >
> > 'End CCRegExpTest
> >
> > 'CCRegExpTest @0-4BE3AE1D
> > Sub CheckSSL()
> > If Not UCase(Request.ServerVariables("HTTPS")) = "ON" Then
> > Response.Write "SSL connection error. This page can be accessed only
> via
> > secured connection."
> > Response.End
> > End If
> > End Sub
> >
> > 'End CCRegExpTest
> >
> > 'CCGetUserLogin @0-4306ED6C
> > Function CCGetUserLogin()
> > CCGetUserLogin = Session("UserLogin")
> > End Function
> > 'End CCGetUserLogin
> >
> > 'CCSecurityRedirect @0-790A88DF
> > Sub CCSecurityRedirect(GroupsAccess, URL)
> > Dim ErrorType
> > Dim Link
> > ErrorType = CCSecurityAccessCheck(GroupsAccess)
> > If NOT (ErrorType = "success") Then
> > If IsEmpty(URL) Then _
> > Link = ServerURL & "Login.asp" _
> > Else _
> > Link = URL
> > Response.Redirect(Link & "?ret_link=" & _
> > Server.URLEncode(Request.ServerVariables("SCRIPT_NAME") & _
> > "?" & CCRemoveParam(Request.ServerVariables("QUERY_STRING"),
> > "ccsForm")) & "&type=" & ErrorType)
> > End If
> > End Sub
> > 'End CCSecurityRedirect
> >
> > 'CCGetUserID @0-449B3B19
> > Function CCGetUserID()
> > CCGetUserID = Session("UserID")
> > End Function
> > 'End CCGetUserID
> >
> > 'CCSecurityAccessCheck @0-8A7701BE
> > Function CCSecurityAccessCheck(GroupsAccess)
> > Dim ErrorType
> > Dim GroupID
> > ErrorType = "success"
> > If IsEmpty(CCGetUserID()) Then
> > ErrorType = "notLogged"
> > Else
> > GroupID = CCGetGroupID()
> > If IsEmpty(GroupID) Then
> > ErrorType = "groupIDNotSet"
> > Else
> > If NOT CCUserInGroups(GroupID, GroupsAccess) Then
> > ErrorType = "illegalGroup"
> > End If
> > End If
> > End If
> > CCSecurityAccessCheck = ErrorType
> > End Function
> > 'End CCSecurityAccessCheck
> >
> > 'CCGetGroupID @0-B2650479
> > Function CCGetGroupID()
> > CCGetGroupID = Session("GroupID")
> > End Function
> > 'End CCGetGroupID
> >
> > 'CCUserInGroups @0-4332AEA7
> > Function CCUserInGroups(GroupID, GroupsAccess)
> > Dim Result
> > Dim GroupNumber
> > If NOT IsEmpty(GroupsAccess) Then
> > GroupNumber = CLng(GroupID)
> > While NOT Result AND GroupNumber > 0
> > Result = NOT (InStr(";" & GroupsAccess & ";", ";" & GroupNumber & ";") =
> 0)
> > GroupNumber = GroupNumber - 1
> > Wend
> > Else
> > Result = True
> > End If
> > CCUserInGroups = Result
> > End Function
> > 'End CCUserInGroups
> >
> > 'CCLoginUser @0-6D3FEC5B
> > Function CCLoginUser(Login, Password)
> > Dim Result
> > Dim SQL
> > Dim RecordSet
> > Dim Connection
> >
> > Set Connection = New clsDBConnection1
> > Connection.Open
> > SQL = "SELECT id_empleado, group FROM Empleados WHERE emp_login='" &
> > Replace(Login, "'", "''") & "' AND emp_password='" & Replace(Password,
> "'",
> > "''") & "'"
> > Set RecordSet = Connection.Execute(SQL)
> > Result = NOT RecordSet.EOF
> > If Result Then
> > Session("UserID") = RecordSet("id_empleado")
> > Session("UserLogin") = Login
> > Session("GroupID") = RecordSet("group")
> > End If
> > RecordSet.Close
> > Set RecordSet = Nothing
> > Connection.Close
> > Set Connection = Nothing
> > CCLoginUser = Result
> > End Function
> > 'End CCLoginUser
> >
> > 'CCLogoutUser @0-DB93CE50
> > Sub CCLogoutUser()
> > Session("UserID") = Empty
> > Session("UserLogin") = Empty
> > Session("GroupID") = Empty
> > End Sub
> > 'End CCLogoutUser
> >
> >
> > %>
> >
> > Any help will be greatly appreciated...
> >
> >
> >
> >
> > "Pepito" <dfga@kk.com> wrote in message
> >news:b44qfl$ltg$1@news.codecharge.com...
> > > Hello Everyone, I uploaded a css project (that runs great on IIS at my
> > > machine) to a free server (brinkster). I can properly see on a browser
> > > *.html files but not the same file *.asp....error 500...
> > >
> > > any hint?
> > >
> > > check it out at
> > http://www10.brinkster.com/mariosbm/code/Empleados_list.html
> > > http://www10.brinkster.com/mariosbm/code/Empleados_list.asp
> > >
> > > your help is greatly appreciated...I 'not a programmer but would like
to
> > set
> > > a site of this kind
> > >
> > > Thanks
> > >
> > >
> > >
> >
> >
>
>
>
|
|
|
|
Sixto Luis Santos
|
| Posted: 03/05/2003, 9:15 AM |
|
Pepito,
First, move your database to its own folder (for example, db). Then, You
need to manually edit your DB connection to use a custom connection string
(remove the checkmark from "Same as design"). Set your connection string to
something like this:
Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" &
Server.MapPath("./db/GardenCo.mdb") & ";Persist Security Info=False
This should allow your application to run, but almost certainly, you won't
be able to edit anything. You must explicitly assign write permissions to
the db folder and that is an entirely different problem not always easy to
solve. But, most good hosts provide a folder with the necessary permissions
already in place. Check for a folder named db or fpdb or something like
that. Now, if you use FrontPage, use it to upload the database and allow it
to move the database to the fpdb folder. FrontPage should take care of the
permissions issue all by itself. Remember to change the connection string
accordingly.
Regards,
Sixto
"Pepito" <pepitxispi@yahoo.com> wrote in message
news:b458ko$m31$1@news.codecharge.com...
> Sorry, Outlook does not allow me to see the attachment because it is
> "potentially" unsafe...could you please zip or rar it?
> Anyway, as the brinkers site is not good for uploading, I am trying
> everything at this server..
> the database is here
> http://mariosbm.www4.dotnetplayground.com/code/GardenCo.mdb
> the page is here
> http://mariosbm.www4.dotnetplayground.com/code/Empleados_list.asp (you can
> see the html here
> http://mariosbm.www4.dotnetplayground.com/code/Empleados_list.html)
>
> Thanks for your help!!!!
>
> "NetFocus.biz" <amcfayen@netfocus.biz> wrote in message
>news:b457e6$ipc$1@news.codecharge.com...
> > Hi
> >
> > You need to know the file path to the database. You can find this out
> using
> > the server.mappath method. You can take the attached small file and copy
> it
> > to the same folder as your database, then go to
> > http://www10.brinkster.com/mariosbm/code/getpath.asp
> >
> > you should then see a result like this in your browser:
> >
> > c:\inetpub\wwwroot\test\getpath.asp
> >
> > which will tell you how to refer to the database in Common.asp (in this
> case
> > c:\inetpub\wwwroot\test\GardenCo.mdb).
> >
> > Hope this helps
> >
> > Alistair
> >
> >
> >
> > --
> > Managing Director
> > NetFocus Solutions Ltd
> > 2 Cockburn Place
> > Riverside Business Park
> > Irvine, Ayrshire, KA11 5DA
> > Tel: +44 (0) 1294 318701
> > Fax: +44 (0) 1294 316580
> > Internet: www.netfocus.biz
> >
> > "Pepito" <pepitxispi@yahoo.com> wrote in message
> >news:b4568c$fu3$1@news.codecharge.com...
> > > Thanks for your responses:
> > >
> > > 1) I already turn off the friendly error showing,
> > > 2) I am playing with changing the path as Alistair kindly suggested..
> > >
> > > However, I am messing the code ...
> > > well....the database is here
> > > http://mariosbm.www4.dotnetplayground.com/code/GardenCo.mdb
> > > the page is here
> > > http://mariosbm.www4.dotnetplayground.com/code/Empleados_list.asp (you
> can
> > > see the html here
> > > http://mariosbm.www4.dotnetplayground.com/code/Empleados_list.html)
> > > so, if the problem is here:
> > > "Microsoft JET Database Engine error '80004005'
> > >
> > > 'C:\Documents and Settings\M\My Documents\web solutions\New
> > > Folder\NewProject6\GardenCo.mdb' is not a valid path. Make sure that
the
> > > path name is spelled correctly and that you are connected to the
server
> on
> > > which the file resides.
> > >
> > > /mariosbm/code/Common.asp, line 117"
> > >
> > > Should I write instead of C:\...etc this: \code\GardenCo.mdb ?? that
is
> > not
> > > working also....
> > >
> > > here is the old code:
> > >
> > > <%
> > > Option Explicit
> > >
> > > 'Include Files @0-0F8FBEEB
> > > %>
> > > <!-- #INCLUDE FILE="Adovbs.asp" -->
> > > <!-- #INCLUDE FILE="Classes.asp" -->
> > > <%
> > > 'End Include Files
> > >
> > > 'Script Engine Version Check @0-A118D8E9
> > > If ScriptEngineMajorVersion < 5 Then
> > > Response.Write "Sorry. This program requires VBScript 5.1 to
> > run.<br>You
> > > may upgrade your VBScript at
> > > http://www.microsoft.com/msdownload/vbscript/scripting.asp.";
> > > Response.End
> > > Else
> > > If ScriptEngineMajorVersion & ":" & ScriptEngineMinorVersion =
"5:0"
> > > Then
> > > Response.Write "Due to a bug in VBScript 5.0, this program
would
> > > crash your server. See
> > > http://support.microsoft.com/default.aspx?scid=kb;EN-US...<br>";
&
> _
> > > "Upgrade your VBScript at
> > > http://www.microsoft.com/msdownload/vbscript/scripting.asp.";
> > > Response.End
> > > End If
> > > End If
> > > 'End Script Engine Version Check
> > >
> > > 'Initialize Common Variables @0-EB7D5995
> > > Dim CCSDateConstants
> > > Dim ServerURL
> > > Dim SecureURL
> > > Dim TemplatesRepository
> > > Dim EventCaller
> > >
> > > Set TemplatesRepository = New clsCache_FileSystem
> > > ServerURL = "http://localhost/NewProject5/"
> > > Set CCSDateConstants = New clsCCSDateConstants
> > >
> > > Class clsCCSDateConstants
> > >
> > > Public Weekdays
> > > Public ShortWeekdays
> > > Public Months
> > > Public ShortMonths
> > > Public DateMasks
> > >
> > > Private Sub Class_Initialize()
> > > ShortWeekdays = Array("Sun", "Mon", "Tue", "Wed", "Thu",
"Fri",
> > > "Sat")
> > > Weekdays = Array("Sunday", "Monday", "Tuesday", "Wednesday",
> > > "Thursday", "Friday", "Saturday")
> > > ShortMonths = Array("Jan", "Feb", "Mar", "Apr", "May", "Jun",
> > > "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")
> > > Months = Array("January", "February", "March", "April", "May",
> > > "June", "July", "August", "September", "October", "November",
> "December")
> > > Set DateMasks = CreateObject("Scripting.Dictionary")
> > > DateMasks("d") = 0
> > > DateMasks("dd") = 2
> > > DateMasks("m") = 0
> > > DateMasks("mm") = 2
> > > DateMasks("mmm") = 3
> > > DateMasks("mmmm") = 0
> > > DateMasks("yy") = 2
> > > DateMasks("yyyy") = 4
> > > DateMasks("h") = 0
> > > DateMasks("hh") = 2
> > > DateMasks("H") = 0
> > > DateMasks("HH") = 2
> > > DateMasks("n") = 0
> > > DateMasks("nn") = 2
> > > DateMasks("s") = 0
> > > DateMasks("ss") = 2
> > > DateMasks("am/pm") = 2
> > > DateMasks("AM/PM") = 2
> > > DateMasks("A/P") = 1
> > > DateMasks("a/p") = 1
> > > DateMasks("w") = 0
> > > DateMasks("q") = 0
> > > End Sub
> > >
> > > Private Sub Class_Terminate()
> > > Set DateMasks = Nothing
> > > End Sub
> > >
> > > End Class
> > >
> > > Const ccsInteger = 1
> > > Const ccsFloat = 2
> > > Const ccsText = 3
> > > Const ccsDate = 4
> > > Const ccsBoolean = 5
> > > Const ccsMemo = 6
> > >
> > > Const ccsGet = 1
> > > Const ccsPost = 2
> > > 'End Initialize Common Variables
> > >
> > > 'Connection1 Connection Class @-2D543FFD
> > > Class clsDBConnection1
> > >
> > > Public ConnectionString
> > > Public User
> > > Public Password
> > > Public DateFormat
> > > Public BooleanFormat
> > > Public LastSQL
> > > Public Errors
> > >
> > > Private objConnection
> > > Private blnState
> > >
> > > Private Sub Class_Initialize()
> > > ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;User
> > > ID=Admin;Data Source=C:\Documents and Settings\M\My Documents\web
> > > solutions\New Folder\NewProject5\GardenCo.mdb;Persist Security
> Info=False"
> > > User = "Admin"
> > > Password = ""
> > > DateFormat = Empty
> > > BooleanFormat = Empty
> > > Set objConnection = Server.CreateObject("ADODB.Connection")
> > > Set Errors = New clsErrors
> > > End Sub
> > >
> > > Sub Open()
> > > On Error Resume Next
> > > objConnection.Errors.Clear
> > > objConnection.Open ConnectionString, User, Password
> > > If Err.Number <> 0 then
> > > Response.Write "<div><h2>Unable to establish connection to
> > > database.</h2>"
> > > Response.Write "<ul><li>Error information:<br>"
> > > Response.Write Err.Source & " (0x" & Hex(Err.Number) &
> ")<br>"
> > > Response.Write Err.Description & "</li>"
> > > If Err.Number = -2147467259 then _
> > > Response.Write "<li>More information:<br>The database
cannot
> > be
> > > opened, most likely due to insufficient security set on your database
> > folder
> > > or file.</li>"
> > > Response.Write "</ul></div>"
> > > Response.End
> > > End If
> > > End Sub
> > >
> > > Sub Close()
> > > objConnection.Close
> > > End Sub
> > >
> > > Function Execute(varCMD)
> > > Dim ErrorMessage, objResult
> > > Errors.Clear
> > > Set objResult = Server.CreateObject("ADODB.Recordset")
> > > objResult.CursorType = adOpenForwardOnly
> > > objResult.LockType = adLockReadOnly
> > > If TypeName(varCMD) = "Command" Then
> > > Set varCMD.ActiveConnection = objConnection
> > > Set objResult.Source = varCMD
> > > LastSQL = varCMD.CommandText
> > > Else
> > > Set objResult.ActiveConnection = objConnection
> > > objResult.Source = varCMD
> > > LastSQL = varCMD
> > > End If
> > > On Error Resume Next
> > > objResult.Open
> > > Errors.AddError CCProcessError(objConnection)
> > > On Error Goto 0
> > > Set Execute = objResult
> > > End Function
> > >
> > > Property Get Connection()
> > > Set Connection = objConnection
> > > End Property
> > >
> > > Property Get State()
> > > State = objConnection.State
> > > End Property
> > >
> > > Function ToSQL(Value, ValueType)
> > > If CStr(Value) = "" OR IsEmpty(Value) Then
> > > ToSQL = "Null"
> > > Else
> > > If ValueType = ccsInteger or ValueType = ccsFloat Then
> > > ToSQL = Replace(Value, ",", ".")
> > > ElseIf ValueType = ccsDate Then
> > > ToSQL = "'" & Replace(Value, "'", "''") & "'"
> > > Else
> > > ToSQL = "'" & Replace(Value, "'", "''") & "'"
> > > End If
> > > End If
> > > End Function
> > >
> > >
> > > End Class
> > > 'End Connection1 Connection Class
> > >
> > > 'IIf @0-535EAADD
> > > Function IIf(Expression, TrueResult, FalseResult)
> > > If CBool(Expression) Then _
> > > IIf = TrueResult _
> > > Else _
> > > IIf = FalseResult
> > > End Function
> > > 'End IIf
> > >
> > > 'Print @0-065FC167
> > > Sub Print(Value)
> > > Response.Write CStr(Value)
> > > End Sub
> > > 'End Print
> > >
> > > 'CCRaiseEvent @0-E59A6846
> > > Function CCRaiseEvent(Events, EventName, Caller)
> > > Set EventCaller = Caller
> > > Dim Result : Result = Events(EventName)
> > > Set EventCaller = Nothing
> > > If VarType(Result) = vbEmpty Then _
> > > Result = True
> > > CCRaiseEvent = Result
> > > End Function
> > > 'End CCRaiseEvent
> > >
> > > 'CCFormatError @0-21121FA6
> > > Function CCFormatError(Title, Errors)
> > > Dim Result, I
> > > Result = "<p><b>Source:</b> " & Title & "<br>"
> > > For I = 0 To Errors.Count - 1
> > > Result = Result & "<b>Error:</b> " & Errors.ErrorByNumber(I)
> > > Next
> > > Result = Result & "</p>"
> > > CCFormatError = Result
> > > End Function
> > > 'End CCFormatError
> > >
> > > 'CCOpenRS @0-9E4633EC
> > > Function CCOpenRS(RecordSet, SQL, Connection, ShowError)
> > > Dim ErrorMessage, Result
> > > Result = Empty
> > > Set RecordSet = Server.CreateObject("ADODB.Recordset")
> > > On Error Resume Next
> > > RecordSet.Open SQL, Connection, adOpenForwardOnly, adLockReadOnly,
> > > adCmdText
> > > ErrorMessage = CCProcessError(Connection)
> > > If NOT IsEmpty(ErrorMessage) Then
> > > If ShowError Then _
> > > Result = "SQL: " & CommandObject.CommandText & "<br>" &
> > "Error:
> > > " & ErrorMessage & "<br>" _
> > > Else _
> > > Result = "Database error.<br>"
> > > End If
> > > On Error Goto 0
> > > CCOpenRS = Result
> > > End Function
> > > 'End CCOpenRS
> > >
> > > 'CCOpenRSFromCmd @0-A2A33ECF
> > > Function CCOpenRSFromCmd(RecordSet, CommandObject, ShowError)
> > > Dim ErrorMessage, Result
> > > Result = Empty
> > > Set RecordSet = Server.CreateObject("ADODB.Recordset")
> > > On Error Resume Next
> > > RecordSet.CursorType = adOpenForwardOnly
> > > RecordSet.LockType = adLockReadOnly
> > > RecordSet.Open CommandObject
> > > ErrorMessage = CCProcessError(CommandObject.ActiveConnection)
> > > If NOT IsEmpty(ErrorMessage) Then
> > > If ShowError Then _
> > > Result = "SQL: " & CommandObject.CommandText & "<br>" &
> > "Error:
> > > " & ErrorMessage & "<br>" _
> > > Else _
> > > Result = "Database error.<br>"
> > > End If
> > > On Error Goto 0
> > > CCOpenRSFromCmd = Result
> > > End Function
> > > 'End CCOpenRSFromCmd
> > >
> > > 'CCExecCmd @0-3DC993D0
> > > Function CCExecCmd(CommandObject, ShowError)
> > > Dim ErrorMessage, Result
> > > Result = Empty
> > > On Error Resume Next
> > > CommandObject.Execute
> > > ErrorMessage = CCProcessError(CommandObject.ActiveConnection)
> > > If NOT IsEmpty(ErrorMessage) Then
> > > If ShowError Then _
> > > Result = "SQL: " & CommandObject.CommandText & "<br>" &
> > "Error:
> > > " & ErrorMessage & "<br>" _
> > > Else _
> > > Result = "Database error.<br>"
> > > End If
> > > On Error Goto 0
> > > CCExecCmd = Result
> > > End Function
> > > 'End CCExecCmd
> > >
> > > 'CCExecSQL @0-24CC2822
> > > Function CCExecSQL(SQL, Connection, ShowError)
> > > Dim ErrorMessage, Result
> > > Result = Empty
> > > On Error Resume Next
> > > Connection.Execute(SQL)
> > > ErrorMessage = CCProcessError(Connection)
> > > If NOT IsEmpty(ErrorMessage) Then
> > > If ShowError Then _
> > > Result = "SQL: " & SQL & "<br>" & "Error: " & ErrorMessage
&
> > > "<br>" _
> > > Else _
> > > Result = "Database error.<br>"
> > > End If
> > > On Error Goto 0
> > > CCExecSQL = Result
> > > End Function
> > > 'End CCExecSQL
> > >
> > > 'CCToHTML @0-44D2E9F4
> > > Function CCToHTML(Value)
> > > If IsNull(Value) Then Value = ""
> > > CCToHTML = Server.HTMLEncode(Value)
> > > End Function
> > > 'End CCToHTML
> > >
> > > 'CCToURL @0-23A93674
> > > Function CCToURL(Value)
> > > If IsNull(Value) Then Value = ""
> > > CCToURL = Server.URLEncode(Value)
> > > End Function
> > > 'End CCToURL
> > >
> > > 'CCGetValueHTML @0-30C69AED
> > > Function CCGetValueHTML(RecordSet, FieldName)
> > > CCGetValueHTML = CCToHTML(CCGetValue(RecordSet, FieldName))
> > > End Function
> > > 'End CCGetValueHTML
> > >
> > > 'CCGetValue @0-C5915067
> > > Function CCGetValue(RecordSet, FieldName)
> > > Dim Result
> > > On Error Resume Next
> > > If RecordSet Is Nothing Then
> > > CCGetValue = Empty
> > > ElseIf (NOT RecordSet.EOF) AND (FieldName <> "") Then
> > > Result = RecordSet(FieldName)
> > > If IsNull(Result) Then _
> > > Result = Empty
> > > CCGetValue = Result
> > > Else
> > > CCGetValue = Empty
> > > End If
> > > On Error Goto 0
> > > End Function
> > > 'End CCGetValue
> > >
> > > 'CCGetDate @0-4102C01B
> > > Function CCGetDate(RecordSet, FieldName, arrDateFormat)
> > > Dim Result
> > > Result = CCGetValue(RecordSet, FieldName)
> > > If Not IsEmpty(arrDateFormat) Then
> > > If Not (VarType(Result) = vbDate OR VarType(Result) = vbEmpty)
Then
> _
> > > If CCValidateDate(Result, arrDateFormat) Then _
> > > Result = CCParseDate(Result, arrDateFormat)
> > > End If
> > > CCGetDate = Result
> > > End Function
> > > 'End CCGetDate
> > >
> > > 'CCGetBoolean @0-C64EED38
> > > Function CCGetBoolean(RecordSet, FieldName, BooleanFormat)
> > > Dim Result
> > > Result = CCGetValue(RecordSet, FieldName)
> > > CCGetBoolean = CCParseBoolean(Result, BooleanFormat)
> > > End Function
> > > 'End CCGetBoolean
> > >
> > > 'CCGetParam @0-B1CC8211
> > > Function CCGetParam(ParameterName, DefaultValue)
> > > Dim ParameterValue : ParameterValue = ""
> > > If Request.QueryString(ParameterName).Count > 0 Then
> > > ParameterValue = Request.QueryString(ParameterName)
> > > ElseIf Request.Form(ParameterName).Count > 0 Then
> > > ParameterValue = Request.Form(ParameterName)
> > > Else
> > > ParameterValue = DefaultValue
> > > End If
> > > CCGetParam = ParameterValue
> > > End Function
> > > 'End CCGetParam
> > >
> > > 'CCGetFromPost @0-B27302B2
> > > Function CCGetFromPost(ParameterName, DefaultValue)
> > > Dim ParameterValue : ParameterValue = Empty
> > > ParameterValue = Request.Form(ParameterName)
> > > If IsEmpty(ParameterValue) Then _
> > > ParameterValue = DefaultValue
> > > CCGetFromPost = ParameterValue
> > > End Function
> > > 'End CCGetFromPost
> > >
> > > 'CCGetFromGet @0-F6BB8115
> > > Function CCGetFromGet(ParameterName, DefaultValue)
> > > Dim ParameterValue : ParameterValue = Empty
> > > ParameterValue = Request.QueryString(ParameterName)
> > > If IsEmpty(ParameterValue) Then _
> > > ParameterValue = DefaultValue
> > > CCGetFromGet = ParameterValue
> > > End Function
> > > 'End CCGetFromGet
> > >
> > > 'CCToSQL @0-CA2C324A
> > > Function CCToSQL(Value, ValueType)
> > > If CStr(Value) = "" OR IsEmpty(Value) Then
> > > CCToSQL = "Null"
> > > Else
> > > If ValueType = "Integer" or ValueType = "Float" Then
> > > CCToSQL = Replace(CDbl(Value), ",", ".")
> > > Else
> > > CCToSQL = "'" & Replace(Value, "'", "''") & "'"
> > > End If
> > > End If
> > > End Function
> > > 'End CCToSQL
> > >
> > > 'CCDLookUp @0-9125C206
> > > Function CCDLookUp(ColumnName, TableName, Where, Connection)
> > > Dim RecordSet
> > > Dim Result
> > > Dim SQL
> > > Dim ErrorMessage
> > > SQL = "SELECT " & ColumnName & " FROM " & TableName &
> > IIf(IsEmpty(Where),
> > > "", " WHERE " & Where)
> > > Set RecordSet = Connection.Execute(SQL)
> > > ErrorMessage = CCProcessError(Connection)
> > > If NOT IsEmpty(ErrorMessage) Then
> > > PrintDBError "CCDLookUp function", SQL, ErrorMessage
> > > End If
> > > On Error Goto 0
> > > Result = CCGetValue(RecordSet, 0)
> > > CCDLookUp = Result
> > > End Function
> > > 'End CCDLookUp
> > >
> > > 'PrintDBError @0-3D5DDA9A
> > > Sub PrintDBError(Source, SQL, ErrorMessage)
> > > Dim CommandText
> > > Dim SourceText
> > > Dim ErrorText
> > >
> > > If Source <> "" Then SourceText = "<b>Source:</b> " & Source &
"<br>"
> > > If SQL <> "" Then CommandText = "<b>Command Text:</b> " & SQL &
"<br>"
> > > If ErrorMessage <> "" Then ErrorText = "<b>Error description:</b> "
&
> > > ErrorMessage & "</div>"
> > >
> > > Response.Write "<div style=""background-color: rgb(250, 250, 250); "
&
> _
> > > "border: solid 1px rgb(200, 200, 200);"">" & SourceText
> > > Response.Write CommandText & ErrorText
> > > End Sub
> > > 'End PrintDBError
> > >
> > > 'CCGetCheckBoxValue @0-ABCF54E0
> > > Function CCGetCheckBoxValue(Value, CheckedValue, UncheckedValue,
> > ValueType)
> > > If isEmpty(Value) Then
> > > If UncheckedValue = "" Then
> > > CCGetCheckBoxValue = "Null"
> > > Else
> > > If ValueType = "Integer" or ValueType = "Float" Then
> > > CCGetCheckBoxValue = UncheckedValue
> > > Else
> > > CCGetCheckBoxValue = "'" & Replace(UncheckedValue, "'", "''")
&
> > "'"
> > > End If
> > > End If
> > > Else
> > > If CheckedValue = "" Then
> > > CCGetCheckBoxValue = "Null"
> > > Else
> > > If ValueType = "Integer" OR ValueType = "Float" Then
> > > CCGetCheckBoxValue = CheckedValue
> > > Else
> > > CCGetCheckBoxValue = "'" & Replace(CheckedValue, "'", "''") &
> "'"
> > > End If
> > > End If
> > > End If
> > > End Function
> > > 'End CCGetCheckBoxValue
> > >
> > > 'CCGetValFromLOV @0-5041B9C1
> > > Function CCGetValFromLOV(Value, ListOfValues)
> > > Dim I
> > > Dim Result : Result = ""
> > > If (Ubound(ListOfValues) MOD 2) = 1 Then
> > > For I = 0 To Ubound(ListOfValues) Step 2
> > > If CStr(Value) = CStr(ListOfValues(I)) Then Result =
> ListOfValues(I
> > +
> > > 1)
> > > Next
> > > End If
> > > CCGetValFromLOV = Result
> > > End Function
> > > 'End CCGetValFromLOV
> > >
> > > 'CCProcessError @0-A3A2654C
> > > Function CCProcessError(Connection)
> > > If Connection.Errors.Count > 0 Then
> > > If TypeName(Connection) = "Connection" Then
> > > CCProcessError = Connection.Errors(0).Description & " (" &
> > > Connection.Errors(0).Source & ")"
> > > Else
> > > CCProcessError = Connection.Errors.ToString
> > > End If
> > > ElseIf NOT (Err.Description = "") Then
> > > CCProcessError = Err.Description
> > > Else
> > > CCProcessError = Empty
> > > End If
> > > end Function
> > > 'End CCProcessError
> > >
> > > 'CCGetRequestParam @0-C154AA52
> > > Function CCGetRequestParam(ParameterName, Method)
> > > Dim ParameterValue
> > >
> > > If Method = ccsGet Then
> > > ParameterValue = Request.QueryString(ParameterName)
> > > ElseIf Method = ccsPost Then
> > > ParameterValue = Request.Form(ParameterName)
> > > End If
> > > If CStr(ParameterValue) = "" Then _
> > > ParameterValue = Empty
> > >
> > > CCGetRequestParam = ParameterValue
> > > End Function
> > > 'End CCGetRequestParam
> > >
> > > 'CCGetQueryString @0-CBD7B22E
> > > Function CCGetQueryString(CollectionName, RemoveParameters)
> > > Dim QueryString, PostData
> > >
> > > If CollectionName = "Form" Then
> > > QueryString = CCCollectionToString(Request.Form, RemoveParameters)
> > > ElseIf CollectionName = "QueryString" Then
> > > QueryString = CCCollectionToString(Request.QueryString,
> > > RemoveParameters)
> > > ElseIf CollectionName = "All" Then
> > > QueryString = CCCollectionToString(Request.QueryString,
> > > RemoveParameters)
> > > PostData = CCCollectionToString(Request.Form, RemoveParameters)
> > > If Len(PostData) > 0 and Len(QueryString) > 0 Then _
> > > QueryString = QueryString & "&" & PostData _
> > > Else _
> > > QueryString = QueryString & PostData
> > > Else
> > > Err.Raise 1050, "Common Functions. CCGetQueryString Function", _
> > > "The CollectionName contains an illegal value."
> > > End If
> > >
> > > CCGetQueryString = QueryString
> > > End Function
> > > 'End CCGetQueryString
> > >
> > > 'CCCollectionToString @0-57CAA4B7
> > > Function CCCollectionToString(ParametersCollection, RemoveParameters)
> > > Dim ItemName, ItemValue, Result, Remove, I
> > >
> > > For Each ItemName In ParametersCollection
> > > Remove = false
> > > If IsArray(RemoveParameters) Then
> > > For I = 0 To UBound(RemoveParameters)
> > > If RemoveParameters(I) = ItemName Then
> > > Remove = True
> > > Exit For
> > > End If
> > > Next
> > > End If
> > > If Not Remove Then
> > > For Each ItemValue In ParametersCollection(ItemName)
> > > Result = Result & _
> > > "&" & ItemName & "=" & Server.URLEncode(ItemValue)
> > > Next
> > > End If
> > > Next
> > >
> > > If Len(Result) > 0 Then _
> > > Result = Mid(Result, 2)
> > > CCCollectionToString = Result
> > > End Function
> > > 'End CCCollectionToString
> > >
> > > 'CCAddZero @0-B5648418
> > > Function CCAddZero(Value, ResultLength)
> > > Dim CountZero, I
> > >
> > > CountZero = ResultLength - Len(Value)
> > > For I = 1 To CountZero
> > > Value = "0" & Value
> > > Next
> > > CCAddZero = Value
> > > End Function
> > > 'End CCAddZero
> > >
> > > 'CCGetAMPM @0-CB6EA5BF
> > > Function CCGetAMPM(HoursNumber, AnteMeridiem, PostMeridiem)
> > > If HoursNumber >= 0 And HoursNumber < 12 Then
> > > CCGetAMPM = AnteMeridiem
> > > Else
> > > CCGetAMPM = PostMeridiem
> > > End If
> > > End Function
> > > 'End CCGetAMPM
> > >
> > > 'CC12Hour @0-12B00AFF
> > > Function CC12Hour(HoursNumber)
> > > If HoursNumber = 0 Then
> > > HoursNumber = 12
> > > ElseIf HoursNumber > 12 Then
> > > HoursNumber = HoursNumber - 12
> > > End If
> > > CC12Hour = HoursNumber
> > > End Function
> > > 'End CC12Hour
> > >
> > > 'CCDBFormatByType @0-531721B5
> > > Function CCDBFormatByType(Variable)
> > > Dim Result
> > > If VarType(Variable) = vbString Then
> > > If LCase(Variable) = "null" Then
> > > Result = Variable
> > > Else
> > > Result = "'" & Variable & "'"
> > > End If
> > > Else
> > > Result = CStr(Variable)
> > > End If
> > > CCDBFormatByType = Result
> > > End Function
> > >
> > > 'End CCDBFormatByType
> > >
> > > 'CCFormatDate @0-9C44D5D4
> > > Function CCFormatDate(DateToFormat, FormatMask)
> > > Dim ResultArray(), I, Result
> > > If VarType(DateToFormat) = vbEmpty Then
> > > Result = Empty
> > > ElseIf VarType(DateToFormat) <> vbDate Then
> > > Err.Raise 4000, "CCFormatDate function. Type mismatch."
> > > ElseIf IsEmpty(FormatMask) Then
> > > Result = CStr(DateToFormat)
> > > Else
> > > ReDim ResultArray(UBound(FormatMask))
> > > For I = 0 To UBound(FormatMask)
> > > Select Case FormatMask(I)
> > > Case "d" ResultArray(I) = Day(DateToFormat)
> > > Case "w" ResultArray(I) = Weekday(DateToFormat)
> > > Case "m" ResultArray(I) = Month(DateToFormat)
> > > Case "q" ResultArray(I) = (Month(DateToFormat) + 3) \ 4
> > > Case "y" ResultArray(I) = (DateDiff("d", "1/1" & "/" &
> > > Year(DateToFormat), Month(DateToFormat) & "/" & Day(DateToFormat) &
"/"
> &
> > > Year(DateToFormat)) + 1)
> > > Case "h" ResultArray(I) = CC12Hour(Hour(DateToFormat))
> > > Case "H" ResultArray(I) = Hour(DateToFormat)
> > > Case "n" ResultArray(I) = Minute(DateToFormat)
> > > Case "s" ResultArray(I) = Second(DateToFormat)
> > > Case "dd" ResultArray(I) = CCAddZero(Day(DateToFormat), 2)
> > > Case "ww" ResultArray(I) = (DateDiff("ww", "1/1" & "/" &
> > > Year(DateToFormat), Month(DateToFormat) & "/" & Day(DateToFormat) &
"/"
> &
> > > Year(DateToFormat)) + 1)
> > > Case "mm" ResultArray(I) = CCAddZero(Month(DateToFormat), 2)
> > > Case "yy" ResultArray(I) = Right(Year(DateToFormat), 2)
> > > Case "hh" ResultArray(I) =
> CCAddZero(CC12Hour(Hour(DateToFormat)),
> > > 2)
> > > Case "HH" ResultArray(I) = CCAddZero(Hour(DateToFormat), 2)
> > > Case "nn" ResultArray(I) = CCAddZero(Minute(DateToFormat), 2)
> > > Case "ss" ResultArray(I) = CCAddZero(Second(DateToFormat), 2)
> > > Case "ddd" ResultArray(I) =
> > > CCSDateConstants.ShortWeekdays(Weekday(DateToFormat) - 1)
> > > Case "mmm" ResultArray(I) =
> > > CCSDateConstants.ShortMonths(Month(DateToFormat) - 1)
> > > Case "A/P" ResultArray(I) = CCGetAMPM(Hour(DateToFormat), "A",
> > "P")
> > > Case "a/p" ResultArray(I) = CCGetAMPM(Hour(DateToFormat), "a",
> > "p")
> > > Case "dddd" ResultArray(I) =
> > > CCSDateConstants.Weekdays(Weekday(DateToFormat) - 1)
> > > Case "mmmm" ResultArray(I) =
> > > CCSDateConstants.Months(Month(DateToFormat) - 1)
> > > Case "yyyy" ResultArray(I) = Year(DateToFormat)
> > > Case "AM/PM" ResultArray(I) = CCGetAMPM(Hour(DateToFormat),
> "AM",
> > > "PM")
> > > Case "am/pm" ResultArray(I) = CCGetAMPM(Hour(DateToFormat),
> "am",
> > > "pm")
> > > Case "LongDate" ResultArray(I) = FormatDateTime(DateToFormat,
> > > vbLongDate)
> > > Case "LongTime" ResultArray(I) = FormatDateTime(DateToFormat,
> > > vbLongTime)
> > > Case "ShortDate" ResultArray(I) = FormatDateTime(DateToFormat,
> > > vbShortDate)
> > > Case "ShortTime" ResultArray(I) = FormatDateTime(DateToFormat,
> > > vbShortTime)
> > > Case "GeneralDate" ResultArray(I) =
FormatDateTime(DateToFormat,
> > > vbGeneralDate)
> > > Case Else
> > > If Left(FormatMask(I), 1) = "\" Then _
> > > ResultArray(I) = Mid(FormatMask(I), 1) _
> > > Else
> > > ResultArray(I) = FormatMask(I)
> > > End Select
> > > Next
> > > Result = Join(ResultArray, "")
> > > End If
> > > CCFormatDate = Result
> > > End Function
> > > 'End CCFormatDate
> > >
> > > 'CCFormatBoolean @0-635596FD
> > > Function CCFormatBoolean(BooleanValue, arrFormat)
> > > Dim Result, TrueValue, FalseValue, EmptyValue
> > >
> > > If IsEmpty(arrFormat) Then
> > > Result = CStr(BooleanValue)
> > > Else
> > > TrueValue = arrFormat(0)
> > > FalseValue = arrFormat(1)
> > > EmptyValue = arrFormat(2)
> > > If IsEmpty(BooleanValue) Then
> > > Result = EmptyValue
> > > Else
> > > If BooleanValue Then _
> > > Result = TrueValue _
> > > Else _
> > > Result = FalseValue
> > > End If
> > > End If
> > > CCFormatBoolean = Result
> > > End Function
> > > 'End CCFormatBoolean
> > >
> > > 'CCFormatNumber @0-67C259CA
> > > Function CCFormatNumber(NumberToFormat, FormatArray)
> > > Dim IsNegative
> > > Dim IsExtendedFormat, IsDecimalSeparator, DecimalSeparator,
> > > IsPeriodSeparator, PeriodSeparator
> > >
> > > If IsEmpty(NumberToFormat) Then
> > > CCFormatNumber = ""
> > > Exit Function
> > > End If
> > >
> > > If IsArray(FormatArray) Then
> > > IsExtendedFormat = FormatArray(0)
> > > IsNegative = (NumberToFormat < 0)
> > > NumberToFormat = ABS(NumberToFormat) * FormatArray(7)
> > >
> > > If IsExtendedFormat Then ' Extended format
> > > IsDecimalSeparator = FormatArray(1)
> > > DecimalSeparator = FormatArray(2)
> > > IsPeriodSeparator = FormatArray(3)
> > > PeriodSeparator = FormatArray(4)
> > >
> > > Dim BeforeDecimal, AfterDecimal
> > > Dim ObligatoryBeforeDecimal, DigitsBeforeDecimal,
> > > ObligatoryAfterDecimal, DigitsAfterDecimal
> > > Dim I, Z
> > > BeforeDecimal = FormatArray(5)
> > > AfterDecimal = FormatArray(6)
> > > If IsArray(BeforeDecimal) Then
> > > For I = 0 To UBound(BeforeDecimal)
> > > If BeforeDecimal(I) = "0" Then
> > > ObligatoryBeforeDecimal = ObligatoryBeforeDecimal + 1
> > > DigitsBeforeDecimal = DigitsBeforeDecimal + 1
> > > ElseIf BeforeDecimal(I) = "#" Then
> > > DigitsBeforeDecimal = DigitsBeforeDecimal + 1
> > > End If
> > > Next
> > > End If
> > > If IsArray(AfterDecimal) Then
> > > For I = 0 To UBound(AfterDecimal)
> > > If AfterDecimal(I) = "0" Then
> > > ObligatoryAfterDecimal = ObligatoryAfterDecimal + 1
> > > DigitsAfterDecimal = DigitsAfterDecimal + 1
> > > ElseIf AfterDecimal(I) = "#" Then
> > > DigitsAfterDecimal = DigitsAfterDecimal + 1
> > > End If
> > > Next
> > > End If
> > >
> > > Dim NumDigitsAfterDecimal, Result, DefaultValue
> > > If ObligatoryAfterDecimal = 0 And DigitsAfterDecimal = 1 Then
> > > NumDigitsAfterDecimal = -1
> > > ElseIf Not IsDecimalSeparator Then
> > > NumDigitsAfterDecimal = 0
> > > Else
> > > NumDigitsAfterDecimal = DigitsAfterDecimal
> > > End If
> > > NumberToFormat = FormatNumber(NumberToFormat,
DigitsAfterDecimal,
> > > False, False, False)
> > >
> > > Dim DefaultDecimal : DefaultDecimal = Mid(FormatNumber(10001/10,
> 1,
> > > True, False, True), 6, 1)
> > > Dim LeftPart, RightPart
> > > If Not InStr(CStr(NumberToFormat), DefaultDecimal) = 0 Then
> > > Dim NumberParts : NumberParts = Split(CStr(NumberToFormat),
> > > DefaultDecimal)
> > > LeftPart = CStr(NumberParts(0))
> > > RightPart = CStr(NumberParts(1))
> > > Else
> > > LeftPart = CStr(NumberToFormat)
> > > End If
> > >
> > > Dim J : J = Len(LeftPart)
> > >
> > > If IsDecimalSeparator And DecimalSeparator = "" Then
> > > DefaultValue = CStr(FormatNumber(10001/10, 1, True, False,
> True))
> > > DecimalSeparator = Mid(DefaultValue, 6, 1)
> > > End If
> > >
> > > If IsPeriodSeparator And PeriodSeparator = "" Then
> > > DefaultValue = CStr(FormatNumber(10001/10, 1, True, False,
> True))
> > > PeriodSeparator = Mid(DefaultValue, 2, 1)
> > > End If
> > >
> > > If IsArray(BeforeDecimal) Then
> > > Dim RankNumber : RankNumber = 0
> > > For I = UBound(BeforeDecimal) To 0 Step -1
> > > If BeforeDecimal(i) = "#" Or BeforeDecimal(i) = "0" Then
> > > If DigitsBeforeDecimal = 1 And J > 1 Then
> > > If Not IsPeriodSeparator Then
> > > Result = Left(LeftPart, j) & Result
> > > Else
> > > For z = J To 1 Step -1
> > > RankNumber = RankNumber + 1
> > > If RankNumber Mod 3 = 1 And RankNumber - 3 > 0 Then
> > > Result = Mid(LeftPart, z, 1) & PeriodSeparator &
> > Result
> > > Else
> > > Result = Mid(LeftPart, z, 1) & Result
> > > End If
> > > Next
> > > End If
> > > ElseIf J > 0 Then
> > > RankNumber = RankNumber + 1
> > > If RankNumber Mod 3 = 1 And RankNumber - 3 > 0 And
> > > IsPeriodSeparator Then
> > > Result = Mid(LeftPart, j, 1) & PeriodSeparator &
Result
> > > Else
> > > Result = Mid(LeftPart, j, 1) & Result
> > > End If
> > > J = J - 1
> > > ObligatoryBeforeDecimal = ObligatoryBeforeDecimal - 1
> > > DigitsBeforeDecimal = DigitsBeforeDecimal - 1
> > > Else
> > > If ObligatoryBeforeDecimal > 0 Then
> > > RankNumber = RankNumber + 1
> > > If RankNumber Mod 3 = 1 And RankNumber - 3 > 0 And
> > > IsPeriodSeparator Then
> > > Result = "0" & PeriodSeparator & Result
> > > Else
> > > Result = "0" & Result
> > > End If
> > > ObligatoryBeforeDecimal = ObligatoryBeforeDecimal - 1
> > > DigitsBeforeDecimal = DigitsBeforeDecimal - 1
> > > End If
> > > End If
> > > Else
> > > BeforeDecimal(I) = Replace(BeforeDecimal(I), "##", "#")
> > > BeforeDecimal(I) = Replace(BeforeDecimal(I), "00", "0")
> > > Result = BeforeDecimal(I) & Result
> > > End If
> > > Next
> > > End If
> > >
> > > ' Left part after decimal
> > > Dim RightResult : RightResult = ""
> > > If IsArray(AfterDecimal) Then
> > > Dim IsZero : IsZero = True
> > > For I = UBound(AfterDecimal) To 0 Step -1
> > > If AfterDecimal(I) = "#" Or AfterDecimal(I) = "0" Then
> > > If DigitsAfterDecimal > ObligatoryAfterDecimal Then
> > > If Not Mid(RightPart, DigitsAfterDecimal, 1) = "0" Then
> > IsZero
> > > = False
> > > If Not IsZero Then _
> > > RightResult = Mid(RightPart, DigitsAfterDecimal, 1) &
> > > RightResult
> > > DigitsAfterDecimal = DigitsAfterDecimal - 1
> > > Else
> > > RightResult = Mid(RightPart, DigitsAfterDecimal, 1) &
> > > RightResult
> > > DigitsAfterDecimal = DigitsAfterDecimal - 1
> > > End If
> > > Else
> > > AfterDecimal(I) = Replace(AfterDecimal(I), "##", "#")
> > > AfterDecimal(I) = Replace(AfterDecimal(I), "00", "0")
> > > RightResult = AfterDecimal(I) & RightResult
> > > End If
> > > Next
> > > End If
> > >
> > > If IsDecimalSeparator AND Len(RightResult) > 0 Then _
> > > Result = Result & DecimalSeparator & RightResult
> > >
> > > If NOT FormatArray(10) AND IsNegative Then _
> > > Result = "-" & Result
> > >
> > > Result = Result & RightResult
> > > Else ' Simple format
> > > If Not FormatArray(3) AND IsNegative Then _
> > > Result = "-" & FormatArray(5) & FormatNumber(NumberToFormat,
> > > FormatArray(1), FormatArray(2), False, FormatArray(4)) &
FormatArray(6)
> _
> > > Else _
> > > Result = FormatArray(5) & FormatNumber(NumberToFormat,
> > > FormatArray(1), FormatArray(2), False, FormatArray(4)) &
FormatArray(6)
> > > End If
> > > If Not FormatArray(8) Then Result = Server.HTMLEncode(Result)
> > > If Not CStr(FormatArray(9)) = "" Then _
> > > Result = "<FONT COLOR=""" & FormatArray(9) & """>" & Result &
> > > "</FONT>"
> > > Else
> > > Result = NumberToFormat
> > > End If
> > > CCFormatNumber = Result
> > >
> > > End Function
> > > 'End CCFormatNumber
> > >
> > > 'CCParseBoolean @0-33711A62
> > > Function CCParseBoolean(Value, FormatMask)
> > > Dim Result
> > > Result = Empty
> > > If VarType(Value) = vbBoolean Then
> > > Result = Value
> > > Else
> > > If IsEmpty(FormatMask) Then
> > > Result = CBool(Value)
> > > Else
> > > If IsEmpty(Value) Then
> > > If CStr(FormatMask(0)) = "null" Then _
> > > Result = True
> > > If CStr(FormatMask(1)) = "null" Then _
> > > Result = False
> > > Else
> > > If CStr(Value) = CStr(FormatMask(0)) Then
> > > Result = True
> > > ElseIf CStr(Value) = CStr(FormatMask(1)) Then
> > > Result = False
> > > End If
> > > End If
> > > End If
> > > End If
> > > CCParseBoolean = Result
> > > End Function
> > > 'End CCParseBoolean
> > >
> > > 'CCParseDate @0-0D3D1ED4
> > > Function CCParseDate(ParsingDate, FormatMask)
> > > Dim ResultDate, ResultDateArray(8)
> > > Dim MaskPart, MaskLength, TokenLength
> > > Dim IsError
> > > Dim DatePosition, MaskPosition
> > > Dim Delimiter, BeginDelimiter
> > > Dim MonthNumber, MonthName, MonthArray
> > > Dim DatePart
> > >
> > > Dim IS_DATE_POS, YEAR_POS, MONTH_POS, DAY_POS, IS_TIME_POS,
HOUR_POS,
> > > MINUTE_POS, SECOND_POS
> > >
> > > IS_DATE_POS = 0 : YEAR_POS = 1 : MONTH_POS = 2 : DAY_POS = 3
> > > IS_TIME_POS = 4 : HOUR_POS = 5 : MINUTE_POS = 6 : SECOND_POS = 7
> > >
> > >
> > > If IsEmpty(FormatMask) Then
> > > If CStr(ParsingDate) = "" Then _
> > > ResultDate = Empty _
> > > Else _
> > > ResultDate = CDate(ParsingDate)
> > > ElseIf (FormatMask(0) = "GeneralDate" Or FormatMask(0) = "LongDate"
_
> > > Or FormatMask(0) = "ShortDate" Or FormatMask(0) = "LongTime" _
> > > Or FormatMask(0) = "ShortTime") And Not CStr(ParsingDate) = ""
Then
> > > ResultDate = CDate(ParsingDate)
> > > ElseIf CStr(ParsingDate) = "" Then
> > > ResultDate = Empty
> > > Else
> > > DatePosition = 1
> > > MaskPosition = 0
> > > MaskLength = UBound(FormatMask)
> > > IsError = False
> > >
> > > ' Default date
> > > ResultDateArray(IS_DATE_POS) = False
> > > ResultDateArray(IS_TIME_POS) = False
> > > ResultDateArray(YEAR_POS) = 0 : ResultDateArray(MONTH_POS) = 12 :
> > > ResultDateArray(DAY_POS) = 1
> > > ResultDateArray(HOUR_POS) = 0 : ResultDateArray(MINUTE_POS) = 0 :
> > > ResultDateArray(SECOND_POS) = 0
> > >
> > > While (MaskPosition <= MaskLength) AND NOT IsError
> > > MaskPart = FormatMask(MaskPosition)
> > > If CCSDateConstants.DateMasks.Exists(MaskPart) Then
> > > TokenLength = CCSDateConstants.DateMasks(MaskPart)
> > > If TokenLength > 0 Then
> > > DatePart = Mid(ParsingDate, DatePosition, TokenLength)
> > > DatePosition = DatePosition + TokenLength
> > > Else
> > > If MaskPosition < MaskLength Then
> > > Delimiter = FormatMask(MaskPosition + 1)
> > > BeginDelimiter = InStr(DatePosition, ParsingDate,
Delimiter)
> > > If BeginDelimiter = 0 Then
> > > Err.Raise 4000, "ParseDate function: The number doesn't
> > match
> > > the mask."
> > > Else
> > > DatePart = Mid(ParsingDate, DatePosition,
BeginDelimiter -
> > > DatePosition)
> > > DatePosition = BeginDelimiter
> > > End If
> > > Else
> > > DatePart = Mid(ParsingDate, DatePosition)
> > > End If
> > > End If
> > > Select Case MaskPart
> > > Case "d", "dd"
> > > ResultDateArray(DAY_POS) = CInt(DatePart)
> > > ResultDateArray(IS_DATE_POS) = True
> > > Case "m", "mm"
> > > ResultDateArray(MONTH_POS) = CInt(DatePart)
> > > ResultDateArray(IS_DATE_POS) = True
> > > Case "mmm", "mmmm"
> > > MonthNumber = 0
> > > MonthName = UCase(DatePart)
> > > If MaskPart = "mmm" Then _
> > > MonthArray = CCSDateConstants.ShortMonths _
> > > Else _
> > > MonthArray = CCSDateConstants.Months
> > > While MonthNumber < 11 AND UCase(MonthArray(MonthNumber))
<>
> > > MonthName
> > > MonthNumber = MonthNumber + 1
> > > Wend
> > > If MonthNumber = 11 Then
> > > If UCase(MonthArray(11)) <> MonthName Then _
> > > Err.Raise 4000, "ParseDate function: The number
doesn't
> > > match the mask."
> > > End If
> > > ResultDateArray(MONTH_POS) = MonthNumber + 1
> > > ResultDateArray(IS_DATE_POS) = True
> > > Case "yy", "yyyy"
> > > ResultDateArray(YEAR_POS) = CInt(DatePart)
> > > ResultDateArray(IS_DATE_POS) = True
> > > Case "h", "hh"
> > > If CInt(DatePart) = 12 Then _
> > > ResultDateArray(HOUR_POS) = 0 _
> > > Else _
> > > ResultDateArray(HOUR_POS) = CInt(DatePart)
> > > ResultDateArray(IS_TIME_POS) = True
> > > Case "H", "HH"
> > > ResultDateArray(HOUR_POS) = CInt(DatePart)
> > > ResultDateArray(IS_TIME_POS) = True
> > > Case "n", "nn"
> > > ResultDateArray(MINUTE_POS) = CInt(DatePart)
> > > ResultDateArray(IS_TIME_POS) = True
> > > Case "s", "ss"
> > > ResultDateArray(SECOND_POS) = CInt(DatePart)
> > > ResultDateArray(IS_TIME_POS) = True
> > > Case "am/pm", "a/p", "AM/PM", "A/P"
> > > If Left(LCase(DatePart), 1) = "p" Then
> > > ResultDateArray(HOUR_POS) = ResultDateArray(HOUR_POS) +
12
> > > ElseIf Left(LCase(DatePart), 1) = "a" Then
> > > ResultDateArray(HOUR_POS) = ResultDateArray(HOUR_POS)
> > > End If
> > > ResultDateArray(IS_TIME_POS) = True
> > > Case "w", "q"
> > > ' Do Nothing
> > > End Select
> > > Else
> > > DatePosition = DatePosition + Len(FormatMask(MaskPosition))
> > > End If
> > > MaskPosition = MaskPosition + 1
> > > Wend
> > > If ResultDateArray(IS_TIME_POS) AND ResultDateArray(IS_TIME_POS)
> Then
> > > ResultDate = DateSerial(ResultDateArray(YEAR_POS),
> > > ResultDateArray(MONTH_POS), ResultDateArray(DAY_POS)) _
> > > + TimeSerial(ResultDateArray(HOUR_POS),
> > ResultDateArray(MINUTE_POS),
> > > ResultDateArray(SECOND_POS))
> > > ElseIf ResultDateArray(IS_TIME_POS) Then
> > > ResultDate = TimeSerial(ResultDateArray(HOUR_POS),
> > > ResultDateArray(MINUTE_POS), ResultDateArray(SECOND_POS))
> > > ElseIf ResultDateArray(IS_DATE_POS) Then
> > > ResultDate = DateSerial(ResultDateArray(YEAR_POS),
> > > ResultDateArray(MONTH_POS), ResultDateArray(DAY_POS))
> > > End If
> > > End If
> > > CCParseDate = ResultDate
> > > End Function
> > > 'End CCParseDate
> > >
> > > 'CCParseNumber @0-BDE16F1E
> > > Function CCParseNumber(NumberValue, FormatArray, DataType)
> > > Dim Result, NumberValueType
> > > NumberValueType = VarType(NumberValue)
> > > If NumberValueType = vbInteger OR NumberValueType = vbLong _
> > > OR NumberValueType = vbSingle OR NumberValueType = vbSingle _
> > > OR NumberValueType = vbCurrency OR NumberValueType = vbDecimal _
> > > OR NumberValueType = vbByte Then
> > > If DataType = ccsInteger Then
> > > Result = CLng(NumberValue)
> > > ElseIf DataType = ccsFloat Then
> > > Result = CDbl(NumberValue)
> > > End If
> > > Else
> > > If Not CStr(NumberValue) = "" Then
> > > Dim DefaultValue, DefaultDecimal
> > > Dim DecimalSeparator, PeriodSeparator
> > > DecimalSeparator = "" : PeriodSeparator = ""
> > > If IsArray(FormatArray) Then
> > > If FormatArray(0) Then
> > > DecimalSeparator = FormatArray(2)
> > > PeriodSeparator = FormatArray(4)
> > > End If
> > > End If
> > > If Not CStr(DecimalSeparator) = "" Then
> > > DefaultValue = CStr(FormatNumber(10001/10, 1, True, False,
> True))
> > > DefaultDecimal = Mid(DefaultValue, 6, 1)
> > > NumberValue = Replace(NumberValue, DecimalSeparator,
> > DefaultDecimal)
> > > End If
> > > If Not CStr(PeriodSeparator) = "" Then NumberValue =
> > > Replace(NumberValue, PeriodSeparator, "")
> > > If DataType = ccsInteger Then
> > > Result = CLng(NumberValue)
> > > ElseIf DataType = ccsFloat Then
> > > Result = CDbl(NumberValue)
> > > End If
> > > Else
> > > Result = Empty
> > > End If
> > > End If
> > > CCParseNumber = Result
> > > End Function
> > > 'End CCParseNumber
> > >
> > > 'CCParseInteger @0-42815927
> > > Function CCParseInteger(NumberValue, FormatArray)
> > > CCParseInteger = CCParseNumber(NumberValue, FormatArray, ccsInteger)
> > > End Function
> > > 'End CCParseInteger
> > >
> > > 'CCParseFloat @0-56667DF0
> > > Function CCParseFloat(NumberValue, FormatArray)
> > > CCParseFloat = CCParseNumber(NumberValue, FormatArray, ccsFloat)
> > > End Function
> > > 'End CCParseFloat
> > >
> > > 'CCValidateDate @0-D0BEB752
> > > Function CCValidateDate(ValidatingDate, FormatMask)
> > > Dim MaskPosition, I, Result, OneChar, IsSeparator
> > > Dim RegExpPattern, RegExpObject, Matches
> > >
> > > IsSeparator = False
> > >
> > > If ValidatingDate = "" OR IsEmpty(ValidatingDate) Then
> > > Result = True
> > > ElseIf IsEmpty(FormatMask) Then
> > > Result = IsDate(ValidatingDate)
> > > ElseIf FormatMask(0) = "GeneralDate" Or FormatMask(0) = "LongDate" _
> > > Or FormatMask(0) = "ShortDate" Or FormatMask(0) = "LongTime" _
> > > Or FormatMask(0) = "ShortTime" Then
> > > Result = IsDate(ValidatingDate)
> > > Else
> > > For MaskPosition = 0 To UBound(FormatMask)
> > > If NOT IsSeparator Then
> > > Select Case FormatMask(MaskPosition)
> > > Case "d", "m", "h", "n", "s", "w", "q", "H"
> > > RegExpPattern = RegExpPattern + "\d{1,2}.+"
> > > IsSeparator = True
> > > Case "dd", "mm", "yy", "hh", "nn", "ss", "HH"
> > > RegExpPattern = RegExpPattern + "\d{2}"
> > > Case "yyyy"
> > > RegExpPattern = RegExpPattern + "\d{4}"
> > > Case "mmm"
> > > RegExpPattern = RegExpPattern + "(" &
> > > Join(CCSDateConstants.ShortMonths, "|") & ")"
> > > Case "mmmm"
> > > RegExpPattern = RegExpPattern + "(" &
> > > Join(CCSDateConstants.Months, "|") & ")"
> > > Case "am/pm"
> > > RegExpPattern = RegExpPattern + "[ap]m"
> > > Case "AM/PM"
> > > RegExpPattern = RegExpPattern + "[AP]M"
> > > Case "a/p"
> > > RegExpPattern = RegExpPattern + "[ap]"
> > > Case "A/P"
> > > RegExpPattern = RegExpPattern + "[AP]"
> > > Case Else
> > > For I = 1 To Len(FormatMask(MaskPosition))
> > > OneChar = Mid(FormatMask(MaskPosition), I, 1)
> > > If InStr("bBdDfnrsStvwW\", OneChar) = 0 Then _
> > > OneChar = "\" + OneChar
> > > RegExpPattern = RegExpPattern + OneChar
> > > Next
> > > End Select
> > > Else
> > > IsSeparator = False
> > > For I = 2 To Len(FormatMask(MaskPosition))
> > > OneChar = Mid(FormatMask(MaskPosition), I, 1)
> > > If InStr("bBdDfnrsStvwW\", OneChar) = 0 Then _
> > > OneChar = "\" + OneChar
> > > RegExpPattern = RegExpPattern + OneChar
> > > Next
> > > End If
> > > Next
> > > Set RegExpObject = New RegExp
> > > RegExpObject.IgnoreCase = False
> > > RegExpObject.Global = True
> > > RegExpObject.Pattern = RegExpPattern
> > > Set Matches = RegExpObject.Execute(ValidatingDate)
> > > Result = CBool(Matches.Count = 1)
> > > Set Matches = Nothing
> > > Set RegExpObject = Nothing
> > > End If
> > > CCValidateDate = Result
> > > End Function
> > > 'End CCValidateDate
> > >
> > > 'CCValidateNumber @0-08089509
> > > Function CCValidateNumber(NumberValue, FormatArray)
> > > Dim Result, NumberValueType
> > > NumberValueType = VarType(NumberValue)
> > > If NumberValueType = vbInteger OR NumberValueType = vbLong _
> > > OR NumberValueType = vbSingle OR NumberValueType = vbSingle _
> > > OR NumberValueType = vbCurrency OR NumberValueType = vbDecimal _
> > > OR NumberValueType = vbByte Then
> > > Result = True
> > > Else
> > > If Not CStr(NumberValue) = "" Then
> > > Dim DefaultValue, DefaultDecimal
> > > Dim DecimalSeparator, PeriodSeparator
> > > DecimalSeparator = "" : PeriodSeparator = ""
> > > If IsArray(FormatArray) Then
> > > If FormatArray(0) Then
> > > DecimalSeparator = FormatArray(2)
> > > PeriodSeparator = FormatArray(4)
> > > End If
> > > End If
> > > If Not CStr(DecimalSeparator) = "" Then
> > > DefaultValue = CStr(FormatNumber(10001/10, 1, True, False,
> True))
> > > DefaultDecimal = Mid(DefaultValue, 6, 1)
> > > NumberValue = Replace(NumberValue, DecimalSeparator,
> > DefaultDecimal)
> > > End If
> > > If Not CStr(PeriodSeparator) = "" Then NumberValue =
> > > Replace(NumberValue, PeriodSeparator, "")
> > > Result = IsNumeric(NumberValue)
> > > Else
> > > Result = True
> > > End If
> > > End If
> > > CCValidateNumber = Result
> > > End Function
> > > 'End CCValidateNumber
> > >
> > > 'CCValidateBoolean @0-B8DE2060
> > > Function CCValidateBoolean(Value, FormatMask)
> > > Dim Result: Result = False
> > >
> > > If VarType(Value) = vbBoolean Then
> > > Result = True
> > > Else
> > > If IsEmpty(FormatMask) Then
> > > On Error Resume Next
> > > Result = CBool(Value)
> > > Result = Not(Err > 0)
> > > Else
> > > If IsEmpty(Value) Or CStr(Value) = "" Then
> > > Result = (CStr(FormatMask(0)) = "null") Or
(CStr(FormatMask(0))
> =
> > > "Undefined") Or (CStr(FormatMask(0)) = "")
> > > Result = Result Or (CStr(FormatMask(1)) = "null") Or
> > > (CStr(FormatMask(1)) = "Undefined") Or (CStr(FormatMask(1)) = "")
> > > If UBound(FormatMask) = 2 Then _
> > > Result = Result Or (CStr(FormatMask(2)) = "null") Or
> > > (CStr(FormatMask(2)) = "Undefined") Or (CStr(FormatMask(2)) = "")
> > > Else
> > > Result = (CStr(Value) = CStr(FormatMask(0))) Or (CStr(Value) =
> > > CStr(FormatMask(1)))
> > > If UBound(FormatMask) = 2 Then _
> > > Result = Result Or (CStr(Value) = CStr(FormatMask(2)))
> > > End If
> > > End If
> > > End If
> > > CCValidateBoolean = Result
> > > End Function
> > > 'End CCValidateBoolean
> > >
> > > 'CCAddParam @0-6D59DAA5
> > > Function CCAddParam(QueryString, ParameterName, ParameterValue)
> > > Dim Result
> > >
> > > Result = Replace("&" & QueryString, "&" & ParameterName & "=" &
> > > Server.URLEncode(Request.QueryString(ParameterName)), "")
> > > Result = Result & "&" & ParameterName & "=" &
> > > Server.URLEncode(ParameterValue)
> > > Result = Replace(Result, "&&", "&")
> > > If Left(Result, 1) = "&" Then Result = Mid(Result, 2)
> > > CCAddParam = Result
> > > End Function
> > > 'End CCAddParam
> > >
> > > 'CCRemoveParam @0-64B4FAAF
> > > Function CCRemoveParam(QueryString, ParameterName)
> > > Dim Result
> > > Result = Replace(QueryString, ParameterName & "=" &
> > > Server.URLEncode(Request.QueryString(ParameterName)), "")
> > > Result = Replace(Result, "&&", "&")
> > > If Left(Result, 1) = "&" Then Result = Mid(Result, 2)
> > > CCRemoveParam = Result
> > > End Function
> > > 'End CCRemoveParam
> > >
> > > 'CCRegExpTest @0-9EAA5A2D
> > > Function CCRegExpTest(TestValue, RegExpMask, IgnoreCase, GlobalTest)
> > > Dim Result
> > > If Not CStr(TestValue) = "" Then
> > > Dim RegExpObject
> > > Set RegExpObject = New RegExp
> > > RegExpObject.Pattern = RegExpMask
> > > RegExpObject.IgnoreCase = IgnoreCase
> > > RegExpObject.Global = GlobalTest
> > > Result = RegExpObject.Test(CStr(TestValue))
> > > Set RegExpObject = Nothing
> > > Else
> > > Result = True
> > > End If
> > > CCRegExpTest = Result
> > > End Function
> > >
> > >
> > > 'End CCRegExpTest
> > >
> > > 'CCRegExpTest @0-4BE3AE1D
> > > Sub CheckSSL()
> > > If Not UCase(Request.ServerVariables("HTTPS")) = "ON" Then
> > > Response.Write "SSL connection error. This page can be accessed
only
> > via
> > > secured connection."
> > > Response.End
> > > End If
> > > End Sub
> > >
> > > 'End CCRegExpTest
> > >
> > > 'CCGetUserLogin @0-4306ED6C
> > > Function CCGetUserLogin()
> > > CCGetUserLogin = Session("UserLogin")
> > > End Function
> > > 'End CCGetUserLogin
> > >
> > > 'CCSecurityRedirect @0-790A88DF
> > > Sub CCSecurityRedirect(GroupsAccess, URL)
> > > Dim ErrorType
> > > Dim Link
> > > ErrorType = CCSecurityAccessCheck(GroupsAccess)
> > > If NOT (ErrorType = "success") Then
> > > If IsEmpty(URL) Then _
> > > Link = ServerURL & "Login.asp" _
> > > Else _
> > > Link = URL
> > > Response.Redirect(Link & "?ret_link=" & _
> > > Server.URLEncode(Request.ServerVariables("SCRIPT_NAME") &
_
> > > "?" &
CCRemoveParam(Request.ServerVariables("QUERY_STRING"),
> > > "ccsForm")) & "&type=" & ErrorType)
> > > End If
> > > End Sub
> > > 'End CCSecurityRedirect
> > >
> > > 'CCGetUserID @0-449B3B19
> > > Function CCGetUserID()
> > > CCGetUserID = Session("UserID")
> > > End Function
> > > 'End CCGetUserID
> > >
> > > 'CCSecurityAccessCheck @0-8A7701BE
> > > Function CCSecurityAccessCheck(GroupsAccess)
> > > Dim ErrorType
> > > Dim GroupID
> > > ErrorType = "success"
> > > If IsEmpty(CCGetUserID()) Then
> > > ErrorType = "notLogged"
> > > Else
> > > GroupID = CCGetGroupID()
> > > If IsEmpty(GroupID) Then
> > > ErrorType = "groupIDNotSet"
> > > Else
> > > If NOT CCUserInGroups(GroupID, GroupsAccess) Then
> > > ErrorType = "illegalGroup"
> > > End If
> > > End If
> > > End If
> > > CCSecurityAccessCheck = ErrorType
> > > End Function
> > > 'End CCSecurityAccessCheck
> > >
> > > 'CCGetGroupID @0-B2650479
> > > Function CCGetGroupID()
> > > CCGetGroupID = Session("GroupID")
> > > End Function
> > > 'End CCGetGroupID
> > >
> > > 'CCUserInGroups @0-4332AEA7
> > > Function CCUserInGroups(GroupID, GroupsAccess)
> > > Dim Result
> > > Dim GroupNumber
> > > If NOT IsEmpty(GroupsAccess) Then
> > > GroupNumber = CLng(GroupID)
> > > While NOT Result AND GroupNumber > 0
> > > Result = NOT (InStr(";" & GroupsAccess & ";", ";" & GroupNumber & ";")
=
> > 0)
> > > GroupNumber = GroupNumber - 1
> > > Wend
> > > Else
> > > Result = True
> > > End If
> > > CCUserInGroups = Result
> > > End Function
> > > 'End CCUserInGroups
> > >
> > > 'CCLoginUser @0-6D3FEC5B
> > > Function CCLoginUser(Login, Password)
> > > Dim Result
> > > Dim SQL
> > > Dim RecordSet
> > > Dim Connection
> > >
> > > Set Connection = New clsDBConnection1
> > > Connection.Open
> > > SQL = "SELECT id_empleado, group FROM Empleados WHERE emp_login='"
&
> > > Replace(Login, "'", "''") & "' AND emp_password='" & Replace(Password,
> > "'",
> > > "''") & "'"
> > > Set RecordSet = Connection.Execute(SQL)
> > > Result = NOT RecordSet.EOF
> > > If Result Then
> > > Session("UserID") = RecordSet("id_empleado")
> > > Session("UserLogin") = Login
> > > Session("GroupID") = RecordSet("group")
> > > End If
> > > RecordSet.Close
> > > Set RecordSet = Nothing
> > > Connection.Close
> > > Set Connection = Nothing
> > > CCLoginUser = Result
> > > End Function
> > > 'End CCLoginUser
> > >
> > > 'CCLogoutUser @0-DB93CE50
> > > Sub CCLogoutUser()
> > > Session("UserID") = Empty
> > > Session("UserLogin") = Empty
> > > Session("GroupID") = Empty
> > > End Sub
> > > 'End CCLogoutUser
> > >
> > >
> > > %>
> > >
> > > Any help will be greatly appreciated...
> > >
> > >
> > >
> > >
> > > "Pepito" <dfga@kk.com> wrote in message
> > >news:b44qfl$ltg$1@news.codecharge.com...
> > > > Hello Everyone, I uploaded a css project (that runs great on IIS at
my
> > > > machine) to a free server (brinkster). I can properly see on a
browser
> > > > *.html files but not the same file *.asp....error 500...
> > > >
> > > > any hint?
> > > >
> > > > check it out at
> > > http://www10.brinkster.com/mariosbm/code/Empleados_list.html
> > > > http://www10.brinkster.com/mariosbm/code/Empleados_list.asp
> > > >
> > > > your help is greatly appreciated...I 'not a programmer but would
like
> to
> > > set
> > > > a site of this kind
> > > >
> > > > Thanks
> > > >
> > > >
> > > >
> > >
> > >
> >
> >
> >
>
>
|
|
|
|
Pepito
|
| Posted: 03/05/2003, 9:56 AM |
|
Damn it!! I can't make it work.
Well, thanks for your help:
I had the original chunk of code:
----------------------------------------------------------------------------
---
Private Sub Class_Initialize()
ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;User
ID=Admin;Data Source=C:\Documents and Settings\M\My Documents\web
solutions\New Folder\NewProject5\GardenCo.mdb;Persist Security Info=False"
User = "Admin"
Password = ""
DateFormat = Empty
BooleanFormat = Empty
Set objConnection = Server.CreateObject("ADODB.Connection")
Set Errors = New clsErrors
End Sub
----------------------------------------------------------------------------
---
and I used your tip...this is the result..
----------------------------------------------------------------------------
---
Private Sub Class_Initialize()
ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" &
Server.MapPath("./mariosbm/db/GardenCo.mdb") & ";Persist Security
Info=False"
User = "Admin"
Password = ""
DateFormat = Empty
BooleanFormat = Empty
Set objConnection = Server.CreateObject("ADODB.Connection")
Set Errors = New clsErrors
End Sub
----------------------------------------------------------------------------
---
Does not work, the error now is this:
Microsoft JET Database Engine error '80004005'
'\\genfs1\www10\mariosbm\code\mariosbm\db\GardenCo.mdb' is not a valid path.
Make sure that the path name is spelled correctly and that you are connected
to the server on which the file resides.
/mariosbm/code/Common.asp, line 117
----------------------------------------------------------------------------
---
Yes, there is a db directory where to put the database, and it is there
\mariosbm\db\GardenCo.mdb I hve to tell you that there is a couple of lines
at the beggining..
Set TemplatesRepository = New clsCache_FileSystem
ServerURL = "http://localhost/NewProject6/"
Set CCSDateConstants = New clsCCSDateConstants
could that be the problem? I mean, the server id www.brinkster.com...and
the site is
http://www10.brinkster.com/mariosbm/code/Empleados_list.asp
any help will be greatly appreciated...
Thanks
----------------------------------------------------------------------------
---
"Sixto Luis Santos" <ccs@tecnoapoyo.com> wrote in message
news:b45baj$rgg$1@news.codecharge.com...
> Pepito,
>
> First, move your database to its own folder (for example, db). Then, You
> need to manually edit your DB connection to use a custom connection string
> (remove the checkmark from "Same as design"). Set your connection string
to
> something like this:
> Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" &
> Server.MapPath("./db/GardenCo.mdb") & ";Persist Security Info=False
>
> This should allow your application to run, but almost certainly, you won't
> be able to edit anything. You must explicitly assign write permissions to
> the db folder and that is an entirely different problem not always easy to
> solve. But, most good hosts provide a folder with the necessary
permissions
> already in place. Check for a folder named db or fpdb or something like
> that. Now, if you use FrontPage, use it to upload the database and allow
it
> to move the database to the fpdb folder. FrontPage should take care of the
> permissions issue all by itself. Remember to change the connection string
> accordingly.
>
> Regards,
>
> Sixto
>
> "Pepito" <pepitxispi@yahoo.com> wrote in message
>news:b458ko$m31$1@news.codecharge.com...
> > Sorry, Outlook does not allow me to see the attachment because it is
> > "potentially" unsafe...could you please zip or rar it?
> > Anyway, as the brinkers site is not good for uploading, I am trying
> > everything at this server..
> > the database is here
> > http://mariosbm.www4.dotnetplayground.com/code/GardenCo.mdb
> > the page is here
> > http://mariosbm.www4.dotnetplayground.com/code/Empleados_list.asp (you
can
> > see the html here
> > http://mariosbm.www4.dotnetplayground.com/code/Empleados_list.html)
> >
> > Thanks for your help!!!!
> >
> > "NetFocus.biz" <amcfayen@netfocus.biz> wrote in message
> >news:b457e6$ipc$1@news.codecharge.com...
> > > Hi
> > >
> > > You need to know the file path to the database. You can find this out
> > using
> > > the server.mappath method. You can take the attached small file and
copy
> > it
> > > to the same folder as your database, then go to
> > > http://www10.brinkster.com/mariosbm/code/getpath.asp
> > >
> > > you should then see a result like this in your browser:
> > >
> > > c:\inetpub\wwwroot\test\getpath.asp
> > >
> > > which will tell you how to refer to the database in Common.asp (in
this
> > case
> > > c:\inetpub\wwwroot\test\GardenCo.mdb).
> > >
> > > Hope this helps
> > >
> > > Alistair
> > >
> > >
> > >
> > > --
> > > Managing Director
> > > NetFocus Solutions Ltd
> > > 2 Cockburn Place
> > > Riverside Business Park
> > > Irvine, Ayrshire, KA11 5DA
> > > Tel: +44 (0) 1294 318701
> > > Fax: +44 (0) 1294 316580
> > > Internet: www.netfocus.biz
> > >
> > > "Pepito" <pepitxispi@yahoo.com> wrote in message
> > >news:b4568c$fu3$1@news.codecharge.com...
> > > > Thanks for your responses:
> > > >
> > > > 1) I already turn off the friendly error showing,
> > > > 2) I am playing with changing the path as Alistair kindly
suggested..
> > > >
> > > > However, I am messing the code ...
> > > > well....the database is here
> > > > http://mariosbm.www4.dotnetplayground.com/code/GardenCo.mdb
> > > > the page is here
> > > > http://mariosbm.www4.dotnetplayground.com/code/Empleados_list.asp
(you
> > can
> > > > see the html here
> > > > http://mariosbm.www4.dotnetplayground.com/code/Empleados_list.html)
> > > > so, if the problem is here:
> > > > "Microsoft JET Database Engine error '80004005'
> > > >
> > > > 'C:\Documents and Settings\M\My Documents\web solutions\New
> > > > Folder\NewProject6\GardenCo.mdb' is not a valid path. Make sure that
> the
> > > > path name is spelled correctly and that you are connected to the
> server
> > on
> > > > which the file resides.
> > > >
> > > > /mariosbm/code/Common.asp, line 117"
> > > >
> > > > Should I write instead of C:\...etc this: \code\GardenCo.mdb ?? that
> is
> > > not
> > > > working also....
> > > >
> > > > here is the old code:
> > > >
> > > > <%
> > > > Option Explicit
> > > >
> > > > 'Include Files @0-0F8FBEEB
> > > > %>
> > > > <!-- #INCLUDE FILE="Adovbs.asp" -->
> > > > <!-- #INCLUDE FILE="Classes.asp" -->
> > > > <%
> > > > 'End Include Files
> > > >
> > > > 'Script Engine Version Check @0-A118D8E9
> > > > If ScriptEngineMajorVersion < 5 Then
> > > > Response.Write "Sorry. This program requires VBScript 5.1 to
> > > run.<br>You
> > > > may upgrade your VBScript at
> > > > http://www.microsoft.com/msdownload/vbscript/scripting.asp.";
> > > > Response.End
> > > > Else
> > > > If ScriptEngineMajorVersion & ":" & ScriptEngineMinorVersion =
> "5:0"
> > > > Then
> > > > Response.Write "Due to a bug in VBScript 5.0, this program
> would
> > > > crash your server. See
> > > >
http://support.microsoft.com/default.aspx?scid=kb;EN-US...<br>";
> &
> > _
> > > > "Upgrade your VBScript at
> > > > http://www.microsoft.com/msdownload/vbscript/scripting.asp.";
> > > > Response.End
> > > > End If
> > > > End If
> > > > 'End Script Engine Version Check
> > > >
> > > > 'Initialize Common Variables @0-EB7D5995
> > > > Dim CCSDateConstants
> > > > Dim ServerURL
> > > > Dim SecureURL
> > > > Dim TemplatesRepository
> > > > Dim EventCaller
> > > >
> > > > Set TemplatesRepository = New clsCache_FileSystem
> > > > ServerURL = "http://localhost/NewProject5/"
> > > > Set CCSDateConstants = New clsCCSDateConstants
> > > >
> > > > Class clsCCSDateConstants
> > > >
> > > > Public Weekdays
> > > > Public ShortWeekdays
> > > > Public Months
> > > > Public ShortMonths
> > > > Public DateMasks
> > > >
> > > > Private Sub Class_Initialize()
> > > > ShortWeekdays = Array("Sun", "Mon", "Tue", "Wed", "Thu",
> "Fri",
> > > > "Sat")
> > > > Weekdays = Array("Sunday", "Monday", "Tuesday", "Wednesday",
> > > > "Thursday", "Friday", "Saturday")
> > > > ShortMonths = Array("Jan", "Feb", "Mar", "Apr", "May",
"Jun",
> > > > "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")
> > > > Months = Array("January", "February", "March", "April",
"May",
> > > > "June", "July", "August", "September", "October", "November",
> > "December")
> > > > Set DateMasks = CreateObject("Scripting.Dictionary")
> > > > DateMasks("d") = 0
> > > > DateMasks("dd") = 2
> > > > DateMasks("m") = 0
> > > > DateMasks("mm") = 2
> > > > DateMasks("mmm") = 3
> > > > DateMasks("mmmm") = 0
> > > > DateMasks("yy") = 2
> > > > DateMasks("yyyy") = 4
> > > > DateMasks("h") = 0
> > > > DateMasks("hh") = 2
> > > > DateMasks("H") = 0
> > > > DateMasks("HH") = 2
> > > > DateMasks("n") = 0
> > > > DateMasks("nn") = 2
> > > > DateMasks("s") = 0
> > > > DateMasks("ss") = 2
> > > > DateMasks("am/pm") = 2
> > > > DateMasks("AM/PM") = 2
> > > > DateMasks("A/P") = 1
> > > > DateMasks("a/p") = 1
> > > > DateMasks("w") = 0
> > > > DateMasks("q") = 0
> > > > End Sub
> > > >
> > > > Private Sub Class_Terminate()
> > > > Set DateMasks = Nothing
> > > > End Sub
> > > >
> > > > End Class
> > > >
> > > > Const ccsInteger = 1
> > > > Const ccsFloat = 2
> > > > Const ccsText = 3
> > > > Const ccsDate = 4
> > > > Const ccsBoolean = 5
> > > > Const ccsMemo = 6
> > > >
> > > > Const ccsGet = 1
> > > > Const ccsPost = 2
> > > > 'End Initialize Common Variables
> > > >
> > > > 'Connection1 Connection Class @-2D543FFD
> > > > Class clsDBConnection1
> > > >
> > > > Public ConnectionString
> > > > Public User
> > > > Public Password
> > > > Public DateFormat
> > > > Public BooleanFormat
> > > > Public LastSQL
> > > > Public Errors
> > > >
> > > > Private objConnection
> > > > Private blnState
> > > >
> > > > Private Sub Class_Initialize()
> > > > ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;User
> > > > ID=Admin;Data Source=C:\Documents and Settings\M\My Documents\web
> > > > solutions\New Folder\NewProject5\GardenCo.mdb;Persist Security
> > Info=False"
> > > > User = "Admin"
> > > > Password = ""
> > > > DateFormat = Empty
> > > > BooleanFormat = Empty
> > > > Set objConnection = Server.CreateObject("ADODB.Connection")
> > > > Set Errors = New clsErrors
> > > > End Sub
> > > >
> > > > Sub Open()
> > > > On Error Resume Next
> > > > objConnection.Errors.Clear
> > > > objConnection.Open ConnectionString, User, Password
> > > > If Err.Number <> 0 then
> > > > Response.Write "<div><h2>Unable to establish connection
to
> > > > database.</h2>"
> > > > Response.Write "<ul><li>Error information:<br>"
> > > > Response.Write Err.Source & " (0x" & Hex(Err.Number) &
> > ")<br>"
> > > > Response.Write Err.Description & "</li>"
> > > > If Err.Number = -2147467259 then _
> > > > Response.Write "<li>More information:<br>The database
> cannot
> > > be
> > > > opened, most likely due to insufficient security set on your
database
> > > folder
> > > > or file.</li>"
> > > > Response.Write "</ul></div>"
> > > > Response.End
> > > > End If
> > > > End Sub
> > > >
> > > > Sub Close()
> > > > objConnection.Close
> > > > End Sub
> > > >
> > > > Function Execute(varCMD)
> > > > Dim ErrorMessage, objResult
> > > > Errors.Clear
> > > > Set objResult = Server.CreateObject("ADODB.Recordset")
> > > > objResult.CursorType = adOpenForwardOnly
> > > > objResult.LockType = adLockReadOnly
> > > > If TypeName(varCMD) = "Command" Then
> > > > Set varCMD.ActiveConnection = objConnection
> > > > Set objResult.Source = varCMD
> > > > LastSQL = varCMD.CommandText
> > > > Else
> > > > Set objResult.ActiveConnection = objConnection
> > > > objResult.Source = varCMD
> > > > LastSQL = varCMD
> > > > End If
> > > > On Error Resume Next
> > > > objResult.Open
> > > > Errors.AddError CCProcessError(objConnection)
> > > > On Error Goto 0
> > > > Set Execute = objResult
> > > > End Function
> > > >
> > > > Property Get Connection()
> > > > Set Connection = objConnection
> > > > End Property
> > > >
> > > > Property Get State()
> > > > State = objConnection.State
> > > > End Property
> > > >
> > > > Function ToSQL(Value, ValueType)
> > > > If CStr(Value) = "" OR IsEmpty(Value) Then
> > > > ToSQL = "Null"
> > > > Else
> > > > If ValueType = ccsInteger or ValueType = ccsFloat Then
> > > > ToSQL = Replace(Value, ",", ".")
> > > > ElseIf ValueType = ccsDate Then
> > > > ToSQL = "'" & Replace(Value, "'", "''") & "'"
> > > > Else
> > > > ToSQL = "'" & Replace(Value, "'", "''") & "'"
> > > > End If
> > > > End If
> > > > End Function
> > > >
> > > >
> > > > End Class
> > > > 'End Connection1 Connection Class
> > > >
> > > > 'IIf @0-535EAADD
> > > > Function IIf(Expression, TrueResult, FalseResult)
> > > > If CBool(Expression) Then _
> > > > IIf = TrueResult _
> > > > Else _
> > > > IIf = FalseResult
> > > > End Function
> > > > 'End IIf
> > > >
> > > > 'Print @0-065FC167
> > > > Sub Print(Value)
> > > > Response.Write CStr(Value)
> > > > End Sub
> > > > 'End Print
> > > >
> > > > 'CCRaiseEvent @0-E59A6846
> > > > Function CCRaiseEvent(Events, EventName, Caller)
> > > > Set EventCaller = Caller
> > > > Dim Result : Result = Events(EventName)
> > > > Set EventCaller = Nothing
> > > > If VarType(Result) = vbEmpty Then _
> > > > Result = True
> > > > CCRaiseEvent = Result
> > > > End Function
> > > > 'End CCRaiseEvent
> > > >
> > > > 'CCFormatError @0-21121FA6
> > > > Function CCFormatError(Title, Errors)
> > > > Dim Result, I
> > > > Result = "<p><b>Source:</b> " & Title & "<br>"
> > > > For I = 0 To Errors.Count - 1
> > > > Result = Result & "<b>Error:</b> " & Errors.ErrorByNumber(I)
> > > > Next
> > > > Result = Result & "</p>"
> > > > CCFormatError = Result
> > > > End Function
> > > > 'End CCFormatError
> > > >
> > > > 'CCOpenRS @0-9E4633EC
> > > > Function CCOpenRS(RecordSet, SQL, Connection, ShowError)
> > > > Dim ErrorMessage, Result
> > > > Result = Empty
> > > > Set RecordSet = Server.CreateObject("ADODB.Recordset")
> > > > On Error Resume Next
> > > > RecordSet.Open SQL, Connection, adOpenForwardOnly,
adLockReadOnly,
> > > > adCmdText
> > > > ErrorMessage = CCProcessError(Connection)
> > > > If NOT IsEmpty(ErrorMessage) Then
> > > > If ShowError Then _
> > > > Result = "SQL: " & CommandObject.CommandText & "<br>" &
> > > "Error:
> > > > " & ErrorMessage & "<br>" _
> > > > Else _
> > > > Result = "Database error.<br>"
> > > > End If
> > > > On Error Goto 0
> > > > CCOpenRS = Result
> > > > End Function
> > > > 'End CCOpenRS
> > > >
> > > > 'CCOpenRSFromCmd @0-A2A33ECF
> > > > Function CCOpenRSFromCmd(RecordSet, CommandObject, ShowError)
> > > > Dim ErrorMessage, Result
> > > > Result = Empty
> > > > Set RecordSet = Server.CreateObject("ADODB.Recordset")
> > > > On Error Resume Next
> > > > RecordSet.CursorType = adOpenForwardOnly
> > > > RecordSet.LockType = adLockReadOnly
> > > > RecordSet.Open CommandObject
> > > > ErrorMessage = CCProcessError(CommandObject.ActiveConnection)
> > > > If NOT IsEmpty(ErrorMessage) Then
> > > > If ShowError Then _
> > > > Result = "SQL: " & CommandObject.CommandText & "<br>" &
> > > "Error:
> > > > " & ErrorMessage & "<br>" _
> > > > Else _
> > > > Result = "Database error.<br>"
> > > > End If
> > > > On Error Goto 0
> > > > CCOpenRSFromCmd = Result
> > > > End Function
> > > > 'End CCOpenRSFromCmd
> > > >
> > > > 'CCExecCmd @0-3DC993D0
> > > > Function CCExecCmd(CommandObject, ShowError)
> > > > Dim ErrorMessage, Result
> > > > Result = Empty
> > > > On Error Resume Next
> > > > CommandObject.Execute
> > > > ErrorMessage = CCProcessError(CommandObject.ActiveConnection)
> > > > If NOT IsEmpty(ErrorMessage) Then
> > > > If ShowError Then _
> > > > Result = "SQL: " & CommandObject.CommandText & "<br>" &
> > > "Error:
> > > > " & ErrorMessage & "<br>" _
> > > > Else _
> > > > Result = "Database error.<br>"
> > > > End If
> > > > On Error Goto 0
> > > > CCExecCmd = Result
> > > > End Function
> > > > 'End CCExecCmd
> > > >
> > > > 'CCExecSQL @0-24CC2822
> > > > Function CCExecSQL(SQL, Connection, ShowError)
> > > > Dim ErrorMessage, Result
> > > > Result = Empty
> > > > On Error Resume Next
> > > > Connection.Execute(SQL)
> > > > ErrorMessage = CCProcessError(Connection)
> > > > If NOT IsEmpty(ErrorMessage) Then
> > > > If ShowError Then _
> > > > Result = "SQL: " & SQL & "<br>" & "Error: " &
ErrorMessage
> &
> > > > "<br>" _
> > > > Else _
> > > > Result = "Database error.<br>"
> > > > End If
> > > > On Error Goto 0
> > > > CCExecSQL = Result
> > > > End Function
> > > > 'End CCExecSQL
> > > >
> > > > 'CCToHTML @0-44D2E9F4
> > > > Function CCToHTML(Value)
> > > > If IsNull(Value) Then Value = ""
> > > > CCToHTML = Server.HTMLEncode(Value)
> > > > End Function
> > > > 'End CCToHTML
> > > >
> > > > 'CCToURL @0-23A93674
> > > > Function CCToURL(Value)
> > > > If IsNull(Value) Then Value = ""
> > > > CCToURL = Server.URLEncode(Value)
> > > > End Function
> > > > 'End CCToURL
> > > >
> > > > 'CCGetValueHTML @0-30C69AED
> > > > Function CCGetValueHTML(RecordSet, FieldName)
> > > > CCGetValueHTML = CCToHTML(CCGetValue(RecordSet, FieldName))
> > > > End Function
> > > > 'End CCGetValueHTML
> > > >
> > > > 'CCGetValue @0-C5915067
> > > > Function CCGetValue(RecordSet, FieldName)
> > > > Dim Result
> > > > On Error Resume Next
> > > > If RecordSet Is Nothing Then
> > > > CCGetValue = Empty
> > > > ElseIf (NOT RecordSet.EOF) AND (FieldName <> "") Then
> > > > Result = RecordSet(FieldName)
> > > > If IsNull(Result) Then _
> > > > Result = Empty
> > > > CCGetValue = Result
> > > > Else
> > > > CCGetValue = Empty
> > > > End If
> > > > On Error Goto 0
> > > > End Function
> > > > 'End CCGetValue
> > > >
> > > > 'CCGetDate @0-4102C01B
> > > > Function CCGetDate(RecordSet, FieldName, arrDateFormat)
> > > > Dim Result
> > > > Result = CCGetValue(RecordSet, FieldName)
> > > > If Not IsEmpty(arrDateFormat) Then
> > > > If Not (VarType(Result) = vbDate OR VarType(Result) = vbEmpty)
> Then
> > _
> > > > If CCValidateDate(Result, arrDateFormat) Then _
> > > > Result = CCParseDate(Result, arrDateFormat)
> > > > End If
> > > > CCGetDate = Result
> > > > End Function
> > > > 'End CCGetDate
> > > >
> > > > 'CCGetBoolean @0-C64EED38
> > > > Function CCGetBoolean(RecordSet, FieldName, BooleanFormat)
> > > > Dim Result
> > > > Result = CCGetValue(RecordSet, FieldName)
> > > > CCGetBoolean = CCParseBoolean(Result, BooleanFormat)
> > > > End Function
> > > > 'End CCGetBoolean
> > > >
> > > > 'CCGetParam @0-B1CC8211
> > > > Function CCGetParam(ParameterName, DefaultValue)
> > > > Dim ParameterValue : ParameterValue = ""
> > > > If Request.QueryString(ParameterName).Count > 0 Then
> > > > ParameterValue = Request.QueryString(ParameterName)
> > > > ElseIf Request.Form(ParameterName).Count > 0 Then
> > > > ParameterValue = Request.Form(ParameterName)
> > > > Else
> > > > ParameterValue = DefaultValue
> > > > End If
> > > > CCGetParam = ParameterValue
> > > > End Function
> > > > 'End CCGetParam
> > > >
> > > > 'CCGetFromPost @0-B27302B2
> > > > Function CCGetFromPost(ParameterName, DefaultValue)
> > > > Dim ParameterValue : ParameterValue = Empty
> > > > ParameterValue = Request.Form(ParameterName)
> > > > If IsEmpty(ParameterValue) Then _
> > > > ParameterValue = DefaultValue
> > > > CCGetFromPost = ParameterValue
> > > > End Function
> > > > 'End CCGetFromPost
> > > >
> > > > 'CCGetFromGet @0-F6BB8115
> > > > Function CCGetFromGet(ParameterName, DefaultValue)
> > > > Dim ParameterValue : ParameterValue = Empty
> > > > ParameterValue = Request.QueryString(ParameterName)
> > > > If IsEmpty(ParameterValue) Then _
> > > > ParameterValue = DefaultValue
> > > > CCGetFromGet = ParameterValue
> > > > End Function
> > > > 'End CCGetFromGet
> > > >
> > > > 'CCToSQL @0-CA2C324A
> > > > Function CCToSQL(Value, ValueType)
> > > > If CStr(Value) = "" OR IsEmpty(Value) Then
> > > > CCToSQL = "Null"
> > > > Else
> > > > If ValueType = "Integer" or ValueType = "Float" Then
> > > > CCToSQL = Replace(CDbl(Value), ",", ".")
> > > > Else
> > > > CCToSQL = "'" & Replace(Value, "'", "''") & "'"
> > > > End If
> > > > End If
> > > > End Function
> > > > 'End CCToSQL
> > > >
> > > > 'CCDLookUp @0-9125C206
> > > > Function CCDLookUp(ColumnName, TableName, Where, Connection)
> > > > Dim RecordSet
> > > > Dim Result
> > > > Dim SQL
> > > > Dim ErrorMessage
> > > > SQL = "SELECT " & ColumnName & " FROM " & TableName &
> > > IIf(IsEmpty(Where),
> > > > "", " WHERE " & Where)
> > > > Set RecordSet = Connection.Execute(SQL)
> > > > ErrorMessage = CCProcessError(Connection)
> > > > If NOT IsEmpty(ErrorMessage) Then
> > > > PrintDBError "CCDLookUp function", SQL, ErrorMessage
> > > > End If
> > > > On Error Goto 0
> > > > Result = CCGetValue(RecordSet, 0)
> > > > CCDLookUp = Result
> > > > End Function
> > > > 'End CCDLookUp
> > > >
> > > > 'PrintDBError @0-3D5DDA9A
> > > > Sub PrintDBError(Source, SQL, ErrorMessage)
> > > > Dim CommandText
> > > > Dim SourceText
> > > > Dim ErrorText
> > > >
> > > > If Source <> "" Then SourceText = "<b>Source:</b> " & Source &
> "<br>"
> > > > If SQL <> "" Then CommandText = "<b>Command Text:</b> " & SQL &
> "<br>"
> > > > If ErrorMessage <> "" Then ErrorText = "<b>Error description:</b>
"
> &
> > > > ErrorMessage & "</div>"
> > > >
> > > > Response.Write "<div style=""background-color: rgb(250, 250, 250);
"
> &
> > _
> > > > "border: solid 1px rgb(200, 200, 200);"">" & SourceText
> > > > Response.Write CommandText & ErrorText
> > > > End Sub
> > > > 'End PrintDBError
> > > >
> > > > 'CCGetCheckBoxValue @0-ABCF54E0
> > > > Function CCGetCheckBoxValue(Value, CheckedValue, UncheckedValue,
> > > ValueType)
> > > > If isEmpty(Value) Then
> > > > If UncheckedValue = "" Then
> > > > CCGetCheckBoxValue = "Null"
> > > > Else
> > > > If ValueType = "Integer" or ValueType = "Float" Then
> > > > CCGetCheckBoxValue = UncheckedValue
> > > > Else
> > > > CCGetCheckBoxValue = "'" & Replace(UncheckedValue, "'",
"''")
> &
> > > "'"
> > > > End If
> > > > End If
> > > > Else
> > > > If CheckedValue = "" Then
> > > > CCGetCheckBoxValue = "Null"
> > > > Else
> > > > If ValueType = "Integer" OR ValueType = "Float" Then
> > > > CCGetCheckBoxValue = CheckedValue
> > > > Else
> > > > CCGetCheckBoxValue = "'" & Replace(CheckedValue, "'", "''")
&
> > "'"
> > > > End If
> > > > End If
> > > > End If
> > > > End Function
> > > > 'End CCGetCheckBoxValue
> > > >
> > > > 'CCGetValFromLOV @0-5041B9C1
> > > > Function CCGetValFromLOV(Value, ListOfValues)
> > > > Dim I
> > > > Dim Result : Result = ""
> > > > If (Ubound(ListOfValues) MOD 2) = 1 Then
> > > > For I = 0 To Ubound(ListOfValues) Step 2
> > > > If CStr(Value) = CStr(ListOfValues(I)) Then Result =
> > ListOfValues(I
> > > +
> > > > 1)
> > > > Next
> > > > End If
> > > > CCGetValFromLOV = Result
> > > > End Function
> > > > 'End CCGetValFromLOV
> > > >
> > > > 'CCProcessError @0-A3A2654C
> > > > Function CCProcessError(Connection)
> > > > If Connection.Errors.Count > 0 Then
> > > > If TypeName(Connection) = "Connection" Then
> > > > CCProcessError = Connection.Errors(0).Description & " (" &
> > > > Connection.Errors(0).Source & ")"
> > > > Else
> > > > CCProcessError = Connection.Errors.ToString
> > > > End If
> > > > ElseIf NOT (Err.Description = "") Then
> > > > CCProcessError = Err.Description
> > > > Else
> > > > CCProcessError = Empty
> > > > End If
> > > > end Function
> > > > 'End CCProcessError
> > > >
> > > > 'CCGetRequestParam @0-C154AA52
> > > > Function CCGetRequestParam(ParameterName, Method)
> > > > Dim ParameterValue
> > > >
> > > > If Method = ccsGet Then
> > > > ParameterValue = Request.QueryString(ParameterName)
> > > > ElseIf Method = ccsPost Then
> > > > ParameterValue = Request.Form(ParameterName)
> > > > End If
> > > > If CStr(ParameterValue) = "" Then _
> > > > ParameterValue = Empty
> > > >
> > > > CCGetRequestParam = ParameterValue
> > > > End Function
> > > > 'End CCGetRequestParam
> > > >
> > > > 'CCGetQueryString @0-CBD7B22E
> > > > Function CCGetQueryString(CollectionName, RemoveParameters)
> > > > Dim QueryString, PostData
> > > >
> > > > If CollectionName = "Form" Then
> > > > QueryString = CCCollectionToString(Request.Form,
RemoveParameters)
> > > > ElseIf CollectionName = "QueryString" Then
> > > > QueryString = CCCollectionToString(Request.QueryString,
> > > > RemoveParameters)
> > > > ElseIf CollectionName = "All" Then
> > > > QueryString = CCCollectionToString(Request.QueryString,
> > > > RemoveParameters)
> > > > PostData = CCCollectionToString(Request.Form, RemoveParameters)
> > > > If Len(PostData) > 0 and Len(QueryString) > 0 Then _
> > > > QueryString = QueryString & "&" & PostData _
> > > > Else _
> > > > QueryString = QueryString & PostData
> > > > Else
> > > > Err.Raise 1050, "Common Functions. CCGetQueryString Function", _
> > > > "The CollectionName contains an illegal value."
> > > > End If
> > > >
> > > > CCGetQueryString = QueryString
> > > > End Function
> > > > 'End CCGetQueryString
> > > >
> > > > 'CCCollectionToString @0-57CAA4B7
> > > > Function CCCollectionToString(ParametersCollection,
RemoveParameters)
> > > > Dim ItemName, ItemValue, Result, Remove, I
> > > >
> > > > For Each ItemName In ParametersCollection
> > > > Remove = false
> > > > If IsArray(RemoveParameters) Then
> > > > For I = 0 To UBound(RemoveParameters)
> > > > If RemoveParameters(I) = ItemName Then
> > > > Remove = True
> > > > Exit For
> > > > End If
> > > > Next
> > > > End If
> > > > If Not Remove Then
> > > > For Each ItemValue In ParametersCollection(ItemName)
> > > > Result = Result & _
> > > > "&" & ItemName & "=" & Server.URLEncode(ItemValue)
> > > > Next
> > > > End If
> > > > Next
> > > >
> > > > If Len(Result) > 0 Then _
> > > > Result = Mid(Result, 2)
> > > > CCCollectionToString = Result
> > > > End Function
> > > > 'End CCCollectionToString
> > > >
> > > > 'CCAddZero @0-B5648418
> > > > Function CCAddZero(Value, ResultLength)
> > > > Dim CountZero, I
> > > >
> > > > CountZero = ResultLength - Len(Value)
> > > > For I = 1 To CountZero
> > > > Value = "0" & Value
> > > > Next
> > > > CCAddZero = Value
> > > > End Function
> > > > 'End CCAddZero
> > > >
> > > > 'CCGetAMPM @0-CB6EA5BF
> > > > Function CCGetAMPM(HoursNumber, AnteMeridiem, PostMeridiem)
> > > > If HoursNumber >= 0 And HoursNumber < 12 Then
> > > > CCGetAMPM = AnteMeridiem
> > > > Else
> > > > CCGetAMPM = PostMeridiem
> > > > End If
> > > > End Function
> > > > 'End CCGetAMPM
> > > >
> > > > 'CC12Hour @0-12B00AFF
> > > > Function CC12Hour(HoursNumber)
> > > > If HoursNumber = 0 Then
> > > > HoursNumber = 12
> > > > ElseIf HoursNumber > 12 Then
> > > > HoursNumber = HoursNumber - 12
> > > > End If
> > > > CC12Hour = HoursNumber
> > > > End Function
> > > > 'End CC12Hour
> > > >
> > > > 'CCDBFormatByType @0-531721B5
> > > > Function CCDBFormatByType(Variable)
> > > > Dim Result
> > > > If VarType(Variable) = vbString Then
> > > > If LCase(Variable) = "null" Then
> > > > Result = Variable
> > > > Else
> > > > Result = "'" & Variable & "'"
> > > > End If
> > > > Else
> > > > Result = CStr(Variable)
> > > > End If
> > > > CCDBFormatByType = Result
> > > > End Function
> > > >
> > > > 'End CCDBFormatByType
> > > >
> > > > 'CCFormatDate @0-9C44D5D4
> > > > Function CCFormatDate(DateToFormat, FormatMask)
> > > > Dim ResultArray(), I, Result
> > > > If VarType(DateToFormat) = vbEmpty Then
> > > > Result = Empty
> > > > ElseIf VarType(DateToFormat) <> vbDate Then
> > > > Err.Raise 4000, "CCFormatDate function. Type mismatch."
> > > > ElseIf IsEmpty(FormatMask) Then
> > > > Result = CStr(DateToFormat)
> > > > Else
> > > > ReDim ResultArray(UBound(FormatMask))
> > > > For I = 0 To UBound(FormatMask)
> > > > Select Case FormatMask(I)
> > > > Case "d" ResultArray(I) = Day(DateToFormat)
> > > > Case "w" ResultArray(I) = Weekday(DateToFormat)
> > > > Case "m" ResultArray(I) = Month(DateToFormat)
> > > > Case "q" ResultArray(I) = (Month(DateToFormat) + 3) \ 4
> > > > Case "y" ResultArray(I) = (DateDiff("d", "1/1" & "/" &
> > > > Year(DateToFormat), Month(DateToFormat) & "/" & Day(DateToFormat) &
> "/"
> > &
> > > > Year(DateToFormat)) + 1)
> > > > Case "h" ResultArray(I) = CC12Hour(Hour(DateToFormat))
> > > > Case "H" ResultArray(I) = Hour(DateToFormat)
> > > > Case "n" ResultArray(I) = Minute(DateToFormat)
> > > > Case "s" ResultArray(I) = Second(DateToFormat)
> > > > Case "dd" ResultArray(I) = CCAddZero(Day(DateToFormat), 2)
> > > > Case "ww" ResultArray(I) = (DateDiff("ww", "1/1" & "/" &
> > > > Year(DateToFormat), Month(DateToFormat) & "/" & Day(DateToFormat) &
> "/"
> > &
> > > > Year(DateToFormat)) + 1)
> > > > Case "mm" ResultArray(I) = CCAddZero(Month(DateToFormat), 2)
> > > > Case "yy" ResultArray(I) = Right(Year(DateToFormat), 2)
> > > > Case "hh" ResultArray(I) =
> > CCAddZero(CC12Hour(Hour(DateToFormat)),
> > > > 2)
> > > > Case "HH" ResultArray(I) = CCAddZero(Hour(DateToFormat), 2)
> > > > Case "nn" ResultArray(I) = CCAddZero(Minute(DateToFormat),
2)
> > > > Case "ss" ResultArray(I) = CCAddZero(Second(DateToFormat),
2)
> > > > Case "ddd" ResultArray(I) =
> > > > CCSDateConstants.ShortWeekdays(Weekday(DateToFormat) - 1)
> > > > Case "mmm" ResultArray(I) =
> > > > CCSDateConstants.ShortMonths(Month(DateToFormat) - 1)
> > > > Case "A/P" ResultArray(I) = CCGetAMPM(Hour(DateToFormat),
"A",
> > > "P")
> > > > Case "a/p" ResultArray(I) = CCGetAMPM(Hour(DateToFormat),
"a",
> > > "p")
> > > > Case "dddd" ResultArray(I) =
> > > > CCSDateConstants.Weekdays(Weekday(DateToFormat) - 1)
> > > > Case "mmmm" ResultArray(I) =
> > > > CCSDateConstants.Months(Month(DateToFormat) - 1)
> > > > Case "yyyy" ResultArray(I) = Year(DateToFormat)
> > > > Case "AM/PM" ResultArray(I) = CCGetAMPM(Hour(DateToFormat),
> > "AM",
> > > > "PM")
> > > > Case "am/pm" ResultArray(I) = CCGetAMPM(Hour(DateToFormat),
> > "am",
> > > > "pm")
> > > > Case "LongDate" ResultArray(I) =
FormatDateTime(DateToFormat,
> > > > vbLongDate)
> > > > Case "LongTime" ResultArray(I) =
FormatDateTime(DateToFormat,
> > > > vbLongTime)
> > > > Case "ShortDate" ResultArray(I) =
FormatDateTime(DateToFormat,
> > > > vbShortDate)
> > > > Case "ShortTime" ResultArray(I) =
FormatDateTime(DateToFormat,
> > > > vbShortTime)
> > > > Case "GeneralDate" ResultArray(I) =
> FormatDateTime(DateToFormat,
> > > > vbGeneralDate)
> > > > Case Else
> > > > If Left(FormatMask(I), 1) = "\" Then _
> > > > ResultArray(I) = Mid(FormatMask(I), 1) _
> > > > Else
> > > > ResultArray(I) = FormatMask(I)
> > > > End Select
> > > > Next
> > > > Result = Join(ResultArray, "")
> > > > End If
> > > > CCFormatDate = Result
> > > > End Function
> > > > 'End CCFormatDate
> > > >
> > > > 'CCFormatBoolean @0-635596FD
> > > > Function CCFormatBoolean(BooleanValue, arrFormat)
> > > > Dim Result, TrueValue, FalseValue, EmptyValue
> > > >
> > > > If IsEmpty(arrFormat) Then
> > > > Result = CStr(BooleanValue)
> > > > Else
> > > > TrueValue = arrFormat(0)
> > > > FalseValue = arrFormat(1)
> > > > EmptyValue = arrFormat(2)
> > > > If IsEmpty(BooleanValue) Then
> > > > Result = EmptyValue
> > > > Else
> > > > If BooleanValue Then _
> > > > Result = TrueValue _
> > > > Else _
> > > > Result = FalseValue
> > > > End If
> > > > End If
> > > > CCFormatBoolean = Result
> > > > End Function
> > > > 'End CCFormatBoolean
> > > >
> > > > 'CCFormatNumber @0-67C259CA
> > > > Function CCFormatNumber(NumberToFormat, FormatArray)
> > > > Dim IsNegative
> > > > Dim IsExtendedFormat, IsDecimalSeparator, DecimalSeparator,
> > > > IsPeriodSeparator, PeriodSeparator
> > > >
> > > > If IsEmpty(NumberToFormat) Then
> > > > CCFormatNumber = ""
> > > > Exit Function
> > > > End If
> > > >
> > > > If IsArray(FormatArray) Then
> > > > IsExtendedFormat = FormatArray(0)
> > > > IsNegative = (NumberToFormat < 0)
> > > > NumberToFormat = ABS(NumberToFormat) * FormatArray(7)
> > > >
> > > > If IsExtendedFormat Then ' Extended format
> > > > IsDecimalSeparator = FormatArray(1)
> > > > DecimalSeparator = FormatArray(2)
> > > > IsPeriodSeparator = FormatArray(3)
> > > > PeriodSeparator = FormatArray(4)
> > > >
> > > > Dim BeforeDecimal, AfterDecimal
> > > > Dim ObligatoryBeforeDecimal, DigitsBeforeDecimal,
> > > > ObligatoryAfterDecimal, DigitsAfterDecimal
> > > > Dim I, Z
> > > > BeforeDecimal = FormatArray(5)
> > > > AfterDecimal = FormatArray(6)
> > > > If IsArray(BeforeDecimal) Then
> > > > For I = 0 To UBound(BeforeDecimal)
> > > > If BeforeDecimal(I) = "0" Then
> > > > ObligatoryBeforeDecimal = ObligatoryBeforeDecimal + 1
> > > > DigitsBeforeDecimal = DigitsBeforeDecimal + 1
> > > > ElseIf BeforeDecimal(I) = "#" Then
> > > > DigitsBeforeDecimal = DigitsBeforeDecimal + 1
> > > > End If
> > > > Next
> > > > End If
> > > > If IsArray(AfterDecimal) Then
> > > > For I = 0 To UBound(AfterDecimal)
> > > > If AfterDecimal(I) = "0" Then
> > > > ObligatoryAfterDecimal = ObligatoryAfterDecimal + 1
> > > > DigitsAfterDecimal = DigitsAfterDecimal + 1
> > > > ElseIf AfterDecimal(I) = "#" Then
> > > > DigitsAfterDecimal = DigitsAfterDecimal + 1
> > > > End If
> > > > Next
> > > > End If
> > > >
> > > > Dim NumDigitsAfterDecimal, Result, DefaultValue
> > > > If ObligatoryAfterDecimal = 0 And DigitsAfterDecimal = 1 Then
> > > > NumDigitsAfterDecimal = -1
> > > > ElseIf Not IsDecimalSeparator Then
> > > > NumDigitsAfterDecimal = 0
> > > > Else
> > > > NumDigitsAfterDecimal = DigitsAfterDecimal
> > > > End If
> > > > NumberToFormat = FormatNumber(NumberToFormat,
> DigitsAfterDecimal,
> > > > False, False, False)
> > > >
> > > > Dim DefaultDecimal : DefaultDecimal =
Mid(FormatNumber(10001/10,
> > 1,
> > > > True, False, True), 6, 1)
> > > > Dim LeftPart, RightPart
> > > > If Not InStr(CStr(NumberToFormat), DefaultDecimal) = 0 Then
> > > > Dim NumberParts : NumberParts = Split(CStr(NumberToFormat),
> > > > DefaultDecimal)
> > > > LeftPart = CStr(NumberParts(0))
> > > > RightPart = CStr(NumberParts(1))
> > > > Else
> > > > LeftPart = CStr(NumberToFormat)
> > > > End If
> > > >
> > > > Dim J : J = Len(LeftPart)
> > > >
> > > > If IsDecimalSeparator And DecimalSeparator = "" Then
> > > > DefaultValue = CStr(FormatNumber(10001/10, 1, True, False,
> > True))
> > > > DecimalSeparator = Mid(DefaultValue, 6, 1)
> > > > End If
> > > >
> > > > If IsPeriodSeparator And PeriodSeparator = "" Then
> > > > DefaultValue = CStr(FormatNumber(10001/10, 1, True, False,
> > True))
> > > > PeriodSeparator = Mid(DefaultValue, 2, 1)
> > > > End If
> > > >
> > > > If IsArray(BeforeDecimal) Then
> > > > Dim RankNumber : RankNumber = 0
> > > > For I = UBound(BeforeDecimal) To 0 Step -1
> > > > If BeforeDecimal(i) = "#" Or BeforeDecimal(i) = "0" Then
> > > > If DigitsBeforeDecimal = 1 And J > 1 Then
> > > > If Not IsPeriodSeparator Then
> > > > Result = Left(LeftPart, j) & Result
> > > > Else
> > > > For z = J To 1 Step -1
> > > > RankNumber = RankNumber + 1
> > > > If RankNumber Mod 3 = 1 And RankNumber - 3 > 0
Then
> > > > Result = Mid(LeftPart, z, 1) & PeriodSeparator &
> > > Result
> > > > Else
> > > > Result = Mid(LeftPart, z, 1) & Result
> > > > End If
> > > > Next
> > > > End If
> > > > ElseIf J > 0 Then
> > > > RankNumber = RankNumber + 1
> > > > If RankNumber Mod 3 = 1 And RankNumber - 3 > 0 And
> > > > IsPeriodSeparator Then
> > > > Result = Mid(LeftPart, j, 1) & PeriodSeparator &
> Result
> > > > Else
> > > > Result = Mid(LeftPart, j, 1) & Result
> > > > End If
> > > > J = J - 1
> > > > ObligatoryBeforeDecimal = ObligatoryBeforeDecimal - 1
> > > > DigitsBeforeDecimal = DigitsBeforeDecimal - 1
> > > > Else
> > > > If ObligatoryBeforeDecimal > 0 Then
> > > > RankNumber = RankNumber + 1
> > > > If RankNumber Mod 3 = 1 And RankNumber - 3 > 0 And
> > > > IsPeriodSeparator Then
> > > > Result = "0" & PeriodSeparator & Result
> > > > Else
> > > > Result = "0" & Result
> > > > End If
> > > > ObligatoryBeforeDecimal = ObligatoryBeforeDecimal -
1
> > > > DigitsBeforeDecimal = DigitsBeforeDecimal - 1
> > > > End If
> > > > End If
> > > > Else
> > > > BeforeDecimal(I) = Replace(BeforeDecimal(I), "##", "#")
> > > > BeforeDecimal(I) = Replace(BeforeDecimal(I), "00", "0")
> > > > Result = BeforeDecimal(I) & Result
> > > > End If
> > > > Next
> > > > End If
> > > >
> > > > ' Left part after decimal
> > > > Dim RightResult : RightResult = ""
> > > > If IsArray(AfterDecimal) Then
> > > > Dim IsZero : IsZero = True
> > > > For I = UBound(AfterDecimal) To 0 Step -1
> > > > If AfterDecimal(I) = "#" Or AfterDecimal(I) = "0" Then
> > > > If DigitsAfterDecimal > ObligatoryAfterDecimal Then
> > > > If Not Mid(RightPart, DigitsAfterDecimal, 1) = "0"
Then
> > > IsZero
> > > > = False
> > > > If Not IsZero Then _
> > > > RightResult = Mid(RightPart, DigitsAfterDecimal, 1)
&
> > > > RightResult
> > > > DigitsAfterDecimal = DigitsAfterDecimal - 1
> > > > Else
> > > > RightResult = Mid(RightPart, DigitsAfterDecimal, 1) &
> > > > RightResult
> > > > DigitsAfterDecimal = DigitsAfterDecimal - 1
> > > > End If
> > > > Else
> > > > AfterDecimal(I) = Replace(AfterDecimal(I), "##", "#")
> > > > AfterDecimal(I) = Replace(AfterDecimal(I), "00", "0")
> > > > RightResult = AfterDecimal(I) & RightResult
> > > > End If
> > > > Next
> > > > End If
> > > >
> > > > If IsDecimalSeparator AND Len(RightResult) > 0 Then _
> > > > Result = Result & DecimalSeparator & RightResult
> > > >
> > > > If NOT FormatArray(10) AND IsNegative Then _
> > > > Result = "-" & Result
> > > >
> > > > Result = Result & RightResult
> > > > Else ' Simple format
> > > > If Not FormatArray(3) AND IsNegative Then _
> > > > Result = "-" & FormatArray(5) & FormatNumber(NumberToFormat,
> > > > FormatArray(1), FormatArray(2), False, FormatArray(4)) &
> FormatArray(6)
> > _
> > > > Else _
> > > > Result = FormatArray(5) & FormatNumber(NumberToFormat,
> > > > FormatArray(1), FormatArray(2), False, FormatArray(4)) &
> FormatArray(6)
> > > > End If
> > > > If Not FormatArray(8) Then Result = Server.HTMLEncode(Result)
> > > > If Not CStr(FormatArray(9)) = "" Then _
> > > > Result = "<FONT COLOR=""" & FormatArray(9) & """>" & Result &
> > > > "</FONT>"
> > > > Else
> > > > Result = NumberToFormat
> > > > End If
> > > > CCFormatNumber = Result
> > > >
> > > > End Function
> > > > 'End CCFormatNumber
> > > >
> > > > 'CCParseBoolean @0-33711A62
> > > > Function CCParseBoolean(Value, FormatMask)
> > > > Dim Result
> > > > Result = Empty
> > > > If VarType(Value) = vbBoolean Then
> > > > Result = Value
> > > > Else
> > > > If IsEmpty(FormatMask) Then
> > > > Result = CBool(Value)
> > > > Else
> > > > If IsEmpty(Value) Then
> > > > If CStr(FormatMask(0)) = "null" Then _
> > > > Result = True
> > > > If CStr(FormatMask(1)) = "null" Then _
> > > > Result = False
> > > > Else
> > > > If CStr(Value) = CStr(FormatMask(0)) Then
> > > > Result = True
> > > > ElseIf CStr(Value) = CStr(FormatMask(1)) Then
> > > > Result = False
> > > > End If
> > > > End If
> > > > End If
> > > > End If
> > > > CCParseBoolean = Result
> > > > End Function
> > > > 'End CCParseBoolean
> > > >
> > > > 'CCParseDate @0-0D3D1ED4
> > > > Function CCParseDate(ParsingDate, FormatMask)
> > > > Dim ResultDate, ResultDateArray(8)
> > > > Dim MaskPart, MaskLength, TokenLength
> > > > Dim IsError
> > > > Dim DatePosition, MaskPosition
> > > > Dim Delimiter, BeginDelimiter
> > > > Dim MonthNumber, MonthName, MonthArray
> > > > Dim DatePart
> > > >
> > > > Dim IS_DATE_POS, YEAR_POS, MONTH_POS, DAY_POS, IS_TIME_POS,
> HOUR_POS,
> > > > MINUTE_POS, SECOND_POS
> > > >
> > > > IS_DATE_POS = 0 : YEAR_POS = 1 : MONTH_POS = 2 : DAY_POS = 3
> > > > IS_TIME_POS = 4 : HOUR_POS = 5 : MINUTE_POS = 6 : SECOND_POS = 7
> > > >
> > > >
> > > > If IsEmpty(FormatMask) Then
> > > > If CStr(ParsingDate) = "" Then _
> > > > ResultDate = Empty _
> > > > Else _
> > > > ResultDate = CDate(ParsingDate)
> > > > ElseIf (FormatMask(0) = "GeneralDate" Or FormatMask(0) =
"LongDate"
> _
> > > > Or FormatMask(0) = "ShortDate" Or FormatMask(0) = "LongTime" _
> > > > Or FormatMask(0) = "ShortTime") And Not CStr(ParsingDate) = ""
> Then
> > > > ResultDate = CDate(ParsingDate)
> > > > ElseIf CStr(ParsingDate) = "" Then
> > > > ResultDate = Empty
> > > > Else
> > > > DatePosition = 1
> > > > MaskPosition = 0
> > > > MaskLength = UBound(FormatMask)
> > > > IsError = False
> > > >
> > > > ' Default date
> > > > ResultDateArray(IS_DATE_POS) = False
> > > > ResultDateArray(IS_TIME_POS) = False
> > > > ResultDateArray(YEAR_POS) = 0 : ResultDateArray(MONTH_POS) = 12
:
> > > > ResultDateArray(DAY_POS) = 1
> > > > ResultDateArray(HOUR_POS) = 0 : ResultDateArray(MINUTE_POS) = 0
:
> > > > ResultDateArray(SECOND_POS) = 0
> > > >
> > > > While (MaskPosition <= MaskLength) AND NOT IsError
> > > > MaskPart = FormatMask(MaskPosition)
> > > > If CCSDateConstants.DateMasks.Exists(MaskPart) Then
> > > > TokenLength = CCSDateConstants.DateMasks(MaskPart)
> > > > If TokenLength > 0 Then
> > > > DatePart = Mid(ParsingDate, DatePosition, TokenLength)
> > > > DatePosition = DatePosition + TokenLength
> > > > Else
> > > > If MaskPosition < MaskLength Then
> > > > Delimiter = FormatMask(MaskPosition + 1)
> > > > BeginDelimiter = InStr(DatePosition, ParsingDate,
> Delimiter)
> > > > If BeginDelimiter = 0 Then
> > > > Err.Raise 4000, "ParseDate function: The number
doesn't
> > > match
> > > > the mask."
> > > > Else
> > > > DatePart = Mid(ParsingDate, DatePosition,
> BeginDelimiter -
> > > > DatePosition)
> > > > DatePosition = BeginDelimiter
> > > > End If
> > > > Else
> > > > DatePart = Mid(ParsingDate, DatePosition)
> > > > End If
> > > > End If
> > > > Select Case MaskPart
> > > > Case "d", "dd"
> > > > ResultDateArray(DAY_POS) = CInt(DatePart)
> > > > ResultDateArray(IS_DATE_POS) = True
> > > > Case "m", "mm"
> > > > ResultDateArray(MONTH_POS) = CInt(DatePart)
> > > > ResultDateArray(IS_DATE_POS) = True
> > > > Case "mmm", "mmmm"
> > > > MonthNumber = 0
> > > > MonthName = UCase(DatePart)
> > > > If MaskPart = "mmm" Then _
> > > > MonthArray = CCSDateConstants.ShortMonths _
> > > > Else _
> > > > MonthArray = CCSDateConstants.Months
> > > > While MonthNumber < 11 AND
UCase(MonthArray(MonthNumber))
> <>
> > > > MonthName
> > > > MonthNumber = MonthNumber + 1
> > > > Wend
> > > > If MonthNumber = 11 Then
> > > > If UCase(MonthArray(11)) <> MonthName Then _
> > > > Err.Raise 4000, "ParseDate function: The number
> doesn't
> > > > match the mask."
> > > > End If
> > > > ResultDateArray(MONTH_POS) = MonthNumber + 1
> > > > ResultDateArray(IS_DATE_POS) = True
> > > > Case "yy", "yyyy"
> > > > ResultDateArray(YEAR_POS) = CInt(DatePart)
> > > > ResultDateArray(IS_DATE_POS) = True
> > > > Case "h", "hh"
> > > > If CInt(DatePart) = 12 Then _
> > > > ResultDateArray(HOUR_POS) = 0 _
> > > > Else _
> > > > ResultDateArray(HOUR_POS) = CInt(DatePart)
> > > > ResultDateArray(IS_TIME_POS) = True
> > > > Case "H", "HH"
> > > > ResultDateArray(HOUR_POS) = CInt(DatePart)
> > > > ResultDateArray(IS_TIME_POS) = True
> > > > Case "n", "nn"
> > > > ResultDateArray(MINUTE_POS) = CInt(DatePart)
> > > > ResultDateArray(IS_TIME_POS) = True
> > > > Case "s", "ss"
> > > > ResultDateArray(SECOND_POS) = CInt(DatePart)
> > > > ResultDateArray(IS_TIME_POS) = True
> > > > Case "am/pm", "a/p", "AM/PM", "A/P"
> > > > If Left(LCase(DatePart), 1) = "p" Then
> > > > ResultDateArray(HOUR_POS) = ResultDateArray(HOUR_POS)
+
> 12
> > > > ElseIf Left(LCase(DatePart), 1) = "a" Then
> > > > ResultDateArray(HOUR_POS) = ResultDateArray(HOUR_POS)
> > > > End If
> > > > ResultDateArray(IS_TIME_POS) = True
> > > > Case "w", "q"
> > > > ' Do Nothing
> > > > End Select
> > > > Else
> > > > DatePosition = DatePosition + Len(FormatMask(MaskPosition))
> > > > End If
> > > > MaskPosition = MaskPosition + 1
> > > > Wend
> > > > If ResultDateArray(IS_TIME_POS) AND ResultDateArray(IS_TIME_POS)
> > Then
> > > > ResultDate = DateSerial(ResultDateArray(YEAR_POS),
> > > > ResultDateArray(MONTH_POS), ResultDateArray(DAY_POS)) _
> > > > + TimeSerial(ResultDateArray(HOUR_POS),
> > > ResultDateArray(MINUTE_POS),
> > > > ResultDateArray(SECOND_POS))
> > > > ElseIf ResultDateArray(IS_TIME_POS) Then
> > > > ResultDate = TimeSerial(ResultDateArray(HOUR_POS),
> > > > ResultDateArray(MINUTE_POS), ResultDateArray(SECOND_POS))
> > > > ElseIf ResultDateArray(IS_DATE_POS) Then
> > > > ResultDate = DateSerial(ResultDateArray(YEAR_POS),
> > > > ResultDateArray(MONTH_POS), ResultDateArray(DAY_POS))
> > > > End If
> > > > End If
> > > > CCParseDate = ResultDate
> > > > End Function
> > > > 'End CCParseDate
> > > >
> > > > 'CCParseNumber @0-BDE16F1E
> > > > Function CCParseNumber(NumberValue, FormatArray, DataType)
> > > > Dim Result, NumberValueType
> > > > NumberValueType = VarType(NumberValue)
> > > > If NumberValueType = vbInteger OR NumberValueType = vbLong _
> > > > OR NumberValueType = vbSingle OR NumberValueType = vbSingle _
> > > > OR NumberValueType = vbCurrency OR NumberValueType = vbDecimal _
> > > > OR NumberValueType = vbByte Then
> > > > If DataType = ccsInteger Then
> > > > Result = CLng(NumberValue)
> > > > ElseIf DataType = ccsFloat Then
> > > > Result = CDbl(NumberValue)
> > > > End If
> > > > Else
> > > > If Not CStr(NumberValue) = "" Then
> > > > Dim DefaultValue, DefaultDecimal
> > > > Dim DecimalSeparator, PeriodSeparator
> > > > DecimalSeparator = "" : PeriodSeparator = ""
> > > > If IsArray(FormatArray) Then
> > > > If FormatArray(0) Then
> > > > DecimalSeparator = FormatArray(2)
> > > > PeriodSeparator = FormatArray(4)
> > > > End If
> > > > End If
> > > > If Not CStr(DecimalSeparator) = "" Then
> > > > DefaultValue = CStr(FormatNumber(10001/10, 1, True, False,
> > True))
> > > > DefaultDecimal = Mid(DefaultValue, 6, 1)
> > > > NumberValue = Replace(NumberValue, DecimalSeparator,
> > > DefaultDecimal)
> > > > End If
> > > > If Not CStr(PeriodSeparator) = "" Then NumberValue =
> > > > Replace(NumberValue, PeriodSeparator, "")
> > > > If DataType = ccsInteger Then
> > > > Result = CLng(NumberValue)
> > > > ElseIf DataType = ccsFloat Then
> > > > Result = CDbl(NumberValue)
> > > > End If
> > > > Else
> > > > Result = Empty
> > > > End If
> > > > End If
> > > > CCParseNumber = Result
> > > > End Function
> > > > 'End CCParseNumber
> > > >
> > > > 'CCParseInteger @0-42815927
> > > > Function CCParseInteger(NumberValue, FormatArray)
> > > > CCParseInteger = CCParseNumber(NumberValue, FormatArray,
ccsInteger)
> > > > End Function
> > > > 'End CCParseInteger
> > > >
> > > > 'CCParseFloat @0-56667DF0
> > > > Function CCParseFloat(NumberValue, FormatArray)
> > > > CCParseFloat = CCParseNumber(NumberValue, FormatArray, ccsFloat)
> > > > End Function
> > > > 'End CCParseFloat
> > > >
> > > > 'CCValidateDate @0-D0BEB752
> > > > Function CCValidateDate(ValidatingDate, FormatMask)
> > > > Dim MaskPosition, I, Result, OneChar, IsSeparator
> > > > Dim RegExpPattern, RegExpObject, Matches
> > > >
> > > > IsSeparator = False
> > > >
> > > > If ValidatingDate = "" OR IsEmpty(ValidatingDate) Then
> > > > Result = True
> > > > ElseIf IsEmpty(FormatMask) Then
> > > > Result = IsDate(ValidatingDate)
> > > > ElseIf FormatMask(0) = "GeneralDate" Or FormatMask(0) = "LongDate"
_
> > > > Or FormatMask(0) = "ShortDate" Or FormatMask(0) = "LongTime" _
> > > > Or FormatMask(0) = "ShortTime" Then
> > > > Result = IsDate(ValidatingDate)
> > > > Else
> > > > For MaskPosition = 0 To UBound(FormatMask)
> > > > If NOT IsSeparator Then
> > > > Select Case FormatMask(MaskPosition)
> > > > Case "d", "m", "h", "n", "s", "w", "q", "H"
> > > > RegExpPattern = RegExpPattern + "\d{1,2}.+"
> > > > IsSeparator = True
> > > > Case "dd", "mm", "yy", "hh", "nn", "ss", "HH"
> > > > RegExpPattern = RegExpPattern + "\d{2}"
> > > > Case "yyyy"
> > > > RegExpPattern = RegExpPattern + "\d{4}"
> > > > Case "mmm"
> > > > RegExpPattern = RegExpPattern + "(" &
> > > > Join(CCSDateConstants.ShortMonths, "|") & ")"
> > > > Case "mmmm"
> > > > RegExpPattern = RegExpPattern + "(" &
> > > > Join(CCSDateConstants.Months, "|") & ")"
> > > > Case "am/pm"
> > > > RegExpPattern = RegExpPattern + "[ap]m"
> > > > Case "AM/PM"
> > > > RegExpPattern = RegExpPattern + "[AP]M"
> > > > Case "a/p"
> > > > RegExpPattern = RegExpPattern + "[ap]"
> > > > Case "A/P"
> > > > RegExpPattern = RegExpPattern + "[AP]"
> > > > Case Else
> > > > For I = 1 To Len(FormatMask(MaskPosition))
> > > > OneChar = Mid(FormatMask(MaskPosition), I, 1)
> > > > If InStr("bBdDfnrsStvwW\", OneChar) = 0 Then _
> > > > OneChar = "\" + OneChar
> > > > RegExpPattern = RegExpPattern + OneChar
> > > > Next
> > > > End Select
> > > > Else
> > > > IsSeparator = False
> > > > For I = 2 To Len(FormatMask(MaskPosition))
> > > > OneChar = Mid(FormatMask(MaskPosition), I, 1)
> > > > If InStr("bBdDfnrsStvwW\", OneChar) = 0 Then _
> > > > OneChar = "\" + OneChar
> > > > RegExpPattern = RegExpPattern + OneChar
> > > > Next
> > > > End If
> > > > Next
> > > > Set RegExpObject = New RegExp
> > > > RegExpObject.IgnoreCase = False
> > > > RegExpObject.Global = True
> > > > RegExpObject.Pattern = RegExpPattern
> > > > Set Matches = RegExpObject.Execute(ValidatingDate)
> > > > Result = CBool(Matches.Count = 1)
> > > > Set Matches = Nothing
> > > > Set RegExpObject = Nothing
> > > > End If
> > > > CCValidateDate = Result
> > > > End Function
> > > > 'End CCValidateDate
> > > >
> > > > 'CCValidateNumber @0-08089509
> > > > Function CCValidateNumber(NumberValue, FormatArray)
> > > > Dim Result, NumberValueType
> > > > NumberValueType = VarType(NumberValue)
> > > > If NumberValueType = vbInteger OR NumberValueType = vbLong _
> > > > OR NumberValueType = vbSingle OR NumberValueType = vbSingle _
> > > > OR NumberValueType = vbCurrency OR NumberValueType = vbDecimal _
> > > > OR NumberValueType = vbByte Then
> > > > Result = True
> > > > Else
> > > > If Not CStr(NumberValue) = "" Then
> > > > Dim DefaultValue, DefaultDecimal
> > > > Dim DecimalSeparator, PeriodSeparator
> > > > DecimalSeparator = "" : PeriodSeparator = ""
> > > > If IsArray(FormatArray) Then
> > > > If FormatArray(0) Then
> > > > DecimalSeparator = FormatArray(2)
> > > > PeriodSeparator = FormatArray(4)
> > > > End If
> > > > End If
> > > > If Not CStr(DecimalSeparator) = "" Then
> > > > DefaultValue = CStr(FormatNumber(10001/10, 1, True, False,
> > True))
> > > > DefaultDecimal = Mid(DefaultValue, 6, 1)
> > > > NumberValue = Replace(NumberValue, DecimalSeparator,
> > > DefaultDecimal)
> > > > End If
> > > > If Not CStr(PeriodSeparator) = "" Then NumberValue =
> > > > Replace(NumberValue, PeriodSeparator, "")
> > > > Result = IsNumeric(NumberValue)
> > > > Else
> > > > Result = True
> > > > End If
> > > > End If
> > > > CCValidateNumber = Result
> > > > End Function
> > > > 'End CCValidateNumber
> > > >
> > > > 'CCValidateBoolean @0-B8DE2060
> > > > Function CCValidateBoolean(Value, FormatMask)
> > > > Dim Result: Result = False
> > > >
> > > > If VarType(Value) = vbBoolean Then
> > > > Result = True
> > > > Else
> > > > If IsEmpty(FormatMask) Then
> > > > On Error Resume Next
> > > > Result = CBool(Value)
> > > > Result = Not(Err > 0)
> > > > Else
> > > > If IsEmpty(Value) Or CStr(Value) = "" Then
> > > > Result = (CStr(FormatMask(0)) = "null") Or
> (CStr(FormatMask(0))
> > =
> > > > "Undefined") Or (CStr(FormatMask(0)) = "")
> > > > Result = Result Or (CStr(FormatMask(1)) = "null") Or
> > > > (CStr(FormatMask(1)) = "Undefined") Or (CStr(FormatMask(1)) = "")
> > > > If UBound(FormatMask) = 2 Then _
> > > > Result = Result Or (CStr(FormatMask(2)) = "null") Or
> > > > (CStr(FormatMask(2)) = "Undefined") Or (CStr(FormatMask(2)) = "")
> > > > Else
> > > > Result = (CStr(Value) = CStr(FormatMask(0))) Or (CStr(Value)
=
> > > > CStr(FormatMask(1)))
> > > > If UBound(FormatMask) = 2 Then _
> > > > Result = Result Or (CStr(Value) = CStr(FormatMask(2)))
> > > > End If
> > > > End If
> > > > End If
> > > > CCValidateBoolean = Result
> > > > End Function
> > > > 'End CCValidateBoolean
> > > >
> > > > 'CCAddParam @0-6D59DAA5
> > > > Function CCAddParam(QueryString, ParameterName, ParameterValue)
> > > > Dim Result
> > > >
> > > > Result = Replace("&" & QueryString, "&" & ParameterName & "=" &
> > > > Server.URLEncode(Request.QueryString(ParameterName)), "")
> > > > Result = Result & "&" & ParameterName & "=" &
> > > > Server.URLEncode(ParameterValue)
> > > > Result = Replace(Result, "&&", "&")
> > > > If Left(Result, 1) = "&" Then Result = Mid(Result, 2)
> > > > CCAddParam = Result
> > > > End Function
> > > > 'End CCAddParam
> > > >
> > > > 'CCRemoveParam @0-64B4FAAF
> > > > Function CCRemoveParam(QueryString, ParameterName)
> > > > Dim Result
> > > > Result = Replace(QueryString, ParameterName & "=" &
> > > > Server.URLEncode(Request.QueryString(ParameterName)), "")
> > > > Result = Replace(Result, "&&", "&")
> > > > If Left(Result, 1) = "&" Then Result = Mid(Result, 2)
> > > > CCRemoveParam = Result
> > > > End Function
> > > > 'End CCRemoveParam
> > > >
> > > > 'CCRegExpTest @0-9EAA5A2D
> > > > Function CCRegExpTest(TestValue, RegExpMask, IgnoreCase, GlobalTest)
> > > > Dim Result
> > > > If Not CStr(TestValue) = "" Then
> > > > Dim RegExpObject
> > > > Set RegExpObject = New RegExp
> > > > RegExpObject.Pattern = RegExpMask
> > > > RegExpObject.IgnoreCase = IgnoreCase
> > > > RegExpObject.Global = GlobalTest
> > > > Result = RegExpObject.Test(CStr(TestValue))
> > > > Set RegExpObject = Nothing
> > > > Else
> > > > Result = True
> > > > End If
> > > > CCRegExpTest = Result
> > > > End Function
> > > >
> > > >
> > > > 'End CCRegExpTest
> > > >
> > > > 'CCRegExpTest @0-4BE3AE1D
> > > > Sub CheckSSL()
> > > > If Not UCase(Request.ServerVariables("HTTPS")) = "ON" Then
> > > > Response.Write "SSL connection error. This page can be accessed
> only
> > > via
> > > > secured connection."
> > > > Response.End
> > > > End If
> > > > End Sub
> > > >
> > > > 'End CCRegExpTest
> > > >
> > > > 'CCGetUserLogin @0-4306ED6C
> > > > Function CCGetUserLogin()
> > > > CCGetUserLogin = Session("UserLogin")
> > > > End Function
> > > > 'End CCGetUserLogin
> > > >
> > > > 'CCSecurityRedirect @0-790A88DF
> > > > Sub CCSecurityRedirect(GroupsAccess, URL)
> > > > Dim ErrorType
> > > > Dim Link
> > > > ErrorType = CCSecurityAccessCheck(GroupsAccess)
> > > > If NOT (ErrorType = "success") Then
> > > > If IsEmpty(URL) Then _
> > > > Link = ServerURL & "Login.asp" _
> > > > Else _
> > > > Link = URL
> > > > Response.Redirect(Link & "?ret_link=" & _
> > > > Server.URLEncode(Request.ServerVariables("SCRIPT_NAME")
&
> _
> > > > "?" &
> CCRemoveParam(Request.ServerVariables("QUERY_STRING"),
> > > > "ccsForm")) & "&type=" & ErrorType)
> > > > End If
> > > > End Sub
> > > > 'End CCSecurityRedirect
> > > >
> > > > 'CCGetUserID @0-449B3B19
> > > > Function CCGetUserID()
> > > > CCGetUserID = Session("UserID")
> > > > End Function
> > > > 'End CCGetUserID
> > > >
> > > > 'CCSecurityAccessCheck @0-8A7701BE
> > > > Function CCSecurityAccessCheck(GroupsAccess)
> > > > Dim ErrorType
> > > > Dim GroupID
> > > > ErrorType = "success"
> > > > If IsEmpty(CCGetUserID()) Then
> > > > ErrorType = "notLogged"
> > > > Else
> > > > GroupID = CCGetGroupID()
> > > > If IsEmpty(GroupID) Then
> > > > ErrorType = "groupIDNotSet"
> > > > Else
> > > > If NOT CCUserInGroups(GroupID, GroupsAccess) Then
> > > > ErrorType = "illegalGroup"
> > > > End If
> > > > End If
> > > > End If
> > > > CCSecurityAccessCheck = ErrorType
> > > > End Function
> > > > 'End CCSecurityAccessCheck
> > > >
> > > > 'CCGetGroupID @0-B2650479
> > > > Function CCGetGroupID()
> > > > CCGetGroupID = Session("GroupID")
> > > > End Function
> > > > 'End CCGetGroupID
> > > >
> > > > 'CCUserInGroups @0-4332AEA7
> > > > Function CCUserInGroups(GroupID, GroupsAccess)
> > > > Dim Result
> > > > Dim GroupNumber
> > > > If NOT IsEmpty(GroupsAccess) Then
> > > > GroupNumber = CLng(GroupID)
> > > > While NOT Result AND GroupNumber > 0
> > > > Result = NOT (InStr(";" & GroupsAccess & ";", ";" & GroupNumber &
";")
> =
> > > 0)
> > > > GroupNumber = GroupNumber - 1
> > > > Wend
> > > > Else
> > > > Result = True
> > > > End If
> > > > CCUserInGroups = Result
> > > > End Function
> > > > 'End CCUserInGroups
> > > >
> > > > 'CCLoginUser @0-6D3FEC5B
> > > > Function CCLoginUser(Login, Password)
> > > > Dim Result
> > > > Dim SQL
> > > > Dim RecordSet
> > > > Dim Connection
> > > >
> > > > Set Connection = New clsDBConnection1
> > > > Connection.Open
> > > > SQL = "SELECT id_empleado, group FROM Empleados WHERE
emp_login='"
> &
> > > > Replace(Login, "'", "''") & "' AND emp_password='" &
Replace(Password,
> > > "'",
> > > > "''") & "'"
> > > > Set RecordSet = Connection.Execute(SQL)
> > > > Result = NOT RecordSet.EOF
> > > > If Result Then
> > > > Session("UserID") = RecordSet("id_empleado")
> > > > Session("UserLogin") = Login
> > > > Session("GroupID") = RecordSet("group")
> > > > End If
> > > > RecordSet.Close
> > > > Set RecordSet = Nothing
> > > > Connection.Close
> > > > Set Connection = Nothing
> > > > CCLoginUser = Result
> > > > End Function
> > > > 'End CCLoginUser
> > > >
> > > > 'CCLogoutUser @0-DB93CE50
> > > > Sub CCLogoutUser()
> > > > Session("UserID") = Empty
> > > > Session("UserLogin") = Empty
> > > > Session("GroupID") = Empty
> > > > End Sub
> > > > 'End CCLogoutUser
> > > >
> > > >
> > > > %>
> > > >
> > > > Any help will be greatly appreciated...
> > > >
> > > >
> > > >
> > > >
> > > > "Pepito" <dfga@kk.com> wrote in message
> > > >news:b44qfl$ltg$1@news.codecharge.com...
> > > > > Hello Everyone, I uploaded a css project (that runs great on IIS
at
> my
> > > > > machine) to a free server (brinkster). I can properly see on a
> browser
> > > > > *.html fi
|
|
|
|
Pepito
|
| Posted: 03/05/2003, 10:12 AM |
|
Everybody Cool Now!!!! The site is up and running!!!
Thanks to Alistair I could figure out the damn path!!! Try the getpath.asp
method explained above.
Thanks also to Sixto for his valuable info.
Thanks to everyone to help jackasses like me!!!!
"Pepito" <pepitxispi@yahoo.com> wrote in message
news:b45dnc$110$1@news.codecharge.com...
> Damn it!! I can't make it work.
> Well, thanks for your help:
> I had the original chunk of code:
> --------------------------------------------------------------------------
--
> ---
> Private Sub Class_Initialize()
> ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;User
> ID=Admin;Data Source=C:\Documents and Settings\M\My Documents\web
> solutions\New Folder\NewProject5\GardenCo.mdb;Persist Security Info=False"
> User = "Admin"
> Password = ""
> DateFormat = Empty
> BooleanFormat = Empty
> Set objConnection = Server.CreateObject("ADODB.Connection")
> Set Errors = New clsErrors
> End Sub
>
> --------------------------------------------------------------------------
--
> ---
> and I used your tip...this is the result..
> --------------------------------------------------------------------------
--
> ---
> Private Sub Class_Initialize()
> ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
&
> Server.MapPath("./mariosbm/db/GardenCo.mdb") & ";Persist Security
> Info=False"
> User = "Admin"
> Password = ""
> DateFormat = Empty
> BooleanFormat = Empty
> Set objConnection = Server.CreateObject("ADODB.Connection")
> Set Errors = New clsErrors
> End Sub
> --------------------------------------------------------------------------
--
> ---
> Does not work, the error now is this:
>
>
>
> Microsoft JET Database Engine error '80004005'
>
> '\\genfs1\www10\mariosbm\code\mariosbm\db\GardenCo.mdb' is not a valid
path.
> Make sure that the path name is spelled correctly and that you are
connected
> to the server on which the file resides.
>
> /mariosbm/code/Common.asp, line 117
>
> --------------------------------------------------------------------------
--
> ---
> Yes, there is a db directory where to put the database, and it is there
> \mariosbm\db\GardenCo.mdb I hve to tell you that there is a couple of
lines
> at the beggining..
>
> Set TemplatesRepository = New clsCache_FileSystem
> ServerURL = "http://localhost/NewProject6/"
> Set CCSDateConstants = New clsCCSDateConstants
>
> could that be the problem? I mean, the server id www.brinkster.com...and
> the site is
> http://www10.brinkster.com/mariosbm/code/Empleados_list.asp
> any help will be greatly appreciated...
> Thanks
> --------------------------------------------------------------------------
--
> ---
>
>
>
> "Sixto Luis Santos" <ccs@tecnoapoyo.com> wrote in message
>news:b45baj$rgg$1@news.codecharge.com...
> > Pepito,
> >
> > First, move your database to its own folder (for example, db). Then, You
> > need to manually edit your DB connection to use a custom connection
string
> > (remove the checkmark from "Same as design"). Set your connection string
> to
> > something like this:
> > Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" &
> > Server.MapPath("./db/GardenCo.mdb") & ";Persist Security Info=False
> >
> > This should allow your application to run, but almost certainly, you
won't
> > be able to edit anything. You must explicitly assign write permissions
to
> > the db folder and that is an entirely different problem not always easy
to
> > solve. But, most good hosts provide a folder with the necessary
> permissions
> > already in place. Check for a folder named db or fpdb or something like
> > that. Now, if you use FrontPage, use it to upload the database and allow
> it
> > to move the database to the fpdb folder. FrontPage should take care of
the
> > permissions issue all by itself. Remember to change the connection
string
> > accordingly.
> >
> > Regards,
> >
> > Sixto
> >
> > "Pepito" <pepitxispi@yahoo.com> wrote in message
> >news:b458ko$m31$1@news.codecharge.com...
> > > Sorry, Outlook does not allow me to see the attachment because it is
> > > "potentially" unsafe...could you please zip or rar it?
> > > Anyway, as the brinkers site is not good for uploading, I am trying
> > > everything at this server..
> > > the database is here
> > > http://mariosbm.www4.dotnetplayground.com/code/GardenCo.mdb
> > > the page is here
> > > http://mariosbm.www4.dotnetplayground.com/code/Empleados_list.asp (you
> can
> > > see the html here
> > > http://mariosbm.www4.dotnetplayground.com/code/Empleados_list.html)
> > >
> > > Thanks for your help!!!!
> > >
> > > "NetFocus.biz" <amcfayen@netfocus.biz> wrote in message
> > >news:b457e6$ipc$1@news.codecharge.com...
> > > > Hi
> > > >
> > > > You need to know the file path to the database. You can find this
out
> > > using
> > > > the server.mappath method. You can take the attached small file and
> copy
> > > it
> > > > to the same folder as your database, then go to
> > > > http://www10.brinkster.com/mariosbm/code/getpath.asp
> > > >
> > > > you should then see a result like this in your browser:
> > > >
> > > > c:\inetpub\wwwroot\test\getpath.asp
> > > >
> > > > which will tell you how to refer to the database in Common.asp (in
> this
> > > case
> > > > c:\inetpub\wwwroot\test\GardenCo.mdb).
> > > >
> > > > Hope this helps
> > > >
> > > > Alistair
> > > >
> > > >
> > > >
> > > > --
> > > > Managing Director
> > > > NetFocus Solutions Ltd
> > > > 2 Cockburn Place
> > > > Riverside Business Park
> > > > Irvine, Ayrshire, KA11 5DA
> > > > Tel: +44 (0) 1294 318701
> > > > Fax: +44 (0) 1294 316580
> > > > Internet: www.netfocus.biz
> > > >
> > > > "Pepito" <pepitxispi@yahoo.com> wrote in message
> > > >news:b4568c$fu3$1@news.codecharge.com...
> > > > > Thanks for your responses:
> > > > >
> > > > > 1) I already turn off the friendly error showing,
> > > > > 2) I am playing with changing the path as Alistair kindly
> suggested..
> > > > >
> > > > > However, I am messing the code ...
> > > > > well....the database is here
> > > > > http://mariosbm.www4.dotnetplayground.com/code/GardenCo.mdb
> > > > > the page is here
> > > > > http://mariosbm.www4.dotnetplayground.com/code/Empleados_list.asp
> (you
> > > can
> > > > > see the html here
> > > > >
http://mariosbm.www4.dotnetplayground.com/code/Empleados_list.html)
> > > > > so, if the problem is here:
> > > > > "Microsoft JET Database Engine error '80004005'
> > > > >
> > > > > 'C:\Documents and Settings\M\My Documents\web solutions\New
> > > > > Folder\NewProject6\GardenCo.mdb' is not a valid path. Make sure
that
> > the
> > > > > path name is spelled correctly and that you are connected to the
> > server
> > > on
> > > > > which the file resides.
> > > > >
> > > > > /mariosbm/code/Common.asp, line 117"
> > > > >
> > > > > Should I write instead of C:\...etc this: \code\GardenCo.mdb ??
that
> > is
> > > > not
> > > > > working also....
> > > > >
> > > > > here is the old code:
> > > > >
> > > > > <%
> > > > > Option Explicit
> > > > >
> > > > > 'Include Files @0-0F8FBEEB
> > > > > %>
> > > > > <!-- #INCLUDE FILE="Adovbs.asp" -->
> > > > > <!-- #INCLUDE FILE="Classes.asp" -->
> > > > > <%
> > > > > 'End Include Files
> > > > >
> > > > > 'Script Engine Version Check @0-A118D8E9
> > > > > If ScriptEngineMajorVersion < 5 Then
> > > > > Response.Write "Sorry. This program requires VBScript 5.1 to
> > > > run.<br>You
> > > > > may upgrade your VBScript at
> > > > > http://www.microsoft.com/msdownload/vbscript/scripting.asp.";
> > > > > Response.End
> > > > > Else
> > > > > If ScriptEngineMajorVersion & ":" & ScriptEngineMinorVersion =
> > "5:0"
> > > > > Then
> > > > > Response.Write "Due to a bug in VBScript 5.0, this program
> > would
> > > > > crash your server. See
> > > > >
> http://support.microsoft.com/default.aspx?scid=kb;EN-US...<br>";
> > &
> > > _
> > > > > "Upgrade your VBScript at
> > > > > http://www.microsoft.com/msdownload/vbscript/scripting.asp.";
> > > > > Response.End
> > > > > End If
> > > > > End If
> > > > > 'End Script Engine Version Check
> > > > >
> > > > > 'Initialize Common Variables @0-EB7D5995
> > > > > Dim CCSDateConstants
> > > > > Dim ServerURL
> > > > > Dim SecureURL
> > > > > Dim TemplatesRepository
> > > > > Dim EventCaller
> > > > >
> > > > > Set TemplatesRepository = New clsCache_FileSystem
> > > > > ServerURL = "http://localhost/NewProject5/"
> > > > > Set CCSDateConstants = New clsCCSDateConstants
> > > > >
> > > > > Class clsCCSDateConstants
> > > > >
> > > > > Public Weekdays
> > > > > Public ShortWeekdays
> > > > > Public Months
> > > > > Public ShortMonths
> > > > > Public DateMasks
> > > > >
> > > > > Private Sub Class_Initialize()
> > > > > ShortWeekdays = Array("Sun", "Mon", "Tue", "Wed", "Thu",
> > "Fri",
> > > > > "Sat")
> > > > > Weekdays = Array("Sunday", "Monday", "Tuesday",
"Wednesday",
> > > > > "Thursday", "Friday", "Saturday")
> > > > > ShortMonths = Array("Jan", "Feb", "Mar", "Apr", "May",
> "Jun",
> > > > > "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")
> > > > > Months = Array("January", "February", "March", "April",
> "May",
> > > > > "June", "July", "August", "September", "October", "November",
> > > "December")
> > > > > Set DateMasks = CreateObject("Scripting.Dictionary")
> > > > > DateMasks("d") = 0
> > > > > DateMasks("dd") = 2
> > > > > DateMasks("m") = 0
> > > > > DateMasks("mm") = 2
> > > > > DateMasks("mmm") = 3
> > > > > DateMasks("mmmm") = 0
> > > > > DateMasks("yy") = 2
> > > > > DateMasks("yyyy") = 4
> > > > > DateMasks("h") = 0
> > > > > DateMasks("hh") = 2
> > > > > DateMasks("H") = 0
> > > > > DateMasks("HH") = 2
> > > > > DateMasks("n") = 0
> > > > > DateMasks("nn") = 2
> > > > > DateMasks("s") = 0
> > > > > DateMasks("ss") = 2
> > > > > DateMasks("am/pm") = 2
> > > > > DateMasks("AM/PM") = 2
> > > > > DateMasks("A/P") = 1
> > > > > DateMasks("a/p") = 1
> > > > > DateMasks("w") = 0
> > > > > DateMasks("q") = 0
> > > > > End Sub
> > > > >
> > > > > Private Sub Class_Terminate()
> > > > > Set DateMasks = Nothing
> > > > > End Sub
> > > > >
> > > > > End Class
> > > > >
> > > > > Const ccsInteger = 1
> > > > > Const ccsFloat = 2
> > > > > Const ccsText = 3
> > > > > Const ccsDate = 4
> > > > > Const ccsBoolean = 5
> > > > > Const ccsMemo = 6
> > > > >
> > > > > Const ccsGet = 1
> > > > > Const ccsPost = 2
> > > > > 'End Initialize Common Variables
> > > > >
> > > > > 'Connection1 Connection Class @-2D543FFD
> > > > > Class clsDBConnection1
> > > > >
> > > > > Public ConnectionString
> > > > > Public User
> > > > > Public Password
> > > > > Public DateFormat
> > > > > Public BooleanFormat
> > > > > Public LastSQL
> > > > > Public Errors
> > > > >
> > > > > Private objConnection
> > > > > Private blnState
> > > > >
> > > > > Private Sub Class_Initialize()
> > > > > ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;User
> > > > > ID=Admin;Data Source=C:\Documents and Settings\M\My Documents\web
> > > > > solutions\New Folder\NewProject5\GardenCo.mdb;Persist Security
> > > Info=False"
> > > > > User = "Admin"
> > > > > Password = ""
> > > > > DateFormat = Empty
> > > > > BooleanFormat = Empty
> > > > > Set objConnection =
Server.CreateObject("ADODB.Connection")
> > > > > Set Errors = New clsErrors
> > > > > End Sub
> > > > >
> > > > > Sub Open()
> > > > > On Error Resume Next
> > > > > objConnection.Errors.Clear
> > > > > objConnection.Open ConnectionString, User, Password
> > > > > If Err.Number <> 0 then
> > > > > Response.Write "<div><h2>Unable to establish
connection
> to
> > > > > database.</h2>"
> > > > > Response.Write "<ul><li>Error information:<br>"
> > > > > Response.Write Err.Source & " (0x" & Hex(Err.Number) &
> > > ")<br>"
> > > > > Response.Write Err.Description & "</li>"
> > > > > If Err.Number = -2147467259 then _
> > > > > Response.Write "<li>More information:<br>The database
> > cannot
> > > > be
> > > > > opened, most likely due to insufficient security set on your
> database
> > > > folder
> > > > > or file.</li>"
> > > > > Response.Write "</ul></div>"
> > > > > Response.End
> > > > > End If
> > > > > End Sub
> > > > >
> > > > > Sub Close()
> > > > > objConnection.Close
> > > > > End Sub
> > > > >
> > > > > Function Execute(varCMD)
> > > > > Dim ErrorMessage, objResult
> > > > > Errors.Clear
> > > > > Set objResult = Server.CreateObject("ADODB.Recordset")
> > > > > objResult.CursorType = adOpenForwardOnly
> > > > > objResult.LockType = adLockReadOnly
> > > > > If TypeName(varCMD) = "Command" Then
> > > > > Set varCMD.ActiveConnection = objConnection
> > > > > Set objResult.Source = varCMD
> > > > > LastSQL = varCMD.CommandText
> > > > > Else
> > > > > Set objResult.ActiveConnection = objConnection
> > > > > objResult.Source = varCMD
> > > > > LastSQL = varCMD
> > > > > End If
> > > > > On Error Resume Next
> > > > > objResult.Open
> > > > > Errors.AddError CCProcessError(objConnection)
> > > > > On Error Goto 0
> > > > > Set Execute = objResult
> > > > > End Function
> > > > >
> > > > > Property Get Connection()
> > > > > Set Connection = objConnection
> > > > > End Property
> > > > >
> > > > > Property Get State()
> > > > > State = objConnection.State
> > > > > End Property
> > > > >
> > > > > Function ToSQL(Value, ValueType)
> > > > > If CStr(Value) = "" OR IsEmpty(Value) Then
> > > > > ToSQL = "Null"
> > > > > Else
> > > > > If ValueType = ccsInteger or ValueType = ccsFloat Then
> > > > > ToSQL = Replace(Value, ",", ".")
> > > > > ElseIf ValueType = ccsDate Then
> > > > > ToSQL = "'" & Replace(Value, "'", "''") & "'"
> > > > > Else
> > > > > ToSQL = "'" & Replace(Value, "'", "''") & "'"
> > > > > End If
> > > > > End If
> > > > > End Function
> > > > >
> > > > >
> > > > > End Class
> > > > > 'End Connection1 Connection Class
> > > > >
> > > > > 'IIf @0-535EAADD
> > > > > Function IIf(Expression, TrueResult, FalseResult)
> > > > > If CBool(Expression) Then _
> > > > > IIf = TrueResult _
> > > > > Else _
> > > > > IIf = FalseResult
> > > > > End Function
> > > > > 'End IIf
> > > > >
> > > > > 'Print @0-065FC167
> > > > > Sub Print(Value)
> > > > > Response.Write CStr(Value)
> > > > > End Sub
> > > > > 'End Print
> > > > >
> > > > > 'CCRaiseEvent @0-E59A6846
> > > > > Function CCRaiseEvent(Events, EventName, Caller)
> > > > > Set EventCaller = Caller
> > > > > Dim Result : Result = Events(EventName)
> > > > > Set EventCaller = Nothing
> > > > > If VarType(Result) = vbEmpty Then _
> > > > > Result = True
> > > > > CCRaiseEvent = Result
> > > > > End Function
> > > > > 'End CCRaiseEvent
> > > > >
> > > > > 'CCFormatError @0-21121FA6
> > > > > Function CCFormatError(Title, Errors)
> > > > > Dim Result, I
> > > > > Result = "<p><b>Source:</b> " & Title & "<br>"
> > > > > For I = 0 To Errors.Count - 1
> > > > > Result = Result & "<b>Error:</b> " &
Errors.ErrorByNumber(I)
> > > > > Next
> > > > > Result = Result & "</p>"
> > > > > CCFormatError = Result
> > > > > End Function
> > > > > 'End CCFormatError
> > > > >
> > > > > 'CCOpenRS @0-9E4633EC
> > > > > Function CCOpenRS(RecordSet, SQL, Connection, ShowError)
> > > > > Dim ErrorMessage, Result
> > > > > Result = Empty
> > > > > Set RecordSet = Server.CreateObject("ADODB.Recordset")
> > > > > On Error Resume Next
> > > > > RecordSet.Open SQL, Connection, adOpenForwardOnly,
> adLockReadOnly,
> > > > > adCmdText
> > > > > ErrorMessage = CCProcessError(Connection)
> > > > > If NOT IsEmpty(ErrorMessage) Then
> > > > > If ShowError Then _
> > > > > Result = "SQL: " & CommandObject.CommandText & "<br>"
&
> > > > "Error:
> > > > > " & ErrorMessage & "<br>" _
> > > > > Else _
> > > > > Result = "Database error.<br>"
> > > > > End If
> > > > > On Error Goto 0
> > > > > CCOpenRS = Result
> > > > > End Function
> > > > > 'End CCOpenRS
> > > > >
> > > > > 'CCOpenRSFromCmd @0-A2A33ECF
> > > > > Function CCOpenRSFromCmd(RecordSet, CommandObject, ShowError)
> > > > > Dim ErrorMessage, Result
> > > > > Result = Empty
> > > > > Set RecordSet = Server.CreateObject("ADODB.Recordset")
> > > > > On Error Resume Next
> > > > > RecordSet.CursorType = adOpenForwardOnly
> > > > > RecordSet.LockType = adLockReadOnly
> > > > > RecordSet.Open CommandObject
> > > > > ErrorMessage = CCProcessError(CommandObject.ActiveConnection)
> > > > > If NOT IsEmpty(ErrorMessage) Then
> > > > > If ShowError Then _
> > > > > Result = "SQL: " & CommandObject.CommandText & "<br>"
&
> > > > "Error:
> > > > > " & ErrorMessage & "<br>" _
> > > > > Else _
> > > > > Result = "Database error.<br>"
> > > > > End If
> > > > > On Error Goto 0
> > > > > CCOpenRSFromCmd = Result
> > > > > End Function
> > > > > 'End CCOpenRSFromCmd
> > > > >
> > > > > 'CCExecCmd @0-3DC993D0
> > > > > Function CCExecCmd(CommandObject, ShowError)
> > > > > Dim ErrorMessage, Result
> > > > > Result = Empty
> > > > > On Error Resume Next
> > > > > CommandObject.Execute
> > > > > ErrorMessage = CCProcessError(CommandObject.ActiveConnection)
> > > > > If NOT IsEmpty(ErrorMessage) Then
> > > > > If ShowError Then _
> > > > > Result = "SQL: " & CommandObject.CommandText & "<br>"
&
> > > > "Error:
> > > > > " & ErrorMessage & "<br>" _
> > > > > Else _
> > > > > Result = "Database error.<br>"
> > > > > End If
> > > > > On Error Goto 0
> > > > > CCExecCmd = Result
> > > > > End Function
> > > > > 'End CCExecCmd
> > > > >
> > > > > 'CCExecSQL @0-24CC2822
> > > > > Function CCExecSQL(SQL, Connection, ShowError)
> > > > > Dim ErrorMessage, Result
> > > > > Result = Empty
> > > > > On Error Resume Next
> > > > > Connection.Execute(SQL)
> > > > > ErrorMessage = CCProcessError(Connection)
> > > > > If NOT IsEmpty(ErrorMessage) Then
> > > > > If ShowError Then _
> > > > > Result = "SQL: " & SQL & "<br>" & "Error: " &
> ErrorMessage
> > &
> > > > > "<br>" _
> > > > > Else _
> > > > > Result = "Database error.<br>"
> > > > > End If
> > > > > On Error Goto 0
> > > > > CCExecSQL = Result
> > > > > End Function
> > > > > 'End CCExecSQL
> > > > >
> > > > > 'CCToHTML @0-44D2E9F4
> > > > > Function CCToHTML(Value)
> > > > > If IsNull(Value) Then Value = ""
> > > > > CCToHTML = Server.HTMLEncode(Value)
> > > > > End Function
> > > > > 'End CCToHTML
> > > > >
> > > > > 'CCToURL @0-23A93674
> > > > > Function CCToURL(Value)
> > > > > If IsNull(Value) Then Value = ""
> > > > > CCToURL = Server.URLEncode(Value)
> > > > > End Function
> > > > > 'End CCToURL
> > > > >
> > > > > 'CCGetValueHTML @0-30C69AED
> > > > > Function CCGetValueHTML(RecordSet, FieldName)
> > > > > CCGetValueHTML = CCToHTML(CCGetValue(RecordSet, FieldName))
> > > > > End Function
> > > > > 'End CCGetValueHTML
> > > > >
> > > > > 'CCGetValue @0-C5915067
> > > > > Function CCGetValue(RecordSet, FieldName)
> > > > > Dim Result
> > > > > On Error Resume Next
> > > > > If RecordSet Is Nothing Then
> > > > > CCGetValue = Empty
> > > > > ElseIf (NOT RecordSet.EOF) AND (FieldName <> "") Then
> > > > > Result = RecordSet(FieldName)
> > > > > If IsNull(Result) Then _
> > > > > Result = Empty
> > > > > CCGetValue = Result
> > > > > Else
> > > > > CCGetValue = Empty
> > > > > End If
> > > > > On Error Goto 0
> > > > > End Function
> > > > > 'End CCGetValue
> > > > >
> > > > > 'CCGetDate @0-4102C01B
> > > > > Function CCGetDate(RecordSet, FieldName, arrDateFormat)
> > > > > Dim Result
> > > > > Result = CCGetValue(RecordSet, FieldName)
> > > > > If Not IsEmpty(arrDateFormat) Then
> > > > > If Not (VarType(Result) = vbDate OR VarType(Result) = vbEmpty)
> > Then
> > > _
> > > > > If CCValidateDate(Result, arrDateFormat) Then _
> > > > > Result = CCParseDate(Result, arrDateFormat)
> > > > > End If
> > > > > CCGetDate = Result
> > > > > End Function
> > > > > 'End CCGetDate
> > > > >
> > > > > 'CCGetBoolean @0-C64EED38
> > > > > Function CCGetBoolean(RecordSet, FieldName, BooleanFormat)
> > > > > Dim Result
> > > > > Result = CCGetValue(RecordSet, FieldName)
> > > > > CCGetBoolean = CCParseBoolean(Result, BooleanFormat)
> > > > > End Function
> > > > > 'End CCGetBoolean
> > > > >
> > > > > 'CCGetParam @0-B1CC8211
> > > > > Function CCGetParam(ParameterName, DefaultValue)
> > > > > Dim ParameterValue : ParameterValue = ""
> > > > > If Request.QueryString(ParameterName).Count > 0 Then
> > > > > ParameterValue = Request.QueryString(ParameterName)
> > > > > ElseIf Request.Form(ParameterName).Count > 0 Then
> > > > > ParameterValue = Request.Form(ParameterName)
> > > > > Else
> > > > > ParameterValue = DefaultValue
> > > > > End If
> > > > > CCGetParam = ParameterValue
> > > > > End Function
> > > > > 'End CCGetParam
> > > > >
> > > > > 'CCGetFromPost @0-B27302B2
> > > > > Function CCGetFromPost(ParameterName, DefaultValue)
> > > > > Dim ParameterValue : ParameterValue = Empty
> > > > > ParameterValue = Request.Form(ParameterName)
> > > > > If IsEmpty(ParameterValue) Then _
> > > > > ParameterValue = DefaultValue
> > > > > CCGetFromPost = ParameterValue
> > > > > End Function
> > > > > 'End CCGetFromPost
> > > > >
> > > > > 'CCGetFromGet @0-F6BB8115
> > > > > Function CCGetFromGet(ParameterName, DefaultValue)
> > > > > Dim ParameterValue : ParameterValue = Empty
> > > > > ParameterValue = Request.QueryString(ParameterName)
> > > > > If IsEmpty(ParameterValue) Then _
> > > > > ParameterValue = DefaultValue
> > > > > CCGetFromGet = ParameterValue
> > > > > End Function
> > > > > 'End CCGetFromGet
> > > > >
> > > > > 'CCToSQL @0-CA2C324A
> > > > > Function CCToSQL(Value, ValueType)
> > > > > If CStr(Value) = "" OR IsEmpty(Value) Then
> > > > > CCToSQL = "Null"
> > > > > Else
> > > > > If ValueType = "Integer" or ValueType = "Float" Then
> > > > > CCToSQL = Replace(CDbl(Value), ",", ".")
> > > > > Else
> > > > > CCToSQL = "'" & Replace(Value, "'", "''") & "'"
> > > > > End If
> > > > > End If
> > > > > End Function
> > > > > 'End CCToSQL
> > > > >
> > > > > 'CCDLookUp @0-9125C206
> > > > > Function CCDLookUp(ColumnName, TableName, Where, Connection)
> > > > > Dim RecordSet
> > > > > Dim Result
> > > > > Dim SQL
> > > > > Dim ErrorMessage
> > > > > SQL = "SELECT " & ColumnName & " FROM " & TableName &
> > > > IIf(IsEmpty(Where),
> > > > > "", " WHERE " & Where)
> > > > > Set RecordSet = Connection.Execute(SQL)
> > > > > ErrorMessage = CCProcessError(Connection)
> > > > > If NOT IsEmpty(ErrorMessage) Then
> > > > > PrintDBError "CCDLookUp function", SQL, ErrorMessage
> > > > > End If
> > > > > On Error Goto 0
> > > > > Result = CCGetValue(RecordSet, 0)
> > > > > CCDLookUp = Result
> > > > > End Function
> > > > > 'End CCDLookUp
> > > > >
> > > > > 'PrintDBError @0-3D5DDA9A
> > > > > Sub PrintDBError(Source, SQL, ErrorMessage)
> > > > > Dim CommandText
> > > > > Dim SourceText
> > > > > Dim ErrorText
> > > > >
> > > > > If Source <> "" Then SourceText = "<b>Source:</b> " & Source &
> > "<br>"
> > > > > If SQL <> "" Then CommandText = "<b>Command Text:</b> " & SQL &
> > "<br>"
> > > > > If ErrorMessage <> "" Then ErrorText = "<b>Error
description:</b>
> "
> > &
> > > > > ErrorMessage & "</div>"
> > > > >
> > > > > Response.Write "<div style=""background-color: rgb(250, 250,
250);
> "
> > &
> > > _
> > > > > "border: solid 1px rgb(200, 200, 200);"">" & SourceText
> > > > > Response.Write CommandText & ErrorText
> > > > > End Sub
> > > > > 'End PrintDBError
> > > > >
> > > > > 'CCGetCheckBoxValue @0-ABCF54E0
> > > > > Function CCGetCheckBoxValue(Value, CheckedValue, UncheckedValue,
> > > > ValueType)
> > > > > If isEmpty(Value) Then
> > > > > If UncheckedValue = "" Then
> > > > > CCGetCheckBoxValue = "Null"
> > > > > Else
> > > > > If ValueType = "Integer" or ValueType = "Float" Then
> > > > > CCGetCheckBoxValue = UncheckedValue
> > > > > Else
> > > > > CCGetCheckBoxValue = "'" & Replace(UncheckedValue, "'",
> "''")
> > &
> > > > "'"
> > > > > End If
> > > > > End If
> > > > > Else
> > > > > If CheckedValue = "" Then
> > > > > CCGetCheckBoxValue = "Null"
> > > > > Else
> > > > > If ValueType = "Integer" OR ValueType = "Float" Then
> > > > > CCGetCheckBoxValue = CheckedValue
> > > > > Else
> > > > > CCGetCheckBoxValue = "'" & Replace(CheckedValue, "'",
"''")
> &
> > > "'"
> > > > > End If
> > > > > End If
> > > > > End If
> > > > > End Function
> > > > > 'End CCGetCheckBoxValue
> > > > >
> > > > > 'CCGetValFromLOV @0-5041B9C1
> > > > > Function CCGetValFromLOV(Value, ListOfValues)
> > > > > Dim I
> > > > > Dim Result : Result = ""
> > > > > If (Ubound(ListOfValues) MOD 2) = 1 Then
> > > > > For I = 0 To Ubound(ListOfValues) Step 2
> > > > > If CStr(Value) = CStr(ListOfValues(I)) Then Result =
> > > ListOfValues(I
> > > > +
> > > > > 1)
> > > > > Next
> > > > > End If
> > > > > CCGetValFromLOV = Result
> > > > > End Function
> > > > > 'End CCGetValFromLOV
> > > > >
> > > > > 'CCProcessError @0-A3A2654C
> > > > > Function CCProcessError(Connection)
> > > > > If Connection.Errors.Count > 0 Then
> > > > > If TypeName(Connection) = "Connection" Then
> > > > > CCProcessError = Connection.Errors(0).Description & " (" &
> > > > > Connection.Errors(0).Source & ")"
> > > > > Else
> > > > > CCProcessError = Connection.Errors.ToString
> > > > > End If
> > > > > ElseIf NOT (Err.Description = "") Then
> > > > > CCProcessError = Err.Description
> > > > > Else
> > > > > CCProcessError = Empty
> > > > > End If
> > > > > end Function
> > > > > 'End CCProcessError
> > > > >
> > > > > 'CCGetRequestParam @0-C154AA52
> > > > > Function CCGetRequestParam(ParameterName, Method)
> > > > > Dim ParameterValue
> > > > >
> > > > > If Method = ccsGet Then
> > > > > ParameterValue = Request.QueryString(ParameterName)
> > > > > ElseIf Method = ccsPost Then
> > > > > ParameterValue = Request.Form(ParameterName)
> > > > > End If
> > > > > If CStr(ParameterValue) = "" Then _
> > > > > ParameterValue = Empty
> > > > >
> > > > > CCGetRequestParam = ParameterValue
> > > > > End Function
> > > > > 'End CCGetRequestParam
> > > > >
> > > > > 'CCGetQueryString @0-CBD7B22E
> > > > > Function CCGetQueryString(CollectionName, RemoveParameters)
> > > > > Dim QueryString, PostData
> > > > >
> > > > > If CollectionName = "Form" Then
> > > > > QueryString = CCCollectionToString(Request.Form,
> RemoveParameters)
> > > > > ElseIf CollectionName = "QueryString" Then
> > > > > QueryString = CCCollectionToString(Request.QueryString,
> > > > > RemoveParameters)
> > > > > ElseIf CollectionName = "All" Then
> > > > > QueryString = CCCollectionToString(Request.QueryString,
> > > > > RemoveParameters)
> > > > > PostData = CCCollectionToString(Request.Form,
RemoveParameters)
> > > > > If Len(PostData) > 0 and Len(QueryString) > 0 Then _
> > > > > QueryString = QueryString & "&" & PostData _
> > > > > Else _
> > > > > QueryString = QueryString & PostData
> > > > > Else
> > > > > Err.Raise 1050, "Common Functions. CCGetQueryString Function",
_
> > > > > "The CollectionName contains an illegal value."
> > > > > End If
> > > > >
> > > > > CCGetQueryString = QueryString
> > > > > End Function
> > > > > 'End CCGetQueryString
> > > > >
> > > > > 'CCCollectionToString @0-57CAA4B7
> > > > > Function CCCollectionToString(ParametersCollection,
> RemoveParameters)
> > > > > Dim ItemName, ItemValue, Result, Remove, I
> > > > >
> > > > > For Each ItemName In ParametersCollection
> > > > > Remove = false
> > > > > If IsArray(RemoveParameters) Then
> > > > > For I = 0 To UBound(RemoveParameters)
> > > > > If RemoveParameters(I) = ItemName Then
> > > > > Remove = True
> > > > > Exit For
> > > > > End If
> > > > > Next
> > > > > End If
> > > > > If Not Remove Then
> > > > > For Each ItemValue In ParametersCollection(ItemName)
> > > > > Result = Result & _
> > > > > "&" & ItemName & "=" & Server.URLEncode(ItemValue)
> > > > > Next
> > > > > End If
> > > > > Next
> > > > >
> > > > > If Len(Result) > 0 Then _
> > > > > Result = Mid(Result, 2)
> > > > > CCCollectionToString = Result
> > > > > End Function
> > > > > 'End CCCollectionToString
> > > > >
> > > > > 'CCAddZero @0-B5648418
> > > > > Function CCAddZero(Value, ResultLength)
> > > > > Dim CountZero, I
> > > > >
> > > > > CountZero = ResultLength - Len(Value)
> > > > > For I = 1 To CountZero
> > > > > Value = "0" & Value
> > > > > Next
> > > > > CCAddZero = Value
> > > > > End Function
> > > > > 'End CCAddZero
> > > > >
> > > > > 'CCGetAMPM @0-CB6EA5BF
> > > > > Function CCGetAMPM(HoursNumber, AnteMeridiem, PostMeridiem)
> > > > > If HoursNumber >= 0 And HoursNumber < 12 Then
> > > > > CCGetAMPM = AnteMeridiem
> > > > > Else
> > > > > CCGetAMPM = PostMeridiem
> > > > > End If
> > > > > End Function
> > > > > 'End CCGetAMPM
> > > > >
> > > > > 'CC12Hour @0-12B00AFF
> > > > > Function CC12Hour(HoursNumber)
> > > > > If HoursNumber = 0 Then
> > > > > HoursNumber = 12
> > > > > ElseIf HoursNumber > 12 Then
> > > > > HoursNumber = HoursNumber - 12
> > > > > End If
> > > > > CC12Hour = HoursNumber
> > > > > End Function
> > > > > 'End CC12Hour
> > > > >
> > > > > 'CCDBFormatByType @0-531721B5
> > > > > Function CCDBFormatByType(Variable)
> > > > > Dim Result
> > > > > If VarType(Variable) = vbString Then
> > > > > If LCase(Variable) = "null" Then
> > > > > Result = Variable
> > > > > Else
> > > > > Result = "'" & Variable & "'"
> > > > > End If
> > > > > Else
> > > > > Result = CStr(Variable)
> > > > > End If
> > > > > CCDBFormatByType = Result
> > > > > End Function
> > > > >
> > > > > 'End CCDBFormatByType
> > > > >
> > > > > 'CCFormatDate @0-9C44D5D4
> > > > > Function CCFormatDate(DateToFormat, FormatMask)
> > > > > Dim ResultArray(), I, Result
> > > > > If VarType(DateToFormat) = vbEmpty Then
> > > > > Result = Empty
> > > > > ElseIf VarType(DateToFormat) <> vbDate Then
> > > > > Err.Raise 4000, "CCFormatDate function. Type mismatch."
> > > > > ElseIf IsEmpty(FormatMask) Then
> > > > > Result = CStr(DateToFormat)
> > > > > Else
> > > > > ReDim ResultArray(UBound(FormatMask))
> > > > > For I = 0 To UBound(FormatMask)
> > > > > Select Case FormatMask(I)
> > > > > Case "d" ResultArray(I) = Day(DateToFormat)
> > > > > Case "w" ResultArray(I) = Weekday(DateToFormat)
> > > > > Case "m" ResultArray(I) = Month(DateToFormat)
> > > > > Case "q" ResultArray(I) = (Month(DateToFormat) + 3) \ 4
> > > > > Case "y" ResultArray(I) = (DateDiff("d", "1/1" & "/" &
> > > > > Year(DateToFormat), Month(DateToFormat) & "/" & Day(DateToFormat)
&
> > "/"
> > > &
> > > > > Year(DateToFormat)) + 1)
> > > > > Case "h" ResultArray(I) = CC12Hour(Hour(DateToFormat))
> > > > > Case "H" ResultArray(I) = Hour(DateToFormat)
> > > > > Case "n" ResultArray(I) = Minute(DateToFormat)
> > > > > Case "s" ResultArray(I) = Second(DateToFormat)
> > > > > Case "dd" ResultArray(I) = CCAddZero(Day(DateToFormat), 2)
> > > > > Case "ww" ResultArray(I) = (DateDiff("ww", "1/1" & "/" &
> > > > > Year(DateToFormat), Month(DateToFormat) & "/" & Day(DateToFormat)
&
> > "/"
> > > &
> > > > > Year(DateToFormat)) + 1)
> > > > > Case "mm" ResultArray(I) = CCAddZero(Month(DateToFormat),
2)
> > > > > Case "yy" ResultArray(I) = Right(Year(DateToFormat), 2)
> > > > > Case "hh" ResultArray(I) =
> > > CCAddZero(CC12Hour(Hour(DateToFormat)),
> > > > > 2)
> > > > > Case "HH" ResultArray(I) = CCAddZero(Hour(DateToFormat),
2)
> > > > > Case "nn" ResultArray(I) = CCAddZero(Minute(DateToFormat),
> 2)
> > > > > Case "ss" ResultArray(I) = CCAddZero(Second(DateToFormat),
> 2)
> > > > > Case "ddd" ResultArray(I) =
> > > > > CCSDateConstants.ShortWeekdays(Weekday(DateToFormat) - 1)
> > > > > Case "mmm" ResultArray(I) =
> > > > > CCSDateConstants.ShortMonths(Month(DateToFormat) - 1)
> > > > > Case "A/P" ResultArray(I) = CCGetAMPM(Hour(DateToFormat),
> "A",
> > > > "P")
> > > > > Case "a/p" ResultArray(I) = CCGetAMPM(Hour(DateToFormat),
> "a",
> > > > "p")
> > > > > Case "dddd" ResultArray(I) =
> > > > > CCSDateConstants.Weekdays(Weekday(DateToFormat) - 1)
> > > > > Case "mmmm" ResultArray(I) =
> > > > > CCSDateConstants.Months(Month(DateToFormat) - 1)
> > > > > Case "yyyy" ResultArray(I) = Year(DateToFormat)
> > > > > Case "AM/PM" ResultArray(I) =
CCGetAMPM(Hour(DateToFormat),
> > > "AM",
> > > > > "PM")
> > > > > Case "am/pm" ResultArray(I) =
CCGetAMPM(Hour(DateToFormat),
> > > "am",
> > > > > "pm")
> > > > > Case "LongDate" ResultArray(I) =
> FormatDateTime(DateToFormat,
> > > > > vbLongDate)
> > > > > Case "LongTime" ResultArray(I) =
> FormatDateTime(DateToFormat,
> > > > > vbLongTime)
> > > > > Case "ShortDate" ResultArray(I) =
> FormatDateTime(DateToFormat,
> > > > > vbShortDate)
> > > > > Case "ShortTime" ResultArray(I) =
> FormatDateTime(DateToFormat,
> > > > > vbShortTime)
> > > > > Case "GeneralDate" ResultArray(I) =
> > FormatDateTime(DateToFormat,
> > > > > vbGeneralDate)
> > > > > Case Else
> > > > > If Left(FormatMask(I), 1) = "\" Then _
> > > > > ResultArray(I) = Mid(FormatMask(I), 1) _
> > > > > Else
> > > > > ResultArray(I) = FormatMask(I)
> > > > > End Select
> > > > > Next
> > > > > Result = Join(ResultArray, "")
> > > > > End If
> > > > > CCFormatDate = Result
> > > > > End Function
> > > > > 'End CCFormatDate
> > > > >
> > > > > 'CCFormatBoolean @0-635596FD
> > > > > Function CCFormatBoolean(BooleanValue, arrFormat)
> > > > > Dim Result, TrueValue, FalseValue, EmptyValue
> > > > >
> > > > > If IsEmpty(arrFormat) Then
> > > > > Result = CStr(BooleanValue)
> > > > > Else
> > > > > TrueValue = arrFormat(0)
> > > > > FalseValue = arrFormat(1)
> > > > > EmptyValue = arrFormat(2)
> > > > > If IsEmpty(BooleanValue) Then
> > > > > Result = EmptyValue
> > > > > Else
> > > > > If BooleanValue Then _
> > > > > Result = TrueValue _
> > > > > Else _
> > > > > Result = FalseValue
> > > > > End If
> > > > > End If
> > > > > CCFormatBoolean = Result
> > > > > End Function
> > > > > 'End CCFormatBoolean
> > > > >
> > > > > 'CCFormatNumber @0-67C259CA
> > > > > Function CCFormatNumber(NumberToFormat, FormatArray)
> > > > > Dim IsNegative
> > > > > Dim IsExtendedFormat, IsDecimalSeparator, DecimalSeparator,
> > > > > IsPeriodSeparator, PeriodSeparator
> > > > >
> > > > > If IsEmpty(NumberToFormat) Then
> > > > > CCFormatNumber = ""
> > > > > Exit Function
> > > > > End If
> > > > >
> > > > > If IsArray(FormatArray) Then
> > > > > IsExtendedFormat = FormatArray(0)
> > > > > IsNegative = (NumberToFormat < 0)
> > > > > NumberToFormat = ABS(NumberToFormat) * FormatArray(7)
> > > > >
> > > > > If IsExtendedFormat Then ' Extended format
> > > > > IsDecimalSeparator = FormatArray(1)
> > > > > DecimalSeparator = FormatArray(2)
> > > > > IsPeriodSeparator = FormatArray(3)
> > > > > PeriodSeparator = FormatArray(4)
> > > > >
> > > > > Dim BeforeDecimal, AfterDecimal
> > > > > Dim ObligatoryBeforeDecimal, DigitsBeforeDecimal,
> > > > > ObligatoryAfterDecimal, DigitsAfterDecimal
> > > > > Dim I, Z
> > > > > BeforeDecimal = FormatArray(5)
> > > > > AfterDecimal = FormatArray(6)
> > > > > If IsArray(BeforeDecimal) Then
> > > > > For I = 0 To UBound(BeforeDecimal)
> > > > > If BeforeDecimal(I) = "0" Then
> > > > > ObligatoryBeforeDecimal = ObligatoryBeforeDecimal + 1
> > > > > DigitsBeforeDecimal = DigitsBeforeDecimal + 1
> > > > > ElseIf BeforeDecimal(I) = "#" Then
> > > > > DigitsBeforeDecimal = DigitsBeforeDecimal + 1
> > > > > End If
> > > > > Next
> > > > > End If
> > > > > If IsArray(AfterDecimal) Then
> > > > > For I = 0 To UBound(AfterDecimal)
> > > > > If AfterDecimal(I) = "0" Then
> > > > > ObligatoryAfterDecimal = ObligatoryAfterDecimal + 1
> > > > > DigitsAfterDecimal = DigitsAfterDecimal + 1
> > > > > ElseIf AfterDecimal(I) = "#" Then
> > > > > DigitsAfterDecimal = DigitsAfterDecimal + 1
> > > > > End If
> > > > > Next
> > > > > End If
> > > > >
> > > > > Dim NumDigitsAfterDecimal, Result, DefaultValue
> > > > > If ObligatoryAfterDecimal = 0 And DigitsAfterDecimal = 1
Then
> > > > > NumDigitsAfterDecimal = -1
> > > > > ElseIf Not IsDecimalSeparator Then
> > > > > NumDigitsAfterDecimal = 0
> > > > > Else
> > > > > NumDigitsAfterDecimal = DigitsAfterDecimal
> > > > > End If
> > > > > NumberToFormat = FormatNumber(NumberToFormat,
> > DigitsAfterDecimal,
> > > > > False, False, False)
> > > > >
> > > > > Dim DefaultDecimal : DefaultDecimal =
> Mid(FormatNumber(10001/10,
> > > 1,
> > > > > True, False, True), 6, 1)
> > > > > Dim LeftPart, RightPart
> > > > > If Not InStr(CStr(NumberToFormat), DefaultDecimal) = 0 Then
> > > > > Dim NumberParts : NumberParts =
Split(CStr(NumberToFormat),
> > > > > DefaultDecimal)
> > > > > LeftPart = CStr(NumberParts(0))
> > > > > RightPart = CStr(NumberParts(1))
> > > > > Else
> > > > > LeftPart = CStr(NumberToFormat)
> > > > > End If
> > > > >
> > > > > Dim J : J = Len(LeftPart)
> > > > >
> > > > > If IsDecimalSeparator And DecimalSeparator = "" Then
> > > > > DefaultValue = CStr(FormatNumber(10001/10, 1, True, False,
> > > True))
> > > > > DecimalSeparator = Mid(DefaultValue, 6, 1)
> > > > > End If
> > > > >
> > > > > If IsPeriodSeparator And PeriodSeparator = "" Then
> > > > > DefaultValue = CStr(FormatNumber(10001/10, 1, True, False,
> > > True))
> > > > > PeriodSeparator = Mid(DefaultValue, 2, 1)
> > > > > End If
> > > > >
> > > > > If IsArray(BeforeDecimal) Then
> > > > > Dim RankNumber : RankNumber = 0
> > > > > For I = UBound(BeforeDecimal) To 0 Step -1
> > > > > If BeforeDecimal(i) = "#" Or BeforeDecimal(i) = "0" Then
> > > > > If DigitsBeforeDecimal = 1 And J > 1 Then
> > > > > If Not IsPeriodSeparator Then
> > > > > Result = Left(LeftPart, j) & Result
> > > > > Else
> > > > > For z = J To 1 Step -1
> > > > > RankNumber = RankNumber + 1
> > > > > If RankNumber Mod 3 = 1 And RankNumber - 3 > 0
> Then
> > > > > Result = Mid(LeftPart, z, 1) & PeriodSeparator
&
> > > > Result
> > > > > Else
> > > > > Result = Mid(LeftPart, z, 1) & Result
> > > > > End If
> > > > > Next
> > > > > End If
> > > > > ElseIf J > 0 Then
> > > > > RankNumber = RankNumber + 1
> > > > > If RankNumber Mod 3 = 1 And RankNumber - 3 > 0 And
> > > > > IsPeriodSeparator Then
> > > > > Result = Mid(LeftPart, j, 1) & PeriodSeparator &
> > Result
> > > > > Else
> > > > > Result = Mid(LeftPart, j, 1) & Result
> > > > > End If
> > > > > J = J - 1
> > > > > ObligatoryBeforeDecimal = ObligatoryBeforeDecimal -
1
> > > > > DigitsBeforeDecimal = DigitsBeforeDecimal - 1
> > > > > Else
> > > > > If ObligatoryBeforeDecimal > 0 Then
> > > > > RankNumber = RankNumber + 1
> > > > > If RankNumber Mod 3 = 1 And RankNumber - 3 > 0 And
> > > > > IsPeriodSeparator Then
> > > > > Result = "0" & PeriodSeparator & Result
> > > > > Else
> > > > > Result = "0" & Result
> > > > > End If
> > > > > ObligatoryBeforeDecimal =
ObligatoryBeforeDecimal -
> 1
> > > > > DigitsBeforeDecimal = DigitsBeforeDecimal - 1
> > > > > End If
> > > > > End If
> > > > > Else
> > > > > BeforeDecimal(I) = Replace(BeforeDecimal(I), "##",
"#")
> > > > > BeforeDecimal(I) = Replace(BeforeDecimal(I), "00",
"0")
> > > > > Result = BeforeDecimal(I) & Result
> > > > > End If
> > > > > Next
> > > > > End If
> > > > >
> > > > > ' Left part after decimal
> > > > > Dim RightResult : RightResult = ""
> > > > > If IsArray(AfterDecimal) Then
> > > > > Dim IsZero : IsZero = True
> > > > > For I = UBound(AfterDecimal) To 0 Step -1
> > > > > If AfterDecimal(I) = "#" Or AfterDecimal(I) = "0" Then
> > > > > If DigitsAfterDecimal > ObligatoryAfterDecimal Then
> > > > > If Not Mid(RightPart, DigitsAfterDecimal, 1) = "0"
> Then
> > > > IsZero
> > > > > = False
> > > > > If Not IsZero Then _
> > > > > RightResult = Mid(RightPart, DigitsAfterDecimal,
1)
> &
> > > > > RightResult
> > > > > DigitsAfterDecimal = DigitsAfterDecimal - 1
> > > > > Else
> > > > > RightResult = Mid(RightPart, DigitsAfterDecimal, 1)
&
> > > > > RightResult
> > > > > DigitsAfterDecimal = DigitsAfterDecimal - 1
> > > > > End If
> > > > > Else
> > > > > AfterDecimal(I) = Replace(AfterDecimal(I), "##", "#")
> > > > > AfterDecimal(I) = Replace(AfterDecimal(I), "00", "0")
> > > > > RightResult = AfterDecimal(I) & RightResult
> > > > > End If
> > > > > Next
> > > > > End If
> > > > >
> > > > > If IsDecimalSeparator AND Len(RightResult) > 0 Then _
> > > > > Result = Result & DecimalSeparator & RightResult
> > > > >
> > > > > If NOT FormatArray(10) AND IsNegative Then _
> > > > > Result = "-" & Result
> > > > >
> > > > > Result = Result & RightResult
> > > > > Else ' Simple format
> > > > > If Not FormatArray(3) AND IsNegative Then _
> > > > > Result = "-" & FormatArray(5) &
FormatNumber(NumberToFormat,
> > > > > FormatArray(1), FormatArray(2), False, FormatArray(4)) &
> > FormatArray(6)
> > > _
> > > > > Else _
> > > > > Result = FormatArray(5) & FormatNumber(NumberToFormat,
> > > > > FormatArray(1), FormatArray(2), False, FormatArray(4)) &
> > FormatArray(6)
> > > > > End If
> > > > > If Not FormatArray(8) Then Result = Server.HTMLEncode(Result)
> > > > > If Not CStr(FormatArray(9)) = "" Then _
> > > > > Result = "<FONT COLOR=""" & FormatArray(9) & """>" & Result
&
> > > > > "</FONT>"
> > > > > Else
> > > > > Result = NumberToFormat
> > > > > End If
> > > > > CCFormatNumber = Result
> > > > >
> > > > > End Function
> > > > > 'End CCFormatNumber
> > > > >
> > > > > 'CCParseBoolean @0-33711A62
> > > > > Function CCParseBoolean(Value, FormatMask)
> > > > > Dim Result
> > > > > Result = Empty
> > > > > If VarType(Value) = vbBoolean Then
> > > > > Result = Value
> > > > > Else
> > > > > If IsEmpty(FormatMask) Then
> > > > > Result = CBool(Value)
> > > > > Else
> > > > > If IsEmpty(Value) Then
> > > > > If CStr(FormatMask(0)) = "null" Then _
> > > > > Result = True
> > > > > If CStr(FormatMask(1)) = "null" Then _
> > > > > Result = False
> > > > > Else
> > > > > If CStr(Value) = CStr(FormatMask(0)) Then
> > > > > Result = True
> > > > > ElseIf CStr(Value) = CStr(FormatMask(1)) Then
> > > > > Result = False
> > > > > End If
> > > > > End If
> > > > > End If
> > > > > End If
> > > > > CCParseBoolean = Result
> > > > > End Function
> > > > > 'End CCParseBoolean
> > > > >
> > > > > 'CCParseDate @0-0D3D1ED4
> > > > > Function CCParseDate(ParsingDate, FormatMask)
> > > > > Dim ResultDate, ResultDateArray(8)
> > > > > Dim MaskPart, MaskLength, TokenLength
> > > > > Dim IsError
> > > > > Dim DatePosition, MaskPosition
> > > > > Dim Delimiter, BeginDelimiter
> > > > > Dim MonthNumber, MonthName, MonthArray
> > > > > Dim DatePart
> > > > >
> > > > > Dim IS_DATE_POS, YEAR_POS, MONTH_POS, DAY_POS, IS_TIME_POS,
> > HOUR_POS,
> > > > > MINUTE_POS, SECOND_POS
> > > > >
> > > > > IS_DATE_POS = 0 : YEAR_POS = 1 : MONTH_POS = 2 : DAY_POS = 3
> > > > > IS_TIME_POS = 4 : HOUR_POS = 5 : MINUTE_POS = 6 : SECOND_POS = 7
> > > > >
> > > > >
> > > > > If IsEmpty(FormatMask) Then
> > > > > If CStr(ParsingDate) = "" Then _
> > > > > ResultDate = Empty _
> > > > > Else _
> > > > > ResultDate = CDate(ParsingDate)
> > > > > ElseIf (FormatMask(0) = "GeneralDate" Or FormatMask(0) =
> "LongDate"
> > _
> > > > > Or FormatMask(0) = "ShortDate" Or FormatMask(0) = "LongTime" _
> > > > > Or FormatMask(0) = "ShortTime") And Not CStr(ParsingDate) = ""
> > Then
> > > > > ResultDate = CDate(ParsingDate)
> > > > > ElseIf CStr(ParsingDate) = "" Then
> > > > > ResultDate = Empty
> > > > > Else
> > > > > DatePosition = 1
> > > > > MaskPosition = 0
> > > > > MaskLength = UBound(FormatMask)
> > > > > IsError = False
> > > > >
> > > > > ' Default date
> > > > > ResultDateArray(IS_DATE_POS) = False
> > > > > ResultDateArray(IS_TIME_POS) = False
> > > > > ResultDateArray(YEAR_POS) = 0 : ResultDateArray(MONTH_POS) =
12
> :
> > > > > ResultDateArray(DAY_POS) = 1
> > > > > ResultDateArray(HOUR_POS) = 0 : ResultDateArray(MINUTE_POS) =
0
> :
> > > > > ResultDateArray(SECOND_POS) = 0
> > > > >
> > > > > While (MaskPosition <= MaskLength) AND NOT IsError
> > > > > MaskPart = FormatMask(MaskPosition)
> > > > > If CCSDateConstants.DateMasks.Exists(MaskPart) Then
> > > > > TokenLength = CCSDateConstants.DateMasks(MaskPart)
> > > > > If TokenLength > 0 Then
> > > > > DatePart = Mid(ParsingDate, DatePosition, TokenLength)
> > > > > DatePosition = DatePosition + TokenLength
> > > > > Else
> > > > > If MaskPosition < MaskLength Then
> > > > > Delimiter = FormatMask(MaskPosition + 1)
> > > > > BeginDelimiter = InStr(DatePosition, ParsingDate,
> > Delimiter)
> > > > > If BeginDelimiter = 0 Then
> > > > > Err.Raise 4000, "ParseDate function: The number
> doesn't
> > > > match
> > > > > the mask."
> > > > > Else
> > > > > DatePart = Mid(ParsingDate, DatePosition,
> > BeginDelimiter -
> > > > > DatePosition)
> > > > > DatePosition = BeginDelimiter
> > > > > End If
> > > > > Else
> > > > > DatePart = Mid(ParsingDate, DatePosition)
> > > > > End If
> > > > > End If
> > > > > Select Case MaskPart
> > > > > Case "d", "dd"
> > > > > ResultDateArray(DAY_POS) = CInt(DatePart)
> > > > > ResultDateArray(IS_DATE_POS) = True
> > > > > Case "m", "mm"
> > > > > ResultDateArray(MONTH_POS) = CInt(DatePart)
> > > > > ResultDateArray(IS_DATE_POS) = True
> > > > > Case "mmm", "mmmm"
> > > > > MonthNumber = 0
> > > > > MonthName = UCase(DatePart)
> > > > > If MaskPart = "mmm" Then _
> > > > > MonthArray = CCSDateConstants.ShortMonths _
> > > > > Else _
> > > > > MonthArray = CCSDateConstants.Months
> > > > > While MonthNumber < 11 AND
> UCase(MonthArray(MonthNumber))
> > <>
> > > > > MonthName
> > > > > MonthNumber = MonthNumber + 1
> > > > > Wend
> > > > > If MonthNumber = 11 Then
> > > > > If UCase(MonthArray(11)) <> MonthName Then _
> > > > > Err.Raise 4000, "ParseDate function: The number
> > doesn't
> > > > > match the mask."
> > > > > End If
> > > > > ResultDateArray(MONTH_POS) = MonthNumber + 1
> > > > > ResultDateArray(IS_DATE_POS) = True
> > > > > Case "yy", "yyyy"
> > > > > ResultDateArray(YEAR_POS) = CInt(DatePart)
> > > > > ResultDateArray(IS_DATE_POS) = True
> > > > > Case "h", "hh"
> > > > > If CInt(DatePart) = 12 Then _
> > > > > ResultDateArray(HOUR_POS) = 0 _
> > > > > Else _
> > > > > ResultDateArray(HOUR_POS) = CInt(DatePart)
> > > > > ResultDateArray(IS_TIME_POS) = True
> > > > > Case "H", "HH"
> > > > > ResultDateArray(HOUR_POS) = CInt(DatePart)
> > > > > ResultDateArray(IS_TIME_POS) = True
> > > > > Case "n", "nn"
> > > > > ResultDateArray(MINUTE_POS) = CInt(DatePart)
> > > > > ResultDateArray(IS_TIME_POS) = True
> > > > > Case "s", "ss"
> > > > > ResultDateArray(SECOND_POS) = CInt(DatePart)
> > > > > ResultDateArray(IS_TIME_POS) = True
> > > > > Case "am/pm", "a/p", "AM/PM", "A/P"
> > > > > If Left(LCase(DatePart), 1) = "p" Then
> > > > > ResultDateArray(HOUR_POS) =
ResultDateArray(HOUR_POS)
> +
> > 12
> > > > > ElseIf Left(LCase(DatePart), 1) = "a" Then
> > > > > ResultDateArray(HOUR_POS) =
ResultDateArray(HOUR_POS)
> > > > > End If
> > > > > ResultDateArray(IS_TIME_POS) = True
> > > > > Case "w", "q"
> > > > > ' Do Nothing
> > > > > End Select
> > > > > Else
> > > > > DatePosition = DatePosition +
Len(FormatMask(MaskPosition))
> > > > > End If
> > > > > MaskPosition = MaskPosition + 1
> > > > > Wend
> > > > > If ResultDateArray(IS_TIME_POS) AND
ResultDateArray(IS_TIME_POS)
> > > Then
> > > > > ResultDate = DateSerial(ResultDateArray(YEAR_POS),
> > > > > ResultDateArray(MONTH_POS), ResultDateArray(DAY_POS)) _
> > > > > + TimeSerial(ResultDateArray(HOUR_POS),
> > > > ResultDateArray(MINUTE_POS),
> > > > > ResultDateArray(SECOND_POS))
> > > > > ElseIf ResultDateArray(IS_TIME_POS) Then
> > > > > ResultDate = TimeSerial(ResultDateArray(HOUR_POS),
> > > > > ResultDateArray(MINUTE_POS), ResultDateArray(SECOND_POS))
> > > > > ElseIf ResultDateArray(IS_DATE_POS) Then
> > > > > ResultDate = DateSerial(ResultDateArray(YEAR_POS),
> > > > > ResultDateArray(MONTH_POS), ResultDateArray(DAY_POS))
> > > > > End If
> > > > > End If
> > > > > CCParseDate = ResultDate
> > > > > End Function
> > > > > 'End CCParseDate
> > > > >
> > > > > 'CCParseNumber @0-BDE16F1E
> > > > > Function CCParseNumber(NumberValue, FormatArray, DataType)
> > > > > Dim Result, NumberValueType
> > > > > NumberValueType = VarType(NumberValue)
> > > > > If NumberValueType = vbInteger OR NumberValueType = vbLong _
> > > > > OR NumberValueType = vbSingle OR NumberValueType = vbSingle _
> > > > > OR NumberValueType = vbCurrency OR NumberValueType = vbDecimal
_
> > > > > OR NumberValueType = vbByte Then
> > > > > If DataType = ccsInteger Then
> > > > > Result = CLng(NumberValue)
> > > > > ElseIf DataType = ccsFloat Then
> > > > > Result = CDbl(NumberValue)
> > > > > End If
> > > > > Else
> > > > > If Not CStr(NumberValue) = "" Then
> > > > > Dim DefaultValue, DefaultDecimal
> > > > > Dim DecimalSeparator, PeriodSeparator
> > > > > DecimalSeparator = "" : PeriodSeparator = ""
> > > > > If IsArray(FormatArray) Then
> > > > > If FormatArray(0) Then
> > > > > DecimalSeparator = FormatArray(2)
> > > > > PeriodSeparator = FormatArray(4)
> > > > > End If
> > > > > End If
> > > > > If Not CStr(DecimalSeparator) = "" Then
> > > > > DefaultValue = CStr(FormatNumber(10001/10, 1, True, False,
> > > True))
> > > > > DefaultDecimal = Mid(DefaultValue, 6, 1)
> > > > > NumberValue = Replace(NumberValue, DecimalSeparator,
> > > > DefaultDecimal)
> > > > > End If
> > > > > If Not CStr(PeriodSeparator) = "" Then NumberValue =
> > > > > Replace(NumberValue, PeriodSeparator, "")
> > > > > If DataType = ccsInteger Then
> > > > > Result = CLng(NumberValue)
> > > > > ElseIf DataType = ccsFloat Then
> > > > > Result = CDbl(NumberValue)
> > > > > End If
> > > > > Else
> > > > > Result = Empty
> > > > > End If
> > > > > End If
> > > > > CCParseNumber = Result
> > > > > End Function
> > > > > 'End CCParseNumber
> > > > >
> > > > > 'CCParseInteger @0-42815927
> > > > > Function CCParseInteger(NumberValue, FormatArray)
> > > > > CCParseInteger = CCParseNumber(NumberValue, FormatArray,
> ccsInteger)
> > > > > End Function
> > > > > 'End CCParseInteger
> > > > >
> > > > > 'CCParseFloat @0-56667DF0
> > > > > Function CCParseFloat(NumberValue, FormatArray)
> > > > > CCParseFloat = CCParseNumber(NumberValue, FormatArray, ccsFloat)
> > > > > End Function
> > > > > 'End CCParseFloat
> > > > >
> > > > > 'CCValidateDate @0-D0BEB752
> > > > > Function CCValidateDate(ValidatingDate, FormatMask)
> > > > > Dim MaskPosition, I, Result, OneChar, IsSeparator
> > > > > Dim RegExpPattern, RegExpObject, Matches
> > > > >
> > > > > IsSeparator = False
> > > > >
> > > > > If ValidatingDate = "" OR IsEmpty(ValidatingDate) Then
> > > > > Result = True
> > > > > ElseIf IsEmpty(FormatMask) Then
> > > > > Result = IsDate(ValidatingDate)
> > > > > ElseIf FormatMask(0) = "GeneralDate" Or FormatMask(0) =
"LongDate"
> _
> > > > > Or FormatMask(0) = "ShortDate" Or FormatMask(0) = "LongTime" _
> > > > > Or FormatMask(0) = "ShortTime" Then
> > > > > Result = IsDate(ValidatingDate)
> > > > > Else
> > > > > For MaskPosition = 0 To UBound(FormatMask)
> > > > > If NOT IsSeparator Then
> > > > > Select Case FormatMask(MaskPosition)
> > > > > Case "d", "m", "h", "n", "s", "w", "q", "H"
> > > > > RegExpPattern = RegExpPattern + "\d{1,2}.+"
> > > > > IsSeparator = True
> > > > > Case "dd", "mm", "yy", "hh", "nn", "ss", "HH"
> > > > > RegExpPattern = RegExpPattern + "\d{2}"
> > > > > Case "yyyy"
> > > > > RegExpPattern = RegExpPattern + "\d{4}"
> > > > > Case "mmm"
> > > > > RegExpPattern = RegExpPattern + "(" &
> > > > > Join(CCSDateConstants.ShortMonths, "|") & ")"
> > > > > Case "mmmm"
> > > > > RegExpPattern = RegExpPattern + "(" &
> > > > > Join(CCSDateConstants.Months, "|") & ")"
> > > > > Case "am/pm"
> > > > > RegExpPattern = RegExpPattern + "[ap]m"
> > > > > Case "AM/PM"
> > > > > RegExpPattern = RegExpPattern + "[AP]M"
> > > > > Case "a/p"
> > > > > RegExpPattern = RegExpPattern + "[ap]"
> > > > > Case "A/P"
> > > > > RegExpPattern = RegExpPattern + "[AP]"
> > > > > Case Else
> > > > > For I = 1 To Len(FormatMask(MaskPosition))
> > > > > OneChar = Mid(FormatMask(MaskPosition), I, 1)
> > > > > If InStr("bBdDfnrsStvwW\", OneChar) = 0 Then _
> > > > > OneChar = "\" + OneChar
> > > > > RegExpPattern = RegExpPattern + OneChar
> > > > > Next
> > > > > End Select
> > > > > Else
> > > > > IsSeparator = False
> > > > > For I = 2 To Len(FormatMask(MaskPosition))
> > > > > OneChar = Mid(FormatMask(MaskPosition), I, 1)
> > > > > If InStr("bBdDfnrsStvwW\", OneChar) = 0 Then _
> > > > > OneChar = "\" + OneChar
> > > > > RegExpPattern = RegExpPattern + OneChar
> > > > > Next
> > > > > End If
> > > > > Next
> > > > > Set RegExpObject = New RegExp
> > > > > RegExpObject.IgnoreCase = False
> > > > > RegExpObject.Global = True
> > > > > RegExpObject.Pattern = RegExpPattern
> > > > > Set Matches = RegExpObject.Execute(ValidatingDate)
> > > > > Result = CBool(Matches.Count = 1)
> > > > > Set Matches = Nothing
> > > > > Set RegExpObject = Nothing
> > > > > End If
> > > > > CCValidateDate = Result
> > > > > End Function
> > > > > 'End CCValidateDate
> > > > >
> > > > > 'CCValidateNumber @0-08089509
> > > > > Function CCValidateNumber(NumberValue, FormatArray)
> > > > > Dim Result, NumberValueType
> > > > > NumberValueType = VarType(NumberValue)
> > > > > If NumberValueType = vbInteger OR NumberValueType = vbLong _
> > > > > OR NumberValueType = vbSingle OR NumberValueType = vbSingle _
> > > > > OR NumberValueType = vbCurrency OR NumberValueType = vbDecimal
_
> > > > > OR NumberValueType = vbByte Then
> > > > > Result = True
> > > > > Else
> > > > > If Not CStr(NumberValue) = "" Then
> > > > > Dim DefaultValue, DefaultDecimal
> > > > > Dim DecimalSeparator, PeriodSeparator
> > > > > DecimalSeparator = "" : PeriodSeparator = ""
> > > > > If IsArray(FormatArray) Then
> > > > > If FormatArray(0) Then
> > > > > DecimalSeparator = FormatArray(2)
> > > > > PeriodSeparator = FormatArray(4)
> > > > > End If
> > > > > End If
> > > > > If Not CStr(DecimalSeparator) = "" Then
> > > > > DefaultValue = CStr(FormatNumber(10001/10, 1, True, False,
> > > True))
> > > > > DefaultDecimal = Mid(DefaultValue, 6, 1)
> > > > > NumberValue = Replace(NumberValue, DecimalSeparator,
> > > > DefaultDecimal)
> > > > > End If
> > > > > If Not CStr(PeriodSeparator) = "" Then NumberValue =
> > > > > Replace(NumberValue, PeriodSeparator, "")
> > > > > Result = IsNumeric(NumberValue)
> > > > > Else
> > > > > Result = True
> > > > > End If
> > > > > End If
> > > > > CCValidateNumber = Result
> > > > > End Function
> > > > > 'End CCValidateNumber
> > > > >
> > > > > 'CCValidateBoolean @0-B8DE2060
> > > > > Function CCValidateBoolean(Value, FormatMask)
> > > > > Dim Result: Result = False
> > > > >
> > > > > If VarType(Value) = vbBoolean Then
> > > > > Result = True
> > > > > Else
> > > > > If IsEmpty(FormatMask) Then
> > > > > On Error Resume Next
> > > > > Result = CBool(Value)
> > > > > Result = Not(Err > 0)
> > > > > Else
> > > > > If IsEmpty(Value) Or CStr(Value) = "" Then
> > > > > Result = (CStr(FormatMask(0)) = "null") Or
> > (CStr(FormatMask(0))
> > > =
> > > > > "Undefined") Or (CStr(FormatMask(0)) = "")
> > > > > Result = Result Or (CStr(FormatMask(1)) = "null") Or
> > > > > (CStr(FormatMask(1)) = "Undefined") Or (CStr(FormatMask(1)) = "")
> > > > > If UBound(FormatMask) = 2 Then _
> > > > > Result = Result Or (CStr(FormatMask(2)) = "null") Or
> > > > > (CStr(FormatMask(2)) = "Undefined") Or (CStr(FormatMask(2)) = "")
> > > > > Else
> > > > > Result = (CStr(Value) = CStr(FormatMask(0))) Or
(CStr(Value)
> =
> > > > > CStr(FormatMask(1)))
> > > > > If UBound(FormatMask) = 2 Then _
> > > > > Result = Result Or (CStr(Value) = CStr(FormatMask(2)))
> > > > > End If
> > > > > End If
> > > > > End If
> > > > > CCValidateBoolean = Result
> > > > > End Function
> > > > > 'End CCValidateBoolean
> > > > >
> > > > > 'CCAddParam @0-6D59DAA5
> > > > > Function CCAddParam(QueryString, ParameterName, ParameterValue)
> > > > > Dim Result
> > > > >
> > > > > Result = Replace("&" & QueryString, "&" & ParameterName & "=" &
> > > > > Server.URLEncode(Request.QueryString(ParameterName)), "")
> > > > > Result = Result & "&" & ParameterName & "=" &
> > > > > Server.URLEncode(ParameterValue)
> > > > > Result = Replace(Result, "&&", "&")
> > > > > If Left(Result, 1) = "&" Then Result = Mid(Result, 2)
> > > > > CCAddParam = Result
> > > > > End Function
> > > > > 'End CCAddParam
> > > > >
> > > > > 'CCRemoveParam @0-64B4FAAF
> > > > > Function CCRemoveParam(QueryString, ParameterName)
> > > > > Dim Result
> > > > > Result = Replace(QueryString, ParameterName & "=" &
> > > > > Server.URLEncode(Request.QueryString(ParameterName)), "")
> > > > > Result = Replace(Result, "&&", "&")
> > > > > If Left(Result, 1) = "&" Then Result = Mid(Result, 2)
> > > > > CCRemoveParam = Result
> > > > > End Function
> > > > > 'End CCRemoveParam
> > > > >
> > > > > 'CCRegExpTest @0-9EAA5A2D
> > > > > Function CCRegExpTest(TestValue, RegExpMask, IgnoreCase,
GlobalTest)
> > > > > Dim Result
> > > > > If Not CStr(TestValue) = "" Then
> > > > > Dim RegExpObject
> > > > > Set RegExpObject = New RegExp
> > > > > RegExpObject.Pattern = RegExpMask
> > > > > RegExpObject.IgnoreCase = IgnoreCase
> > > > > RegExpObject.Global = GlobalTest
> > > > > Result = RegExpObject.Test(CStr(TestValue))
> > > > > Set RegExpObject = Nothing
> > > > > Else
> > > > > Result = True
> > > > > End If
> > > > > CCRegExpTest = Result
> > > > > End Function
> > > > >
> > > > >
> > > > > 'End CCRegExpTest
> > > > >
> > > > > 'CCRegExpTest @0-4BE3AE1D
> > > > > Sub CheckSSL()
> > > > > If Not UCase(Request.ServerVariables("HTTPS")) = "ON" Then
> > > > > Response.Write "SSL connection error. This page can be
accessed
> > only
> > > > via
> > > > > secured connection."
> > > > > Response.End
> > > > > End If
> > > > > End Sub
> > > > >
> > > > > 'End CCRegExpTest
> > > > >
> > > > > 'CCGetUserLogin @0-4306ED6C
> > > > > Function CCGetUserLogin()
> > > > > CCGetUserLogin = Session("UserLogin")
> > > > > End Function
> > > > > 'End CCGetUserLogin
> > > > >
> > > > > 'CCSecurityRedirect @0-790A88DF
> > > > > Sub CCSecurityRedirect(GroupsAccess, URL)
> > > > > Dim ErrorType
> > > > > Dim Link
> > > > > ErrorType = CCSecurityAccessCheck(GroupsAccess)
> > > > > If NOT (ErrorType = "success") Then
> > > > > If IsEmpty(URL) Then _
> > > > > Link = ServerURL & "Login.asp" _
> > > > >
|
|
|
|
|
