Object-oriented ASP programming-server-side functions

<Script language = "VBScript" runat = "server">
'*************************************** *************************
'Script compont Object Model
'Design for Active Server Pages
'Copyright 2004 Version 2.0
'Made by Yin Shuguang
'All rights reserved.
'*************************************** *************************
'
'Common system functions
'
'*************************************** **************************

'System Public Information Display
'Strmsg: prompt message
'Msgtype: Message Type
'Jumpurl: the URL to which the page is redirected
'Strcopyright: copyright information
Function fshowmsg (strmsg, msgtype, jumpurl, strcopyright)
Response. Write "<style>" & CHR (13)
Response. write "body {margin: 0px 0px 0px; font-family: ' ', 'tahoma', 'Ms shell dlg'; color: #000000; Font: 9pt; background-color: # f0f1eb;} "& CHR (13)
Response. Write "A {Font: normal 12px; color: #336699; text-Decoration: None}" & CHR (13)
Response. Write "TD {font-family:; font-size: 12px; line-Height: 15px; Background-color: # f0f1eb;}" & CHR (13)
Response. Write ". thead {background-color: #336699; color: # ffffff; font-weight: bold;}" & CHR (13)
Response. Write ". tfoot {background-color: #336699; color: # ffffff;}" & CHR (13)
Response. Write "</style>" & CHR (13)

Response. Write "<Table Height = '000000' width = '000000'> <tr>" & CHR (13)
Response. write "<TD align = center> <Table align = center cellpadding = 0 cellspacing = 0 bordercolor = '#336699 'bgcolor =' #336699 'style = 'width: 90% '>"
Response. Write "<tr align = center>" & CHR (13)
Response. write "<TD width = '000000' Height = 20 colspan = 2 bgcolor = '# 000000' class = 'thead'> system prompt information </T>" & CHR (13)
Response. Write "<tr> <TD width = '000000' colspan = 2 align = 'center' bgcolor = '# ffff'> <br>" & CHR (13)
Response. Write strmsg
Select case CINT (msgtype)
Case 1
Response. Write "[<a href = 'javascript: window. Close (); '> close the window </a>]"
Case 2
Response. Write "[<a href = 'javascript: history. Back (-1); '> return </a>]"
Case 3
Response. Write "[<a href = 'javascript: history. Back (" & jumpurl & "); '> return </a>]"
Case 4
Response. Write "<meta HTTP-EQUIV = Refresh content = '3; url =" & jumpurl & "'>, redirecting ..."
Case 5
Response. Write "[<a href = '" & jumpurl & "'> return </a>]"

End select

Response. write "<br> </TD> </tr> <tr align = center> <TD width = '000000' Height = 20 colspan = 2 class = 'tfoot'> "& CHR (13)

Response. Write strcopyright

Response. Write "</TD> </tr> </table>" & CHR (13)

Response. End ()

End Function

'Check system errors
'Errmsg: error message
Function internal error (errmsg)
If err. Number> 0 then
Response. Write "<br>"
Response. Write errmsg
Response. End
End if
End Function

'Display system error message
Function fsystemerror ()
If err. Number> 0 then
Response. Write "<br>"
Response. Write "Error Source:" & err. Source & "<br>"
Response. Write "error code:" & err. Number & "<br>"
Response. Write "error Description:" & err. Description & "<br>"
Response. End
End if
End Function

