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

'*************************************** ***********
'Function ID: 0020 [Create a msaccess database]
'Function name: crdb_msaccess
'Usage: Create a msaccess Database
'Parameter: dbpath ---- target directory information
'Parameter: dbfilename ---- name of the target Library File
'Parameter: dbupwd ---- password used to open the target database
'Return value: true if creation is successful, otherwise false
'*************************************** ***********
Public Function crdb_msaccess (byval dbpath, byval dbfilename, byval dbupwd)
Crdb_msaccess = false
On Error goto 0
On Error resume next
Dim fxztxt, fu_fu_db_str, fu_db_str
Fxztxt = CHR (60) & "% response. End () %" & CHR (62)
If right (dbpath, 1) <> "\" then dbpath = dbpath &"\"
Fu_fu_db_str = "provider = Microsoft. Jet. oledb.4.0; Data Source =" & dbpath & "Temp. mdb ;"
Fu_db_str = "provider = Microsoft. Jet. oledb.4.0; Data Source =" & dbpath & dbfilename & "; Jet oledb: Database Password =" & dbupwd &";"
Set fu_ca = server. Createobject ("ADOX. catalog ")
Fu_ca.create fu_fu_db_str
Set fu_ca = nothing
Set fu_je = server. Createobject ("jro. jetengine ")
Fu_je.compactdatabase fu_fu_db_str, fu_db_str
Set fu_fso = Createobject ("scripting. FileSystemObject ")
Fu_fso.deletefile (dbpath & "Temp. mdb ")
Set fu_je = nothing
Set fu_fso = nothing
Set fu_conn = server. Createobject ("ADODB. Connection ")
Set fu_rs = server. Createobject ("ADODB. recordset ")
Fu_conn.open fu_db_str
Fu_ SQL _str = "CREATE TABLE [0] ([0] Text default notxt not null, [11] int identity (1, 1) not null primary key )"
Fu_conn.execute (fu_ SQL _str)
Fu_ SQL _str = "select * from [0]"
Fu_rs.open fu_ SQL _str, fu_conn, 1, 3
Fu_rs.addnew
Fu_rs ("0") = fxztxt
Fu_rs.update
Fu_rs.close
Fu_conn.close
Set fu_rs = nothing
Set fu_conn = nothing
If err. Number = 0 then
Crdb_msaccess = true
End if
On Error goto 0
End Function
'*************************************** ***********
'Function ID: 0021 [Create a MSSQLServer database]
'Function name: crdb_mssqlserver
'Usage: Create a MSSQLServer Database
'Parameter: dbip ---- IP address of the database or host name
'Parameter: dbsamc ---- name of the database supermanager user
'Parameter: dbsapwd ---- password of the database administrator
'Parameter: dbname ---- name of the new database
'Parameter: dbupmc ---- name of the user to which the new database belongs
'Parameter: dbupwd ---- user password of the newly created database
'Return value: true if creation is successful, otherwise false
'*************************************** ***********
Public Function crdb_mssqlserver (byval dbip, byval dbsamc, byval dbsapwd, byval dbname, byval dbupmc, byval dbupwd)
Crdb_mssqlserver = false
On Error goto 0
On Error resume next
Dim fu_sa_str, fu_ua_str, fu_conn, fu_rs, fu_ SQL _str, fxztxt
Fxztxt = CHR (60) & "% response. End () %" & CHR (62)
Fu_sa_str = "driver = SQL Server; uid =" & dbsamc & "; database = Master; server =" & dbip & "; Pwd =" & dbsapwd &";"
Fu_ua_str = "driver = SQL Server; uid =" & dbupmc & "; database =" & dbname & "; server =" & dbip & "; Pwd =" & dbupwd &";"
Set fu_conn = server. Createobject ("ADODB. Connection ")
Fu_conn.open fu_sa_str
Fu_conn.execute "create database" & dbname
Fu_conn.close
Fu_db_conn_str = "driver = SQL Server; uid =" & dbsamc & "; database =" & dbname & "; server =" & dbip & "; Pwd =" & dbsapwd &";"
Fu_conn.open fu_db_conn_str
Fu_ SQL _str = "Exec sp_addlogin '" & dbupmc & "', '" & dbupwd & "', '" & dbname &"'"
Fu_conn.execute fu_ SQL _str
Fu_ SQL _str = "Exec sp_grantdbaccess" & dbupmc &"'"
Fu_conn.execute fu_ SQL _str
Fu_ SQL _str = "Exec sp_addrolemember 'db _ owner', '" & dbupmc &"'"
Fu_conn.execute fu_ SQL _str
Fu_ SQL _str = "Exec sp_defaultdb" & dbupmc & "," & dbname
Fu_conn.execute fu_ SQL _str
Fu_conn.close
Fu_conn.open fu_ua_str
Fu_ SQL _str = "CREATE TABLE [0] ([0] Text default ('notxt ') not null, [11] int identity (1, 1) not null primary key )"
Fu_conn.execute fu_ SQL _str
Set fu_rs = server. Createobject ("ADODB. recordset ")
Fu_ SQL _str = "select * from [0]"
Fu_rs.open fu_ SQL _str, fu_conn, 1, 3
Fu_rs.addnew
Fu_rs ("0") = fxztxt
Fu_rs.update
Fu_rs.close
Fu_conn.close
Set fu_rs = nothing
Set fu_conn = nothing
If err. Number = 0 then
Crdb_mssqlserver = true
End if
On Error goto 0
End Function
'*************************************** ***********
'Function ID: 0022 [send via jmail]
'Function name: msmail
'For use: Send mail via jmail
'Parameter: Subject-mail title
'Parameter: mailaddress ---- email server address
'Parameter: sendername ---- sender name
'Parameter: email ---- recipient E-MAIL address
'Parameter: Content ---- mail content
'Parameter: Fromer ---- sender E-MAIL address
'Parameter: seremailuser ---- email server permission Username
'Parameter: seremailpass ---- email server permission User Password
'Return value: true if the message is sent successfully; otherwise, false is returned.
'Example: msmail ("test", "smtp.163.com", "mzy", "mzymcm@yahoo.com.cn", "test", "mzymcm@163.com", "mzymcm", "abcmzy1029abc ")
'*************************************** ***********
Public Function msmail (byval subject, byval mailaddress, byval sendername, byval email, byval content, byval Fromer, byval seremailuser, byval seremailpass)
Dim jmailmsg
Msmail = false
Set jmailmsg = server. Createobject ("jmail. Message ")
Jmailmsg. mailserverusername = seremailuser
Jmailmsg. mailserverpassword = seremailpass
Jmailmsg. addrecipient email
Jmailmsg. From = Fromer
Jmailmsg. fromname = sendername
Jmailmsg. charset = "gb2312"
Jmailmsg. Logging = true
Jmailmsg. Silent = true
Jmailmsg. Subject = subject
Jmailmsg. Body = server. htmlencode (content)
Jmailmsg.html body = content
If not jmailmsg. Send (mailaddress) then
Msmail = false
Else
Msmail = true
End if
Jmailmsg. Close
Set jmailmsg = nothing
End Function
'*************************************** ***********
'Function ID: 0023 [test whether the component is installed]
'Function name: isobjinstalled
'Use: test whether the component is installed
'Parameter: strclassstring ---- component name or ID string
'Return value: true if the test is successful, or false if the test is successful.
'Example: isobjinstalled ("jmail. Message ")
'*************************************** ***********
Public Function isobjinstalled (byval 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
'*************************************** ***********
'Function name: getobjver
'Usage: return component version information
'Parameter: strclassstring ---- component name or ID string
'Return value: returns the component version string.
'Example: getobjver ("jmail. Message ")
'*************************************** ***********
Public Function getobjver (byval strclassstring)
On Error resume next
Getobjver = ""
Err = 0
Dim xtestobj
Set xtestobj = server. Createobject (strclassstring)
If 0 = err then getobjver = xtestobj. Version
Set xtestobj = nothing
Err = 0
End Function
'*************************************** ***********