BASP21 + Windows Script Components

  メール処理を定義したサンプルソースコード



  
<?xml version="1.0" encoding="shift_jis" ?>
<component>

<registration
	description="SCWsc"
	progid="SCWsc.WebMail"
	version="1.00"
	classid="{3e987cde-99b5-416f-b5f7-0cccbc33e0c9}"
>
</registration>

<public>
	<property name="ClientType">
		<get/>
		<put/>
	</property>

	<property name="PopServer">
		<get/>
		<put/>
	</property>

	<property name="RcvDir">
		<get/>
		<put/>
	</property>

	<property name="DataCount">
		<get/>
	</property>

	<method name="MailCount">
		<PARAMETER name="UserName"/>
		<PARAMETER name="PassWord"/>
	</method>

	<method name="MailList">
		<PARAMETER name="UserName"/>
		<PARAMETER name="PassWord"/>
	</method>

	<method name="MailSize">
		<PARAMETER name="UserName"/>
		<PARAMETER name="PassWord"/>
		<PARAMETER name="MailNo"/>
	</method>

	<method name="RcvMail">
		<PARAMETER name="UserName"/>
		<PARAMETER name="PassWord"/>
		<PARAMETER name="MailNo"/>
	</method>

	<method name="DelMail">
		<PARAMETER name="UserName"/>
		<PARAMETER name="PassWord"/>
		<PARAMETER name="MailNo"/>
	</method>
</public>

<implements type="ASP" id="ASP"/>

<script language="VBScript">
<![CDATA[

' ************************************************
' 内部共通関数
' ************************************************
function SetMailObject( )

	if not IsObject( Basp21 ) then
		if Ucase( ClientType ) = "ASP" then
			Set Basp21 = Server.CreateObject( "Basp21" )
		else
			Set Basp21 = CreateObject( "Basp21" )
		end if
	end if

end function

Dim Basp21

' ************************************************
' Property : 動作元の種別
' ************************************************
Dim ClientType
ClientType = "ASP"

function get_ClientType()
	get_ClientType = ClientType
end function

function put_ClientType(newValue)
	ClientType = newValue
end function

' ************************************************
' Property : POP サーバ
' ************************************************
Dim PopServer
PopServer = "127.0.0.1"

function get_PopServer()
	get_PopServer = PopServer
end function

function put_PopServer(newValue)
	PopServer = newValue
end function

' ************************************************
' Property : 受信ディレクトリ
' ************************************************
Dim RcvDir
RcvDir = ">C:\TEMP"

function get_RcvDir()
	get_RcvDir = RcvDir
end function

function put_RcvDir(newValue)
	RcvDir = newValue
end function

' ************************************************
' Property : 処理データ数
' ************************************************
Dim DataCount
DataCount = 0

function get_DataCount()
	get_DataCount = DataCount
end function

' ************************************************
' メール総数の取得
' ************************************************
function MailCount( UserName, PassWord )

	Dim Output
	Dim strArray

	Call SetMailObject()

	Output = Basp21.RcvMail( PopServer, UserName, PassWord, "STAT" , ">" & RcvDir )

	if IsArray( Output ) then
		strArray = Split( Output(0), " " )
		if IsArray( strArray ) then
			MailCount = strArray
			DataCount = strArray( 0 ) + 0
		else
			DataCount = 0
			MailCount = DataCount
		end if
	else
		MailCount = Output
	end if

end function

' ************************************************
' メールLIST ( Subject,From,Date )
' ************************************************
function MailList( UserName, PassWord )

	Dim Output

	Call SetMailObject()

	Output = Basp21.RcvMail( PopServer, UserName, PassWord, "LIST" , ">" & RcvDir )

	if IsArray( Output ) then
		DataCount = Ubound( Output ) + 1
	else
		DataCount = 0
	end if

	MailList = Output

end function

' ************************************************
' メールサイズ
' ************************************************
function MailSize( UserName, PassWord, MailNo )

	Dim Output
	Dim OutArray

	Call SetMailObject()

	Output = Basp21.RcvMail( PopServer, UserName, PassWord, "SIZE " & MailNo , ">" & RcvDir )

	if IsArray( Output ) then
		OutArray = Split( Output(0), " " )
		MailSize = OutArray( 1 ) + 0
	else
		MailSize = 0
	end if

end function

' ************************************************
' メール受信
' ************************************************
function RcvMail( UserName, PassWord, MailNo )

	Dim Output
	Dim OutArray

	Call SetMailObject()

	Output = Basp21.RcvMail( PopServer, UserName, PassWord, "SAVE " & MailNo , ">" & RcvDir )

	if IsArray( Output ) then
		OutArray = Basp21.ReadMail( Output(0), "body:nofile:" , ">" & RcvDir )
		If IsArray( OutArray ) then
			RcvMail = OutArray( 0 )
		else
			RcvMail = ""
		end if
	else
		RcvMail = ""
	end if

end function

' ************************************************
' メール削除
' ************************************************
function DelMail( UserName, PassWord, MailNo )

	Dim Output
	Dim OutArray

	Call SetMailObject()

	Output = Basp21.RcvMail( PopServer, UserName, PassWord, "DELE " & MailNo , ">" & RcvDir )

	DelMail = ""

end function

]]>
</script>

</component>

  










  infoboard   管理者用   
このエントリーをはてなブックマークに追加





フリーフォントWEBサービス
SQLの窓WEBサービス

SQLの窓フリーソフト

素材

一般WEBツールリンク

SQLの窓

フリーソフト

JSライブラリ