Edited an editplus file (ASP content)

# Title = Common ASP syntax and functions
# Info
Some common syntaxes and user-defined functions of ASP
# Sort = N

# T = ASP common syntax =
# T ==================================
# T = database-related
# T = connect to the Access Database
<%
Dim dbname, Conn
Dbname "^! "'Define the database path and name
Set conn = server. Createobject ("ADODB. Connection ")
Conn. Open "provider = Microsoft. Jet. oledb.4.0; Data Source =" & server. mappath (dbname)
%>

# T = connect to the ms SQL database
<%
Dim Conn
Set conn = server. Createobject ("ADODB. Connection ")
Conn. Open "provider = sqloledb; Data Source = SQL server name or IP address; uid = database Logon account; Pwd = Database Password; database = database name"
%>

# T = create record set
Set ^! = Server. Createobject ("ADODB. recordset ")

# T = Execute SQL commands
Rs. Open SQL, Conn, 1, 1

# T = Execute SQL commands
Conn. Execute ("^! ")

# T = Rs directly execute SQL commands
Set rs = conn. Execute ("^! ")

# T = Disable record set
Rs. Close
Set rs = nothing

# T = shut down the database
Conn. Close
Set conn = nothing

# T ==================================
# T = servervariables related
# T = retrieve the previous page address
Request. servervariables ("http_referer ")

# T = get server name 1
Request. servervariables ("SERVER_NAME ")

# T = get the server name 2
Request. servervariables ("http_host ")

# T = Server IP address Retrieval
Request. servervariables ("local_addr ")

# T = obtain the user IP Address
Request. servervariables ("remote_host ")

# T = get the user's real IP1
Request. servervariables ("remote_addr ")

# T = function for retrieving users' real IP addresses
Function getrealip ()
Getrealip = request. servervariables ("http_x_forwarded_for ")
If (getrealip = "") Then getrealip = request. servervariables ("remote_addr ")
End Function

# T = obtain the server port
Request. servervariables ("server_port ")

# T = Server OS
Request. servervariables ("OS ")

# T = obtain the absolute path of the server
Request. servervariables ("appl_physical_path ")

# T = obtain the absolute path of this file 1
Requet. servervariables ("path_translated ")

# T = obtain the absolute path of this file 2
Server. mappath (request. servervariables ("script_name "))

# T = obtain the relative path of this file 1
Request. servervariables ("url ")

# T = get the relative path of this file 2
Request. servervariables ("script_name ")

# T = get the relative path of this file 3
Request. servervariables ("path_info ")

# T = parameters in the address bar
Request. servervariables ("QUERY_STRING ")

# T = retrieve Server System Information
Request. servervariables ("http_user_agent ")

# T = server component Detection
<%
Function isobjinstalled (strclassstring)
On Error resume next
Isobjinstalled = false
Err = 0
Dim xtestobj
Set xtestobj = server. Createobject (strclassstring)
If (0 = ERR) Then isobjinstalled = true
Set xtestobj = nothing
Err = 0
End Function
'If (isobjinstalled ("persits. Upload") = true) then
'Response. Write "supports the aspupload component"
'Else
'Response. Write "does not support the aspupload component"
'End if
%>

# T = obtain the client language environment
^! Request. servervariables ("http_accept_language ")

# T = obtain the client information: http_user_agent
^! Request. servervariables ("http_user_agent ")

# T = element value of form value
Request. Form ("^! ")

# T = get the value passed by the URL
Request. querystring ("^! ")

