Sorted out a EditPlus clip file (ASP content) _asp basics

Common syntax and functions of #TITLE =asp
#INFO
Some common syntax and custom functions of ASP
#SORT =n

#T = ===asp commonly used grammar = = =
#T =============================
#T = Database Related
#T = Connect to an Access database
<%
Dim Dbname,conn
DBName "^!" Define 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 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 login account; pwd= database password; database= database name "
%>

#T = set up a recordset
SET ^!=server.createobject ("Adodb.recordset")

#T = Execute SQL command
Rs. Open sql,conn,1,1

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

#T = rs Execute SQL command directly
SET RS = Conn.execute ("^!")

#T = Close a recordset
Rs. Close
SET rs=nothing

#T = Close Database
Conn.close
SET conn=nothing

#T =============================
#T =servervariables Related
#T = Take a previous page address
Request.ServerVariables ("Http_referer")

#T = fetch name of server 1
Request.ServerVariables ("SERVER_NAME")

#T = fetch name of server 2
Request.ServerVariables ("Http_host")

#T = Fetch server IP
Request.ServerVariables ("Local_addr")

#T = Fetch User IP
Request.ServerVariables ("Remote_host")

#T = Take user real IP1
Request.ServerVariables ("REMOTE_ADDR")

#T = Take user real IP function
Function Getrealip ()
Getrealip = Request.ServerVariables ("Http_x_forwarded_for")
IF (Getrealip = "") THEN Getrealip = Request.ServerVariables ("REMOTE_ADDR")
End Function

#T = Fetch Server port
Request.ServerVariables ("Server_port")

#T = Fetch server operating system
Request.ServerVariables ("OS")

#T = absolute path to fetch server
Request.ServerVariables ("Appl_physical_path")

#T = absolute path to take this file 1
Requet.servervariables ("path_translated")

#T = absolute path to take this file 2
Server.MapPath (Request.ServerVariables ("Script_name"))

#T = Take the relative path of this file 1
Request.ServerVariables ("URL")

#T = Take the relative path of this file 2
Request.ServerVariables ("Script_name")

#T = Take the relative path of this file 3
Request.ServerVariables ("Path_info")

#T = parameter after the address bar is taken
Request.ServerVariables ("Query_string")

#T = Fetch 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 Support AspUpload components '
' ELSE
' Response.Write ' does not support aspupload components '
' End IF
%>

#T = Take Client language environment
^! Request.ServerVariables ("Http_accept_language")

#T = Fetch Client Information: http_user_agent
^! Request.ServerVariables ("Http_user_agent")

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

#T = value passed by URL
Request.QueryString ("^!")

#T = take full URL address
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 = Custom Function
#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 (a) & Chr (a), "</P><P>")
str = Replace (str, CHR (Ten), "<BR>")
str = Replace (str, CHR (255), "")
End IF
HTMLEncode = str
End Function
%>

#T = detect whether the previous page is submitted from this site
<%
' detect if the page is submitted
' return: 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 tags
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 = Take string length
<%
' Ask for 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 = intercept the specified length string
<%
' Intercept specified length of string, superfluous ... Replace
Function Strleft (Str,strlen)
IF (str = "") THEN
Strleft = ""
Exit Function
End IF
Dim L,t,c,i
str = replace (replace (replace (str, "", ""), "", Chr (), ">", ">"), "<", "<")
L=len (str)
T=0
For I=1 to L
C=abs (ASC (str,i,1))
IF (c>255) THEN
T=t+2
ELSE
T=t+1
End IF
IF (T>strlen) THEN
Strleft = Left (str,i) & "..."
Exit for
ELSE
Strleft = str
End IF
Next
Strleft = replace (replace (replace (Strleft, "", "), Chr (+)," ""), ">", ">"), "<", "<")
End Function
%>

#T = Get Secure commit parameter
<%
' ===============================================================
' SQL injection Check
Function: Filter single quotes in character arguments, and for numeric arguments, if not numeric types, assign 0
' parameter meaning: str----parameters to filter
' strtype---- parameter types, divided into character and number type, character "s", and numeric "I"
' ===============================================================
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 = filter Bad characters (BadWord)
<%
' Filter bad characters (badwords)
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
%>

#T = Generate a random custom length password
<%
' Generate randomly custom length passwords
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 = Keep formatting when filling textarea inhtml
<%
' ================================================ ===============
' Remove HTML format for fetching values from the database when filling in the input box
' NOTE: value= '? This way, be sure to use double quotes
' ===============================================================
Function inhtml (str)
      Dim stemp
     stemp = str
     inhtml = ""
      If IsNull (stemp) = True Then
        Exit Function
      End If
     stemp = Replace (Stemp, "&", "&")
   & nbsp Stemp = replace (stemp, "<br>", CHR)
     stemp = replace (stemp, "<", "<")
     stemp = replace (stemp, ">", ">")
     stemp = replace (stemp, "" ", CHR
     inhtml = stemp
End Function
%>

#T = Regular table expression validation function
<%
' Regular table expression validation function patrn-Regular expression strng-a string to be validated
'===============================================================
Function regexptest (PATRN, STRNG)
Dim regEx, RetVal ' Set variable.
Set regEx = New RegExp ' establishes a regular expression.
Regex.pattern = Patrn ' Set mode.
Regex.ignorecase = False ' Sets whether case sensitive.
RetVal = regex.test (strng) ' performs a search test.
Regexptest = RetVal ' return value, return FALSE if not compliant, true
SET regEx = Nothing
End Function
%>

#T = Generate a random string
<%
' Generate random strings
Function Rndcode ()
Dim Codeset,amountset
CodeSet = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNOPQRSTUVWXYZ"
Amountset = 62 ' text quantity
Randomize

Dim Vcode (Ten), 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 = To 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 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 if 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 File
<%
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 functions commonly used by 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 with
    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
& nbsp;   Regex.global = True
    SET matches = Regex.execute (strng)
    For the Match in matches
        retstr = retstr & Regex.Replace (match.value , "$" & ","
    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 With
SET objstream = Nothing
end Function
%>