WILLはネットワークに関するあらゆるソリューションをご提供します。
	株式会社ウィル

概 要

MAILCHKはPOPプロトコルを利用して、メールが到着しているかどうかを調べるプログラムです。 このプログラムを応用すると、独自のメールプログラムを作成することができるようになります（なるかもしれません）。

プログラミング概要

変数Actionに何をしているのかを記憶しておく。

• "INIT" これからConnectメソッドを発行した。
• "USER" Sendメソッドを用いてUSERコマンドを発行した。
• "PASS" Sendメソッドを用いてPASSコマンドを発行した。
• "QUIT" Sendメソッドを用いてQUITコマンドを発行した。
• "CLOSE" Closeメソッドを発行した。

発行したメソッド・コマンドと、それに対するサーバーからのメッセージ(Reply)に応じて処理を切り替える。

ソースコード

'(C)COPYRIGHT 1997 WILL
Option Explicit
Dim Action$
Dim Reply$
'記録を残す
Sub log(state$)
    List1.AddItem Action & ":" & state
    List1.ListIndex = List1.NewIndex    '最後に追加した行を選択
End Sub


'チェック開始ボタン
Private Sub Command1_Click()
    '２度押しされないようにする
    Command1.Enabled = False
    Command2.Enabled = True
    'ログをクリア
    List1.Clear
    Action = "INIT"
    Call log("CONNECT")
    Reply = ""
    Label1 = "チェック中"
    'POPサーバーはポート110
　　Tcpip1.Connect Text1(0), "110", "0"
End Sub
'中断ボタン
Private Sub Command2_Click()
    Label1 = "中断しました"
    Tcpip1.Close
End Sub
'フォームロード
Private Sub Form_Load()
    Label5 = Tcpip1.copyright
End Sub
'通信が切断された。ここに終了処理をまとめておく
Private Sub Tcpip1_Closed()
    Call log("CLOSED")
    Command1.Enabled = True
    Command2.Enabled = False
End Sub

Private Sub Tcpip1_Connected()
    Call log("CONNECTED")
End Sub

'データを受信した
Private Sub Tcpip1_Received(data As String)
    Dim d$     
    'ANSI/DBCSコードからUnicode変換する
    Reply = Reply & StrConv(data, vbUnicode)
    '改行が来るまで待つ
    If (Right$(Reply, 2) <> vbCrLf) Then
        Exit Sub
    End If
    '行末の改行コードを取る
    Reply = Left$(Reply, Len(Reply) - 2)
    Call log("RECV:" & Reply)
    'エラーならそれを表示して終わり
    If (Left$(Reply, 4) = "-ERR") Then
        Label1 = Mid(Reply, 6)
        Tcpip1.Close
        Exit Sub
    End If
    '何をしたかに応じて処理を変える
    Select Case Action
    Case "INIT" '接続した。ユーザー名を入れる
        Action = "USER"
        Reply = ""
        d = StrConv(Action & " " & Text1(1) & vbCrLf, 128)
        Tcpip1.Send d
    Case "USER" 'パスワードを入れる
        Action = "PASS"
        Reply = ""
        d = StrConv(Action & " " & Text1(2) & vbCrLf, 128)
        Tcpip1.Send d
    Case "PASS" '目的は果たしたのでQUITを送信して終了をする
        Label1 = Mid$(Reply, 4)
        Action = "QUIT"
        Reply = ""
        d = StrConv(Action & vbCrLf, 128)
        Tcpip1.Send d
    Case "QUIT" '最終メッセージを受け取った
        Action = "CLOSE"
        Tcpip1.Close
    End Select

End Sub

Private Sub Text1_GotFocus(Index As Integer)
    Text1(Index).SelStart = 0
    Text1(Index).SelLength = Len(Text1(Index))
End Sub