Some code asp worth reading

Filter restriction functions for ip addresses in Asp
<%
'Get the visitor's address
Ip = Request. ServerVariables ("REMOTE_ADDR ")
'Allowed IP address ranges are 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 whether the IP address segment is valid
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
Elseif cint (ipstr (I) <cint (allow2 (I) then
Check (I) = true
Checkip = true
Exit
Elseif cint (ipstr (I)> cint (allow2 (I) then
Check (I) = false
Checkip = false
Exit
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
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
%>
Lists All values submitted using an HTML form.

Use ASP to get the image 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 & "; Height:" & 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 ":
Do
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 can I determine whether the URL format complies with the specifications?
<% 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 _-. /\ ", 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 InStr (tmpString ,". ") <= 0 then checkisUrl = false response. write "f3" exit function end if InStr (checkisUrl ,".. ")> 0 then checkisUrl = false end if
End function %> <%
If checkisUrl (request ("u") = true then %> congratulations, your URL passes! <% Else %> sorry, your URL is not compliant. Please check again! <% End if %>

How can I create a drop-down list using the database content?

<% MyDSN = "DSN = xur; uid = xur; pwd = xur" mySQL = "select * from authors where AU_ID <100" set conntemp = server. createobject ("adodb. connection ") conntemp. open myDSNset rstemp1_conntemp.exe cute (mySQL) if rstemp. eof thenresponse. write "oh, the database is empty! "Response. write mySQLconntemp. closeset conntemp = nothingresponse. end if %> <% do until rstemp. eof %> <% rstemp. movenextlooprstemp. closeset rstemp = nothingconntemp. closeset conntemp = nothing 'clear object %>
'Obtain the user's real IP address Function
Function GetIP ()
GetIP = Request. ServerVariables ("HTTP_X_FORWARDED_FOR ")
If GetIP = "" Then GetIP = Request. ServerVariables ("REMOTE_ADDR ")
End Function

'Get the complete 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 file name of this page
Function SelfName ()
SelfName = Mid (Request. ServerVariables ("URL"), faster Rev (Request. ServerVariables ("URL"), "/") + 1)
End Function

'Get the file suffix
Function GetExt (filename)
GetExt = Mid (filename, limit Rev (filename, ".") + 1)
End Function

'Evaluate the 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 = "Fuck me | fuck you | fuck him | fuck you | fuck | dog | | French | Hong zhi | legal disclaimer"
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

'Prevents 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 (10) & Chr (10), "</P> <P> ")
FString = Replace (fString, Chr (10), "<BR> ")
FString = Replace (fString, Chr (255 ),"")
HTMLEncode = fString
End If
End Function

'Clear HTML Markup
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