Common functions in ASP development

<%
' Whether it is secure access
function Isselfrefer ()
Server_v1=lcase (Request.ServerVariables ("Http_referer"))
Server_v2=lcase (Request.ServerVariables ("SERVER_NAME"))
If InStr (SERVER_V1,SERVER_V2) <1 Then
Isselfrefer = False ' is not
Else
Isselfrefer = True ' is
End If
End Function

' Page error
Private Sub Page_err (msg)
Response.Write (msg)
Response.End ()
End Sub

' Format date
function FormatDate (sdate,ssplit)
y = CStr (year (sdate))
m = CStr (month (sdate))
If Len (m) =1 then M = "0" & M
D = CStr (Day (sdate))
If Len (d) =1 then D = "0" & D
FormatDate = y & ssplit & M & Ssplit & D
End Function

function Mycdbl (str)
If str = "" or not IsNumeric (str) Then
Call Page_err ("parameter error: requirement is a numeric type.") ")
Else
MYCDBL = CDbl (str)
End If
End Function

function GetNumber (str)
If str = "" or not IsNumeric (str) Then
Call Page_err ("parameter error: requirement is a numeric type.") ")
Else
GetNumber = str
End If
End Function

Private Sub MessageBox (Msg,gotourl)
Response.Write ("<script language=" "Web Effects" ">")
Response.Write ("Alert (" "" & Msg & ""); ")
If Gotourl= "" Then
Response.Write ("History.back ();")
Else
Response.Write ("Document.url= '" & Gotourl & "';")
End If
Response.Write ("</script>")
Response.End ()
End Sub

Custom left
function Leftx (str,n)
 dim i,j,ch,strtmp
 j = 0
 strtmp = ""
 for i = 1 to Len (str)
  ch = Mid (str,i,1)
  strtmp = strtmp & CH
  if ASC (CH) <0 T Hen
   j = j + 2
   else
    j = j + 1
  end I F
  if J >= N then exit for
 next
 leftx = strtmp
End Function

Output string
function outstr (str)
  STRER=STR
  If strer= "" or IsNull (strer) then
  &nbs P Outstr= "": Exit Function
  End If
  Strer=replace (Strer, "<", "&lt;")
  Strer=replace (strer, ">", "&gt;")
  Strer=replace (STRER,CHR & Chr (a), "<br>")     ' linefeed
  Strer=replace ( STRER,CHR (+), "&nbsp;")     ' Space
  Strer=replace (STRER,CHR (9), "&nbsp;")     ' table
  strer=replace (STRER,CHR, "& #39;")     ' single quotation mark
  Strer=replace (STRER,CHR), "&quot;"     ' double quotes
  OUTSTR = Strer
End Function

Filter HTML tags
function filterhtml (fstring)
    if IsNull (fstring) or trim (fstring) = "Then
& nbsp;       filterhtml= ""
        exit function
    End If
    set  re = new  regexp
    re.i Gnorecase=true
    re.global=true
    re.pattern= "< (. +?) > "
    fstring = Re.replace (fstring," ")
    set   re=nothing
& nbsp;filterhtml = fstring
End Function

' Execute SQL, return a row of values
function Execsqlreturnonevalue (SQL)
Set Oprs = Server.CreateObject ("Adodb.recordset")
Oprs.open sql,conn,0,1
If oprs.eof and Oprs.bof then
Execsqlreturnonevalue = ""
Else
Execsqlreturnonevalue = Oprs (0)
End If
Oprs.close
Set Oprs = Nothing
End Function

' Format date
function Format_time (S_time,n_flag)
Dim y, M, D, H, MI, s
Format_time = ""
If IsDate (s_time) = False Then Exit function
y = CStr (year (s_time))
m = CStr (month (s_time))
If Len (m) = 1 Then m = "0" & M
D = CStr (Day (s_time))
If Len (d) = 1 then D = "0" & D
h = CStr (Hour (s_time))
If Len (h) = 1 Then H = "0" & H
Mi = CStr (Minute (s_time))
If Len (mi) = 1 then mi = "0" & mi
s = CStr (second (s_time))
If Len (s) = 1 then s = "0" & S
Select Case N_flag
Case 1
' Yyyy-mm-dd Hh:mm:ss
Format_time = y & "-" & M & "-" & D & "" & H & ":" & Mi & ":" & S
Case 2
' Yyyy-mm-dd
Format_time = y & "-" & M & "-" & D
Case 3
' Hh:mm:ss
Format_time = h & ":" & Mi & ":" & S
Case 4
' YYYY year mm month DD Day
Format_time = y & "Year" & M & "Month" & D & "Day"
Case 5
' YYYYMMDD
Format_time = y & M & D
End Select
End Function

