ASP函數庫(全部可以直接調用，非常方便) 3

'**************************************************
'函數ID：0020[建立MsAccess資料庫]
'函數名：CrDb_MsAccess
'作 用：建立MsAccess資料庫
'參 數：DbPath ---- 目標目錄資訊
'參 數：DbFileName ---- 目標庫檔案名稱
'參 數：DbUpwd ---- 目標庫開啟密碼
'傳回值：建立成功返回 True 否則 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
'**************************************************
'函數ID：0021[建立MsSQLServer資料庫]
'函數名：CrDb_MsSQLServer
'作 用：建立MsSQLServer資料庫
'參 數：DbIp ---- 資料庫所在IP或主機名稱
'參 數：DbSamc ---- 資料庫超管使用者名稱稱
'參 數：DbSapwd---- 資料庫超管使用者口令
'參 數：DbName ---- 建立資料庫名稱
'參 數：DbUpmc ---- 建立資料庫所屬使用者名稱稱
'參 數：DbUpwd ---- 建立資料庫所屬使用者密碼
'傳回值：建立成功返回 True 否則 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
'**************************************************
'函數ID：0022[通過JMAIL發信]
'函數名：MSMail
'作 用：通過JMAIL發信
'參 數：subject ---- 郵件的標題
'參 數：mailaddress ---- 郵件伺服器地址
'參 數：senderName ---- 寄件者名稱
'參 數：email ---- 收件者E-MAIL地址
'參 數：content ---- 郵件內容
'參 數：fromer ---- 寄件者E-MAIL地址
'參 數：serEmailUser ---- 郵件伺服器許可權使用者名稱
'參 數：serEmailPass ---- 郵件伺服器許可權使用者密碼
'傳回值：發送成功返回 True 否則 False
'示 例：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.htmlbody=content
if not JmailMsg.send(mailaddress) then
MSMail=False
else
MSMail=True
end if
JmailMsg.close
set JmailMsg=nothing
End function
'**************************************************
'函數ID：0023[測試組件是否安裝]
'函數名：IsObjInstalled
'作 用：測試組件是否安裝
'參 數：strClassString ---- 組件名稱或標識字串
'傳回值：測試成功返回 True 否則 False
'示 例：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
'**************************************************
'函數名：GetObjVer
'作 用：返回組件版本資訊
'參 數：strClassString ---- 組件名稱或標識字串
'傳回值：返回組件版本資訊字串
'示 例：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
'**************************************************