IP filtering restriction function in ASP
<%
' Get the visitor's address
Ip=request.servervariables ("REMOTE_ADDR")
' The allowed IP address segment is 10.0.0.0~10.68.63.255
allowip1= "10.0.0.0"
Allowip2= "10.68.10.71"
Response.Write Checkip (IP,ALLOWIP1,ALLOWIP2)
function Checkip (IP,ALLOWIP1,ALLOWIP2)
Dim Check (4)
Checkip=false
Ipstr=split (IP, ".")
Allow1=split (Allowip1, ".")
Allow2=split (ALLOWIP2, ".")
If CInt (Allow1 (0)) >cint (allow2 (0)) Then
' Determine if the IP address segment is legitimate
Response.Write "IP Address segment Error! "
Exit function
End If
For i=0 to UBound (IPSTR)
If CInt (Allow1 (i)) <cint (Allow2 (i)) then
If CInt (Allow1 (i)) =cint (Ipstr (i)) then
Check (i) =true
Checkip=true
Exit For
ElseIf CInt (Ipstr (i)) <cint (Allow2 (i)) then
Check (i) =true
Checkip=true
Exit For
ElseIf CInt (Ipstr (i)) >cint (Allow2 (i)) then
Check (i) =false
Checkip=false
Exit For
Else
Check (i) =true
Checkip=true
End If
End If
End If
ElseIf CInt (Allow1 (i)) >cint (Ipstr (i)) or CInt (Allow1 (i)) <cint (Ipstr (i)) then
Check (i) =false
Checkip=false
If I<>ubound (IPSTR) Then
Exit For
End If
Else
Check (i) =true
End If
End If
Next
if (check (0) =true and check (1) =true and check (2) =true and check (3) =false) and (CInt (Allow2 (2)) >cint (IPSTR (2))) then
Checkip=true
End If
End Function
%>
<%
' Enumerate all values submitted using an HTML form
For each item in Request.Form
Response.Write Request.Form (item)
Next
%>
Enumerate all values submitted using an HTML form
Using ASP to get picture size
<%
Imgpath= "Default_22.gif"
Set Pp=new Imginfo
W = PP.IMGW (Server.MapPath (Imgpath))
h = pp.imgh (Server.MapPath (Imgpath))
Set pp=nothing
Response.Write "<br> width: &w&"; High: "&h
Class Imginfo
Dim aso
Private Sub Class_Initialize
Set Aso=createobject ("ADODB.stream")
Aso. Mode=3
Aso. Type=1
Aso. Open
End Sub
Private Sub Class_Terminate
Err.Clear
Set aso=nothing
End Sub
Private Function bin2str (Bin)
Dim I, Str
For I=1 to LenB (Bin)
CLOW=MIDB (bin,i,1)
If ASCB (Clow) <128 Then
str = str & CHR (ASCB (Clow))
Else
I=i+1
If I <= LenB (Bin) then str = str & CHR (ASCW (MidB (bin,i,1) &clow))
End If
Next
Bin2str = Str
End Function
Private Function num2str (num,base,lens)
Dim ret
ret = ""
while (Num>=base)
ret = (num mod base) & RET
num = (num-num mod base)/base
Wend
Num2str = Right (string (lens, "0") & Num & Ret,lens)
End Function
Private Function Str2Num (str,base)
Dim ret
RET = 0
For I=1 to Len (str)
RET = ret *base + CInt (Mid (str,i,1))
Next
Str2num=ret
End Function
Private Function Binval (BIN)
Dim ret
RET = 0
For i = LenB (bin) to 1 step-1
RET = ret *256 + ASCB (MidB (bin,i,1))
Next
Binval=ret
End Function
Private Function BinVal2 (BIN)
Dim ret
RET = 0
For i = 1 to LenB (BIN)
RET = ret *256 + ASCB (MidB (bin,i,1))
Next
Binval2=ret
End Function
Private Function getimagesize (filespec)
Dim ret (3)
Aso. LoadFromFile (filespec)
Bflag=aso.read (3)
Select Case Hex (binval (Bflag))
Case "4E5089":
Aso.read (15)
RET (0) = "PNG"
RET (1) =binval2 (Aso.read (2))
Aso.read (2)
RET (2) =binval2 (Aso.read (2))
Case "464947":
Aso.read (3)
RET (0) = "GIF"
RET (1) =binval (Aso.read (2))
RET (2) =binval (Aso.read (2))
Case "535746":
Aso.read (5)
Bindata=aso. Read (1)
Sconv=num2str (ASCB (Bindata), 2, 8)
Nbits=str2num (Left (sconv,5), 2)
Sconv=mid (sconv,6)
while (Len (sconv) <nbits*4)
Bindata=aso. Read (1)
Sconv=sconv&num2str (ASCB (Bindata), 2, 8)
Wend
RET (0) = "SWF"
RET (1) =int (ABS (Str2Num (mid sconv,1*nbits+1,nbits), 2)-str2num (Mid (Sconv,0*nbits+1,nbits), 2))/20)
RET (2) =int (ABS (Str2Num (mid sconv,3*nbits+1,nbits), 2)-str2num (Mid (Sconv,2*nbits+1,nbits), 2))/20)
Case "FFD8FF":
Todo
Do:p1=binval (ASO. Read (1)): Loop while p1=255 and not ASO. Eos
If p1>191 and p1<196 then exit do else Aso.read Binval2 (ASO. Read (2))-2
Do:p1=binval (ASO. Read (1)): Loop while p1<255 and not ASO. Eos
Loop while True
Aso. Read (3)
RET (0) = "JPG"
RET (2) =binval2 (ASO). Read (2))
RET (1) =binval2 (ASO). Read (2))
Case Else:
If left (Bin2str (Bflag), 2) = "BM" Then
Aso. Read (15)
RET (0) = "BMP"
RET (1) =binval (ASO). Read (4))
RET (2) =binval (ASO). Read (4))
Else
RET (0) = ""
End If
End Select
RET (3) = "Width=" "" & RET (1) & "" "Height=" "" & Ret (2) & "" "
Getimagesize=ret
End Function
Public Function IMGW (Pic_path)
Set FSO1 = server. CreateObject ("Scripting.FileSystemObject")
If (FSO1. FileExists (Pic_path)) Then
Set f1 = Fso1. GetFile (Pic_path)
Ext=fso1. Getextensionname (Pic_path)
Select Case Ext
Case "GIF", "BMP", "JPG", "PNG":
Arr=getimagesize (F1.path)
IMGW = arr (1)
End Select
Set f1=nothing
Else
IMGW = 0
End If
Set fso1=nothing
End Function
Public Function IMGH (Pic_path)
Set FSO1 = server. CreateObject ("Scripting.FileSystemObject")
If (FSO1. FileExists (Pic_path)) Then
Set f1 = Fso1. GetFile (Pic_path)
Ext=fso1. Getextensionname (Pic_path)
Select Case Ext
Case "GIF", "BMP", "JPG", "PNG":
Arr=getimagesize (F1.path)
IMGH = arr (2)
End Select
Set f1=nothing
Else
IMGH = 0
End If
Set fso1=nothing
End Function
End Class
%>
Client screen resolution: Request.ServerVariables ("Http_ua_pixels")
How do I determine if the URL format conforms to the specification?
<% function Checkisurl (tmpstring)
dim c,i checkisUrl = True tmpstring=lcase (Trim (tmpstring)) if left (tmpstring,7) <> "http://" then tmpstri ... //&tmpString for i = 8 to len (Checkisurl) c = lcase (Mid (tmpstring, i, 1)) if instr ("Abcdefghijklmnopqrstuvwxyz_-./\", &NBSP;C) <= 0 and not isnumeric (c) then checkisUrl = false exit function end if next if left (tmpstring, 1) = "." or right (tmpstring, 1) = "." then checkisurl = false exit function end if if instr (tmpString, ".") <= 0 then checkisurl = false response. write "F3" exit function end if if instr (CHECKISURL, "...") > 0 then checkisurl = False end if
End function%><%
If Checkisurl ("U") =true then%> Congratulations, your URL through!<%else%> sorry, your URL is not up to standard, please check!<%end if%>
How do I create a drop-down list using the content of the database?
<% mydsn= "Dsn=xur;uid=xur;pwd=xur" mysql= "select * from authors where au_id<100" set Conntemp=server.createobject ("Adodb.connection") Conntemp.open mydsnset Rstemp=conntemp.execute (MySQL) if rstemp.eof thenresponse.write "Oh, the database is empty!" Response.Write Mysqlconntemp.closeset Conntemp=nothingresponse.end End If%><%do until rstemp.eof Rstemp.movenextlooprstemp.closeset rstemp=nothingconntemp.closeset conntemp=nothing ' empty object%>
' Get the user's real IP function
Function GetIP ()
GetIP = Request.ServerVariables ("Http_x_forwarded_for")
If getip = "" Then GetIP = Request.ServerVariables ("REMOTE_ADDR")
End Function
' Get full Address bar address
Function GetUrl ()
Geturl= "http://" &request.servervariables ("SERVER_NAME") &request.servervariables ("URL")
If Request.ServerVariables ("query_string") <> "" Then geturl=geturl& "?" & Request.ServerVariables ("Query_string")
End Function
' Get the filename on this page
Function Selfname ()
Selfname = Mid (request.servervariables ("url"), InStrRev (request.servervariables ("url"), "/" +1)
End Function
' Get file suffix name
Function getext (filename)
Getext = Mid (Filename,instrrev (FileName, ".") +1)
End Function
' Ask for string length function
Function GetLength (str)
Dim I,length
For i = 1 to Len (str)
If ASC (Mid (str,i,1)) <0 or ASC (Mid (str,i,1)) >256 Then
Length = length+2
Else
Length = length+1
End If
Next
GetLength = length
End Function
' Filter Bad characters
Function Chkbadwords (fstring)
Dim Badwords,bwords,i
Badwords = "I fuck | Fuck you | | fuck Him |" | fuck | | | | | | | | | | | | | | | | | |
If Not (IsNull (badwords) or IsNull (fstring)) Then
Bwords = Split (badwords, "|")
For i = 0 to UBound (bwords)
fstring = Replace (fstring, Bwords (i), String (Len (Bwords (i)), "*")
Next
Chkbadwords = fstring
End If
End Function
' Prevent external submissions
Function Chkpost ()
Dim Url1,url2
Chkpost = False
URL1 = Cstr (Request.ServerVariables ("Http_referer"))
URL2 = Cstr (Request.ServerVariables ("SERVER_NAME"))
If Mid (Url1,8,len (URL2)) <>url2 Then
Chkpost = False
Else
Chkpost = True
End If
End Function
' Filter HTML character functions
Function HTMLEncode (fstring)
If not IsNull (fstring) and fstring <> "" Then
fstring = Replace (fstring, "&", "&")
fstring = Replace (fstring, ">", ">")
fstring = Replace (fstring, "<", "<")
fstring = Replace (fstring, Chr (32), "")
fstring = Replace (fstring, CHR (9), "")
fstring = Replace (fstring, Chr (34), "" ")
fstring = Replace (fstring, CHR (39), "'")
fstring = Replace (fstring, CHR (13), "")
fstring = Replace (fstring, Chr (a) & Chr (a), "</P><P>")
fstring = Replace (fstring, Chr (), "<BR>")
fstring = Replace (fstring, CHR (255), "")
HTMLEncode = fstring
End If
End Function
' Clear HTML tags
Function striphtml (strhtml)
Dim Objregexp,stroutput
Set objRegExp = New Regexp
Objregexp.ignorecase = True
Objregexp.global = True
Objregexp.pattern = "<.+?>"
Stroutput = Objregexp.replace (strHTML, "")
Stroutput = Replace (Stroutput, "<", "<")
Stroutput = Replace (Stroutput, ">", ">")
striphtml = Stroutput
Set objRegExp = Nothing
End Function
