ASP function library (all functions can be called directly, which is very convenient) 1

'*************************************** ***********''''
'Function ID: 0001 [String truncation]
'Function name: substzfc
'Usage: String truncation. One Chinese character is counted as two characters, and one English character is counted as one character.
'Parameter: Str ---- original string
'Strlen ---- truncation Length
'Return value: the intercepted string
'*************************************** ***********
Public Function substzfc (byval STR, byval strlen)
If STR = "" then
Substzfc = ""
Exit Function
End if
Dim L, T, C, I, strtemp
STR = Replace (replace (STR, "& nbsp;", ""), "& quot;", CHR (34), "& gt ;", ">"), "& lt;", "<")
L = Len (STR)
T = 0
Strtemp = Str
Strlen = clng (strlen)
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
Strtemp = left (STR, I)
Exit
End if
Next
Substzfc = Replace (replace (strtemp, "", "& nbsp;"), CHR (34), "& quot;"), "> ", "& gt;"), "<", "& lt ;")
End Function
'*************************************** ***********
'Function ID: 0002 [filter HTML]
'Function name: glhtml
'Use: filter HTML elements
'Parameter: Str ---- to filter characters
'Return value: No HTML characters
'*************************************** ***********
Public Function glhtml (byval Str)
If isnull (STR) or trim (STR) = "" then
Glhtml = ""
Exit Function
End if
Dim re
Set Re = new Regexp
Re. ignorecase = true
Re. Global = true
Re. pattern = "(\ <. [^ \ <] * \> )"
STR = Re. Replace (STR ,"")
Re. pattern = "(\ <\/[^ \ <] * \> )"
STR = Re. Replace (STR ,"")
Set Re = nothing
STR = Replace (STR ,"'","")
STR = Replace (STR, CHR (34 ),"")
Glhtml = Str
End Function
'*************************************** ***********
'Function ID: 0003 [open any data table and display the table structure and content]
'Function name: opotherdb
'Usage: open any data table and display the table structure and content
'Parameter: dbthestr ---- database link string to open the table
'Parameter: opentdname ---- name of the table to be opened
'Return value: displays the table structure and content.
'*************************************** ***********
Public Function opotherdb (byval dbthestr, byval opentdname)
Response. Write "<Table border = '0' width = '000000' cellspacing = '0' cellpadding = '0'>" & vbcrlf
Set opdb_conn = server. Createobject ("ADODB. Connection ")
Set opdb_rs = server. Createobject ("ADODB. recordset ")
Opdb_conn.open dbthestr
Opdb_ SQL _str = "select * from" & opentdname
Opdb_rs.open opdb_ SQL _str, opdb_conn, 1, 1
Nfieldnumber = opdb_rs.fields.count
If nfieldnumber> 0 then
Response. Write "<tr>" & vbcrlf
For I = 0 to (Nfieldnumber-1)
Response. Write "<TD style = 'border-style: Ridge; border-width: 1 'bgcolor = '# e1e1e1 'valign = 'middle' align = 'center'>"
Response. Write trim (opdb_rs.fields (I). Name)
Response. Write "</TD>" & vbcrlf
Next
Temptraumatic brain = 0
Do while not opdb_rs.eof
Response. Write "</tr>" & vbcrlf
For I = 0 to (Nfieldnumber-1)
If (temptrauma <2) then
Response. Write "<TD style = 'border-style: Ridge; border-width: 1 'bgcolor = '# f6f6f6' valign = 'middle'>"
Response. Write trim (opdb_rs.fields (I ))
Response. Write "</TD>" & vbcrlf
Temptraumatic brain = temptraumatic brain + 1
Else
Response. Write "<TD style = 'border-style: Ridge; border-width: 1 'valign = 'middle'>"
Response. Write trim (opdb_rs.fields (I ))
Response. Write "</TD>" & vbcrlf
If temptrauma> = 3 then
Temptraumatic brain = 0
Else
Temptraumatic brain = temptraumatic brain + 1
End if
End if
Next
Opdb_rs.movenext
Response. Write "</tr>" & vbcrlf
Loop
End if
Opdb_rs.close
Opdb_conn.close
Set opdb_rs = nothing
Set opdb_conn = nothing
Response. Write "</table>" & vbcrlf
End Function
'*************************************** ***********
'Function ID: 0004 [read two paths]
'Function name: readsyspath
'Usage: Read path
'Parameter: lx ---- 0: Server IP address plus Path 1: physical service path
'Return value: path string
'*************************************** ***********
Public Function readsyspath (byval lx)
Dim templj, arytemp, newpath
Templj = ""
Newpath = ""
If Lx = 0 then
Templj = "http: //" & request ("SERVER_NAME") & request ("path_info ")
Arytemp = Split (templj ,"/")
Else
Templj = request ("path_translated ")
Arytemp = Split (templj ,"\")
End if
For I = lbound (arytemp) to ubound (arytemp)-1
If Lx = 0 then
Newpath = newpath & arytemp (I )&"/"
Else
Newpath = newpath & arytemp (I )&"\"
End if
Next
Readsyspath = newpath
End Function
'*************************************** ***********
'Function ID: 0005 [test whether a file exists]
'Function name: checkfile
'For use: test whether a file exists
'Parameter: ckfilename ---- name of the tested file (including the path)
'Return value: true if the object exists; otherwise, false
'*************************************** ***********
Public Function checkfile (byval ckfilename)
Dim m_fso
Checkfile = false
Set m_fso = Createobject ("scripting. FileSystemObject ")
If m_fso.fileexists (ckfilename) then
Checkfile = true
End if
Set m_fso = nothing
End Function
'*************************************** ***********
'Function ID: 0006 [delete an object]
'Function name: delfile
'Usage: delete an object
'Parameter: dfilename ---- name of the deleted file (including the path)
'Return value: true if the object is deleted; otherwise, false.
'*************************************** ***********
Public Function delfile (byval dfilename)
Dim m_fso
Delfile = false
Set m_fso = Createobject ("scripting. FileSystemObject ")
If m_fso.fileexists (dfilename) then
M_fso.deletefile (dfilename)
Delfile = true
End if
Set m_fso = nothing
End Function
'*************************************** ***********
'Function ID: 0007 [determine whether a directory exists]
'Function name: checkdir
'Usage: Determine whether a directory exists
'Parameter: ckdirname ---- directory name (including path)
'Return value: If a directory exists, true is returned; otherwise, false is returned.
'*************************************** ***********
Public Function checkdir (byval ckdirname)
Dim m_fso
Checkdir = false
Set m_fso = Createobject ("scripting. FileSystemObject ")
If (m_fso.folderexists (ckdirname) then
Checkdir = true
End if
Set m_fso = nothing
End Function
'*************************************** ***********
'Function ID: 0008 [create a directory]
'Function name: createdir
'Usage: create a directory
'Parameter: crdirname ---- directory name (including path)
'Return value: "true" is returned if the directory is successfully created; otherwise, "false" is returned.
'*************************************** ***********
Public Function createdir (byval crdirname)
Dim m_fso
Createdir = false
Set m_fso = Createobject ("scripting. FileSystemObject ")
If (m_fso.folderexists (crdirname) then
Createdir = false
Else
M_fso.createfolder (crdirname)
Createdir = true
End if
Set m_fso = nothing
End Function
'*************************************** ***********