Source code of Windows XP (NT5)
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 

321 lines
10 KiB

<%
dim quote,isAdmin,disabletextstart,disableintstart,disabletextend
dim bUpdateGlobal
bUpdateGlobal = true
quote=chr(34)
disabletextstart= "<TABLE BORDER=1 BORDERCOLORLIGHT=" & quote & "#000000" & quote & " BORDERCOLORMEDIUM=" & quote & "#000000" & quote & " BORDERCOLORDARK=" & quote & "Gray" & quote & "><TR><TD BGCOLOR=" & quote & "#C0C0C0" & quote & " BORDERCOLOR=" & quote & "#C0C0C0" & quote & " BORDERCOLORLIGHT=" & quote & "#C0C0C0" & quote & " BORDERCOLORMEDIUM=" & quote & "#C0C0C0" & quote & " BORDERCOLORDARK=" & quote & "#C0C0C0" & quote & "WIDTH=300>"
disableintstart= "<TABLE BORDER=1 BORDERCOLORLIGHT=" & quote & "#000000" & quote & " BORDERCOLORMEDIUM=" & quote & "#000000" & quote & " BORDERCOLORDARK=" & quote & "Gray" & quote & "><TR><TD BGCOLOR=" & quote & "#C0C0C0" & quote & " BORDERCOLOR=" & quote & "#C0C0C0" & quote & " BORDERCOLORLIGHT=" & quote & "#C0C0C0" & quote & " BORDERCOLORMEDIUM=" & quote & "#C0C0C0" & quote & " BORDERCOLORDARK=" & quote & "#C0C0C0" & quote & "WIDTH=75>"
disabletextend="</TD></TR></TABLE>"
isAdmin=Session("isAdmin")
function checkboxmask(fieldname, fieldmask, onclickproc, adminonly)
On Error Resume Next
Dim val
if mid(fieldname,1,1)="!" then
fieldname=mid(fieldname,2)
val=not (currentobj.Get(fieldname) and fieldmask)
else
val=(currentobj.Get(fieldname) and fieldmask)
end if
checkboxmask = writeCheckboxVal(err, val, fieldname, fieldmask, onclickproc, adminonly)
end function
function checkbox(fieldname, onclickproc, adminonly)
On Error Resume Next
Dim val
if mid(fieldname,1,1)="!" then
fieldname=mid(fieldname,2)
val=not currentobj.Get(fieldname)
else
val=currentobj.Get(fieldname)
end if
checkbox = checkboxVal(err,val,"chk" & fieldname,onclickproc,adminonly)
end function
function checkboxVal(err, val, fieldname, onclickproc, adminonly)
On Error Resume Next
checkboxVal = writeCheckboxVal(err, val, fieldname, "", onclickproc, adminonly)
end function
function writeCheckboxVal(err, val, fieldname,fieldmask, onclickproc, adminonly)
On Error Resume Next
Dim outputStr
if err <> 0 then
outputStr="<INPUT NAME='" & fieldname & "' TYPE='CHECKBOX'>"
alertuser fieldname
else
if (not adminonly) or isAdmin then
if val then
outputStr="<INPUT NAME='" & fieldname & "' TYPE='CHECKBOX' CHECKED"
else
outputStr="<INPUT NAME='" & fieldname & "' TYPE='CHECKBOX' "
end if
if fieldmask <> "" then
outputStr = outputStr & " VALUE=" & fieldmask
end if
outputStr = outputStr & " OnClick=" & quote
if bUpdateGlobal then
outputStr = outputStr & "top.title.Global.updated=true;"
end if
if onclickproc <> "" then
outputStr = outputStr & onclickproc & quote & ">"
else
outputStr = outputStr & quote & ">"
end if
else
if Session("hasDHTML") then
if val then
outputStr="<INPUT NAME='" & fieldname & "' TYPE='CHECKBOX' CHECKED DISABLED>"
else
outputStr="<INPUT NAME='" & fieldname & "' TYPE='CHECKBOX' CHECKED DISABLED>"
end if
else
if val then
outputStr="<IMG ALIGN=middle SRC=" & quote & "images/checkon.gif" & quote & ">"
else
outputStr="<IMG ALIGN=middle SRC=" & quote & "images/checkoff.gif" & quote & ">"
end if
end if
end if
end if
writeCheckboxVal = outputStr
end function
function printoption(selected, text, adminonly)
'On Error Resume Next
if selected then
printoption="<OPTION SELECTED>" & text
else
if (isadmin or not adminonly) then
printoption="<OPTION>" & text
end if
end if
end function
function getoption(fieldname,value, adminonly)
'On Error Resume Next
Dim val
val=currentobj.Get(fieldname)
if err <> 0 then
val = False
alertuser fieldname
end if
getoption = printoption((value=val),value,adminonly)
end function
function radio(fieldname,value, onclickproc, adminonly)
On Error Resume Next
Dim val
val=currentobj.Get(fieldname)
if err <> 0 then
radio=(printradio(fieldname, False,onclickproc,adminonly))
alertuser "rdo" & fieldname
else
if (typename(val)="Boolean") then
output=printradio(fieldname, (val=value),onclickproc,adminonly)
else
if mid(value,1,1)="!" then
output=printradio(fieldname, (val <> mid(value,2)),onclickproc,adminonly)
else
output=printradio(fieldname, (val=value),onclickproc,adminonly)
end if
end if
radio=output
end if
end function
function printradio(fieldname, checked, onclickproc,adminonly)
Dim output, chkstr
if checked then
chkstr="CHECKED"
else
chkstr=""
end if
if ((not adminonly) or isAdmin) then
output="<INPUT NAME=" & quote & "rdo" & fieldname & quote & " TYPE=" & quote & "RADIO" & quote & " " & chkstr
output=output & " OnClick=" & quote
if bUpdateGlobal then
output = output & "top.title.Global.updated=true;"
end if
if onclickproc <> "" then
printradio=output & onclickproc & quote & ">"
else
printradio=output & quote & ">"
end if
else
if checked then
printradio="<IMG SRC=" & quote & "images/radioon.gif" & quote & ">"
else
printradio="<IMG SRC=" & quote & "images/radiooff.gif" & quote & ">"
end if
end if
end function
function text(fieldname,fieldsize,onchangeproc,onfocusproc, onblurproc,hidden,adminonly)
On Error Resume Next
Dim val
val=currentobj.Get(fieldname)
text=inputbox(err,"text",fieldname,val,fieldsize,onchangeproc,onfocusproc,onblurproc,hidden,adminonly,false)
end function
function pword(fieldname,fieldsize,onchangeproc,onfocusproc, onblurproc,hidden,adminonly)
On Error Resume Next
Dim val
val=currentobj.Get(fieldname)
if ((not adminonly) or isAdmin) then
pword=inputbox(err,"password",fieldname,val,fieldsize,onchangeproc,onfocusproc,onblurproc,hidden,adminonly,false)
else
pword=disabletextstart & "*******" & disabletextend
end if
end function
function writehidden(fieldname)
On Error Resume Next
writehidden=inputbox(0,"hidden",fieldname,currentobj.Get(fieldname),"","","","",false,false,false)
end function
function inputbox(err,fieldtype,fieldname,val,fieldsize,onchangeproc,onfocusproc,onblurproc,hidden,adminonly,readonly)
inputbox = writeinputbox(err,fieldtype,fieldname,val,fieldsize,"",onchangeproc,onfocusproc,onblurproc,hidden,adminonly,readonly,false)
end function
function inputboxfixed(err,fieldtype,fieldname,val,fieldsize,maxfieldsize,onchangeproc,onfocusproc,onblurproc,hidden,adminonly,readonly)
inputboxfixed = writeinputbox(err,fieldtype,fieldname,val,fieldsize,maxfieldsize,onchangeproc,onfocusproc,onblurproc,hidden,adminonly,readonly,false)
end function
function disabledbox(err,fieldtype,fieldname,val,fieldsize,maxfieldsize,onchangeproc,onfocusproc,onblurproc,hidden,adminonly)
disabledbox = writeinputbox(err,fieldtype,fieldname,val,fieldsize,maxfieldsize,onchangeproc,onfocusproc,onblurproc,hidden,adminonly,false,true)
end function
function writeinputbox(err,fieldtype,fieldname,val,fieldsize,maxfieldsize,onchangeproc,onfocusproc,onblurproc,hidden,adminonly,readonly,disabled)
On Error Resume Next
Dim textstr
if err <> 0 then
textstr="<INPUT TYPE=" & quote & fieldtype & quote & " NAME=" & quote & fieldname & quote & " SIZE=" & fieldsize & ">"
alertuser fieldname
else
if ((not adminonly) or isAdmin) then
textstr="<INPUT TYPE=" & quote & fieldtype & quote
textstr=textstr & " NAME=" & quote & fieldname & quote
if fieldsize <> "" then
textstr = textstr & " SIZE = " & (Session("BrowserTBScalePct") * fieldsize/100)
else
end if
if maxfieldsize <> "" then
textstr=textstr & " MAXLENGTH=" & maxfieldsize
else
end if
textstr=textstr & " VALUE=" & quote & val & quote
textstr=textstr & " OnChange=" & quote
if bUpdateGlobal then
textstr = textstr & "top.title.Global.updated=true;"
end if
if onchangeproc <> "" then
textstr=textstr & onchangeproc & quote
else
textstr=textstr & quote
end if
if onfocusproc <> "" then
textstr=textstr & " OnFocus=" & quote & onfocusproc & quote
end if
if onblurproc <> "" then
textstr=textstr & " OnBlur=" & quote & onblurproc & quote
end if
if readonly then
textstr=textstr & " READONLY"
end if
if disabled then
textstr=textstr & " DISABLED"
end if
if Session("hasStyles") then
textstr=textstr & Session("DEFINPUTSTYLE")
end if
textstr=textstr & ">"
if hidden then
textstr=textstr & " <INPUT TYPE=" & quote & "hidden" & quote & " NAME=" & quote & "hdn" & fieldname & quote & " VALUE=" & quote & val & quote & ">"
end if
else
if Session("hasDHTML") then
textstr="<INPUT TYPE=" & quote & fieldtype & quote & " NAME=" & quote & fieldname & quote & " SIZE=" & fieldsize & " VALUE='" & val & "' DISABLED FACE=" & quote & Session("FONTFACE") & quote & ">"
else
if val = "" then
val = "&nbsp;"
else
if len(val) > 50 then
val = Left(val,50) & "..."
end if
end if
if fieldsize < 15 then
textstr=disableintstart & "<FONT FACE='" & Session("FONTFACE") & "' SIZE='" & Session("FONTPOINT") & "'>"& val & "</FONT>" & disabletextend
else
textstr=disabletextstart & "<FONT FACE='" & Session("FONTFACE") & "' SIZE='" & Session("FONTPOINT") & "'>"& val & "</FONT>" & disabletextend
end if
end if
end if
end if
writeinputbox=textstr
end function
function writeSelect(selName, size, onChange, isMultiSel)
dim textstr
textstr = "<SELECT NAME='" & selName & "'"
if size <> "" then
textstr = textstr & " Size='" & size & "'"
end if
if onChange <> "" then
textstr = textstr & " OnChange='" & onChange & "'"
end if
if isMultiSel then
textstr = textstr & " MULTIPLE"
end if
if Session("hasStyles") then
textstr=textstr & Session("DEFINPUTSTYLE")
end if
textstr = textstr & ">"
writeSelect = textstr
end function
function minVal(thisval, min)
if thisval < min then
thisval = min
end if
minVal = thisval
end function
Sub alertuser(fieldname)
'Response.Write "<SCRIPT>alert(" & quote & "Could not retrieve a value for " & fieldname & ". (" & err & ":" & err.description & ")" & quote & ");</SCRIPT>"
Response.Write "<FONT COLOR=red><B>*</B></FONT>"
End Sub
%>