列出你的所有Session變: 
<%@ Language=VBScript %> 
<% Option Explicit %> 
<% 
Response.Write "在你的程序中一共使用了 " & Session.Contents.Count & _ 
" 個(gè)Session變量<P>" 
Dim strName, iLoop 
For Each strName in Session.Contents 
'判斷一個(gè)Session變量是否為數(shù)組 
If IsArray(Session(strName)) then 
'如果是數(shù)組，那么羅列出所有的數(shù)組元素內(nèi)容 
For iLoop = LBound(Session(strName)) to UBound(Session(strName)) 
Response.Write strName & "(" & iLoop & ") - " & _ 
Session(strName)(iLoop) & "<BR>" 
Next 
Else 
'如果不是數(shù)組，那么直接顯示 
Response.Write strName & " - " & Session.Contents(strName) & "<BR>" 
End If 
Next 
%> 
利用CDONTS發(fā)送郵件的ASP函數(shù) 
<% 
'Last Updated By Recon On 05/14/2001 
'On Error Resume Next 

'利用CDONTS組件在Win2k上發(fā)送郵件 

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

'發(fā)送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 

'參數(shù)說(shuō)明 
'strFrom : 發(fā)件人Email 
'strTo : 收件人Email 
'strSubject : 信件主題 
'strBody : 信件正文 
'lngImportance : 信件重要性 
' : 0 - 低重要性 
' : 0 - 中等重要性（默認(rèn)） 
' : 0 - 高重要性 
'lngAType : 信件格式 
' : 為1時(shí)將郵件正文作為HTML（此時(shí)可以發(fā)送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 
%> 
處理驅(qū)動(dòng)器和文件夾 


使用 FileSystemObject (FSO) 對(duì)象模式，可以有計(jì)劃地處理驅(qū)動(dòng)器和文件夾，就像在 Windows 資源管理器中交互式地處理它們一樣?？梢詮?fù)制和移動(dòng)文件夾，獲取有關(guān)驅(qū)動(dòng)器和文件夾的信息，等等。 

獲取有關(guān)驅(qū)動(dòng)器的信息 
可以用 Drive 對(duì)象來(lái)獲得有關(guān)各種驅(qū)動(dòng)器的信息，這些驅(qū)動(dòng)器是實(shí)物地或通過(guò)網(wǎng)絡(luò)連接到系統(tǒng)上的。它的屬性可以用來(lái)獲得下面的信息內(nèi)容： 

驅(qū)動(dòng)器的總?cè)萘?，以字?jié)為單位（TotalSize 屬性） 
驅(qū)動(dòng)器的可用空間是多少，以字節(jié)為單位（AvailableSpace 或 FreeSpace 屬性） 
哪個(gè)號(hào)被賦給了該驅(qū)動(dòng)器（DriveLetter 屬性） 
驅(qū)動(dòng)器的類(lèi)型是什么，如可移動(dòng)的、固定的、網(wǎng)絡(luò)的、CD-ROM 或 RAM 磁盤(pán)（DriveType 屬性） 
驅(qū)動(dòng)器的序列號(hào)（SerialNumber 屬性） 
驅(qū)動(dòng)器使用的文件系統(tǒng)類(lèi)型，如 FAT、FAT32、NTFS 等等（FileSystem 屬性） 
驅(qū)動(dòng)器是否可以使用（IsReady 屬性） 
共享和/或卷的名字（ShareName 和 VolumeName 屬性） 
驅(qū)動(dòng)器的路徑或根文件夾（Path 和 RootFolder 屬性） 
請(qǐng)考察示例代碼，來(lái)領(lǐng)會(huì)如何在 FileSystemObject 中使用這些屬性。 

Drive 對(duì)象用法示例 
使用 Drive 對(duì)象來(lái)收集有關(guān)驅(qū)動(dòng)器的信息。在下面的代碼中，沒(méi)有對(duì)實(shí)際的 Drive 對(duì)象的引用；相反，使用 GetDrive 方法來(lái)獲得現(xiàn)有 Drive 對(duì)象的引用（在這個(gè)例子中就是 drv）。 
下面示例示范了如何在 VBScript 中使用 Drive 對(duì)象： 

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 