# T = obtain the complete URL
Function geturl ()
Geturl = "http: //" & request. servervariables ("server_n... servervariables (" url ")
If (request. servervariables ("QUERY_STRING") <> "") Then geturl = geturl &"? "& Request. servervariables (" QUERY_STRING ")
End Function

# T ==================================
# T = User-Defined Functions
# T = filter HTML characters
<%
'Filter HTML character functions'
Function htmlencode (STR)
If (STR <> "") then
STR = Replace (STR ,"&","&")
STR = Replace (STR, ">", "> ")
STR = Replace (STR, "<", "<")
STR = Replace (STR, CHR (32 ),"")
STR = Replace (STR, CHR (9 ),"")
STR = Replace (STR, CHR (34 ),""")
STR = Replace (STR, CHR (39 ),"'")
STR = Replace (STR, CHR (13 ),"")
STR = Replace (STR, CHR (10) & CHR (10), "</P> <p> ")
STR = Replace (STR, CHR (10), "<br> ")
STR = Replace (STR, CHR (255 ),"")
End if
Htmlencode = Str
End Function
%>

# T = check whether the previous page is submitted from this site
<%
'Check whether the previous page is submitted from this site
'Return Value: True, false
'================================================ ======================================
Function isselfrefer ()
Dim shttp_referer, sserver_name
Shttp_referer = CSTR (request. servervariables ("http_referer "))
Sserver_name = CSTR (request. servervariables ("SERVER_NAME "))
If (mid (shttp_referer, 8, Len (sserver_name) = sserver_name) then
Isselfrefer = true
Else
Isselfrefer = false
End if
End Function
%>

# T = clear all HTML tags
<%
'Clear HTML Markup
Function striphtml (htmlstr)
Dim RegEx
Set RegEx = new Regexp
RegEx. ignorecase = true
RegEx. Global = true
RegEx. pattern = "<. +?> "
Htmlstr = RegEx. Replace (htmlstr ,"")
Htmlstr = Replace (htmlstr, "<", "<")
Htmlstr = Replace (htmlstr, ">", "> ")
Htmlstr = Replace (htmlstr, CHR (10 ),"")
Htmlstr = Replace (htmlstr, CHR (13 ),"")
Striphtml = htmlstr
Set RegEx = nothing
End Function

%>

# T = String Length
<%
'Evaluate the string length Function
Function getlength (STR)
Dim 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
%>

# T = truncates a string of the specified length
<%
'Intercept a string of the specified length, and use... to replace it.
Function strleft (STR, strlen)
If (STR = "") then
Strleft = ""
Exit Function
End if
Dim L, T, C, I
STR = Replace (replace (STR, "", ""), ", CHR (34),"> ","> "), "<", "<")
L = Len (STR)
T = 0
For I = 1 to L
C = ABS (ASC (mid (STR, I, 1 )))
If (C & gt; 255) then
T = T + 2
Else
T = t + 1
End if
If (T> strlen) then
Strleft = left (STR, I )&"..."
Exit
Else
Strleft = Str
End if
Next
Strleft = Replace (replace (strleft, "", ""), CHR (34), "),"> ","> "), "<", "<")
End Function
%>

# T = obtain secure submission parameters
<%
'==================== ========================================================== ===< br> 'SQL injection check
' function: filter the single quotes in the character parameter and determine the numeric parameter. If it is not a numerical value, the value is 0
'. Meaning: STR ---- parameters to be filtered
'strtype ---- parameter type, which can be classified into numeric type and numeric type. The numeric type is "S ", number Type: "I"
'================================== =====================================< br> function checkstr (STR, strtype)
dim strtmp
strtmp = ""
If (strtype = "S") Then
strtmp = Replace (TRIM (STR ), "'", "'' ")
elseif (strtype =" I ") Then
If (isnumeric (STR) = false) then STR = false
strtmp = STR
else
strtmp = STR
end if
checkstr = strtmp
end function
%>

# T = bad character filtering (badword)
<%
'Badwords)
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
%>

# T = generate a random custom length Password
<%
'Generate a random custom length Password
Function makepassword (maxlen)
Dim strnewpass
Dim whatsnext, upper, lower, intcounter
Randomize
For intcounter = 1 to maxlen
Whatsnext = int (1-0 + 1) * RND + 0)
If (whatsnext = 0) then
'Character
Upper = 90
Lower = 65
Else
Upper = 57
Lower = 48
End if
Strnewpass = strnewpass & CHR (INT (upper-lower + 1) * RND + lower ))
Next
Makepassword = strnewpass
End Function
'Response. Write makepassword (8)
%>

# T = retain the format of inhtml when entering textarea
<%
'================ ========================================================== ===< br> 'remove HTML format,
'note: value = "? "Double quotation marks must be used here
'============================ =======================================< br> function inhtml (STR)
dim stemp
stemp = STR
inhtml = ""
If isnull (stemp) = true then
exit function
end if
stemp = Replace (stemp, "&", "&")
stemp = Replace (stemp, "
", CHR (13)
stemp = Replace (stemp, "<", "<")
stemp = Replace (stemp, ">", ">")
stemp = Replace (stemp, ", CHR (34 ))
inhtml = stemp
end function
%>

# T = regular table expression verification function
<%
'Regular table expression verification function patrn-Regular Expression strng-string to be verified
'================================================ ======================================
Function regexptest (patrn, strng)
Dim RegEx, retval 'to create a variable.
Set RegEx = new Regexp 'to create a regular expression.
RegEx. pattern = patrn 'setting mode.
RegEx. ignorecase = false' specifies whether to enable case sensitivity.
Retval = RegEx. Test (strng.
Regexptest = retval 'Return value. If it does not match, false is returned, and true is returned.
Set RegEx = nothing
End Function
%>

# T = generate a random string
<%
'Generate a random string
Function rndcode ()
Dim codeset, amountset
Codeset = "0123456789 abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz"
Amountset = 62 'text count
Randomize

Dim vcode (10), vcodes, I
For I = 0 to 9
Vcode (I) = int (RND * amountset)
Vcodes = vcodes & Mid (codeset, vcode (I) + 1, 1)
Next
Rndcode = vcodes
End Function
%>

# T ==================================
# T = FSO related operations
# T = determine whether a directory exists
<%
Function isfloderexist (strfoldername)
Set FSO = server. Createobject ("scripting. FileSystemObject ")
If (FSO. folderexists (strfoldername) then
Isfloderexist = true
Else
Isfloderexist = false
End if
Set FSO = nothing
End Function
%>

# T = create a directory
<%
Function createfolder (strfoldername)
Set FSO = server. Createobject ("scripting. FileSystemObject ")
If (FSO. folderexists (strfoldername) = false) then
FSO. createfolder (strfoldername)
End if
Set FSO = nothing
End Function
%>

# T = delete a directory
<%
Function deletefolder (strfoldername)
Set FSO = server. Createobject ("scripting. FileSystemObject ")
If (FSO. folderexists (strfoldername) then
FSO. deletefolder (strfoldername)
End if
Set FSO = nothing
End Function
%>

# T = determine whether a file exists
<%
Function isfileexist (strfilename)
Set FSO = server. Createobject ("scripting. FileSystemObject ")
If (FSO. fileexists (strfilename) then
Isfileexist = true
Else
Isfileexist = false
End if
Set FSO = nothing
End Function
%>

# T = delete an object
<%
Function deletefile (strfilename)
Set FSO = server. Createobject ("scripting. FileSystemObject ")
If (FSO. fileexists (strfilename) then
FSO. deletefile (strfilename)
End if
Set FSO = nothing
End Function
%>

# T ==================================
# T = several common functions of ASP thieves
<%
Function bytetostr (VIN)
Dim strreturn, I, thischarcode, innercode, hight8, low8, nextcharcode
Strreturn = ""
For I = 1 to lenb (VIN)
Thischarcode = ASCB (midb (Vin, I, 1 ))
If (thischarcode <& h80) then
Strreturn = strreturn & CHR (thischarcode)
Else
Nextcharcode = ASCB (midb (VIN, I + 1, 1 ))
Strreturn = strreturn & CHR (clng (thischarcode) * & h100 + CINT (nextcharcode ))
I = I + 1
End if
Next
Bytetostr = strreturn
End Function

Function gethttppagecontent (URL, method, sendstr)
Dim Retrieval
Set retrieval = server. Createobject ("Microsoft. XMLHTTP ")
With Retrieval
. Open method, URL, false ,"",""
. SetRequestHeader "Content-Type", "application/X-WWW-form-urlencoded"
. Send (sendstr)
Gethttppagecontent =. responsebody
End
Set retrieval = nothing
Gethttppagecontent = bytetostr (gethttppagecontent)
End Function

Function regexptext (strng, regstr)
Dim RegEx, match, matches, retstr
Set RegEx = new Regexp
RegEx. pattern = regstr
RegEx. ignorecase = true
RegEx. Global = true
Set matches = RegEx. Execute (strng)
For each match in matches
Retstr = retstr & RegEx. Replace (match. value, "$1 ")&","
Next
Regexptext = retstr
Set RegEx = nothing
End Function

Function streambytestobstr (strbody, codebase)
Dim objstream
Set objstream = server. Createobject ("ADODB. Stream ")
With objstream
. Type = 1
. Mode = 3
. Open
. Write strbody
. Position = 0
. Type = 2
. Charset = codebase
Streambytestobstr =. readtext
. Close
End
Set objstream = nothing
End Function
%>