ASP鏈接數據庫大全

<%  
'#######如下是一個類文件，下面的註解是調用類的方法################################################  
'# 注意：若是系統不支持創建Scripting.FileSystemObject對象，那麼數據庫壓縮功能將沒法使用  
'# Access 數據庫類  
'# CreateDbFile 創建一個Access 數據庫文件  
'# CompactDatabase 壓縮一個Access 數據庫文件  
'# 創建對象方法:  
'# Set a = New DatabaseTools  
'# by (蕭寒雪) s.f.  
'#########################################################################################  


Class DatabaseTools  

Public function CreateDBfile(byVal dbFileName,byVal DbVer,byVal SavePath)  
'創建數據庫文件  
'If DbVer is 0 Then Create Access97 dbFile  
'If DbVer is 1 Then Create Access2000 dbFile  
On error resume Next  
If Right(SavePath,1)<>"\" or Right(SavePath,1)<>"/" Then SavePath = Trim(SavePath) & "\"  
If Left(dbFileName,1)="\" or Left(dbFileName,1)="/" Then dbFileName = Trim(Mid(dbFileName,2,Len(dbFileName)))  
If DbExists(SavePath & dbFileName) Then  
Response.Write ("對不起，該數據庫已經存在!")  
CreateDBfile = False  
Else  
Dim Ca  
Set Ca = Server.CreateObject("ADOX.Catalog")  
If Err.number<>0 Then  
Response.Write ("沒法創建，請檢查錯誤信息 
" & Err.number & " 
" & Err.Description)  
Err.Clear  
Exit function  
End If  
If DbVer=0 Then  
call Ca.Create("Provider=Microsoft.Jet.OLEDB.3.51;Data Source=" & SavePath & dbFileName)  
Else  
call Ca.Create("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & SavePath & dbFileName)  
End If  
Set Ca = Nothing  
CreateDBfile = True  
End If  
End function  

Public function CompactDatabase(byVal dbFileName,byVal DbVer,byVal SavePath)  
'壓縮數據庫文件  
'0 爲access 97  
'1 爲access 2000  
On Error resume next  
If Right(SavePath,1)<>"\" or Right(SavePath,1)<>"/" Then SavePath = Trim(SavePath) & "\"  
If Left(dbFileName,1)="\" or Left(dbFileName,1)="/" Then dbFileName = Trim(Mid(dbFileName,2,Len(dbFileName)))  
If DbExists(SavePath & dbFileName) Then  
Response.Write ("對不起，該數據庫已經存在!")  
CompactDatabase = False  
Else  
Dim Cd  
Set Cd =Server.CreateObject("JRO.JetEngine")  
If Err.number<>0 Then  
Response.Write ("沒法壓縮，請檢查錯誤信息 
" & Err.number & " 
" & Err.Description)  
Err.Clear  
Exit function  
End If  
If DbVer=0 Then  
call Cd.CompactDatabase("Provider=Microsoft.Jet.OLEDB.3.51;Data Source=" & SavePath & dbFileName,"Provider=Microsoft.Jet.OLEDB.3.51;Data  
Source=" & SavePath & dbFileName & ".bak.mdb;Jet OLEDB;Encrypt Database=True")  
Else  
call Cd.CompactDatabase("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" &  
SavePath & dbFileName,"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" &  
SavePath & dbFileName & ".bak.mdb;Jet OLEDB;Encrypt Database=True")  
End If  
'刪除舊的數據庫文件  
call DeleteFile(SavePath & dbFileName)  
'將壓縮後的數據庫文件還原  
call RenameFile(SavePath & dbFileName & ".bak.mdb",SavePath & dbFileName)  
Set Cd = False  
CompactDatabase = True  
End If  
end function  

Public function DbExists(byVal dbPath)  
'查找數據庫文件是否存在  
On Error resume Next  
Dim c  
Set c = Server.CreateObject("ADODB.Connection")  
c.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbPath  
If Err.number<>0 Then  
Err.Clear  
DbExists = false  
else  
DbExists = True  
End If  
set c = nothing  
End function  

Public function AppPath()  
'取當前真實路徑  
AppPath = Server.MapPath("./")  
End function  

Public function AppName()  
'取當前程序名稱  
AppName = Mid(Request.ServerVariables("SCRIPT_NAME"),(InStrRev(Request.ServerVariables("SCRIPT_NAME") ,"/",-1,1))+1,Len(Request.ServerVariables("SCRIPT_NAME")))  
End Function  

Public function DeleteFile(filespec)  
'刪除一個文件  
Dim fso  
Set fso = CreateObject("Scripting.FileSystemObject")  
If Err.number<>0 Then  
Response.Write("刪除文件發生錯誤!請查看錯誤信息 
" & Err.number & " 
" & Err.Description)  
Err.Clear  
DeleteFile = False  
End If  
call fso.DeleteFile(filespec)  
Set fso = Nothing  
DeleteFile = True  
End function  

Public function RenameFile(filespec1,filespec2)  
'修改一個文件  
Dim fso  
Set fso = CreateObject("Scripting.FileSystemObject")  
If Err.number<>0 Then  
Response.Write("修改文件名時發生錯誤!請查看錯誤信息 
" & Err.number & " 
" & Err.Description)  
Err.Clear  
RenameFile = False  
End If  
call fso.CopyFile(filespec1,filespec2,True)  
call fso.DeleteFile(filespec1)  
Set fso = Nothing  
RenameFile = True  
End function  

End Class  
%>  

如今已能夠壓縮有密碼的數據庫，代碼以下，可是壓縮以後的數據庫密碼就沒有了！如何解決？ 

<% 
Const JET_3X = 4 

Function CompactDB(dbPath, boolIs97) 
Dim fso, Engine, strDBPath 
strDBPath = left(dbPath,instrrev(DBPath,"\")) 
Set fso = CreateObject("Scripting.FileSystemObject") 

If fso.FileExists(dbPath) Then  
Set Engine = CreateObject("JRO.JetEngine") 

If boolIs97 = "True" Then 
Engine.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbpath, _ 
"Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Database Password='XXXXXXXX';Data Source=" & strDBPath & "temp.mdb;" _ 
& "Jet OLEDB:Engine Type=" & JET_3X 
Else 
Engine.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Database Password='XXXXXXXX';Data Source=" & dbpath, _ 
"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDBPath & "temp.mdb" 
End If 

fso.CopyFile strDBPath & "temp.mdb",dbpath 
fso.DeleteFile(strDBPath & "temp.mdb") 
Set fso = nothing 
Set Engine = nothing 

CompactDB = "你的數據庫, " & dbpath & ", 已經壓縮成功!" & vbCrLf 

Else 
CompactDB = "數據庫名稱或路徑不正確. 請重試!" & vbCrLf 
End If 

End Function 
%> 

  

  

  


asp編程有用的例子（一） 
1.如何用Asp判斷你的網站的虛擬物理路徑  
答：使用Mappath方法  
< p align="center" >< font size="4" face="Arial" >< b >  
The Physical path to this virtual website is:  
< /b >< /font >  
< font color="#FF0000" size="6" face="Arial" >  
< %= Server.MapPath("\")% >  
< /font >< /p >  
2.我如何知道使用者所用的瀏覽器？  
答：使用the Request object方法  
strBrowser=Request.ServerVariables("HTTP_USER_AGENT")  
If Instr(strBrowser,"MSIE") < > 0 Then  
　　Response.redirect("ForMSIEOnly.htm")  
Else  
　　Response.redirect("ForAll.htm")  
End If  

3.如何計算天天的平均反覆訪問人數  
答：解決方法  
< % startdate=DateDiff("d",Now,"01/01/1990")  
if strdate< 0 then startdate=startdate*-1  
avgvpd=Int((usercnt)/startdate) % >  
顯示結果  
< % response.write(avgvpd) % >  
that is it.this page have been viewed since November 10,1998  

4.如何顯示隨機圖象  
< % dim p,ppic,dpic  
ppic=12  
randomize  
p=Int((ppic*rnd)+1)  
dpic="graphix/randompics/"&p&".gif"  
% >  
顯示  
< img src="< %=dpic% >" >  

5.如何回到先前的頁面  
答：< a href="< %=request.serverVariables("Http_REFERER")% >" >preivous page< /a >  
或用圖片如：< img src="arrowback.gif" alt="< %=request.serverVariables("HTTP_REFERER")% >" >  

6.如何肯定對方的IP地址  
答：< %=Request.serverVariables("REMOTE_ADDR)% >  

7.如何鏈結到一副圖片上  
答：< % @Languages=vbs cript % >  
< % response.expires=0  
strimagename="graphix/errors/erroriamge.gif"  
response.redirect(strimagename)  
% >  

8.強迫輸入密碼對話框  
答：把這句話放載頁面的開頭  
< % response.status="401 not Authorized"  
response.end  
% >  

9.如何傳遞變量從一頁到另外一頁  
答：用 HIDDEN 類型來傳遞變量  
< % form method="post" action="mynextpage.asp" >  
< % for each item in request.form % >  
< input namee="< %=item% >" type="HIDDEN"  
value="< %=server.HTMLEncode(Request.form(item)) % >" >  
< % next % >  
< /form >  

10.爲什麼我在 asp 程序內使用 msgbox，程序出錯說沒有權限  
答：因爲 asp 是服務器運行的，若是能夠在服務器顯示一個對話框，那麼你只好等有人按了肯定以後，你的程序才能繼續執行，而通常服務器不會有人守着，因此微軟不得不由止這個函數，並胡亂告訴你 (:) 呵呵) 沒有權限。可是ASP和客戶端腳本結合倒能夠顯示一個對話框，as follows:  
< % yourVar="測試對話框"% >  
< % s cript language='javas cript' >  
alert("< %=yourvar% >")  
< /s cript >  

11.有沒有辦法保護本身的源代碼，不給人看到  
答：能夠去下載一個微軟的Windows s cript Encoder，它能夠對asp的腳本和客戶端javas cript/vbs cript腳本進行加密。。。不過客戶端加密後，只有ie5才能執行，服務器端腳本加密後，只有服務器上安裝有s cript engine 5（裝一個ie5就有了）才能執行。  

12.怎樣才能將 query string 從一個 asp 文件傳送到另外一個？  
答：前者文件加入下句： Response.Redirect("second.asp?" & Request.ServerVariables("QUERY_STRING"))  

13.global.asa文件老是不起做用?  
答：只有web目錄設置爲web application, global.asa纔有效，而且一個web application的根目錄下 global.asa纔有效。IIS4可使用Internet Service Manager設置application setting 怎樣才能使得htm文件如同asp文件同樣能夠執行腳本代碼？  

14.怎樣才能使得htm文件如同asp文件同樣能夠執行腳本代碼？  
答：Internet Sevices Manager - > 選擇default web site - >右鼠鍵- >菜單屬性-〉主目錄- > 應用程序設置（Application Setting）- > 點擊按鈕 "配置"- > app mapping - >點擊按鈕"Add" - > executable browse選擇 \WINNT\SYSTEM32\INETSRV\ASP.DLL EXTENSION 輸入 htm method exclusions 輸入PUT.Delete 所有肯定便可。可是值得注意的是這樣對htm也要由asp.dll處理，效率將下降。  

15.如何註冊組件  
答：有兩種方法。  
第一種方法：手工註冊 DLL 這種方法從IIs 3.0一直使用到IIs 4.0和其它的Web Server。它須要你在命令行方式下來執行，進入到包含有DLL的目錄，並輸入：regsvr32 component_name.dll 例如 c:\temp\regsvr32 AspEmail.dll 它會把dll的特定信息註冊入服務器中的註冊表中。而後這個組件就能夠在服務器上使用了，可是這個方法有一個缺陷。當使用這種方法註冊完畢組件後，該組件必需要相應的設置NT的匿名賬號有權限執行這個dll。特別是一些組件須要讀取註冊表，因此，這個註冊組件的方法僅僅是使用在服務器上沒有MTS的狀況下，要取消註冊這個dll，使用：regsvr32 /u aspobject.dll example c:\temp\regsvr32 /u aneiodbc.dll  

第二種方法：使用MTS(Microsoft Transaction Server) MTS是IIS 4新增特點，可是它提供了巨大的改進。MTS容許你指定只有有特權的用戶纔可以訪問組件，大大提升了網站服務器上的安全性設置。在MTS上註冊組件的步驟以下：  
1) 打開IIS管理控制檯。  
2) 展開transaction server，右鍵單擊"pkgs installed"而後選擇"new package"。  
3) 單擊"create an empty package"。  
4) 給該包命名。  
5) 指定administrator賬號或則使用"interactive"（若是服務器常常是使用administrator 登錄的話）。  
6) 如今使用右鍵單擊你剛創建的那個包下面展開後的"components"。選擇 "new then component"。  
7) 選擇 "install new component" 。  
8) 找到你的.dll文件而後選擇next到完成。  
要刪除這個對象，只要選擇它的圖標，而後選擇delete。  
附註：特別要注意第二種方法，它是用來調試本身編寫組件的最好方法，而沒必要每次都須要從新啓動機器了。 

16. ASP與Access數據庫鏈接：  

<%@ language=VBs cript%>  
<%  
dim conn,mdbfile  
mdbfile=server.mappath("數據庫名稱.mdb")  
set conn=server.createobject("adodb.connection")  
conn.open "driver={microsoft access driver (*.mdb)};uid=admin;pwd=數據庫密碼;dbq="&mdbfile  

%>  

asp編程有用的例子（二） 
17. ASP與SQL數據庫鏈接：  

<%@ language=VBs cript%>  
<%  
dim conn  
set conn=server.createobject("ADODB.connection")  
con.open "PROVIDER=SQLOLEDB;DATA SOURCE=SQL服務器名稱或IP地址;UID=sa;PWD=數據庫密碼;DATABASE=數據庫名稱  
%>  

創建記錄集對象：  

set rs=server.createobject("adodb.recordset")  
rs.open SQL語句,conn,3,2  

18. SQL經常使用命令使用方法：  

(1) 數據記錄篩選：  

sql="select * from 數據表 where 字段名=字段值 order by 字段名 [desc]"  

sql="select * from 數據表 where 字段名 like '%字段值%' order by 字段名 [desc]"  

sql="select top 10 * from 數據表 where 字段名 order by 字段名 [desc]"  

sql="select * from 數據表 where 字段名 in ('值1','值2','值3')"  

sql="select * from 數據表 where 字段名 between 值1 and 值2"  

(2) 更新數據記錄：  

sql="update 數據表 set 字段名=字段值 where 條件表達式"  

sql="update 數據表 set 字段1=值1,字段2=值2 …… 字段n=值n where 條件表達式"  

(3) 刪除數據記錄：  

sql="delete from 數據表 where 條件表達式"  

sql="delete from 數據表" (將數據表全部記錄刪除)  

(4) 添加數據記錄：  

sql="insert into 數據表 (字段1,字段2,字段3 …) valuess (值1,值2,值3 …)"  

sql="insert into 目標數據表 select * from 源數據表" (把源數據表的記錄添加到目標數據表)  

(5) 數據記錄統計函數：  

AVG(字段名) 得出一個表格欄平均值  
COUNT(*|字段名) 對數據行數的統計或對某一欄有值的數據行數統計  
MAX(字段名) 取得一個表格欄最大的值  
MIN(字段名) 取得一個表格欄最小的值  
SUM(字段名) 把數據欄的值相加  

引用以上函數的方法：  

sql="select sum(字段名) as 別名 from 數據表 where 條件表達式"  
set rs=conn.excute(sql)  

用 rs("別名") 獲取統的計值，其它函數運用同上。  

(5) 數據表的創建和刪除：  

Create TABLE 數據表名稱(字段1 類型1(長度),字段2 類型2(長度) …… )  

例：Create TABLE tab01(name varchar(50),datetime default now())  

Drop TABLE 數據表名稱 (永久性刪除一個數據表)  

19. 記錄集對象的方法：  

rs.movenext 將記錄指針從當前的位置向下移一行  
rs.moveprevious 將記錄指針從當前的位置向上移一行  
rs.movefirst 將記錄指針移到數據表第一行  
rs.movelast 將記錄指針移到數據表最後一行  
rs.absoluteposition=N 將記錄指針移到數據表第N行  
rs.absolutepage=N 將記錄指針移到第N頁的第一行  
rs.pagesize=N 設置每頁爲N條記錄  
rs.pagecount 根據 pagesize 的設置返回總頁數  
rs.recordcount 返回記錄總數  
rs.bof 返回記錄指針是否超出數據表首端，true表示是，false爲否  
rs.eof 返回記錄指針是否超出數據表末端，true表示是，false爲否  
rs.delete 刪除當前記錄，但記錄指針不會向下移動  
rs.addnew 添加記錄到數據表末端  
rs.update 更新數據表記錄  

－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－  

20 Recordset對象方法  

Open方法  

recordset.Open Source,ActiveConnection,CursorType,LockType,Options  

Source  
Recordset對象能夠經過Source屬性來鏈接Command對象。Source參數能夠是一個Command對象名稱、一段SQL命令、一個指定的數據表名稱或是一個Stored Procedure。假如省略這個參數，系統則採用Recordset對象的Source屬性。  

ActiveConnection  
Recordset對象能夠經過ActiveConnection屬性來鏈接Connection對象。這裏的ActiveConnection能夠是一個Connection對象或是一串包含數據庫鏈接信息（ConnectionString）的字符串參數。  

CursorType  
Recordset對象Open方法的CursorType參數表示將以什麼樣的遊標類型啓動數據，包括adOpenForwardOnly、adOpenKeyset、adOpenDynamic及adOpenStatic，分述以下：  
--------------------------------------------------------------  
常數 常數值 說明  
-------------------------------------------------------------  
adOpenForwardOnly 0 缺省值，啓動一個只能向前移動的遊標（Forward Only）。  
adOpenKeyset 1 啓動一個Keyset類型的遊標。  
adOpenDynamic 2 啓動一個Dynamic類型的遊標。  
adOpenStatic 3 啓動一個Static類型的遊標。  
-------------------------------------------------------------  
以上幾個遊標類型將直接影響到Recordset對象全部的屬性和方法，如下列表說明他們之間的區別。  

-------------------------------------------------------------  
Recordset屬性 adOpenForwardOnly adOpenKeyset adOpenDynamic adOpenStatic  
-------------------------------------------------------------  
AbsolutePage 不支持 不支持 可讀寫 可讀寫  
AbsolutePosition 不支持 不支持 可讀寫 可讀寫  
ActiveConnection 可讀寫 可讀寫 可讀寫 可讀寫  
BOF 只讀 只讀 只讀 只讀  
Bookmark 不支持 不支持 可讀寫 可讀寫  
CacheSize 可讀寫 可讀寫 可讀寫 可讀寫  
CursorLocation 可讀寫 可讀寫 可讀寫 可讀寫  
CursorType 可讀寫 可讀寫 可讀寫 可讀寫  
EditMode 只讀 只讀 只讀 只讀  
EOF 只讀 只讀 只讀 只讀  
Filter 可讀寫 可讀寫 可讀寫 可讀寫  
LockType 可讀寫 可讀寫 可讀寫 可讀寫  
MarshalOptions 可讀寫 可讀寫 可讀寫 可讀寫  
MaxRecords 可讀寫 可讀寫 可讀寫 可讀寫  
PageCount 不支持 不支持 只讀 只讀  
PageSize 可讀寫 可讀寫 可讀寫 可讀寫  
RecordCount 不支持 不支持 只讀 只讀  
Source 可讀寫 可讀寫 可讀寫 可讀寫  
State 只讀 只讀 只讀 只讀  
Status 只讀 只讀 只讀 只讀  
AddNew 支持 支持 支持 支持  
CancelBatch 支持 支持 支持 支持  
CancelUpdate 支持 支持 支持 支持  
Clone 不支持 不支持  
Close 支持 支持 支持 支持  
Delete 支持 支持 支持 支持  
GetRows 支持 支持 支持 支持  
Move 不支持 支持 支持 支持  
MoveFirst 支持 支持 支持 支持  
MoveLast 不支持 支持 支持 支持  
MoveNext 支持 支持 支持 支持  
MovePrevious 不支持 支持 支持 支持  
NextRecordset 支持 支持 支持 支持  
Open 支持 支持 支持 支持  
Requery 支持 支持 支持 支持  
Resync 不支持 不支持 支持 支持  
Supports 支持 支持 支持 支持  
Update 支持 支持 支持 支持  
UpdateBatch 支持 支持 支持 支持  
--------------------------------------------------------------  
其中NextRecordset方法並不適用於Microsoft Access數據庫。  

LockType  
Recordset對象Open方法的LockType參數表示要採用的Lock類型，若是忽略這個參數，那麼系統會以Recordset對象的LockType屬性爲預設值。LockType參數包含adLockReadOnly、adLockPrssimistic、adLockOptimistic及adLockBatchOptimistic等，分述以下：  

-------------------------------------------------------------  
常數 常數值 說明  
--------------------------------------------------------------  
adLockReadOnly 1 缺省值，Recordset對象以只讀方式啓動，沒法運行AddNew、Update及Delete等方法  
adLockPrssimistic 2 當數據源正在更新時，系統會暫時鎖住其餘用戶的動做，以保持數據一致性。  
adLockOptimistic 3 當數據源正在更新時，系統並不會鎖住其餘用戶的動做，其餘用戶能夠對數據進行增、刪、改的操做。  
adLockBatchOptimistic 4 當數據源正在更新時，其餘用戶必須將CursorLocation屬性改成adUdeClientBatch才能對數據進行增、  
刪、改的操做。 
如何在服務器端調用winzip命令行對上傳的多個文件打包壓縮 
------------------------------------------- 
如何在服務器端調用winzip命令行對上傳的多個文件打包壓縮？ 

要解決這個問題，首先要了解一下Windows Scripting Host,簡稱爲WSH！下面引用一下微軟給的解釋： 
************************************************************************ 
* WSH是微軟腳本技術系列中的一種，簡單講，就是提供了一種腳本環境， * 
* 在這個環境中，預約義了一些對象，同時也可使用COM裏的其餘對象。 * 
* 他使用一種腳本引擎來對腳本解釋執行，微軟本身支持VBSCRIPT和JSCRIPT， * 
* 第三方也能夠開發本身的腳本引擎。 * 
************************************************************************ 
具體點，就是你先編好一些腳本文件（微軟自帶例子若干，後綴.vbs或 .js), 
而後用一個程序對他解釋執行，這個程序就叫Windows Scripting Host,程序 
的名字是Wscript.exe(或者命令行的Cscript.exe），你能夠查看一下你的機器 
裏有沒有這兩個文件，就知道有沒有WSH了。(win2000是在winnt/system32/下) 
這很是像批處理文件，只不過文件裏不是命令行，而是腳本語言寫的腳本。 

再來簡單介紹一下WSH自帶的幾個內置對象包括： 

1.由 Wscript.exe 提供的對象 
Wscript 做爲 Wscript 公開給腳本引擎。  
WshArguments 未公開；經過 Wscript.Arguments 屬性訪問。 入 

2.由 WSHom.Ocx 提供的對象。 
WshShell 自動對象。ProgID 是 Wscript.WshShell。  
（注：這個就是咱們要用到的，能夠執行dos命令） 
WshNetwork 自動對象。ProgID 是 Wscript.WshNetwork。  
WshShortcut 未公開；經過 WshShell.CreateShortcut 方法訪問。  
WshUrlShortcut 未公開；經過 WshShell.CreateShortcut 方法訪問。  
WshCollection 未公開；經過 WshNetwork.EnumNetworkDrives 或 WshNetwork.EnumPrinterConnection 方法訪問。  
WshEnvironment 未公開；經過 WshShell.Environment 屬性訪問。  
WshSpecialFolders 未公開；經過 WshShell.Folder 屬性訪問。  

他們主要能夠完成環境變量的獲取，網絡登錄，驅動器映射，快截方式建立， 
程序加載，特殊文件夾（如系統文件夾）信息獲取等功能。 

若是你的系統裏支持ADO等COM部件，你一樣可使用， 
下面這個例子演示打開寫字板查看文本文件，同時建立一個文本文件並寫入一 
段話，你能夠把他拷貝到寫字板中，而後以.vbs爲後綴存盤，以後雙擊他， 

'test.vbs 
'********************* 
'下面用SHELL對象啓動程序 
'********************* 
Set WshShell = Wscript.CreateObject("Wscript.Shell") 
WshShell.Run ("notepad " & Wscript.ScriptFullName) 


'*********************************************** 
'用COM對象Scripting.FileSystemObject操做文本文件 
'*********************************************** 
Set fs = Wscript.CreateObject("Scripting.FileSystemObject") 
Set a = fs.CreateTextFile("c:\testfile.txt", True) 
a.WriteLine("這是一個測試。") 
a.Close 

也能夠在asp等web編程語言中應用 
<script language="VBScript.Encode" runat=server> 
'上面用SHELL對象啓動程序 
Set WshShell = server.CreateObject("Wscript.Shell") 
IsSuccess = WshShell.Run ("D:\winnt\system32\cmd.exe" ,1, true) 
if IsSuccess = 0 Then  
Response.write " 命令成功執行！" 
else  
Response.write " 命令執行失敗！權限不夠或者該程序沒法在DOS狀態下運行" 
end if 
</script> 
注： 
1.其中runat=server必需要有 
2.Set WshShell = Wscript.CreateObject("Wscript.Shell") 
要改成Set WshShell = server.CreateObject("Wscript.Shell")， 
3.參數1表明SW_SHOWNORMAL， 激活並顯示一個窗口。若窗口是最小化或最大化，則恢復到其原來的大小和位置。  
4.TRUE表明返回執行的錯誤，False或者爲指定表明腳本繼續執行而不等待進程結束。 
5.調用WSH的內置對象了，能夠象調用函數和過程同樣。 
如call WshShell.Run ("D:\winnt\system32\cmd.exe" ,1, true) 

若是你對WSH感興趣，想了解更多的話，請察看 
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/script56/html/wsconwshbasics.asp 
http://www.dev-club.com/club/bbs/showEssence.asp?id=11136 

如今咱們言歸正傳來看看如何對文件進行壓縮和解壓！ 
你們都知道winzip對文件解壓和壓縮都易如反掌，可是如何經過程序和命令行對其調用呢？ 
固然winzip的做者已經開發出 
WinZip Command Line Support Add-On Version 1.0  
你們去能夠去http://www.winzip.com/wzcline.htm 下載wzcline.exe！ 
前提是本機須安裝winzip8.0或更高版本的支持，若是你不是winzip8.0，去 
http://www.winzip.com/download.htm 下載！ 

下載後，直接安裝就能夠！ 
就會在winzip的目錄中產生winzip命令行幫助文件和程序WZZIP.exe,WZUNZIP.EXE。 
你能夠開始運行裏調用： 
如："c:\program files\winzip\wzzip" myfile.zip 
也能夠拷貝這裏兩個文件到任意目錄下，直接在dos窗口下運行 
如：wzzip.exe myfile.zip 
你能夠在系統的環境變量里加入set path=c:\windows;c:\program files\winzip; 
就能夠在任何地方不用加入路經調用了！ 

如今來簡單的瞭解一下幫助中兩個命令的基本用法 
壓縮文件用 WZZIP.exe ： 
通用格式：wzzip [options] zipfile [@listfile] [files...] 
[options]包括： 
-a 默認的操做，壓縮文件 
-a+ 壓縮文件，並刪除要壓縮的文件 
-b[drive|path] 是在另外的驅動器上建立臨時壓縮文件 
-d 刪除zip文件中指定的目標文件 
-e<x|n|f|s|0> 是設置壓縮比率，x最大，0最小 
-f 替換zip文件中存在的文件 
-h|-? 察看幫助 
-v 建立一個壓縮文件的列表信息 
-@list 先建立一個包含全部要解壓的文件的文件，而後按所包含的的文件名壓縮 
...............（其餘具體看幫助文件） 
[@listfile] 是壓縮文件的列表信息紀錄 
[files...] 則是要壓縮的多個文件，用空格隔開，也能夠用通配符 

例： 
壓縮當前目錄的全部文件  
wzzip test.zip *.* 
壓縮類型爲txt的全部文件  
wzzip test.zip *.txt 
壓縮兩個文件  
wzzip test.zip abc.txt def.txt 
壓縮類型爲txt的全部文件除了abc.txt  
wzzip -xABC.TXT test.zip *.txt 
壓縮D:\docs下的全部類型爲txt的文件及子目錄  
wzzip -rp test.zip d:\docs\*.txt 
把zipit.1st裏的文件更新到test.zip  
wzzip -u test.zip @Zipit.lst 
列出一個壓縮文件的列表內容 
wzzip -v test.zip 


解壓文件用WZUNZIP.exe : 
經過格式：wzunzip [options] zipfile [@listfile] [path] [files...] 
[options]包括： 
-c[m] 解壓是顯示文件列表在dos屏幕中 
-d 重建zip文件中的目錄結構 
-f 只解壓在zip文件裏同目前文件夾存在的同名的文件，若是沒有則不解壓 
-jhrs 忽視zip文件裏的文件的隱藏、只讀、系統屬性 
-Jhrs 只解壓帶有隱藏、只讀、系統屬性的文件 
-n 只解壓叫新的文件，若是要解壓的文件比已存在的新則替換。 
-o 不用經過yes來肯定是否要替換文件 
-v 建立一個壓縮文件的列表信息 
-@list 先建立一個包含全部要解壓的文件的文件，而後按所包含的的文件名解壓 
...............（其餘具體看幫助文件） 
例如： 
建立全部文件到當前目錄下 
wzunzip test.zip 
從test.zip中建立abc.txt到當前目錄下 
wzunzip test.zip abc.txt 
建立在test.zip中的目錄結構及文件到當前目錄下 
wzunzip -d test.zip 
建立在test.zip中的目錄結構及文件到c:\docs下 
wzunzip -d test.zip c:\docs從test.zip中建立包含在files.ist中的文件名的文件 
wzunzip test.zip @files.lst 
顯示test.zip的文件列表內容 
wzunzip -v test.zip 
顯示壓縮文件中全部類型爲txt的文件列表內容 
wzunzip -v test.zip *.txt 


有了以上的準備，那麼咱們如今來編寫VBS來執行文件解壓和壓縮就易如反掌了： 
'test.vbs 
'********************* 
'上面用SHELL對象啓動程序 
'********************* 
Set WshShell = Wscript.CreateObject("Wscript.Shell") 
WshShell.Run ("c:\wzzip.exe c:\test.zip c:\a.txt c:\b.txt") 


'test.asp 
'********************* 
'上面用SHELL對象啓動程序 
'********************* 
<script language="VBScript.Encode" runat=server> 
'上面用SHELL對象啓動程序 
Set WshShell = server.CreateObject("Wscript.Shell") 
IsSuccess = WshShell.Run (" c:\wzzip.exe c:\test.zip c:\a.txt c:\b.txt" ,1, true) 
if IsSuccess = 0 Then  
Response.write " 命令成功執行！" 
else  
Response.write " 命令執行失敗！權限不夠或者該程序沒法在DOS狀態下運行" 
end if 
</script> 

  


利用ASP遠程註冊DLL的方法 
-------------------------- 
<% Response.Buffer = True %> 
<% Server.ScriptTimeout = 500  
Dim frmFolderPath, frmFilePath 

frmFolderPath = Request.Form("frmFolderPath") 
frmFilePath = Request.Form("frmDllPath") 
frmMethod = Request.Form("frmMethod") 
btnREG = Request.Form("btnREG") 
%> 

<HTML> 
<HEAD> 
<TITLE>Regsvr32.asp</TITLE> 
<STYLE TYPE="TEXT/CSS"> 
.Legend {FONT-FAMILY: veranda; FONT-SIZE: 14px; FONT-WEIGHT: bold; COLOR: blue} 
.FS {FONT-FAMILY: veranda; FONT-SIZE: 12px; BORDER-WIDTH: 4px; BORDER-COLOR: green; 
MARGIN-LEFT:2px; MARGIN-RIGHT:2px} 
TD {MARGIN-LEFT:6px; MARGIN-RIGHT:6px; PADDING-LEFT:12px; PADDING-RIGHT:12px} 
</STYLE> 
</HEAD> 

<BODY> 
<FORM NAME="regForm" METHOD="POST"> 
<TABLE BORDER=0 CELLSPACING=6 CELLPADDING=6 MARGINWIDTH=6> 
<TR> 
<TD VALIGN=TOP> 
<FIELDSET ID=FS1 NAME=FS1 CLASS=FS> 
<LEGEND CLASS=Legend>Regsvr Functions</LEGEND> 
Insert Path to DLL Directory<BR> 
<INPUT TYPE=TEXT NAME="frmFolderPath" value="<%=frmFolderPath%>"><BR> 
<INPUT TYPE=SUBMIT NAME=btnFileList value="Build File List"><BR> 
<%  
IF Request.Form("btnFileList") <> "" or btnREG <> "" Then 
Set RegisterFiles = New clsRegister 
RegisterFiles.EchoB("<B>Select File</B>") 
Call RegisterFiles.init(frmFolderPath) 
RegisterFiles.EchoB("<BR><INPUT TYPE=SUBMIT NAME=btnREG value=" & Chr(34) _ 
& "REG/UNREG" & Chr(34) & ">") 
IF Request.Form("btnREG") <> "" Then 
Call RegisterFiles.Register(frmFilePath, frmMethod) 
End IF 
Set RegisterFiles = Nothing 
End IF 
%> 
</FIELDSET> 
</TD> 
</TR> 
</TABLE> 
</FORM> 
</BODY> 
</HTML> 
<% 
Class clsRegister 

Private m_oFS  

Public Property Let oFS(objOFS) 
m_oFS = objOFS 
End Property 

Public Property Get oFS() 
Set oFS = Server.CreateObject("Scripting.FileSystemObject") 
End Property 


Sub init(strRoot) 'Root to Search (c:, d:, e:) 
Dim oDrive, orootDir 
IF oFS.FolderExists(strRoot) Then 
IF Len(strRoot) < 3 Then 'Must Be a Drive 
Set oDrive = oFS.GetDrive(strRoot) 
Set orootDir = oDrive.RootFolder 
Else 
Set orootDir = oFS.GetFolder(strRoot) 
End IF 
Else 
EchoB("<B>Folder ( " & strRoot & " ) Not Found.") 
Exit Sub 
End IF 
setRoot = orootDir 

Echo("<Select NAME=" & Chr(34) & "frmDllPath" & Chr(34) & ">") 
Call getAllDlls(oRootDir) 
EchoB("</Select>") 
BuildOptions 
End Sub 

Sub getAllDlls(oParentFolder) 
Dim oSubFolders, oFile, oFiles 
Set oSubFolders = oParentFolder.SubFolders 
Set opFiles = oParentFolder.Files 

For Each oFile in opFiles 
IF Right(lCase(oFile.Name), 4) = ".dll" or Right(lCase(oFile.Name), 4) = ".ocx" Then 
Echo("<OPTION value=" & Chr(34) & oFile.Path & Chr(34) & ">" _ 
& oFile.Name & "</Option>") 
End IF 
Next 

On Error Resume Next 
For Each oFolder In oSubFolders 'Iterate All Folders in Drive 
Set oFiles = oFolder.Files 
For Each oFile in oFiles 
IF Right(lCase(oFile.Name), 4) = ".dll" or Right(lCase(oFile.Name), 4) = ".ocx" Then 
Echo("<OPTION value=" & Chr(34) & oFile.Path & Chr(34) & ">" _ 
& oFile.Name & "</Option>") 
End IF 
Next 
Call getAllDlls(oFolder) 
Next 
On Error GoTo 0 
End Sub 

Sub Register(strFilePath, regMethod) 
Dim theFile, strFile, oShell, exitcode 
Set theFile = oFS.GetFile(strFilePath) 
strFile = theFile.Path 

Set oShell = CreateObject ("WScript.Shell") 

IF regMethod = "REG" Then 'Register 
oShell.Run "c:\WINNT\system32\regsvr32.exe /s " & strFile, 0, False 
exitcode = oShell.Run("c:\WINNT\system32\regsvr32.exe /s " & strFile, 0, False) 
EchoB("regsvr32.exe exitcode = " & exitcode) 
Else 'unRegister 
oShell.Run "c:\WINNT\system32\regsvr32.exe /u/s " & strFile, 0, False 
exitcode = oShell.Run("c:\WINNT\system32\regsvr32.exe /u/s " & strFile, 0, False) 
EchoB("regsvr32.exe exitcode = " & exitcode) 
End IF 

Cleanup oShell 
End Sub 

Sub BuildOptions 
EchoB("Register: <INPUT TYPE=RADIO NAME=frmMethod value=REG CHECKED>") 
EchoB("unRegister: <INPUT TYPE=RADIO NAME=frmMethod value=UNREG>") 
End Sub 

Function Echo(str) 
Echo = Response.Write(str & vbCrLf) 
End Function 

Function EchoB(str) 
EchoB = Response.Write(str & "<BR>" & vbCrLf) 
End Function 

Sub Cleanup(obj) 
If isObject(obj) Then 
Set obj = Nothing 
End IF 
End Sub 

Sub Class_Terminate() 
Cleanup oFS 
End Sub 
End Class 
%> 

利用CDONTS發送郵件的ASP函數 
<% 
'Last Updated By Recon On 05/14/2001 
'On Error Resume Next 

'利用CDONTS組件在Win2k上發送郵件 

'發送普通郵件 
SendMail "admin@ny.com", "iamchn@263.net", "Normal Mail!", "Please check the attatchment!", 2, 0, "C:\Love.txt" 

'發送HTML郵件 
Dim m_fso, m_tf 
Dim m_strHTML 

Set m_fso = Server.CreateObject("SCRIPTING.FILESYSTEMOBJECT") 
Set m_tf = m_fso.OpenTextFile("C:\Mail.htm", 1) 
m_strHTML = m_tf.ReadAll 

'Write m_strHTML 
Set m_tf = Nothing 
Set m_fso = Nothing 

SendMail "admin@ny.com", "iamchn@263.net", "HTML Mail!", m_strHTML, 2, 1, Null 

'參數說明 
'strFrom : 發件人Email 
'strTo : 收件人Email 
'strSubject : 信件主題 
'strBody : 信件正文 
'lngImportance : 信件重要性 
' : 0 - 低重要性 
' : 0 - 中等重要性（默認） 
' : 0 - 高重要性 
'lngAType : 信件格式 
' : 爲1時將郵件正文做爲HTML（此時能夠發送HTML郵件） 
'strAttach : 附件的路徑 
Sub SendMail(strFrom, strTo, strSubject, strBody, lngImportance, lngAType, strAttach) 
Dim objMail 

Set objMail = Server.CreateObject("CDONTS.NEWMAIL") 
With objMail 

.From = strFrom 
.To = strTo 
.Subject = strSubject 
.Body = strBody 
.Importance = lngImportance 

If lngAType = 1 Then 
.BodyFormat = 0 
.MailFormat = 0 
End If 

If IsEmpty(strAttach) = False And IsNull(strAttach) = False Then 
.AttachFile strAttach 
End If 

.Send 
End With 
Set objMail = Nothing 
End Sub 
%> 
處理驅動器和文件夾 


使用 FileSystemObject (FSO) 對象模式，能夠有計劃地處理驅動器和文件夾，就像在 Windows 資源管理器中交互式地處理它們同樣。能夠複製和移動文件夾，獲取有關驅動器和文件夾的信息，等等。 

獲取有關驅動器的信息  
能夠用 Drive 對象來得到有關各類驅動器的信息，這些驅動器是實物地或經過網絡鏈接到系統上的。它的屬性能夠用來得到下面的信息內容： 

驅動器的總容量，以字節爲單位（TotalSize 屬性）  
驅動器的可用空間是多少，以字節爲單位（AvailableSpace 或 FreeSpace 屬性）  
哪一個號被賦給了該驅動器（DriveLetter 屬性）  
驅動器的類型是什麼，如可移動的、固定的、網絡的、CD-ROM 或 RAM 磁盤（DriveType 屬性）  
驅動器的序列號（SerialNumber 屬性）  
驅動器使用的文件系統類型，如 FAT、FAT3二、NTFS 等等（FileSystem 屬性）  
驅動器是否可使用（IsReady 屬性）  
共享和/或卷的名字（ShareName 和 VolumeName 屬性）  
驅動器的路徑或根文件夾（Path 和 RootFolder 屬性）  
請考察示例代碼，來領會如何在 FileSystemObject 中使用這些屬性。 

Drive 對象用法示例  
使用 Drive 對象來收集有關驅動器的信息。在下面的代碼中，沒有對實際的 Drive 對象的引用；相反，使用 GetDrive 方法來得到現有 Drive 對象的引用（在這個例子中就是 drv）。 
下面示例示範瞭如何在 VBScript 中使用 Drive 對象：  

Sub ShowDriveInfo(drvPath) 
Dim fso, drv, s 
Set fso = CreateObject("Scripting.FileSystemObject") 
Set drv = fso.GetDrive(fso.GetDriveName(drvPath)) 
s = "Drive " & UCase(drvPath) & " - " 
s = s & drv.VolumeName & "<br/>" 
s = s & "Total Space: " & FormatNumber(drv.TotalSize / 1024, 0) 
s = s & " Kb" & "<br/>" 
s = s & "Free Space: " & FormatNumber(drv.FreeSpace / 1024, 0) 
s = s & " Kb" & "<br/>" 
Response.Write s 
End Sub 

下面的代碼說明在 JScript 中實現一樣的功能：  
function ShowDriveInfo1(drvPath) 
{ 
var fso, drv, s =""; 
fso = new ActiveXObject("Scripting.FileSystemObject"); 
drv = fso.GetDrive(fso.GetDriveName(drvPath)); 
s += "Drive " + drvPath.toUpperCase()+ " - "; 
s += drv.VolumeName + "<br/>"; 
s += "Total Space: " + drv.TotalSize / 1024; 
s += " Kb" + "<br/>";  
s += "Free Space: " + drv.FreeSpace / 1024; 
s += " Kb" + "<br/>"; 
Response.Write(s); 
} 

處理文件夾  
在下面的表中，描述了普通的文件夾任務和執行它們的方法。  
任務 方法  
建立文件夾。 FileSystemObject.CreateFolder  
刪除文件夾。 Folder.Delete 或 FileSystemObject.DeleteFolder  
移動文件夾。 Folder.Move 或 FileSystemObject.MoveFolder  
複製文件夾。 Folder.Copy 或 FileSystemObject.CopyFolder  
檢索文件夾的名字。 Folder.Name  
若是文件夾在驅動器上存在，則找出它。 FileSystemObject.FolderExists  
得到現有 Folder 對象的實例。 FileSystemObject.GetFolder  
找出文件夾的父文件夾名。 FileSystemObject.GetParentFolderName  
找出系統文件夾的路徑。 FileSystemObject.GetSpecialFolder  


請考察示例代碼，來看看在 FileSystemObject 中使用了多少種這些的方法和屬性。 

下面的示例示範瞭如何在 VBScript 中使用 Folder 和 FileSystemObject 對象，來操做文件夾和得到有關它們的信息： 


Sub ShowFolderInfo() 
Dim fso, fldr, s 
' 得到 FileSystemObject 的實例。 
Set fso = CreateObject("Scripting.FileSystemObject") 
' 得到 Drive 對象。 
Set fldr = fso.GetFolder("c:") 
' 打印父文件夾名字。 
Response.Write "Parent folder name is: " & fldr & "<br/>" 
' 打印驅動器名字。 
Response.Write "Contained on drive " & fldr.Drive & "<br/>" 
' 打印根文件名。 
If fldr.IsRootFolder = True Then 
Response.Write "This is the root folder." & ""<br/>"<br/>" 
Else 
Response.Write "This folder isn't a root folder." & "<br/><br/>"  
End If 
' 用 FileSystemObject 對象建立新的文件夾。 
fso.CreateFolder ("C:\Bogus") 
Response.Write "Created folder C:\Bogus" & "<br/>" 
' 打印文件夾的基本名字。 
Response.Write "Basename = " & fso.GetBaseName("c:\bogus") & "<br/>" 
' 刪除新建立的文件夾。 
fso.DeleteFolder ("C:\Bogus") 
Response.Write "Deleted folder C:\Bogus" & "<br/>" 
End Sub 

下面的示例顯示如何在 JScript 中使用 Folder 和 FileSystemObject 對象：  
function ShowFolderInfo() 
{ 
var fso, fldr, s = ""; 
// 得到 FileSystemObject 的實例。 
fso = new ActiveXObject("Scripting.FileSystemObject"); 
// 得到 Drive 對象。 
fldr = fso.GetFolder("c:"); 
// 打印父文件夾名。 
Response.Write("Parent folder name is: " + fldr + "<br/>"); 
// 打印驅動器名字。 
Response.Write("Contained on drive " + fldr.Drive + "<br/>"); 
// 打印根文件名。 
if (fldr.IsRootFolder) 
Response.Write("This is the root folder."); 
else 
Response.Write("This folder isn't a root folder."); 
Response.Write("<br/><br/>"); 
// 用 FileSystemObject 對象建立新的文件夾。 
fso.CreateFolder ("C:\\Bogus"); 
Response.Write("Created folder C:\\Bogus" + "<br/>"); 
// 打印文件夾的基本名。 
Response.Write("Basename = " + fso.GetBaseName("c:\\bogus") + "<br/>"); 
// 刪除新建立的文件夾。 
fso.DeleteFolder ("C:\\Bogus"); 
Response.Write("Deleted folder C:\\Bogus" + "<br/>"); 
} 
ASP分頁函數  

Function ExportPageInfo(ByRef rs,curpage,i,LinkFile) 
Dim retval, j, pageNumber, BasePage 

retval = "第" & curpage & "頁/總" & rs.pagecount & "頁 "  
retval = retval & "本頁" & i & "條/總" & rs.recordcount & "條 " 

If curpage = 1 Then  
retval = retval & "首頁 前頁 "  
Else  
retval = retval & "<a href='" & LinkFile & "page=1'>首頁</a> <a href='" & LinkFile & "page=" & cstr(curpage - 1) & "'>前頁</a> "  
End If 
If curpage = rs.pagecount Then  
retval = retval & "後頁 末頁" 
Else 
retval = retval & "<a href='" & LinkFile & "page=" & cstr(curpage + 1) & "'>後頁</a> <a href='" & LinkFile & "page=" & cstr(rs.pagecount) & "'>末頁</a>" 
End if 

retval = retval & "<br/>" 
BasePage = (curpage \ 10) * 10 
If BasePage > 0 Then retval = retval & " <a href='" & LinkFile & "page=" & (BasePage - 9) & "'><<</a>" 
For j = 1 to 10 
pageNumber = BasePage + j 
If PageNumber > rs.pagecount Then Exit For 
If pageNumber = Cint(curpage) Then 
retval = retval & " <font color='#FF0000'>" & pageNumber & "</font>" 
Else 
retval = retval & " <a href='" & LinkFile & "page=" & pageNumber & "'>" & pageNumber & "</a>" 
End If 
Next 
If rs.pagecount > BasePage Then retval = retval & " <a href='" & LinkFile & "page=" & (BasePage + 11) & "'>>></a>" 

ExportPageInfo = retval 
End Function 

應用 

<% 
adoPageRS.open "Select * FROM news orDER BY addtime DESC", conn, 1, 1 
if err.number <> 0 then 
response.write "數據庫操做失敗："&err.description 
else 
if adoPageRS.eof and adoPageRS.bof then 
response.write "沒有記錄" 
else 
%> 
<div align="center">  
<center> 
<table width="100%" border="0" cellspacing="1" cellpadding="2"> 
<tr class="big">  
<td width="60%">新 聞 標 題</td> 
<td width="25%" align="center">日期</td> 
<td width="15%" align="center">操　　做</td> 
</tr> 
<%  
adoPageRS.pagesize = 10  
adoPageRS.absolutepage = curpage  
for i = 0 to 9  
%> 
<tr>  
<td><%= adoPageRS("title") %></td> 
<td align="center">  
<% = adoPageRS("addtime") %> 
</td> 
<td align="center"><a href='newsman.asp?action=edit&id=<%= adoPageRS("id")%>'>編輯</a>  
<a href='javascript:confirmDel(<%= adoPageRS("id") %>)'>刪除</a></td> 
</tr> 
<%  
adoPageRS.movenext  
if adoPageRS.eof then 
i = i + 1 
exit for 
End If 
next 
%> 
<tr align="center">  
<td colspan="3">  
<% = ExportPageInfo(adoPageRS, curpage, i, "Newsman.asp?") %> 
</td> 
</tr> 
</table> 
</center> 
</div> 

asp經常用到的一些東西， 
<%=Request.ServerVariables("remote_addr")%> 

FOR each item in Request.form 
tempvalue=trim(Request(item)) 
tempvalue=Replace(tempvalue,chr(13)&chr(10),"<br/>") 
tempvalue=Replace(tempvalue,"<br/><br/>","<br/>") 
if tempvalue="" then tempvalue=0 
Execute item&"="""&tempvalue&"""" 
'response.write item&"="&tempvalue&"<br/>" 
next 
'response.write request("id") 
'response.end 

if ="" then  
response.write "<script language='javascript'>window.alert('')</script>" 
response.write "<script language='javascript'>window.history.go(-1);</script>" 
response.end 
end if 

<!--#include file="" --> 
<!--#include virtual="" --> 

sql="select max(id) from pack" 
set RS=conn.execute(sql) 
if isnull(RS(0)) then 
id=1 
else 
id=RS(0)+1 
end if 
set rs=nothing 


sql="insert into pack(id,strpackdm,strusername) values("&id&",'"&strpackdm&"','"&Session("username")&"')" 
set RS=conn.execute(sql) 


sql="update pack set "&Itemname&"='"&tempvalue&"' where id="&id&"" 
if Itemname<>"id" then 
response.write sql&"<br/>" 
set rs=conn.execute(sql) 


if err.number<>0 then 
'錯誤處理 
response.write "數據庫操做失敗：" & err.description 
err.clear 
end if 

Set rs=Nothing 
Conn.close 
Set conn=Nothing 

do while not rs.eof and rowcount>0 

rowcount=rowcount-1 
rs.MoveNext 

do while not rs.eof 

rs.MoveNext 
loop 

for each item in rs2.fields 
Execute item.name&"="""&trim(rs2(""&item.name&""))&"""" 
next 


function Mycn(str) 
str=lcase(str) 
str=replace(str,"","") 
response.write str 
end function 

dim conn 
dim connstr 
on error resume next 
set conn=server.CreateObject("adodb.connection") 

Connstr="driver=SQL Server; server="&servername&"; uid="&username&"; pwd="&password&"; database="&datebasename&";" 

Connstr="DBQ="+server.mappath(mydbpath&mdbname)+";DRIVER={Microsoft Access Driver (*.mdb)};" 

'response.write Connstr 
'response.end 
conn.Open connstr  
if err<>0 then 
Response.Write "沒法創建到數據庫的鏈接！" 
end if  

MD5不可逆加密算法的ASP實現實例（一） 

此爲國外轉載函數，可將任意字符轉換爲md5 16爲字符加密形式，並且爲不可逆轉換。 
<% 
Private Const BITS_TO_A_BYTE = 8 
Private Const BYTES_TO_A_WORD = 4 
Private Const BITS_TO_A_WORD = 32  

Private m_lOnBits(30) 
Private m_l2Power(30) 

Private Function LShift(lvalue, iShiftBits) 
If iShiftBits = 0 Then 
LShift = lvalue 
Exit Function 
ElseIf iShiftBits = 31 Then 
If lvalue And 1 Then 
LShift = &H80000000 
Else 
LShift = 0 
End If 
Exit Function 
ElseIf iShiftBits < 0 or iShiftBits > 31 Then 
Err.Raise 6 
End If 

If (lvalue And m_l2Power(31 - iShiftBits)) Then 
LShift = ((lvalue And m_lOnBits(31 - (iShiftBits + 1))) * m_l2Power(iShiftBits)) or &H80000000 
Else 
LShift = ((lvalue And m_lOnBits(31 - iShiftBits)) * m_l2Power(iShiftBits)) 
End If 
End Function 

Private Function RShift(lvalue, iShiftBits) 
If iShiftBits = 0 Then 
RShift = lvalue 
Exit Function 
ElseIf iShiftBits = 31 Then 
If lvalue And &H80000000 Then 
RShift = 1 
Else 
RShift = 0 
End If 
Exit Function 
ElseIf iShiftBits < 0 or iShiftBits > 31 Then 
Err.Raise 6 
End If 

RShift = (lvalue And &H7FFFFFFE) \ m_l2Power(iShiftBits) 

If (lvalue And &H80000000) Then 
RShift = (RShift or (&H40000000 \ m_l2Power(iShiftBits - 1))) 
End If 
End Function 

Private Function RotateLeft(lvalue, iShiftBits) 
RotateLeft = LShift(lvalue, iShiftBits) or RShift(lvalue, (32 - iShiftBits)) 
End Function 

Private Function AddUnsigned(lX, lY) 
Dim lX4 
Dim lY4 
Dim lX8 
Dim lY8 
Dim lResult 

lX8 = lX And &H80000000 
lY8 = lY And &H80000000 
lX4 = lX And &H40000000 
lY4 = lY And &H40000000 

lResult = (lX And &H3FFFFFFF) + (lY And &H3FFFFFFF) 

If lX4 And lY4 Then 
lResult = lResult Xor &H80000000 Xor lX8 Xor lY8 
ElseIf lX4 or lY4 Then 
If lResult And &H40000000 Then 
lResult = lResult Xor &HC0000000 Xor lX8 Xor lY8 
Else 
lResult = lResult Xor &H40000000 Xor lX8 Xor lY8 
End If 
Else 
lResult = lResult Xor lX8 Xor lY8 
End If 

AddUnsigned = lResult 
End Function 

Private Function md5_F(x, y, z) 
md5_F = (x And y) or ((Not x) And z) 
End Function 

Private Function md5_G(x, y, z) 
md5_G = (x And z) or (y And (Not z)) 
End Function 

Private Function md5_H(x, y, z) 
md5_H = (x Xor y Xor z) 
End Function 

Private Function md5_I(x, y, z) 
md5_I = (y Xor (x or (Not z))) 
End Function 

Private Sub md5_FF(a, b, c, d, x, s, ac) 
a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_F(b, c, d), x), ac)) 
a = RotateLeft(a, s) 
a = AddUnsigned(a, b) 
End Sub 

Private Sub md5_GG(a, b, c, d, x, s, ac) 
a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_G(b, c, d), x), ac)) 
a = RotateLeft(a, s) 
a = AddUnsigned(a, b) 
End Sub 

Private Sub md5_HH(a, b, c, d, x, s, ac) 
a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_H(b, c, d), x), ac)) 
a = RotateLeft(a, s) 
a = AddUnsigned(a, b) 
End Sub 

Private Sub md5_II(a, b, c, d, x, s, ac) 
a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_I(b, c, d), x), ac)) 
a = RotateLeft(a, s) 
a = AddUnsigned(a, b) 
End Sub 

Private Function ConvertToWordArray(sMessage) 
Dim lMessageLength 
Dim lNumberOfWords 
Dim lWordArray() 
Dim lBytePosition 
Dim lByteCount 
Dim lWordCount 

Const MODULUS_BITS = 512 
Const CONGRUENT_BITS = 448 

lMessageLength = Len(sMessage) 

lNumberOfWords = (((lMessageLength + ((MODULUS_BITS - CONGRUENT_BITS) \ BITS_TO_A_BYTE)) \ (MODULUS_BITS \ BITS_TO_A_BYTE)) + 1) * (MODULUS_BITS \ BITS_TO_A_WORD) 
ReDim lWordArray(lNumberOfWords - 1) 

lBytePosition = 0 
lByteCount = 0 
Do Until lByteCount >= lMessageLength 
lWordCount = lByteCount \ BYTES_TO_A_WORD 
lBytePosition = (lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE 
lWordArray(lWordCount) = lWordArray(lWordCount) or LShift(Asc(Mid(sMessage, lByteCount + 1, 1)), lBytePosition) 
lByteCount = lByteCount + 1 
Loop 

lWordCount = lByteCount \ BYTES_TO_A_WORD 
lBytePosition = (lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE 

lWordArray(lWordCount) = lWordArray(lWordCount) or LShift(&H80, lBytePosition) 

lWordArray(lNumberOfWords - 2) = LShift(lMessageLength, 3) 
lWordArray(lNumberOfWords - 1) = RShift(lMessageLength, 29) 

ConvertToWordArray = lWordArray 
End Function 

Private Function WordToHex(lvalue) 
Dim lByte 
Dim lCount 

For lCount = 0 To 3 
lByte = RShift(lvalue, lCount * BITS_TO_A_BYTE) And m_lOnBits(BITS_TO_A_BYTE - 1) 
WordToHex = WordToHex & Right("0" & Hex(lByte), 2) 
Next 
End Function 

  


Top  


MD5不可逆加密算法的ASP實現實例（一） 
-------------------------------------- 

Public Function MD5(sMessage) 
m_lOnBits(0) = CLng(1) 
m_lOnBits(1) = CLng(3) 
m_lOnBits(2) = CLng(7) 
m_lOnBits(3) = CLng(15) 
m_lOnBits(4) = CLng(31) 
m_lOnBits(5) = CLng(63) 
m_lOnBits(6) = CLng(127) 
m_lOnBits(7) = CLng(255) 
m_lOnBits(8) = CLng(511) 
m_lOnBits(9) = CLng(1023) 
m_lOnBits(10) = CLng(2047) 
m_lOnBits(11) = CLng(4095) 
m_lOnBits(12) = CLng(8191) 
m_lOnBits(13) = CLng(16383) 
m_lOnBits(14) = CLng(32767) 
m_lOnBits(15) = CLng(65535) 
m_lOnBits(16) = CLng(131071) 
m_lOnBits(17) = CLng(262143) 
m_lOnBits(18) = CLng(524287) 
m_lOnBits(19) = CLng(1048575) 
m_lOnBits(20) = CLng(2097151) 
m_lOnBits(21) = CLng(4194303) 
m_lOnBits(22) = CLng(8388607) 
m_lOnBits(23) = CLng(16777215) 
m_lOnBits(24) = CLng(33554431) 
m_lOnBits(25) = CLng(67108863) 
m_lOnBits(26) = CLng(134217727) 
m_lOnBits(27) = CLng(268435455) 
m_lOnBits(28) = CLng(536870911) 
m_lOnBits(29) = CLng(1073741823) 
m_lOnBits(30) = CLng(2147483647) 

m_l2Power(0) = CLng(1) 
m_l2Power(1) = CLng(2) 
m_l2Power(2) = CLng(4) 
m_l2Power(3) = CLng(8) 
m_l2Power(4) = CLng(16) 
m_l2Power(5) = CLng(32) 
m_l2Power(6) = CLng(64) 
m_l2Power(7) = CLng(128) 
m_l2Power(8) = CLng(256) 
m_l2Power(9) = CLng(512) 
m_l2Power(10) = CLng(1024) 
m_l2Power(11) = CLng(2048) 
m_l2Power(12) = CLng(4096) 
m_l2Power(13) = CLng(8192) 
m_l2Power(14) = CLng(16384) 
m_l2Power(15) = CLng(32768) 
m_l2Power(16) = CLng(65536) 
m_l2Power(17) = CLng(131072) 
m_l2Power(18) = CLng(262144) 
m_l2Power(19) = CLng(524288) 
m_l2Power(20) = CLng(1048576) 
m_l2Power(21) = CLng(2097152) 
m_l2Power(22) = CLng(4194304) 
m_l2Power(23) = CLng(8388608) 
m_l2Power(24) = CLng(16777216) 
m_l2Power(25) = CLng(33554432) 
m_l2Power(26) = CLng(67108864) 
m_l2Power(27) = CLng(134217728) 
m_l2Power(28) = CLng(268435456) 
m_l2Power(29) = CLng(536870912) 
m_l2Power(30) = CLng(1073741824) 


Dim x 
Dim k 
Dim AA 
Dim BB 
Dim CC 
Dim DD 
Dim a 
Dim b 
Dim c 
Dim d 

Const S11 = 7 
Const S12 = 12 
Const S13 = 17 
Const S14 = 22 
Const S21 = 5 
Const S22 = 9 
Const S23 = 14 
Const S24 = 20 
Const S31 = 4 
Const S32 = 11 
Const S33 = 16 
Const S34 = 23 
Const S41 = 6 
Const S42 = 10 
Const S43 = 15 
Const S44 = 21 

x = ConvertToWordArray(sMessage) 

a = &H67452301 
b = &HEFCDAB89 
c = &H98BADCFE 
d = &H10325476 

For k = 0 To UBound(x) Step 16 
AA = a 
BB = b 
CC = c 
DD = d 

md5_FF a, b, c, d, x(k + 0), S11, &HD76AA478 
md5_FF d, a, b, c, x(k + 1), S12, &HE8C7B756 
md5_FF c, d, a, b, x(k + 2), S13, &H242070DB 
md5_FF b, c, d, a, x(k + 3), S14, &HC1BDCEEE 
md5_FF a, b, c, d, x(k + 4), S11, &HF57C0FAF 
md5_FF d, a, b, c, x(k + 5), S12, &H4787C62A 
md5_FF c, d, a, b, x(k + 6), S13, &HA8304613 
md5_FF b, c, d, a, x(k + 7), S14, &HFD469501 
md5_FF a, b, c, d, x(k + 8), S11, &H698098D8 
md5_FF d, a, b, c, x(k + 9), S12, &H8B44F7AF 
md5_FF c, d, a, b, x(k + 10), S13, &HFFFF5BB1 
md5_FF b, c, d, a, x(k + 11), S14, &H895CD7BE 
md5_FF a, b, c, d, x(k + 12), S11, &H6B901122 
md5_FF d, a, b, c, x(k + 13), S12, &HFD987193 
md5_FF c, d, a, b, x(k + 14), S13, &HA679438E 
md5_FF b, c, d, a, x(k + 15), S14, &H49B40821 

md5_GG a, b, c, d, x(k + 1), S21, &HF61E2562 
md5_GG d, a, b, c, x(k + 6), S22, &HC040B340 
md5_GG c, d, a, b, x(k + 11), S23, &H265E5A51 
md5_GG b, c, d, a, x(k + 0), S24, &HE9B6C7AA 
md5_GG a, b, c, d, x(k + 5), S21, &HD62F105D 
md5_GG d, a, b, c, x(k + 10), S22, &H2441453 
md5_GG c, d, a, b, x(k + 15), S23, &HD8A1E681 
md5_GG b, c, d, a, x(k + 4), S24, &HE7D3FBC8 
md5_GG a, b, c, d, x(k + 9), S21, &H21E1CDE6 
md5_GG d, a, b, c, x(k + 14), S22, &HC33707D6 
md5_GG c, d, a, b, x(k + 3), S23, &HF4D50D87 
md5_GG b, c, d, a, x(k + 8), S24, &H455A14ED 
md5_GG a, b, c, d, x(k + 13), S21, &HA9E3E905 
md5_GG d, a, b, c, x(k + 2), S22, &HFCEFA3F8 
md5_GG c, d, a, b, x(k + 7), S23, &H676F02D9 
md5_GG b, c, d, a, x(k + 12), S24, &H8D2A4C8A 

md5_HH a, b, c, d, x(k + 5), S31, &HFFFA3942 
md5_HH d, a, b, c, x(k + 8), S32, &H8771F681 
md5_HH c, d, a, b, x(k + 11), S33, &H6D9D6122 
md5_HH b, c, d, a, x(k + 14), S34, &HFDE5380C 
md5_HH a, b, c, d, x(k + 1), S31, &HA4BEEA44 
md5_HH d, a, b, c, x(k + 4), S32, &H4BDECFA9 
md5_HH c, d, a, b, x(k + 7), S33, &HF6BB4B60 
md5_HH b, c, d, a, x(k + 10), S34, &HBEBFBC70 
md5_HH a, b, c, d, x(k + 13), S31, &H289B7EC6 
md5_HH d, a, b, c, x(k + 0), S32, &HEAA127FA 
md5_HH c, d, a, b, x(k + 3), S33, &HD4EF3085 
md5_HH b, c, d, a, x(k + 6), S34, &H4881D05 
md5_HH a, b, c, d, x(k + 9), S31, &HD9D4D039 
md5_HH d, a, b, c, x(k + 12), S32, &HE6DB99E5 
md5_HH c, d, a, b, x(k + 15), S33, &H1FA27CF8 
md5_HH b, c, d, a, x(k + 2), S34, &HC4AC5665 

md5_II a, b, c, d, x(k + 0), S41, &HF4292244 
md5_II d, a, b, c, x(k + 7), S42, &H432AFF97 
md5_II c, d, a, b, x(k + 14), S43, &HAB9423A7 
md5_II b, c, d, a, x(k + 5), S44, &HFC93A039 
md5_II a, b, c, d, x(k + 12), S41, &H655B59C3 
md5_II d, a, b, c, x(k + 3), S42, &H8F0CCC92 
md5_II c, d, a, b, x(k + 10), S43, &HFFEFF47D 
md5_II b, c, d, a, x(k + 1), S44, &H85845DD1 
md5_II a, b, c, d, x(k + 8), S41, &H6FA87E4F 
md5_II d, a, b, c, x(k + 15), S42, &HFE2CE6E0 
md5_II c, d, a, b, x(k + 6), S43, &HA3014314 
md5_II b, c, d, a, x(k + 13), S44, &H4E0811A1 
md5_II a, b, c, d, x(k + 4), S41, &HF7537E82 
md5_II d, a, b, c, x(k + 11), S42, &HBD3AF235 
md5_II c, d, a, b, x(k + 2), S43, &H2AD7D2BB 
md5_II b, c, d, a, x(k + 9), S44, &HEB86D391 

a = AddUnsigned(a, AA) 
b = AddUnsigned(b, BB) 
c = AddUnsigned(c, CC) 
d = AddUnsigned(d, DD) 
Next 

MD5 = LCase(WordToHex(a) & WordToHex(b) & WordToHex(c) & WordToHex(d)) 
' MD5=LCase(WordToHex(b) & WordToHex(c)) 'I crop this to fit 16byte database password :D 
End Function 

Response.Write "123456的加密結果爲[" & md5 ("123456") & "]" 
%>