下面的代碼說(shuō)明在 JScript 中實(shí)現(xiàn)同樣的功能： 
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); 
} 

處理文件夾 
在下面的表中，描述了普通的文件夾任務(wù)和執(zhí)行它們的方法。 
任務(wù) 方法 
創(chuàng)建文件夾。 FileSystemObject.CreateFolder 
刪除文件夾。 Folder.Delete 或 FileSystemObject.DeleteFolder 
移動(dòng)文件夾。 Folder.Move 或 FileSystemObject.MoveFolder 
復(fù)制文件夾。 Folder.Copy 或 FileSystemObject.CopyFolder 
檢索文件夾的名字。 Folder.Name 
如果文件夾在驅(qū)動(dòng)器上存在，則找出它。 FileSystemObject.FolderExists 
獲得現(xiàn)有 Folder 對(duì)象的實(shí)例。 FileSystemObject.GetFolder 
找出文件夾的父文件夾名。 FileSystemObject.GetParentFolderName 
找出系統(tǒng)文件夾的路徑。 FileSystemObject.GetSpecialFolder 


請(qǐng)考察示例代碼，來(lái)看看在 FileSystemObject 中使用了多少種這些的方法和屬性。 

下面的示例示范了如何在 VBScript 中使用 Folder 和 FileSystemObject 對(duì)象，來(lái)操作文件夾和獲得有關(guān)它們的信息： 


Sub ShowFolderInfo() 
Dim fso, fldr, s 
' 獲得 FileSystemObject 的實(shí)例。 
Set fso = CreateObject("Scripting.FileSystemObject") 
' 獲得 Drive 對(duì)象。 
Set fldr = fso.GetFolder("c:") 
' 打印父文件夾名字。 
Response.Write "Parent folder name is: " & fldr & "<br/>" 
' 打印驅(qū)動(dòng)器名字。 
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 對(duì)象創(chuàng)建新的文件夾。 
fso.CreateFolder ("C:\Bogus") 
Response.Write "Created folder C:\Bogus" & "<br/>" 
' 打印文件夾的基本名字。 
Response.Write "Basename = " & fso.GetBaseName("c:\bogus") & "<br/>" 
' 刪除新創(chuàng)建的文件夾。 
fso.DeleteFolder ("C:\Bogus") 
Response.Write "Deleted folder C:\Bogus" & "<br/>" 
End Sub 

下面的示例顯示如何在 JScript 中使用 Folder 和 FileSystemObject 對(duì)象： 
function ShowFolderInfo() 
{ 
var fso, fldr, s = ""; 
// 獲得 FileSystemObject 的實(shí)例。 
fso = new ActiveXObject("Scripting.FileSystemObject"); 
// 獲得 Drive 對(duì)象。 
fldr = fso.GetFolder("c:"); 
// 打印父文件夾名。 
Response.Write("Parent folder name is: " + fldr + "<br/>"); 
// 打印驅(qū)動(dòng)器名字。 
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 對(duì)象創(chuàng)建新的文件夾。 
fso.CreateFolder ("C:\\Bogus"); 
Response.Write("Created folder C:\\Bogus" + "<br/>"); 
// 打印文件夾的基本名。 
Response.Write("Basename = " + fso.GetBaseName("c:\\bogus") + "<br/>"); 
// 刪除新創(chuàng)建的文件夾。 
fso.DeleteFolder ("C:\\Bogus"); 
Response.Write("Deleted folder C:\\Bogus" + "<br/>"); 
} 
ASP分頁(yè)函數(shù) 

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

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

