ASP鍑芥暟搴�4

源代码网整理以下"**************************************************
  "鍑芥暟ID锛�0020[鍒涘缓MsAccess鏁版嵁搴揮
  "鍑芥暟鍚嶏細CrDb_MsAccess
  "浣� 鐢�锛氬垱寤篗sAccess鏁版嵁搴�
  "鍙� 鏁帮細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
  "浣� 鐢�锛氬垱寤篗sSQLServer鏁版嵁搴�
  "鍙� 鏁帮細DbIp ---- 鏁版嵁搴撴墍鍦↖P鎴栦富鏈哄悕绉�
  "鍙� 鏁帮細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 ---- 鏀朵欢浜篍-MAIL鍦板潃
  "鍙� 鏁帮細content ---- 閭�浠跺唴瀹�
  "鍙� 鏁帮細fromer ---- 鍙戜欢浜篍-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
  "**************************************************
  "鍑芥暟鍚嶏細ListObjInfo
  "浣� 鐢�锛氬垪鍑虹粍浠跺畨瑁呬俊鎭�
  "鍙� 鏁帮細 ----
  "杩斿洖鍊硷細鍒楀嚭缁勪欢瀹夎�呬俊鎭�
  "绀� 渚嬶細ListObjInfo()
  "**************************************************
  Public Function ListObjInfo()
   Dim TempBs,TempBsXX,TempObjType,tmpObjs
   TempBs="×"
   TempBsXX=""
   TempObjType=""
   tmpObjs=""
   tmpObjs=tmpObjs& "JMail.Message|"
   tmpObjs=tmpObjs& "ADODB.Stream|"
   tmpObjs=tmpObjs& "MSWC.AdRotator|"
   tmpObjs=tmpObjs& "MSWC.BrowserType|"
   tmpObjs=tmpObjs& "MSWC.NextLink|"
   tmpObjs=tmpObjs& "MSWC.Tools|"
   tmpObjs=tmpObjs& "MSWC.Status|"
   tmpObjs=tmpObjs& "MSWC.Counters|"
   tmpObjs=tmpObjs& "MSWC.PermissionChecker|"
   tmpObjs=tmpObjs& "Scripting.FileSystemObject|"
   tmpObjs=tmpObjs& "adodb.connection|"
   tmpObjs=tmpObjs& "SoftArtisans.FileUp|"
   tmpObjs=tmpObjs& "SoftArtisans.FileManager|"
   tmpObjs=tmpObjs& "CDONTS.NewMail|"
   tmpObjs=tmpObjs& "Persits.MailSender|"
   tmpObjs=tmpObjs& "LyfUpload.UploadFile|"
   tmpObjs=tmpObjs& "Persits.Upload.1|"
   tmpObjs=tmpObjs& "w3.upload|"
   tmpObjs=Split(tmpObjs,"|")
   Response.write "<center><table border="1" bordercolor="#000000" cellspacing="0" cellpadding="0" style="font-size: 9pt;"">瀹嬩綋"><tr><td width="33%" valign="middle" align="center" style="border-left: 1 solid #808080; border-right: 1 solid #FFFFFF; border-top: 1 solid #FFFFFF; border-bottom: 1 solid #808080; padding-left: 2; padding-right: 2; padding-top: 1; padding-bottom: 1">缁勪欢鏍囪瘑</td><td width="33%" valign="middle" align="center" style="border-left: 1 solid #808080; border-right: 1 solid #FFFFFF; border-top: 1 solid #FFFFFF; border-bottom: 1 solid #808080; padding-left: 2; padding-right: 2; padding-top: 1; padding-bottom: 1">√|×</td><td width="34%" valign="middle" align="center" style="border-left: 1 solid #808080; border-right: 1 solid #FFFFFF; border-top: 1 solid #FFFFFF; border-bottom: 1 solid #808080; padding-left: 2; padding-right: 2; padding-top: 1; padding-bottom: 1">鐗堟湰</td></tr>" & vbCrlf
   For i = LBound(tmpObjs) To UBound(tmpObjs)
   If Trim(tmpObjs(i))<>"" Then
   If IsObjInstalled(tmpObjs(i)) Then
   TempObjType=tmpObjs(i)
   TempBs="√"
   TempBsXX=GetObjVer(tmpObjs(i))
   If TempBsXX="" Then TempBsXX=" "
   Else
   TempObjType="<font color="#800000">"&tmpObjs(i)&"</font>"
   TempBs="<font color="#800000">×</font>"
   TempBsXX=" "
   End If
   Response.write "<tr>" & vbCrlf
   Response.write "<td valign="middle" style="border-left: 1 solid #808080; border-right: 1 solid #FFFFFF; border-top: 1 solid #FFFFFF; border-bottom: 1 solid #808080; padding-left: 2; padding-right: 2; padding-top: 1; padding-bottom: 1">"&TempObjType&"</td>" & vbCrlf
   Response.write "<td valign="middle" align="center" style="border-left: 1 solid #808080; border-right: 1 solid #FFFFFF; border-top: 1 solid #FFFFFF; border-bottom: 1 solid #808080; padding-left: 2; padding-right: 2; padding-top: 1; padding-bottom: 1">"&TempBs&"</td>" & vbCrlf
   Response.write "<td valign="middle" align="center" style="border-left: 1 solid #808080; border-right: 1 solid #FFFFFF; border-top: 1 solid #FFFFFF; border-bottom: 1 solid #808080; padding-left: 2; padding-right: 2; padding-top: 1; padding-bottom: 1">"&TempBsXX&"</td>" & vbCrlf
   Response.write "</tr>" & vbCrlf
   End If
   Next
   Response.write "</table></center>" & vbCrlf
  End Function
  "**************************************************
  "鍑芥暟ID锛�0024[涓婁紶鏂囦欢鐨勭獥鍙�]
  "鍑芥暟鍚嶏細PosImageWin
  "浣� 鐢�锛氫笂浼犻�夋嫨鏂囦欢绐楀彛锛屽彲鑷�鍔ㄦ彁鍙栨枃浠跺悕鍙婄被鍨�
  "鍙� 鏁帮細PfUrlstr ---- 澶勭悊浜岃繘鍒舵枃浠朵俊鎭�鐨刄RL鍦板潃
  "杩斿洖鍊硷細缃戦〉HTML鏂囦欢
  "绀� 渚嬶細搴撶粨鏋勪緥瀛� CREATE TABLE [IMAGES] ([ID] int IDENTITY (1,1) NOT NULL PRIMARY KEY,[MC] varchar(50),[LX] varchar(20),[MEM] Text,[IMGS] image)
  "**************************************************
  Public Function PosImageWin(ByVal PfUrlstr)
   PosImageWin=""
   PosImageWin=PosImageWin & "<center><table border="0" width="0" cellspacing="0" cellpadding="0" style="font-size: 9pt">" & vbCrlf
   PosImageWin=PosImageWin & "<SCRIPT LANGUAGE=javascript>"&vbCrlf
   PosImageWin=PosImageWin & "function ckfilelx(){"&vbCrlf
   PosImageWin=PosImageWin & "tempwjm=POFile.ImageFs.value;"&vbCrlf
   PosImageWin=PosImageWin & "fgwjm=tempwjm.split(".");"&vbCrlf
   PosImageWin=PosImageWin & "newwjm=fgwjm.reverse();"&vbCrlf
   PosImageWin=PosImageWin & "POMem.ImageType.value=newwjm[0].toUpperCase();"&vbCrlf
   PosImageWin=PosImageWin & "tempwjm=newwjm[1].toUpperCase();"&vbCrlf
   PosImageWin=PosImageWin & "fgwjm=tempwjm.split("\");"&vbCrlf
   PosImageWin=PosImageWin & "newwjm=fgwjm.reverse();"&vbCrlf
   PosImageWin=PosImageWin & "POMem.ImageName.value=newwjm[0].toUpperCase();"&vbCrlf
   PosImageWin=PosImageWin & "POMem.ImageReadme.value=newwjm[0].toUpperCase();"&vbCrlf
   PosImageWin=PosImageWin & "}"&vbCrlf
   PosImageWin=PosImageWin & "function Reedit(){POFile.reset();POMem.reset();}"&vbCrlf
   PosImageWin=PosImageWin & "function PostDo(){if (POFile.ImageFs.value==""){alert("娌℃湁閫夋嫨鏂囦欢鍝燂紒");}else{bc.innerHTML="姝ｅ湪涓婁紶锛岃�风◢鍚�...";POFile.action=POFile.action+"&mc="+POMem.ImageName.value+"&lx="+POMem.ImageType.value+"&mem="+POMem.ImageReadme.value;bc.style.visibility="visible";ReEd.disabled=true;PoSe.disabled=true;POFile.submit();POFile.ImageFs.disabled=true;}}"&vbCrlf
   PosImageWin=PosImageWin & "</SCRIPT>"&vbCrlf
   PosImageWin=PosImageWin & "<tr><form method="POST" name="POFile" enctype="multipart/form-data" ACTION=""&PfUrlstr&"" target="tempa"><td width="100%" valign="middle">" & vbCrlf
   PosImageWin=PosImageWin & "閫夋嫨鏂囦欢锛�<input type="file" name="ImageFs" ONCHANGE="ckfilelx();" style="font-size: 9pt;width:300;">" & vbCrlf
   PosImageWin=PosImageWin & "</td></form></tr>" & vbCrlf
   PosImageWin=PosImageWin & "<tr><form method="POST" name="POMem"><td width="100%" valign="middle">" & vbCrlf
   PosImageWin=PosImageWin & "鏂囦欢ID鍙凤細<input type="text" name="ImageID" ReadOnly style="font-size: 9pt;width:300;"><br>" & vbCrlf
   PosImageWin=PosImageWin & "鏂囦欢鍚嶇О锛�<input type="text" name="ImageName" style="font-size: 9pt;width:300;"><br>" & vbCrlf
   PosImageWin=PosImageWin & "鏂囦欢绫诲瀷锛�<input type="text" name="ImageType" ReadOnly style="font-size: 9pt;width:300;"><br>" & vbCrlf
   PosImageWin=PosImageWin & "鏂囦欢浠嬬粛锛�<textarea rows="8" name="ImageReadme" cols="20" style="font-size: 9pt;width:300;">杩樻病鏈�</textarea>" & vbCrlf
   PosImageWin=PosImageWin & "</td></form></tr>" & vbCrlf
   PosImageWin=PosImageWin & "<tr><td width="100%" valign="middle" align="center">" & vbCrlf
   PosImageWin=PosImageWin & "<input type="button" value="閲嶇疆" name="ReEd" OnClick="Reedit();">  <input type="button" value="涓婁紶" name="PoSe" OnClick="PostDo();">" & vbCrlf
   PosImageWin=PosImageWin & "</td></tr></table></center><div id="bc" name="bc" style="position: absolute; left: 45%; top:40%; z-index: 0;background-color: #EAEAEA;visibility: hidden;" valign="middle" align="center"></div>" & vbCrlf
   PosImageWin=PosImageWin & "<iframe src="" ID="tempa" NAME="tempa" frameborder="0" width="0" height="0" style="width:0;Height:0;">" & vbCrlf
  End Function