'Determine whether it was submitted from Form
Function fispostback ()
If (ucase (TRIM (request. servervariables ("request_method") = "Post") then
Fispostback = true
Else
Fispostback = false
End if
End Function

Function fgetuserip ()
Fgetuserip = request. servervariables ("remote_addr ")
End Function
</SCRIPT>

 

 

<Script language = "VBScript" runat = "server">
'*************************************** *************************
'Script compont Object Model
'Design for Active Server Pages
'Copyright 2004 Version 2.0
'Made by Yin Shuguang
'All rights reserved.
'*************************************** *************************
'
'String processing functions
'
'*************************************** **************************

'Get a string with the ilen length, including letters and numbers.
Function frandomstr (ilen)
Dim C, strresult
Ilen = CINT (ilen)
For I = 1 to ilen
Randomize
C = int (74 * RND) + 48) 'C> 48 and C <122
While (C> 57 and C <65) or (C> 90 and C <97)
Randomize
C = int (74 * RND) + 48)
Wend
Strresult = strresult & CSTR (CHR (c ))
Next
Frandomstr = strresult
End Function
'The following two functions are used to check the ID card number
Function fcheckidcard2 (stridcard)
Dim iidcard, strtmp
Iidcard = Len (stridcard)
If (iidcard = NULL or (not (iidcard = 15 or iidcard = 18) then
Fcheckidcard2 = false
Exit Function
End if

If iidcard = 15 then
Strtmp = stridcard
Else
Strtmp = mid (stridcard, 1, 17)
End if

If isnumeric (strtmp) then
Fcheckidcard2 = true
Else
Fcheckidcard2 = false
Exit Function
End if

If iidcard = 18 then
Strtmp = mid (stridcard, 18, 1)
Strtmp = ucase (strtmp)
If not (isnumeric (strtmp) or strtmp = "X") then
Fcheckidcard2 = false
Exit Function
End if
End if
End Function

'Check the ID card number
'Parameter: Str: string to be checked
'Parameter 2: Year of birth (4 digits)
'Parameter 3: month of birth
'Parameter 4: Date of birth
Function fcheckidcard (byval stridcard, byval iyear, byval Imonth, byval iday)
Dim strbirthday, strtmp1

If not fcheckidcard2 (stridcard) then
Fcheckidcard = false
Exit Function
End if

If Len (iyear) <> 4 then
Fcheckidcard = false
Exit Function
End if
Strbirthday = CSTR (iyear) + String (2-len (CSTR (Imonth), "0") + CSTR (Imonth) + String (2-len (CSTR (iday )), "0") + CSTR (iday)

If Len (stridcard) = 15 then
Strtmp1 = mid (stridcard, 7,6)
Strbirthday = mid (strbirthday, 3, 6)
If strtmp1 <> strbirthday then
Fcheckidcard = false
Exit Function
End if
Else
Strtmp1 = mid (stridcard, 7,8)
If strtmp1 <> strbirthday then
Fcheckidcard = false
Exit Function
End if
End if
Fcheckidcard = true
End Function

'Check zip code
Function fcheckpostcode (byval strcode)
If (LEN (TRIM (strcode) <> 6) then
Fcheckpostcode = false
Exit Function
Else
Fcheckpostcode = isnumeric (strcode)
Exit Function
End if
End Function
'----------------- Reversible Encryption ----------------------------------------------
Function encrypt (byval ecode)
Dim texts
Dim I
For I = 1 to Len (ecode)
Texts = texts & CHR (ASC (mid (ecode, I, 1) + I)
Next
Encrypt = texts
End Function

Function decrypt (byval dcode)
Dim texts
Dim I
For I = 1 to Len (dcode)
Texts = texts & CHR (ASC (mid (dcode, I, 1)-I)
Next
Decrypt = texts
End Function
'---------------- Irreversible encryption ---------------------------------------------------
Function mistake (byval prestring)
Dim texts
Dim Seed
Dim I, Length
Prestring = trim (prestring)
Length = Len (prestring)
Seed = Length
Randomize (length)
Texts = ""
For I = 1 to length
Seed = int (94 * RND (-ASC (mid (prestring, I, 1)-seed * ASC (right (prestring, 1) + 32)
Texts = texts & CHR (SEED) & CHR (INT (94 * RND (-seed) + 32 ))
Next
Dim Dist
Dist = ""
For I = 1 to Len (texts)
If mid (texts, I, 1) <> "'" Then
Dist = DIST + mid (texts, I, 1)
End if
Next
Mistake = DIST
End Function

</SCRIPT>

 

 

 

 

<Script language = JavaScript runat = Server>
//************************************** **********************************
// Script compont Object Model
// Design for Active Server Pages
//
// Copyright 2003 version 1.0
// Made by Yin Shuguang
//************************************** **********************************

Function getarrayorder (amain, STR) {// array. Given its value, calculate its subscript in the array.
// Amain is an array and STR is the content in the array
VaR imain =-1
If (amain. Length = 0) | (Str. Length = 0 )){
Return imain
}
For (VAR I = 0; I <amain. length; I ++ ){
If (amain [I] = Str ){
Imain = I
Break;
}
}
Return imain
}

Function getarrayorders (amain, STR) {// array. Given its value, calculate its subscript in the array.
// This function returns to the tree group, which is listed in sequence and has subscript values in the array.
// Amain is an array and STR is the content in the array
Thisresult = new array
Thisresult [0] =-1
If (amain. Length = 0) | (Str. Length = 0 )){
Return thisresult
}
VaR J = 0;
For (VAR I = 0; I <amain. length; I ++ ){
If (amain [I] = Str ){
Thisresult [J ++] = I
}
}
Return thisresult
}
</SCRIPT>

 

 

 

 

 

 

 

<Script language = JScript runat = Server>
//************************************** **********************************
// Script compont Object Model
// Design for Active Server Pages
//
// Copyright 2003 version 1.0
// Made by Yin Shuguang
//************************************** **********************************
Function saverstotxtfile (RS, filename)
{
// Save the recordset content to an absolute path of the RS dataset and filename file in a TXT file.
VaR FS = server. Createobject ("scripting. FileSystemObject ")

If (FS. fileexists (filename ))
FS. deletefile (filename)

VaR txtfile = FS. createtextfile (filename)

VaR strline = ""

// Write field name
VaR nfields = Rs. Fields. count;

For (VAR I = 0; I <nfields; I ++)
Strline + = RS (I). Name + "/t"
 
Txtfile. writeline (strline)

// Write content
While (! Rs. EOF ){
Strline = ""
For (VAR I = 0; I <nfields; I ++)
Strline + = RS (I). Value + "/t"
 
Txtfile. writeline (strline)

Rs. movenext ()
}
Txtfile = NULL
FS = NULL
}

</SCRIPT>