function Cmdsafelikesqlstr (str)
str = replace (str, "'", "" ")
str = replace (str, [], [[]]
str = replace (str, "%", "[%]")
str = replace (str, "_", "[_]")
CMDSAFELIKESQLSTR = str
End Function

function Replacetest (STR,PATRN, REPLSTR)
Dim regex, Str1
STR1 = str
Set regex = new RegExp
Regex.pattern = patrn
Regex.ignorecase = True
Regex.global=true
Replacetest = Regex.Replace (str1, REPLSTR)
End Function

function Getpageurlpath ()
server_name = Request.ServerVariables ("SERVER_NAME")
Server_port = Request.ServerVariables ("Server_port")
Path_info = Request.ServerVariables ("Path_info")
Path_tmp = Split (Path_info, "/")
Path_info = replace (path_info,path_tmp (UBound (path_tmp)), "")
url = "http://" & server_name
If server_port<>80 then url = URL & ":" & Server_port
url = URL & path_info
Getpageurlpath = URL
End Function

function Getadsense (ID)
Sql= "Select code from Ok3w_adsense where id=" & ID
Set ors = Conn.execute (SQL)
If ors.eof and Ors.bof then
Getadsense = "Ad does not exist, id=" & ID
Else
Getadsense = ORS ("code")
End If
Ors.close
Set ors = Nothing
End Function

' Channel name
function Getchannelname (channelid)
If channelid= "" Then
Getchannelname = "--------"
Exit function
End If
sql = "Select ChannelName from Ok3w_channel where channelid=" & Channelid
Getchannelname = execsqlreturnonevalue (SQL)
End Function

' Column name
function GetClassName (CLASSID)
If classid= "0" Then
GetClassName = "--------"
Exit function
End If
sql = "Select Sortname from Ok3w_class where id=" & ClassID
GetClassName = execsqlreturnonevalue (SQL)
End Function

function Getcommentscount (Typeid,tableid)
Sql= "SELECT count (id) from ok3w_guest where Ispass=1 and typeid=" & typeID & "and tableid=" & TableID
Getcommentscount = execsqlreturnonevalue (SQL)
End Function

' Category ID drop-down list Selection menu
Private Sub Initclassselectoption (Channelid,parentid,chkid)
Dim Oprs,ctmp,clen,ccount
Set Oprs = Server.CreateObject ("Adodb.recordset")
sql = "Select Id,sortname,sortpath from Ok3w_class where channelid=" & Channelid & "and parentid=" & ParentID & "ORDER BY OrderID"
Oprs.open sql,conn,0,1
Do as not oprs.eof
Response.Write ("<option value=" "" & Oprs ("id") & "" "
If Chkid = OPRS ("id") Then Response.Write ("selected=" "Selected" "")
Response.Write (">")
Ctmp = Split (Oprs ("Sortpath"), ",")
Clen = UBound (ctmp)-2
For Ccount=1 to Clen
Response.Write ("│&nbsp;")
Next
Response.Write ("├" & Oprs ("Sortname") & "</option>")

Call Initclassselectoption (CHANNELID,OPRS ("id"), chkid)
Oprs.movenext
Loop
Oprs.close
Set Oprs = Nothing
End Sub

Private Sub Outthispagecontent (Aid,content,pagepath)
Thispage = Request.QueryString ("Thispage")
If thispage<> "" Then Thispage = Mycdbl (thispage)
If thispage= "" then thispage=1
Thispage = CInt (thispage)
content_tmp = Split (Content, "[Ok3w_nextpage]")
Page_count = UBound (content_tmp) +1
If thispage> page_count then Thispage = Page_count

Response.Write (Replacetest (Content_tmp (thispage-1), "
If Page_count>1 Then
Response.Write ("<div class=" "Thispagenav" ">")
For ipage=1 to Page_count
If IPage = 1 Then
url = "? id=" & Aid
Else
url = "? id=" & Aid & "&thispage=" & IPage
End If
If IPage = Thispage Then
Response.Write ("<a href=" "" & URL & "" ><strong> "& ipage &" Page </strong></a> ")
Else
Response.Write ("<a href=" "" & URL & "" > "& ipage &" Page </a> ")
End If
Next
Response.Write ("</div>")
End If
End Sub
%>