Modificare il file: \Admin\include\Admins_aspfunctions.asp

<% function StrWhere(strField, SearchFor, strSearchOption, SearchFor2) strQuote1 = "'" strQuote2 = "'" if IsDateFieldType(GetFieldType(strField)) then if InStr(1, strConnection, "Microsoft Access Driver") > 0 then strQuote1="#" strQuote2="#" elseif InStr(1, strConnection, "*.dbf") > 0 then strQuote1="{" strQuote2="}" end if end if sSearchFor=Replace(SearchFor,"'","''") sSearchFor2=Replace(SearchFor2,"'","''") if Request.Form("NeedQuotes" & BuildFieldName(strField))="" then bNeedQ = IfNeedQuotes(GetFieldType(strField)) else if Request.Form("NeedQuotes" & BuildFieldName(strField)) = "True" then bNeedQ = true else bNeedQ = false end if end if if bNeedQ and strSearchOption<>"Contains" and strSearchOption<>"Starts with ..." then sSearchFor=strQuote1 & Replace(sSearchFor,"'","''") & strQuote2 sSearchFor2=strQuote1 & Replace(sSearchFor2,"'","''") & strQuote2 end if Select Case strSearchOption Case "Contains" StrWhere = " like '%" & sSearchFor & "%'" Case "Equals" StrWhere = "=" & sSearchFor Case "Starts with ..." StrWhere = " like '" & sSearchFor & "%'" Case "More than ..." StrWhere = ">" & sSearchFor Case "Less than ..." StrWhere = "<" & sSearchFor Case "Equal or more than ..." StrWhere= ">=" & sSearchFor Case "Equal or less than ..." StrWhere= "<=" & sSearchFor Case "Between" StrWhere = ">=" & sSearchFor if SearchFor2<>"" then StrWhere = StrWhere & " and " & AddWrappers(strField) & "<=" & sSearchFor2 Case "IsNull" StrWhere = " is null " if bNeedQ and not IsDateFieldType(GetFieldType(strField)) then StrWhere = StrWhere & " or " & AddWrappers(strField) & "=''" end if End Select end function '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' function IsDateFieldType(nType) if nType=7 or nType=133 or nType=134 or nType=135 then IsDateFieldType = True else IsDateFieldType = False end if end function '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' function IsGUIDField(nType) if nType=72 then return True else return False end if end function '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' function IfNeedQuotes(nType) if nType = 203 or nType = 8 or nType = 129 or nType = 130 or _ nType = 7 or nType = 133 or nType = 134 or nType = 135 or _ nType = 201 or nType = 205 or nType = 200 or nType = 202 or nType=72 then IfNeedQuotes="True" else IfNeedQuotes="False" end if end function function IsBinaryField(Field) if (Field.Attributes and 128) and ( Field.Type = 204 or Field.Type = 205 ) then IsBinaryField = True else IsBinaryField = False end if End Function function GetData(Field, Format) ' long binary data? if IsBinaryField(Field) then GetData = "LONG BINARY DATA - CANNOT BE DISPLAYED" elseif Field.Type = 11 then if IsNull(Field.Value) then GetData="No" else if Field.Value = "True" or CInt(Field.Value)<>0 then GetData = "Yes" else GetData = "No" end if end if else if Field.Type <> 205 then if Field.Type=19 then GetData = CInt(Field.Value) else GetData = Field.Value end if end if end if if Format = FORMAT_DATE_SHORT and GetData<>"" _ then GetData = FormatDateTime(GetData,2) if Format = FORMAT_DATE_LONG and GetData<>"" _ then GetData = FormatDateTime(GetData,1) if Format = FORMAT_DATE_TIME and GetData<>"" _ then GetData = FormatDateTime(GetData,3) if Format = FORMAT_CURRENCY and GetData<>"" _ then GetData = FormatCurrency(GetData) if Format = FORMAT_NUMBER and GetData<>"" and IsNumeric(GetData) _ then GetData = FormatNumber(CDbl(GetData), 2) if Format = FORMAT_PHONE_NUMBER and GetData<>"" then if Len(GetData)=7 then GetData = Left(GetData,3) & "-" & Mid(GetData, 4) elseif Len(GetData)=10 then GetData = "(" & Left(GetData,3) & ") " & Mid(GetData, 4, 3) & "-" & Mid(GetData, 7) end if end if ' file-based image if Format = FORMAT_FILE_IMAGE then _ GetData = "<img src=""" & GetData & """ border=0>" ' hyperlink if ((Field.Type=203 and Right(GetData,1)="#") and Format<>FORMAT_NONE ) _ or Format = FORMAT_HYPERLINK then str = GetData GetData = GetHyperlink(str, Field.Name) end if ' email if Format = FORMAT_EMAILHYPERLINK then str = GetData ' mailto hyperlink if Left(str,7)="mailto:" then strTitle = Mid(str,8) else strTitle = str str = "mailto:" & str end if GetData = "<a href=""" & str & """>" & strTitle & "</a>" end if ' if Format = FORMAT_NONE then _ ' GetData = HTMLEncode(GetData) end function ' aggiunge wrapper al nome del campo, se necessario function AddWrappers(strName) if (InStr(1, strConnection, "Microsoft Access")>1 or isnumeric(strName) or InStr(strName, " ")>0 or InStr(strName, "'")>0 or InStr(strName, "_")>0 or InStr(strName, "-")>0 or InStr(strName, "#")>0 or InStr(strName, ")")>0 or InStr(strName, "(")>0 or InStr(strName, "/")>0) and Left(strName,1)<>strLeftWrapper then AddWrappers = strLeftWrapper + strName + strRightWrapper else AddWrappers = strName end if end function function IsListField(strField) IsListField = false if strField="ID" then IsListField = true end if if strField="Username" then IsListField = true end if if strField="Password" then IsListField = true end if if strField="accesso" then IsListField = true end if if strField="lista" then IsListField = true end if if strField="pin" then IsListField = true end if end function ' restituisce l'etichetta del campo function Label(strField) Label = strField if strField="ID" then Label = "ID" end if if strField="Username" then Label = "Username" end if if strField="Password" then Label = "Password" end if if strField="accesso" then Label = "accesso" end if if strField="lista" then Label = "lista" end if if strField="pin" then Label = "pin" end if end function ' restituisce il formato del campo function Format(strField) Format = FORMAT_NONE if strField="ID" then Format = "" end if if strField="Username" then Format = "" end if if strField="Password" then Format = "" end if if strField="accesso" then Format = "" end if if strField="lista" then Format = "" end if if strField="pin" then Format = "" end if end function ' restituisce vero se il campo è obbligatorio function IsRequired(strField) IsRequired = False if strField="ID" then IsRequired = "False" end if if strField="Username" then IsRequired = "False" end if if strField="Password" then IsRequired = "False" end if if strField="accesso" then IsRequired = "False" end if if strField="lista" then IsRequired = "False" end if if strField="pin" then IsRequired = "False" end if end function ' returns edit format function GetEditFormat(strField) GetEditFormat = FORMAT_NONE if strField="ID" then GetEditFormat = "" end if if strField="Username" then GetEditFormat = "" end if if strField="Password" then GetEditFormat = "" end if if strField="accesso" then GetEditFormat = "" end if if strField="lista" then GetEditFormat = "" end if if strField="pin" then GetEditFormat = "" end if end function ' returns true if textarea uses RichTextEditor Function UseRTE(strField) UseRTE = false if strField="ID" then UseRTE = false end if if strField="Username" then UseRTE = false end if if strField="Password" then UseRTE = false end if if strField="accesso" then UseRTE = false end if if strField="lista" then UseRTE = false end if if strField="pin" then UseRTE = false end if End Function ' returns true if field format equals FORMAT_LOOKUP_WIZARD function IsLookupField(strField) IsLookupField = false if Format(strField)=FORMAT_LOOKUP_WIZARD then IsLookupField = true end if end function ' returns Date Edit type function DateEditType(strField) DateEditType = "" if strField="ID" then DateEditType = 0 end if if strField="Username" then DateEditType = 0 end if if strField="Password" then DateEditType = 0 end if if strField="accesso" then DateEditType = 0 end if if strField="lista" then DateEditType = 0 end if if strField="pin" then DateEditType = 0 end if end function ' restituire il campo del nome file, se presente Function GetFilenameField(sFieldName) End Function ' returns text edit parameters function GetEditParams(strField) end function ' returns field's default value function GetDefaultValue(strField) if strField="ID" then GetDefaultValue = "" end if if strField="Username" then GetDefaultValue = "" end if if strField="Password" then GetDefaultValue = "" end if if strField="accesso" then GetDefaultValue = "" end if if strField="lista" then GetDefaultValue = "" end if if strField="pin" then GetDefaultValue = "" end if if LCase(GetDefaultValue) = "now()" then GetDefaultValue=now() end if end function Sub LogInfo(str) if vDebug=true then Response.Write str & "<br>" Response.Flush end if end sub '''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' returns True if Field type is Date, False otherwise '''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Function IsDateField(Field) nType = Field.Type if nType = 7 or nType = 133 or nType = 134 or nType = 135 then IsDateField = True else IsDateField = False end if End Function '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' restituisce il codice HTML che rappresenta il controllo di modifica della data richiesto '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Function GetDateEdit(FieldName, FieldValue, cType) strName = "" For index=1 to Len(FieldName) c = LCase(Mid(FieldName,index,1)) if (Asc(c)>=Asc("a") and Asc(c)<=Asc("z")) or ( Asc(c)>=Asc("0") and Asc(c)<=Asc("9")) then _ strName = strName & c Next if Len(strName) = 0 then Exit Function if (IsDate(FieldValue)) then dDate = CDate(FieldValue) d = Day(dDate) m = Month(dDate) y = Year(dDate) else d = 0 m = 0 y = 0 end if Select Case cType Case EDIT_DATE_SIMPLE GetDateEdit = "<input type=text name=""" & FieldName & """ size = 20 value=""" & FieldValue & """>" Case EDIT_DATE_SIMPLE_DDMMYYYY_DP GetDateEdit = "<input type=text name=""" & FieldName & """ size = 20 value=""" & FieldValue & """>" GetDateEdit = GetDateEdit & "<input type=hidden name=""ts" & strName & """ value=""" & d & "-" & m & "-" & y & """>" GetDateEdit = GetDateEdit & "<a href=""javascript:var v=show_calendar('update" & strName & "', document.editform.ts" & strName & ".value);"">" & _ "<img src=images/cal.gif width=16 height=16 border=0 alt=""Click Here to Pick up the date""></a>" GetDateEdit = GetDateEdit & vbCRLF & vbCRLF & "<script language=JavaScript>" & _ " function update" & strName & "(newDate) " & _ "{ " & _ " var dt_datetime; " & _ " if (newDate!='' && newDate!=null)" & _ " { " & _ " dt_datetime = str2dt(newDate);" & _ " document.forms.editform(""" & FieldName & """).value = dt_datetime.getDate() + '/' + (dt_datetime.getMonth()+1) + '/' + dt_datetime.getYear();" & _ " document.editform.ts" & strName & ".value = newDate; " & _ " }" & _ "}" & _ "</script>" & vbCRLF & vbCRLF Case EDIT_DATE_SIMPLE_MMDDYYYY_DP GetDateEdit = "<input type=text name=""" & FieldName & """ size = 20 value=""" & FieldValue & """>" GetDateEdit = GetDateEdit & "<input type=hidden name=""ts" & strName & """ value=""" & d & "-" & m & "-" & y & """>" GetDateEdit = GetDateEdit & "<a href=""javascript:var v=show_calendar('update" & strName & "', document.editform.ts" & strName & ".value);"">" & _ "<img src=images/cal.gif width=16 height=16 border=0 alt=""Click Here to Pick up the date""></a>" GetDateEdit = GetDateEdit & vbCRLF & vbCRLF & "<script language=JavaScript>" & _ " function update" & strName & "(newDate) " & _ "{ " & _ " var dt_datetime; " & _ " if (newDate!='' && newDate!=null)" & _ " { " & _ " dt_datetime = str2dt(newDate);" & _ " document.forms.editform(""" & FieldName & """).value = (dt_datetime.getMonth()+1) + '/' + dt_datetime.getDate() + '/' + dt_datetime.getYear();" & _ " document.editform.ts" & strName & ".value = newDate; " & _ " }" & _ "}" & _ "</script>" & vbCRLF & vbCRLF Case EDIT_DATE_DDMMYYYY GetDateEdit = "<select class=selects name=day" & strName & " onchange=""javascript: SetDate" & strName & "(); return true;"">" GetDateEdit = GetDateEdit & WriteDays(Now(), d) GetDateEdit = GetDateEdit & "</select>" GetDateEdit = GetDateEdit & "<select class=selects name=month" & strName & " onchange=""javascript: SetDate" & strName & "(); return true;"">" GetDateEdit = GetDateEdit & WriteMonths(Now(), m) GetDateEdit = GetDateEdit & "</select>" GetDateEdit = GetDateEdit & "<select class=selects name=year" & strName & " onchange=""javascript: SetDate" & strName & "(); return true;"">" GetDateEdit = GetDateEdit & WriteYears(Now(), y) GetDateEdit = GetDateEdit & "</select>" & vbCRLF GetDateEdit = GetDateEdit & "<input type=hidden name=""" & FieldName & """ value=""" & FieldValue & """>" GetDateEdit = GetDateEdit & "<script language=JavaScript>" & _ "function SetDate" & strName & "()" & _ "{ " & _ " if (document.forms.editform.month" & strName & ".value!='' && document.forms.editform.day" & strName & ".value!='' && document.forms.editform.year" & strName & ".value!='')" & _ " document.forms.editform(""" & FieldName & """).value= ''+document.forms.editform.year" & strName & ".value + " & _ " '-' + document.forms.editform.month" & strName & ".value + '-' + document.forms.editform.day" & strName & ".value; " & _ " else " & _ " document.forms.editform(""" & FieldName & """).value= '';" & _ " } " & _ " </script>" Case EDIT_DATE_DDMMYYYY_DP GetDateEdit = "<select class=selects name=day" & strName & " onchange=""javascript: SetDate" & strName & "(); return true;"">" GetDateEdit = GetDateEdit & WriteDays(Now(), d) GetDateEdit = GetDateEdit & "</select>" GetDateEdit = GetDateEdit & "<select class=selects name=month" & strName & " onchange=""javascript: SetDate" & strName & "(); return true;"">" GetDateEdit = GetDateEdit & WriteMonths(Now(), m) GetDateEdit = GetDateEdit & "</select>" GetDateEdit = GetDateEdit & "<select class=selects name=year" & strName & " onchange=""javascript: SetDate" & strName & "(); return true;"">" GetDateEdit = GetDateEdit & WriteYears(Now(), y) GetDateEdit = GetDateEdit & "</select>" & vbCRLF GetDateEdit = GetDateEdit & "<input type=hidden name=""ts" & strName & """ value=""" & d & "-" & m & "-" & y & """>" & vbCRLF GetDateEdit = GetDateEdit & "<input type=hidden name=""" & FieldName & """ value=""" & FieldValue & """>" GetDateEdit = GetDateEdit & "<a href=""javascript:var v=show_calendar('update" & strName & "', document.editform.ts" & strName & ".value);"">" & _ "<img src=images/cal.gif width=16 height=16 border=0 alt=""Click Here to Pick up the date""></a>" GetDateEdit = GetDateEdit & "<script language=JavaScript>" & _ " function update" & strName & "(newDate) " & _ "{ " & _ " var dt_datetime; " & _ " var curdate = new Date(); " & _ " if (newDate!='' && newDate!=null)" & _ " { " & _ " dt_datetime = str2dt(newDate);" & _ " document.forms.editform(""" & FieldName & """).value = dt_datetime.getYear() + '-' + (dt_datetime.getMonth()+1) + '-' + dt_datetime.getDate();" & _ " document.forms.editform.day" & strName & ".selectedIndex = dt_datetime.getDate(); " & _ " document.forms.editform.month" & strName & ".selectedIndex = dt_datetime.getMonth()+1; " & _ " document.forms.editform.year" & strName & ".selectedIndex = dt_datetime.getYear()-curdate.getYear()+51; " & _ " document.editform.ts" & strName & ".value = newDate; " & _ " }" & _ "}" & vbCRLF & _ "function SetDate" & strName & "()" & _ "{ " & _ " if (document.forms.editform.month" & strName & ".value!='' && document.forms.editform.day" & strName & ".value!='' && document.forms.editform.year" & strName & ".value!='')" & _ " document.forms.editform(""" & FieldName & """).value= ''+document.forms.editform.year" & strName & ".value + " & _ " '-' + document.forms.editform.month" & strName & ".value + '-' + document.forms.editform.day" & strName & ".value; " & _ " else " & _ " document.forms.editform(""" & FieldName & """).value= '';" & _ " } " & _ " SetDate" & strName & "(); " & _ " </script>" & vbCRLF Case EDIT_DATE_MMDDYYYY GetDateEdit = "<select class=selects name=month" & strName & " onchange=""javascript: SetDate" & strName & "(); return true;"">" GetDateEdit = GetDateEdit & WriteMonths(Now(), m) GetDateEdit = GetDateEdit & "</select>" GetDateEdit = GetDateEdit & "<select class=selects name=day" & strName & " onchange=""javascript: SetDate" & strName & "(); return true;"">" GetDateEdit = GetDateEdit & WriteDays(Now(), d) GetDateEdit = GetDateEdit & "</select>" GetDateEdit = GetDateEdit & "<select class=selects name=year" & strName & " onchange=""javascript: SetDate" & strName & "(); return true;"">" GetDateEdit = GetDateEdit & WriteYears(Now(), y) GetDateEdit = GetDateEdit & "</select>" & vbCRLF GetDateEdit = GetDateEdit & "<input type=hidden name=""" & FieldName & """ value=""" & FieldValue & """>" GetDateEdit = GetDateEdit & "<script language=JavaScript>" & _ "function SetDate" & strName & "()" & _ "{ " & _ " if (document.forms.editform.month" & strName & ".value!='' && document.forms.editform.day" & strName & ".value!='' && document.forms.editform.year" & strName & ".value!='')" & _ " document.forms.editform(""" & FieldName & """).value= ''+document.forms.editform.year" & strName & ".value + " & _ " '-' + document.forms.editform.month" & strName & ".value + '-' + document.forms.editform.day" & strName & ".value; " & _ " else " & _ " document.forms.editform(""" & FieldName & """).value= '';" & _ " } " & _ " </script>" Case EDIT_DATE_MMDDYYYY_DP GetDateEdit = "<select class=selects name=month" & strName & " onchange=""javascript: SetDate" & strName & "(); return true;"">" GetDateEdit = GetDateEdit & WriteMonths(Now(), m) GetDateEdit = GetDateEdit & "</select>" GetDateEdit = GetDateEdit & "<select class=selects name=day" & strName & " onchange=""javascript: SetDate" & strName & "(); return true;"">" GetDateEdit = GetDateEdit & WriteDays(Now(), d) GetDateEdit = GetDateEdit & "</select>" GetDateEdit = GetDateEdit & "<select class=selects name=year" & strName & " onchange=""javascript: SetDate" & strName & "(); return true;"">" GetDateEdit = GetDateEdit & WriteYears(Now(), y) GetDateEdit = GetDateEdit & "</select>" & vbCRLF GetDateEdit = GetDateEdit & "<input type=hidden name=""ts" & strName & """ value=""" & d & "-" & m & "-" & y & """>" & vbCRLF GetDateEdit = GetDateEdit & "<input type=hidden name=""" & FieldName & """ value=""" & FieldValue & """>" GetDateEdit = GetDateEdit & "<a href=""javascript:var v=show_calendar('update" & strName & "', document.editform.ts" & strName & ".value);"">" & _ "<img src=images/cal.gif width=16 height=16 border=0 alt=""Click Here to Pick up the date""></a>" GetDateEdit = GetDateEdit & "<script language=JavaScript>" & _ " function update" & strName & "(newDate) " & _ "{ " & _ " var dt_datetime; " & _ " var curdate = new Date(); " & _ " if (newDate!='' && newDate!=null)" & _ " { " & _ " dt_datetime = str2dt(newDate);" & _ " document.forms.editform(""" & FieldName & """).value = dt_datetime.getYear() + '-' + (dt_datetime.getMonth()+1) + '-' + dt_datetime.getDate();" & _ " document.forms.editform.day" & strName & ".selectedIndex = dt_datetime.getDate(); " & _ " document.forms.editform.month" & strName & ".selectedIndex = dt_datetime.getMonth()+1; " & _ " document.forms.editform.year" & strName & ".selectedIndex = dt_datetime.getYear()-curdate.getYear()+51; " & _ " document.editform.ts" & strName & ".value = newDate; " & _ " }" & _ "}" & vbCRLF & _ "function SetDate" & strName & "()" & _ "{ " & _ " if (document.forms.editform.month" & strName & ".value!='' && document.forms.editform.day" & strName & ".value!='' && document.forms.editform.year" & strName & ".value!='')" & _ " document.forms.editform(""" & FieldName & """).value= ''+document.forms.editform.year" & strName & ".value + " & _ " '-' + document.forms.editform.month" & strName & ".value + '-' + document.forms.editform.day" & strName & ".value; " & _ " else " & _ " document.forms.editform(""" & FieldName & """).value= '';" & _ " } " & _ " </script>" & vbCRLF Case Else GetDateEdit = "<input type=text name=""" & FieldName & """ size = 20 value=""" & FieldValue & """>" End Select End Function Function WriteDays(d, f) if f="" then val=0 else val=CInt(f) end if WriteDays = WriteDays & "<option value=""""> </option>" for x=1 to 31 if x=val then WriteDays = WriteDays & "<option value=" & x & " selected>" & x & "</option>" else WriteDays = WriteDays & "<option value=" & x & ">" & x & "</option>" end if next end function Function WriteMonths(d, f) if f="" then val=0 else val=CInt(f) end if WriteMonths = WriteMonths & "<option value=""""> </option>" for x=1 to 12 if x=val then WriteMonths = WriteMonths & "<option value=" & x & " selected>" & HRMonth(x) & "</option>" else WriteMonths = WriteMonths & "<option value=" & x & ">" & HRMonth(x) & "</option>" end if next end Function Function WriteYears(d, f) if f="" then val=0 else val=CInt(f) end if WriteYears = WriteYears & "<option value=""""> </option>" for x=Year(d)-50 to Year(d)+50 if x=val then WriteYears = WriteYears & "<option value=" & x & " selected>" & x & "</option>" else WriteYears = WriteYears & "<option value=" & x & ">" & x & "</option>" end if next end Function function HRMonth(i) if i=1 then _ HRMonth="Jan" if i=2 then _ HRMonth="Feb" if i=3 then _ HRMonth="Mar" if i=4 then _ HRMonth="Apr" if i=5 then _ HRMonth="May" if i=6 then _ HRMonth="Jun" if i=7 then _ HRMonth="Jul" if i=8 then _ HRMonth="Aug" if i=9 then _ HRMonth="Sep" if i=10 then _ HRMonth="Oct" if i=11 then _ HRMonth="Nov" if i=12 then _ HRMonth="Dec" end function sub ReportError if Err.number<>0 then %> </form> <p align=center><font size=+2>ASP error happened</font></p> <table border="0" cellpadding="3" cellspacing="1" width="700" bgcolor="#000000" align="center"> <tr><td bgcolor="#ccccff" colspan=2 align=middle><font size=+1><b>Technical information</b></font></td></tr> <tr bgcolor="#cccccc"><td bgcolor="#ccccff"><b>Error number</b></td><td align="left"><%=Err.Number%></td></tr> <tr bgcolor="#cccccc"><td bgcolor="#ccccff"><b>Error description</b></td><td align="left"><font color=#cc3300><%=Err.Description%></font></td></tr> <tr bgcolor="#cccccc"><td bgcolor="#ccccff"><b>URL</b></td><td align="left"><%=Request.ServerVariables("URL")%></td></tr> <% if strSQL<>"" then %> <tr bgcolor="#cccccc"><td bgcolor="#ccccff" ><b>SQL query</b></td><td align="left"><%=strSQL%></td></tr> <% end if %> </table> <form target=_new action="http://www.xlinesoft.com/asprunner/errors/default.asp" method="post" name="frmerror"> <input type='hidden' name='ErrorNumber' value="<%=Err.Number%>" /> <input type='hidden' name='Description' value="<%=Err.Description%>" /> <input type='hidden' name='SQL' value="<%=strSQL%>" /> </form> <p align=center> <a href="#" onClick="document.forms.frmerror.submit();return false;"><font size=3><b>More info on this error</b></font></a> </p> <% Response.End end if end sub Function BuildSelectControl(strName, strValue) BuildSelectControl="" Set rsTemp = server.CreateObject ("ADODB.Recordset") strSQL ="" strSize = 1 if IsNull(strValue) then strValue="" if strSQL <> "" then rsTemp.open strSQL, dbConnection if rsTemp.EOF then exit function BuildSelectControl = BuildSelectControl & "<select size = " & strSize & " name=""" & strName & """>" BuildSelectControl = BuildSelectControl & "<option value="""">Please select</option>" while not rsTemp.Eof if Trim(CStr(rsTemp(0)))=Trim(CStr(strValue)) then BuildSelectControl = BuildSelectControl & "<option value=""" & rsTemp(0) & """ selected>" & rsTemp(1) & "</option>" else BuildSelectControl = BuildSelectControl & "<option value=""" & rsTemp(0) & """>" & rsTemp(1) & "</option>" end if rsTemp.MoveNext wend BuildSelectControl = BuildSelectControl & "</select>" rsTemp.Close set rsTemp = Nothing else BuildSelectControl = BuildSelectControl & "<select size = " & strSize & " name=""" & strName & """>" if CInt(strSize)<2 then _ BuildSelectControl = BuildSelectControl & "<option value="""">Please select</option>" for ind=LBound(arr) to UBound(arr) bYes = false if IsNumeric(arr(ind)) then if CDbl(arr(ind)) = strValue then bYes = true end if if arr(ind)=strValue or bYes then BuildSelectControl = BuildSelectControl & "<option value=""" & arr(ind) & """ selected>" & arr(ind) & "</option>" else BuildSelectControl = BuildSelectControl & "<option value=""" & arr(ind) & """>" & arr(ind) & "</option>" end if next BuildSelectControl = BuildSelectControl & "</select>" end if End Function Function BuildRadioControl(strName, strValue) BuildRadioControl="" Set rsTemp = server.CreateObject ("ADODB.Recordset") strSQL ="" if IsNull(strValue) then strValue="" if strSQL <> "" then rsTemp.open strSQL, dbConnection if rsTemp.EOF then exit function BuildRadioControl = BuildRadioControl & "<input type=hidden name=""" & strName & """ value=""" & strValue & """>" while not rsTemp.Eof if Trim(CStr(rsTemp(0)))=Trim(CStr(strValue)) then BuildRadioControl = BuildRadioControl & "<input type=radio name=""radio" & strName & """ checked onclick=""this.form['" & strName & "'].value = '" & rsTemp(0) & "';return true; "">" & rsTemp(1) & "<br>" else BuildRadioControl = BuildRadioControl & "<input type=radio name=""radio" & strName & """ onclick=""this.form['" & strName & "'].value = '" & rsTemp(0) & "';return true; "">" & rsTemp(1) & "<br>" end if rsTemp.MoveNext wend rsTemp.Close set rsTemp = Nothing else BuildRadioControl = BuildRadioControl & "<input type=hidden name=""" & strName & """ value=""" & strValue & """>" for ind=LBound(arr) to UBound(arr) bYes = false if IsNumeric(arr(ind)) then if CDbl(arr(ind)) = strValue then bYes = true end if if arr(ind)=strValue or bYes then BuildRadioControl = BuildRadioControl & "<input type=radio name=""radio" & strName & """ checked onclick=""this.form['" & strName & "'].value = '" & arr(ind) & "';return true; "">" & arr(ind) & "<br>" else BuildRadioControl = BuildRadioControl & "<input type=radio name=""radio" & strName & """ onclick=""this.form['" & strName & "'].value = '" & arr(ind) & "';return true; "">" & arr(ind) & "<br>" end if next end if End Function Function BuildEditControl(Field , sValue, sFormat, sMode) sFieldName = Field.Name nType = Field.Type if Format(sFieldName) <> FORMAT_HTML and sFormat<>EDIT_FORMAT_TEXT_AREA then strEncoded = htmlencode(sValue) else strEncoded = sValue end if ' calculate default value if sMode = "Add" or sFormat = EDIT_FORMAT_HIDDEN then sDefault = HTMLEncode(GetDefaultValue(sFieldName)) else sDefault = strEncoded end if BuildEditControl ="" Select Case sFormat 'if sMode = "Edit" then ' BuildEditControl = BuildEditControl & CreateImageControl(rs, sFieldName, GetFilenameField(sFieldName)) ' BuildEditControl = BuildEditControl & "<br><input type=radio name=""radio_" & sFieldName & """ checked value=1>Replace&nbsp;<input type=radio name=""radio_" & sFieldName & """value=2>Delete<br>" ' end if ' BuildEditControl = BuildEditControl & "<input type=file name=""" & sFieldName & """ onChange=""var ind = document.forms.editform." & sFieldName & ".value.lastIndexOf('\\'); if (ind<0) ind=0; document.forms.editform." & GetFilenameField(sFieldName) & ".value = document.forms.editform." & sFieldName & ".value.substring(ind+1); "">" ' BuildEditControl = BuildEditControl & "<br>Filename: <input type=text size=20 maxlength=50 name=""" & GetFilenameField(sFieldName) & """" & " value="""">" Case EDIT_FORMAT_TEXT_FIELD BuildEditControl = "<input type=text name=""" & sFieldName & """" & GetEditParams(sFieldName) & " value=""" & sDefault & """>" Case EDIT_FORMAT_TEXT_AREA if UseRTE(sFieldName) then sDefault = RTESafe(sDefault) BuildEditControl = "<script language=""JavaScript"" type=""text/javascript"">" & vbcrlf & _ "writeRichText('" & sFieldName & "', '" & sDefault & "', 520, 200, true, false);" & vbcrlf & _ "</script>" else BuildEditControl = "<textarea " & GetEditParams(sFieldName) & " name=""" & sFieldName & """>" & sDefault & "</textarea>" end if Case EDIT_FORMAT_PASSWORD BuildEditControl = "<input type=password name=""" & sFieldName & """" & GetEditParams(sFieldName) & " value=""" & sDefault & """>" Case EDIT_FORMAT_DATE BuildEditControl = GetDateEdit(sFieldName , sDefault , DateEditType(sFieldName )) Case EDIT_FORMAT_RADIO BuildEditControl = BuildRadioControl(sFieldName , sValue) Case EDIT_FORMAT_CHECKBOX BuildEditControl = "<input type=checkbox name=""" & sFieldName & """" : _ if sValue="Yes" or sValue="1" then BuildEditControl = BuildEditControl & " checked " : _ BuildEditControl = BuildEditControl & ">" Case EDIT_FORMAT_DATABASE_IMAGE, EDIT_FORMAT_DATABASE_FILE if sMode="Add" then BuildEditControl = "Upload file after record added" else strImageWhere = " " & AddWrappers(strKeyField) & "=" & gstrQuote & GetData(rs.Fields(strKeyField), "") & gstrQuote if strKeyField2<>"" then strImageWhere = strImageWhere & " and " & AddWrappers(strKeyField2) & "=" & gstrQuote2 & GetData(rs.Fields(strKeyField2), "") & gstrQuote2 if strKeyField3<>"" then strImageWhere = strImageWhere & " and " & AddWrappers(strKeyField3) & "=" & gstrQuote3 & GetData(rs.Fields(strKeyField3), "") & gstrQuote3 strPK = AddWrappers(strKeyField) if strKeyField2<>"" then strPK = strPK & "," & AddWrappers(strKeyField2) if strKeyField3<>"" then strPK = strPK & "," & AddWrappers(strKeyField3) BuildEditControl = CreateImageControl(rs, sFieldName, GetFilenameField(sFieldName)) BuildEditControl = BuildEditControl & "<br><a href=""uploader.asp?pictable=" & HTMLEncode(strTableName) & "&picfield=" & HTMLEncode(sFieldName) & "&where=" & HTMLEncode(strImageWhere) & "&PK=" & HTMLEncode(strPK) & """>Change</a>" BuildEditControl = BuildEditControl & "&nbsp;&nbsp;&nbsp;<a href=# onClick=""if (!confirm('Do you really want to delete this image?')) return false; document.forms.editform.todo.value='deleteimage'; document.forms.editform.imagefield.value='" & sFieldName & "';document.forms.editform.submit(); return false;"">Delete</a>" end if Case EDIT_FORMAT_LOOKUP_WIZARD BuildEditControl = BuildSelectControl(sFieldName , sValue) Case EDIT_FORMAT_HIDDEN BuildEditControl = "<input type=hidden name=""" & sFieldName & """" & " value=""" & sDefault & """>" Case EDIT_FORMAT_READONLY BuildEditControl = "<input type=hidden name=""" & sFieldName & """" & " value=""" & strEncoded & """>" & Replace(strEncoded, vbcrlf, "<br>") End Select if BuildEditControl ="" and sFormat<>EDIT_FORMAT_READONLY then ' text area if nType = 203 or nType = 201 then BuildEditControl = "<textarea cols=50 rows=10 name=""" & sFieldName & """>" & sDefault & "</textarea>" end if ' check box if nType = 11 or (nType=131 and ( sValue="Yes" or sValue="1" or sValue="0" or sValue="No" )) then BuildEditControl = "<input type=checkbox name=""" & sFieldName & """" if sValue="Yes" or sValue="1" then BuildEditControl = BuildEditControl & " checked " end if BuildEditControl = BuildEditControl & ">" end if ' set length for text or numeric if nType>=2 and nType<=6 then strMaxLength = 10 strSize = 10 else if GetDatabaseType()= "DATABASE_MySQL" then strSize=20 strMaxLength = 255 else strMaxLength = Field.DefinedSize strSize = strMaxLength end if end if ' date or datetime field if IsDateField(Field) then BuildEditControl = GetDateEdit(sFieldName , sDefault , DateEditType(sFieldName )) elseif IsLookupField(sFieldName ) then BuildEditControl = BuildSelectControl(sFieldName , sValue) elseif nType <> 201 and nType <> 203 and nType <> 11 and nType <> 204 and nType <> 205 then BuildEditControl = "<input type=text name=""" & sFieldName & """ maxlength = " & strMaxLength & " size = " & strSize & " value=""" & sDefault & """>" elseif (Field.Attributes and 128) and ( nType = 204 or nType=205 ) then strImageWhere = " " & AddWrappers(strKeyField) & "=" & gstrQuote & GetData(rs.Fields(strKeyField), "") & gstrQuote if strKeyField2<>"" then strImageWhere = strImageWhere & " and " & AddWrappers(strKeyField2) & "=" & gstrQuote2 & GetData(rs.Fields(strKeyField2), "") & gstrQuote2 if strKeyField3<>"" then strImageWhere = strImageWhere & " and " & AddWrappers(strKeyField3) & "=" & gstrQuote3 & GetData(rs.Fields(strKeyField3), "") & gstrQuote3 strPK = AddWrappers(strKeyField) if strKeyField2<>"" then strPK = strPK & "," & AddWrappers(strKeyField2) if strKeyField3<>"" then strPK = strPK & "," & AddWrappers(strKeyField3) BuildEditControl = "<img src=""imager.asp?pictable=" & HTMLEncode(strTableName) & "&picfield=" & HTMLEncode(AddWrappers(sFieldName)) & "&where=" & HTMLEncode(strImageWhere) & """>" BuildEditControl = BuildEditControl & "<br><a href=""uploader.asp?pictable=" & HTMLEncode(strTableName) & "&picfield=" & HTMLEncode(sFieldName) & "&where=" & HTMLEncode(strImageWhere) & "&PK=" & HTMLEncode(strPK) & """>Change</a>" BuildEditControl = BuildEditControl & "&nbsp;&nbsp;&nbsp;<a href=# onClick=""if (!confirm('Do you really want to delete this image?')) return false; document.forms.editform.todo.value='deleteimage'; document.forms.editform.imagefield.value='" & sFieldName & "';document.forms.editform.submit(); return false;"">Delete</a>" end if end if End Function Function BuildFieldName(strFieldName) BuildFieldName = Replace(strFieldName," ","") BuildFieldName = Replace(BuildFieldName,"#","") BuildFieldName = Replace(BuildFieldName,"/","") BuildFieldName = Replace(BuildFieldName,"(","") BuildFieldName = Replace(BuildFieldName,")","") BuildFieldName = Replace(BuildFieldName,"'","") BuildFieldName = Replace(BuildFieldName,"_","") BuildFieldName = Replace(BuildFieldName,"-","") End Function Function RemoveWrappers(strValue) if strValue="" then RemoveWrappers="" Exit Function end if if Left(strValue,1)=strLeftWrapper then RemoveWrappers = Mid(strValue, 2 ,Len(strValue)-2) else RemoveWrappers = strValue end if if Left(RemoveWrappers,1)="'" then RemoveWrappers = Mid(RemoveWrappers, 2 ,Len(RemoveWrappers)-2) else RemoveWrappers = RemoveWrappers end if RemoveWrappers = CStr(RemoveWrappers) End Function Function ProcessLargeText(strValue) if LCase(Left(LTrim(strValue),7))="<a href" Then ProcessLargeText = strValue Exit Function end if ' ProcessLargeText = HTMLEncode(strValue) ProcessLargeText = strValue if cNumberOfChars>0 then if Len(ProcessLargeText)>cNumberOfChars and left(strValue,7)<>"<a href" then ProcessLargeText = Left(ProcessLargeText, cNumberOfChars ) & _ " <a href=""#"" onClick=""javascript: pwin = window.open('',null,'height=300,width=400,status=yes,resizable=yes,toolbar=no,menubar=no,location=no,left=150,top=200,scrollbars=yes'); " ind = 1 ProcessLargeText = ProcessLargeText & "pwin.document.write('" & HTMLEncode(Replace(Replace(Mid(strValue,ind, ind+800),"'","\'"), vbcrlf, "<br>")) & "');" & vbcrlf ProcessLargeText = ProcessLargeText & "pwin.document.write('<br><hr size=1 noshade><a href=# onClick=\'window.close();return false;\'>Close window</a>');" ProcessLargeText = ProcessLargeText & "return false;"">More ...</a>" end if end if End Function Function EscapeQuotes(strValue) EscapeQuotes = Replace(strValue, "'", "\'") EscapeQuotes = HTMLEncode(EscapeQuotes) End Function Function HTMLEncode(str) if str="" or IsNull(str) then HTMLEncode="" else HTMLEncode = Server.HTMLEncode(str) end if End Function Function GetDatabaseType GetDatabaseType = "DATABASE_Access" End Function Function GetFieldType(strFieldName) if strFieldName="ID" then GetFieldType= 1001 end if if strFieldName="Username" then GetFieldType= 200 end if if strFieldName="Password" then GetFieldType= 200 end if if strFieldName="accesso" then GetFieldType= 200 end if if strFieldName="lista" then GetFieldType= 200 end if if strFieldName="pin" then GetFieldType= 200 end if End Function Function CreateImageControl(rsData, sFieldName, FilenameField) strImageWhere = " " & AddWrappers(strKeyField) & "=" & gstrQuote & GetData(rsData.Fields(strKeyField), "") & gstrQuote if strKeyField2<>"" then _ strImageWhere = strImageWhere & " and " & AddWrappers(strKeyField2) & "=" & gstrQuote2 & GetData(rsData.Fields(strKeyField2), "") & gstrQuote2 if strKeyField3<>"" then _ strImageWhere = strImageWhere & " and " & AddWrappers(strKeyField3) & "=" & gstrQuote3 & GetData(rsData.Fields(strKeyField3), "") & gstrQuote3 if FilenameField="" then CreateImageControl = "<img border=0 src=""imager.asp?pictable=" & HTMLEncode(strTableName) & "&picfield=" & _ HTMLEncode(AddWrappers(sFieldName)) & "&where=" & HTMLEncode(strImageWhere) & """>" else CreateImageControl = "<img border=0 src=""imager.asp?pictable=" & HTMLEncode(strTableName) & "&picfield=" & _ HTMLEncode(AddWrappers(sFieldName)) & "&where=" & HTMLEncode(strImageWhere) & """>" binTemp = rsData(sFieldName).GetChunk(300) if not IsNull(binTemp) then CreateImageControl = "<a href=""getfile.asp?pictable=" & HTMLEncode(strTableName) & "&picfield=" & _ HTMLEncode(AddWrappers(sFieldName)) & "&filename=" & HTMLEncode(FilenameField) _ & "&where=" & HTMLEncode(strImageWhere) & """>" & CreateImageControl & "</a>" end if end if End Function Function InSQL(sField, sSQL) if InStr(1, LCase(sSQL), LCase(sField) & ",")<1 and InStr(1, LCase(sSQL), LCase(sField) & " ")<1 and _ InStr(1, LCase(sSQL), strLeftWrapper & LCase(sField) & strRightWrapper & ",")<1 and InStr(1, LCase(sSQL), strLeftWrapper & LCase(sField) & strRightWrapper & " ")<1 then InSQL = False else InSQL = True end if End Function Function IsUpdatable(Field) if Field.Attributes and 4 or Field.Attributes and 8 then bUpdatable=true else bUpdatable=false end if if bUpdatable then IsUpdatable="True" else IsUpdatable="False" end if ' long binary data if (Field.Attributes and 128) and ( Field.Type = 204 or Field.Type=205 ) then IsUpdatable="False" end if End Function Sub GetADOXConnection if InStr(1, strConnection, "Microsoft Access Driver") > 0 then set oCat = server.CreateObject("ADOX.Catalog") if Err.number=0 then ind = InStr(1, strConnection, "DBQ=") if ind>0 then ind2=InStr(ind+1, strConnection, ";") sConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Engine Type=5;Data Source=" & Mid(strConnection, ind+Len("DBQ="), ind2-ind-Len("DBQ=")) if InStr(LCASE(strConnection), "pwd=")<1 then oCat.ActiveConnection = sConnection if Left(strTableName,1)="[" then strADOXTableName = Mid(strTableName,2,len(strTableName)-2) else strADOXTableName = strTableName end if end if end if end if Err.Clear end if End Sub Function GetLegendIcon(sFieldName, nType, i) if sFieldName = strKeyField or sFieldName =strKeyField2 or sFieldName = strKeyField3 then GetLegendIcon = GetLegendIcon & "&nbsp;<img src=images/icon_required.gif>" else if strADOXTableName<>"" then bCat = (oCat.Tables(strADOXTableName).Columns(rs.Fields(sFieldName).Name).Properties("Jet OLEDB:Allow Zero Length") = False) else bCat = False end if if (rs.Fields(sFieldName).Attributes and 96)=0 or IsRequired(sFieldName) or _ ((nType=202 or nType=203) and bCat) then GetLegendIcon = GetLegendIcon & "&nbsp;<img src=images/icon_required.gif>" end if end if End Function Function GetHyperlink(str, strField) GetHyperlink = str if (Right(GetHyperlink,1)="#") then ind = InStr(1, str, "#") strTitle = Left(str, ind-1) str = Mid(str,ind+1,Len(str)-ind-1) end if if strTitle="" then strTitle=str if strField="ID" then Target = "" LinkType = 0 if LinkType = 1 then strTitle = "" if LinkType = 2 then strTitle = rs("") end if if strField="Username" then Target = "" LinkType = 0 if LinkType = 1 then strTitle = "" if LinkType = 2 then strTitle = rs("") end if if strField="Password" then Target = "" LinkType = 0 if LinkType = 1 then strTitle = "" if LinkType = 2 then strTitle = rs("") end if if strField="accesso" then Target = "" LinkType = 0 if LinkType = 1 then strTitle = "" if LinkType = 2 then strTitle = rs("") end if if strField="lista" then Target = "" LinkType = 0 if LinkType = 1 then strTitle = "" if LinkType = 2 then strTitle = rs("") end if if strField="pin" then Target = "" LinkType = 0 if LinkType = 1 then strTitle = "" if LinkType = 2 then strTitle = rs("") end if if InStr(1,Left(str,7),"://")=0 and Left(str,7)<>"mailto:" then str = "http://" & str GetHyperlink = "<a href=""" & str & """" & Target & ">" & strTitle & "</a>" End Function function RTESafe(strText) 'returns safe code for preloading in the RTE dim tmpString tmpString = trim(strText) if tmpString ="" or isNull(tmpString) then Exit Function 'convert all types of single quotes tmpString = replace(tmpString, chr(145), chr(39)) tmpString = replace(tmpString, chr(146), chr(39)) tmpString = replace(tmpString, "'", "&#39;") 'convert all types of double quotes tmpString = replace(tmpString, chr(147), chr(34)) tmpString = replace(tmpString, chr(148), chr(34)) ' tmpString = replace(tmpString, """", "\""") 'replace carriage returns & line feeds tmpString = replace(tmpString, chr(10), " ") tmpString = replace(tmpString, chr(13), " ") RTESafe = tmpString end function Function GetQuote(strField) GetQuote = "'" if IsDateFieldType(GetFieldType(strField)) then if InStr(1, strConnection, "Microsoft Access Driver") > 0 then GetQuote="#" end if end if End Function Function CheckSecurity(strValue, strAction) if cAdvSecurityMethod = ADVSECURITY_ALL or Session("AccessLevel")=ACCESS_LEVEL_ADMIN then CheckSecurity = True if Session("AccessLevel")=ACCESS_LEVEL_ADMIN then Exit Function end if if cAdvSecurityMethod = ADVSECURITY_EDIT_OWN and ( strAction="Edit" or strAction="Delete") then if Session("OwnerID")=CStr(strValue) then CheckSecurity = True else CheckSecurity = False Exit Function end if else CheckSecurity = True end if End Function %>

[Íàçàä]