If curpage = 1 Then 
retval = retval & "首頁(yè) 前頁(yè) " 
Else 
retval = retval & "<a href='" & LinkFile & "page=1'>首頁(yè)</a> <a href='" & LinkFile & "page=" & cstr(curpage - 1) & "'>前頁(yè)</a> " 
End If 
If curpage = rs.pagecount Then 
retval = retval & "后頁(yè) 末頁(yè)" 
Else 
retval = retval & "<a href='" & LinkFile & "page=" & cstr(curpage + 1) & "'>后頁(yè)</a> <a href='" & LinkFile & "page=" & cstr(rs.pagecount) & "'>末頁(yè)</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 

應(yīng)用 

<% 
adoPageRS.open "SELECT * FROM news ORDER BY addtime DESC", conn, 1, 1 
if err.number <> 0 then 
response.write "數(shù)據(jù)庫(kù)操作失?。?&err.description 
else 
if adoPageRS.eof and adoPageRS.bof then 
response.write "沒(méi)有記錄" 
else 
%> 
<div align="center"> 
<center> 
<table width="100%" border="0" cellspacing="1" cellpadding="2"> 
<tr class="big"> 
<td width="60%">新 聞 標(biāo) 題</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調(diào)用SQL中的圖像： 
如何處理ASP中的圖象 在用ASP編程中，很多時(shí)侯要用到圖象。對(duì)于單純從數(shù)據(jù)庫(kù)中處理一個(gè)圖象，方法大家講了很多，也不難， 可以看下面的代碼： 這里假設(shè)你有個(gè)數(shù)據(jù)庫(kù)名字叫：PUBS，在數(shù)據(jù)庫(kù)中有一個(gè)叫：PUB_INFO的表，在表中有一個(gè)LOGO 的BLOB列。我們查出PUB_ID=0736的人的相片。 FILE: SHOWIMG.ASP *************************************** < %@ LANGUAGE="VBSCRIPT" %> < % ' Clear out the existing HTTP header information Response.Expires = 0 Response.Buffer = TRUE Response.Clear ' Change the HTTP header to reflect that an image is being passed. Response.ContentType = "image/gif" Set cn = Server.CreateObject("ADODB.Connection") ' The following open line assumes you have set up a System DataSource ' by the name of myDSN. cn.Open "DSN=myDSN;UID=sa;PWD=;DATABASE=pubs" Set rs = cn.Execute("SELECT logo FROM pub_info WHERE pub_id='0736'") Response.BinaryWrite rs("logo") Response.End %> ***************************************** 執(zhí)行這個(gè)ASP文件就可以看到你存在數(shù)據(jù)庫(kù)中的圖象了。 但如果是同時(shí)處理文字和圖象就會(huì)有些困難了:-( 比如：一個(gè)企業(yè)的人員管理，后臺(tái)數(shù)據(jù)庫(kù)可以用SYBASE或SQL SERVER等。（我在這用SQL SERVER）當(dāng) 你在企業(yè)內(nèi)部需要用到BROWSE/SERVER方式，即用瀏覽器查看員工的個(gè)人信息時(shí)，就即要處理文字信息同時(shí) 還要用到關(guān)于圖象的技巧。 問(wèn)題在于你顯示文字信息時(shí)HTML的HEAD中的CONTENT=“TEXT/HTML”，而顯示圖象則必須是 CONTENT=“IMAGE/GIF”或者是CONTENT=”IMAGE/JPEG“。因此你是無(wú)法只用一個(gè)ASP文件就把文字信息和 圖象都處理完的，解決的辦法是：用一個(gè)單獨(dú)的ASP文件處理圖象，然后在處理文字信息的ASP文件中調(diào)用 這個(gè)ASP文件。 在這給大家介紹一個(gè)我的解決方法，希望大家一起討論： 環(huán)境：WINNT4.0 SQL SERVER IIS3.0 數(shù)據(jù)庫(kù)名：RSDA 表名：RSDA_TABLE 目的：從RSDA_TABLE中查出ID=00001的人員的信息，包括姓名，年齡和照片 第一步：創(chuàng)建一個(gè)查詢表單RSDA.HTM： ********************************** < html> < head> < /head> < body> < form method="POST" action="SEARCH.ASP"> < p>請(qǐng)輸入編號(hào)：< input type="text" name="T1" size="20"> < input type="submit" value="提交" name="B1"> < /form> < /body> *********************************** 第二步：建立SEARCH.ASP *********************************** < html> < head> < meta http-equiv="content-type" content="text/html;charset=gb2312"> < title>查詢結(jié)果< /title> < /head> < body bgColor=Azure> < % session("RSDA_ID")=Request.Form("T1") '這里我用了一個(gè)SESSION變量，是為了在處理圖象的ASP文件中再次調(diào)用 temp_id=session("RSDA_ID") < font size=4 color=OrangeRed> 查詢結(jié)果：< /font> < %set conntemp=server.createobject("adodb.connection") conntemp.open "dsn=RSDA;uid=sa;pwd=SA" set rstemp=conntemp.execute("select * from RSDA_TABLE where rsda='"&temp_id&"'") % > < % 'put headings on the table of field names nobody="對(duì)不起！在我們的數(shù)據(jù)庫(kù)里沒(méi)有您要找的資料！"%> '判斷是否有這個(gè)人 < %if rstemp.eof then % > < font size="5" color=OrangeRed> < %Response.Write(nobody)% >< /font> < %else% > < div align="center"> < center> < table border="1" width="73%" height="399"> < tr> < td width="21%" height="49" align="center">< p align="center">姓 名< /td> < td width="30%" height="49" align="center"> < font size=4 color=OrangeRed>< /font>< /td> < /td> < tr> < p align="center">年 齡< /td> < td width="30%" height="47" align="center"> < font size=4 color=OrangeRed>< %=rstemp(0)% >< /font>< /td> < /tr> < tr> < td width="49%" height="146" rowspan="3" colspan="2"> < img src="jpg.asp">< /td> 'JPG.ASP就是我們將要建立的專(zhuān)門(mén)處理圖象的ASP文件 < /tr> < /table> < /center>< /div> rstemp.close set rstemp=nothing conntemp.close set conntemp=nothing % > < /BODY> < /HTML> *********************************** 第三步：建立處理圖象的ASP文件。(JPG.ASP) *********************************** < % Response.Expires = 0 Response.Buffer = TRUE Response.Clear ' Open database Set conntemp = Server.CreateObject("ADODB.Connection") conntemp.open "dsn=RSDA;uid=sa;pwd=SA" 'change http header Response.ContentType = "image/jpeg" ' or "IMAGE/GIF" ' Get picture TEMP_ID=session("RSDA_ID") Set Rs = conntemp.Execute("SELECT photo from RSDA_table where ID='"&TEMP_ID&"'") Response.BinaryWrite Rs("photo") Session.Abandon Response.End % > ********************************** 這里主要就是用到了一個(gè)小技巧就是利用了一個(gè)SESSION變量來(lái)實(shí)現(xiàn)兩次同條件查詢。 大家如我上述只需少量改動(dòng)，就可以實(shí)現(xiàn)一個(gè)頁(yè)面既有文字又有圖象了！ 
asp常常用到的一些東西， 
我做東西一般下面的東西經(jīng)常用（拷貝） 


<%=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 
'錯(cuò)誤處理 
response.write "數(shù)據(jù)庫(kù)操作失?。? & 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 "無(wú)法建立到數(shù)據(jù)庫(kù)的連接！" 
end if 
MD5不可逆加密算法的ASP實(shí)現(xiàn)實(shí)例（一） 

此為國(guó)外轉(zhuǎn)載函數(shù)，可將任意字符轉(zhuǎn)換為md5 16為字符加密形式，而且為不可逆轉(zhuǎn)換。 
<% 
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, 
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, 
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, 
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, 
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 
MD5不可逆加密算法的ASP實(shí)現(xiàn)實(shí)例（一） 
-------------------------------------- 

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 

F

最新評(píng)論