关于不能打开收件箱的问题，着急请指教

ddalone 2002-09-27 05:48:43

情况是这样的，原来写的程序都没有问题
现在出现了这样的问题，
可以打开文件夹查看邮件的数量
但是如果收件箱里有邮件的话，就怎么都进不去，到后来显示超时

好象是循环有问题，但程序原来一直是好的，所以不知道问题出在哪里？程序在下面，
请大家指教一下，万分感谢！！！

<%@ LANGUAGE="VBSCRIPT" %>
<%
'Option Explicit
const ADS_UF_NORMAL_ACCOUNT = 2
const ADS_SECURE_AUTHENTICATION = 1

function size(num)
if num >=1000000 then
size=formatnumber(num/1000000,1)&"mb"
end if
if num >= 1000 then
size=formatnumber(num/1000,0)&"k"
end if
if num <1000 then
size=formatnumber(num/1000,1,-1)&"字节"
end if

end function

Function GetStorageName()
' Return the name of the storage for
' the current server, using ADSI and the ADActive Directory.
' The return value is in the format:
' file://.backofficestorage/<domainname>/
' Turn on error trapping for VB and VBS
' On Error Resume Next

Dim SysInfo ' As ActiveDs.ADSystemInfo
Dim strName ' As String

' Reference the ADSystemInfo object in the
Set SysInfo = Server.CreateObject("ADSystemInfo")
' Get the domain name

strName = SysInfo.DomainDNSName

If Len(strName) <> 0 Then
' Build the generic part of the EXOLEDB string
GetStorageName = "file://./backofficestorage/" & strName & "/"
Else
' Problem accessing the AD
Err.Raise vbObjectError + 1959, "Unable to retrieve domain name."
End If
' Response.Write( GetStorageName )
' Clean up
Set SysInfo = Nothing
End Function
Sub GetAllMail(strUserName)
Dim strMBXAlias, urlMailBox, urlMsg 'As String

On Error Resume Next
' Change this to your alias
strMBXAlias = strUserName
' URL to the TestMessage
urlMailBox = GetStorageName & "MBX/" & strMBXAlias & "/收件箱"

Dim folder 'As CDO.Folder
Dim fd 'As ADODB.Field
Dim msg

set folder = Server.CreateObject("CDO.Folder")
folder.DataSource.Open(urlMailBox)
if Err.number <> 0 then
Response.Write("<BR>Error:" & "Num=" & Err.number & ", Desc=" & Err.description & "Source=" & Err.source)
exit sub
end if

%>
<body topmargin="0"><form method="post" align="left" action="del.asp">
<input type="hidden" name="listmsg_top" value="">
<input type="hidden" name="boxname" value=.>
<table width="95%" border="0" cellspacing="0" cellpadding="0" align="center"
class="unnamed1">
<tr bgcolor="#306CA3" class="unnamed1">
<td height="20" class="unnamed1" colspan="9"><font color="#ffffff"><% =name%> 的收件箱
（共有
<% =folder.ItemCount %>
封邮件，其中 <% =folder.UnreadItemCount %> 封新邮件）</font></td>
</tr>
<tr bgcolor="#FFFFFF" class="unnamed1">

<td><input type=image name="del" src="./image/menu010.gif" alt="删除"
border="0" ONCLICK="DeleteFile();">
</td>
<td align=right width="10%"> </td>
<td align=right width="10%"> </td>
<td height="32" class="unnamed1" valign="bottom" nowrap>
<div align="right"> POP信件</div>
</td>
</tr>

<tr><td colspan=9>
<table border=0 cellpadding=2 cellspacing=1 valign="top" align="center"
width=100%>
<tr bgcolor="#306CA3">
<td align="left" valign="middle" width="23"> </td>
<td valign="middle" class="lemon1" align="left" width="33"><font
color="#ffffff">附件</font></td>
<td valign="middle" class="lemon1" align="left" width="145"><font
color="#ffffff">
发件人 </font></td>
<td valign="middle" class="lemon1" align="center" width="264"><font
color="#ffffff">
主题 </font></td>
<td valign="middle" class="lemon1" align="center" width="150"><font
color="#ffffff">
日期 </font></td>
<td valign="middle" class="lemon1" align="center" width="56"><font
color="#ffffff">
字节 </font></td>

