| |
<%
' **********************************************************
' 件数取得
' **********************************************************
Function GetMailCount( )
Dim Basp,Result,aWork
Set Basp = Server.CreateObject( "Basp21" )
Result = Basp.RcvMail( _
POP3Server, _
UserName, _
UserPassword, _
"STAT" , _
">" & Server.MapPath( "MailData" ) _
)
if IsArray( Result ) then
aWork = Split( Result( 0 ), " " )
Message = "メールは " & aWork( 0 ) & " 件受信可能です"
else
ErrMessage = "メール処理のエラーです : "
ErrMessage = ErrMessage & Result
end if
Set Basp = Nothing
End Function
' **********************************************************
' ヘッダー情報の一覧
' **********************************************************
Function GetMailList( )
Dim Basp,Result
Set Basp = Server.CreateObject( "Basp21" )
Result = Basp.RcvMail( _
POP3Server, _
UserName, _
UserPassword, _
"LIST" , _
">" & Server.MapPath( "MailData" ) _
)
Set Basp = Nothing
if IsArray( Result ) then
For I = 0 to Ubound( Result )
Call EditMailData( Result( i ) )
Next
else
ErrMessage = "メール処理のエラーです : "
ErrMessage = ErrMessage & Result
end if
End Function
' **********************************************************
' ヘッダー情報の一覧の編集
' **********************************************************
Function EditMailData( RowData )
Dim aMail
aMail = Split( RowData, vbTab )
OutData = OutData & "<TR>"
OutData = OutData & "<TD class=MyCell>"
strWork = Replace( aMail( 1 ), "From: ", "" )
strWork = Server.HTMLEncode( strWork )
OutData = OutData & strWork
OutData = OutData & "</TD>"
OutData = OutData & "<TD class=MyCell>"
OutData = OutData & Replace( aMail( 0 ), "Subject: ", "" )
OutData = OutData & "</TD>"
OutData = OutData & "<TD class=MyCell>"
OutData = OutData & Replace( aMail( 2 ), "Date: ", "" )
OutData = OutData & "</TD>"
OutData = OutData & "</TR>"
End Function
' **********************************************************
' メールデータの受信と一覧
' **********************************************************
Function GetMailList2( )
Dim Basp,Result,I
Set Basp = Server.CreateObject( "Basp21" )
Result = Basp.RcvMail( _
POP3Server, _
UserName, _
UserPassword, _
"SAVE 1-10" , _
">" & Server.MapPath( "MailData" ) _
)
if IsArray( Result ) then
For I = 0 to Ubound( Result )
Call EditMailData2( Basp, Result( i ) )
Next
else
ErrMessage = "メール処理のエラーです : "
ErrMessage = ErrMessage & Result
end if
Set Basp = Nothing
End Function
' **********************************************************
' メールデータの受信と一覧の編集
' **********************************************************
Function EditMailData2( Basp, RowFile )
Dim Result,I
Result = Basp.ReadMail( _
RowFile, _
"", _
Server.MapPath( "MailTemp" ) _
)
if not IsArray( Result ) then
OutData = OutData & "<TR>"
OutData = OutData & "<TD class=MyCell colspan=3>"
OutData = OutData & "読込エラー : " & Result
OutData = OutData & "</TD>"
OutData = OutData & "</TR>"
Exit Function
end if
OutData = OutData & "<TR>"
For I = 0 to Ubound( Result )
if Left( Result(I), 5 ) = "From:" then
OutData = OutData & "<TD class=MyCell>"
OutData = OutData & "<A href=""control.asp?In2Command=ReadMail&target="
OutData = OutData & Server.UrlEncode(RowFile)
OutData = OutData & "&GNO=" & PASS_LIST & """>"
strWork = Replace( Result(I), "From: ", "" )
strWork = Server.HTMLEncode( strWork )
OutData = OutData & strWork
OutData = OutData & "</A>"
OutData = OutData & "</TD>"
end if
Next
For I = 0 to Ubound( Result )
if Left( Result(I), 8 ) = "Subject:" then
OutData = OutData & "<TD class=MyCell>"
OutData = OutData & Replace( Result(I), "Subject: ", "" )
OutData = OutData & "</TD>"
end if
Next
For I = 0 to Ubound( Result )
if Left( Result(I), 5 ) = "Date:" then
OutData = OutData & "<TD class=MyCell>"
OutData = OutData & Replace( Result(I), "Date: ", "" )
OutData = OutData & "</TD>"
end if
Next
OutData = OutData & "</TR>"
End Function
' **********************************************************
' メール本文の表示
' **********************************************************
Function ReadMail( )
Dim Basp,Result,I,strWork
Set Basp = Server.CreateObject( "Basp21" )
Result = Basp.ReadMail( _
MyData( "target" ), _
"", _
Server.MapPath( "MailTemp" ) _
)
if not IsArray( Result ) then
OutData = OutData & "<TR>"
OutData = OutData & "<TD class=MyCell colspan=3>"
OutData = OutData & "読込エラー : " & Result
OutData = OutData & "</TD>"
OutData = OutData & "</TR>"
Exit Function
end if
OutData = OutData & "<TR>"
For I = 0 to Ubound( Result )
if Left( Result(I), 5 ) = "From:" then
OutData = OutData & "<TD class=MyCell><B>"
strWork = Replace( Result(I), "From: ", "" )
strWork = Server.HTMLEncode( strWork )
OutData = OutData & strWork
end if
Next
For I = 0 to Ubound( Result )
if Left( Result(I), 12 ) = "Return-Path:" then
OutData = OutData & "</B><BR>"
OutData = OutData & Replace( Result(I), "Return-Path: ", "" )
OutData = OutData & "</B></TD>"
end if
Next
For I = 0 to Ubound( Result )
if Left( Result(I), 8 ) = "Subject:" then
OutData = OutData & "<TD class=MyCell><B>"
OutData = OutData & Replace( Result(I), "Subject: ", "" )
OutData = OutData & "</B></TD>"
end if
Next
For I = 0 to Ubound( Result )
if Left( Result(I), 5 ) = "Date:" then
OutData = OutData & "<TD class=MyCell>"
OutData = OutData & Replace( Result(I), "Date: ", "" )
OutData = OutData & "</TD>"
end if
Next
For I = 0 to Ubound( Result )
if Left( Result(I), 5 ) = "Body:" then
OutData = OutData & "</TR>"
OutData = OutData & "<TR>"
OutData = OutData & "<TD class=MyCell colspan=3>"
strWork = Replace( Result(I), "Body: ", "" )
strWork = Server.HTMLEncode( strWork )
strWork = Replace( strWork, vbCrLf, "<BR>" )
OutData = OutData & strWork
OutData = OutData & "</TR>"
end if
Next
Set Basp = Nothing
End Function
' **********************************************************
' VIEW の編集
' **********************************************************
Function EditDataHead( )
End Function
' **********************************************************
' VIEW2 の編集
' **********************************************************
Function EditDataBody( )
End Function
%>
| |