<%

dim rec, rs
set rec = Server.CreateObject("ADODB.Record")
rec.Open urlMailBox
set rs = rec.GetChildren
' dim i
'i = 0
do until rs.EOF

urlMsg = rs.Fields("DAV:href")

Dim uid
uid = strUserName
call OpenMsg(uid, urlMsg)
rs.MoveNext

Loop

rec.Close

set folder = nothing
set fd = nothing
End sub

Sub OpenMsg(uid,urlMsg)
' Opens a message and enumerates the properties.
' This procedure uses the TestMessage created
' by the CreateTestMessage procedure.
dim sends
dim subs
Dim msg 'As CDO.Message
Dim fd 'As ADODB.Field

' On Error Resume Next

Set msg = Server.CreateObject("CDO.Message")

msg.DataSource.Open(urlMsg)

if Err.number <> 0 then
Response.Write("<BR>Error:" & "Num=" & Err.number & ", Desc=" & Err.description & "Source=" & Err.source)
exit sub
end if

files=msg.fields("DAV:href")
id=msg.fields("urn:schemas:mailheader:message-id")
attach = msg.Fields("urn:schemas:httpmail:hasattachment")
sends = msg.Fields("urn:schemas:httpmail:sendername")
read = msg.Fields("urn:schemas:httpmail:read")
subs = msg.Fields("urn:schemas:httpmail:subject")
dates=msg.fields("urn:schemas:mailheader:date")
sizes=msg.fields("DAV:getcontentlength")
sizes=size(sizes)
id1=right(left(id,len(id)-1),len(id)-2)
%>
<tr bgcolor="#D7EAF9">
<td align="left" valign="middle" width="23"><input type="checkbox" name="box" value="<%=id1%>"></td>
<td valign="middle" class="lemon1" align="center" width="33"><font
color="#000000"><%if attach then
Response.Write "<img src='image/attimg.gif'>"
else
Response.Write ""
end if%></font></td>
<td valign="middle" class="lemon1" align="left" width="145"><font
color="#000000">
<% =sends %> </font></td>
<td valign="middle" class="lemon1" align="center" width="264"><font
color="#000000">
<a href="emailxx.asp?url=<% = id %>" target="_self"><% =subs %></a> </font></td>
<td valign="middle" class="lemon1" align="center" width="150"><font
color="#000000">
<% =dates %> </font></td>
<td valign="middle" class="lemon1" align="center" width="56"><font
color="#000000">
<% =sizes %> </font></td>
</tr>

<%

' Check for attachments
dim atch ' CDO.IBodyPart
Dim stm ' As ADODB.Stream
dim urlAtch
dim msgID

Set fd = Nothing
Set msg = Nothing
Set atch = Nothing
End Sub
%>
<html>
<head>
<title>收件箱
</title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<LINK href="bbs.css" rel="stylesheet">

<script language="JavaScript">


function DeleteFile(){
//this function will delete the responding File
////////////////////////////////////////////////////////////
if (!(window.confirm("确实要删除邮件吗?"))){
event.returnValue = false;
return 0;
}
}

</script>
</head>
<body>

<% name=session("user")
name=trim(name)
%>
<table width="758" border="0" cellspacing="0" cellpadding="0" align="center">
<tr>
<td width="20%" valign="top" bgcolor="#93C4E1"> <br>
<br><br>
</td>
<td width="80%" valign="top" bgcolor="#FFFFFF"> <br>
<div align="left">

<%GetAllMail name %>
</tr>
</table>
</td></tr>
<tr bgcolor="#FFFFFF">
<td height="10" class="unnamed1" colspan="9">

</td>
</tr>

</table> <table align=center><tr><td>
<input type="checkbox" name="chkall" value="on" onclick="CheckAll(this.form)" >选中所有显示的邮件
</td></tr></table> <br>
</form>
</div>
</td>
</tr>
</table>
<table width="758" align="center"><tr><td></td></tr></table>
</body>
</html>

...全文