メール受信時にプログラムを起動するサンプル(VB6)

＜このサンプルの概要＞
メール受信時にメーラー等のプログラムを起動するサンプルです。Basp21(Bsmtp.dll)を使用し、とてもシンプルで簡単でした。

このサンプルの仕様は、メールサーバーのメールボックスにメールが存在する時にメーラープログラムを起動するというものです。
メールボックスのメールはそのまま残しますので、メーラーで受信する事が出来ます。
このサンプルは定期的にメールを受信しますので、メールボックスからメールが削除されるまで何度もプログラム起動してしまう
事が無いように、メールボックスが一度空になってから、新たにメールを受信した時のみプログラムを起動するようにしています。
このサンプルではOutLook Express(msimn.exe)を起動していますが、シャットダウン(shutdown.exe)を起動する事でパソコンの
シャットダウン／再起動が出来ます。しかし、メールを削除しないと何度も再起動してしまう恐れがあるので、何らかの細工が
必要になると思います。

このサンプルに関連したツールとして指令メール実行というものがあります。
指令メール実行は、受信メールを監視しメールタイトルのキーワードに対応したプログラムを実行するというツールです。
実行するプログラムを予め複数登録して置いて、メールのタイトルで実行するプログラムを切り替える事が出来ます。
メールのタイトルに実行するPATHをそのまま指定する方法も考えましたが、どんなプログラムでも実行出来てしまうので、
セキュリティ的に問題有りということでキーワードという手法を採用しています。

また、メールでシャットダウン／再起動する方法(フリーソフト機能)があります。

' メール受信ＡＰＩ
Private Declare Function RcvMail Lib "bsmtp" _ 
(szServer As String, szUser As String, szPass As String, szCommand As String, szDir As String) As Variant

' カレントディレクトリを変更するAPI
Private Declare Function SetCurrentDirectory Lib "kernel32" Alias "SetCurrentDirectoryA" _
(ByVal CurrentDir As String) As Long

' プログラム起動済みフラグ
Private AlreadyExecFlag As Boolean

Private Sub Timer1_Timer()
    
   'カレントディレクトリの変更
    SetCurrentDirectory App.Path
    
    ' メール受信
    Dim outary As Variant
    outary = RcvMail("pop.xxx.com", "userid", "passwd", "LIST 1-1", App.Path)
    If IsArray(outary) Then
        ' 受信メール有り
        If AlreadyExecFlag = False Then
            ' プログラムを起動していない時は起動する
            If MsgBox("メールを受信したのでプログラムを起動します。" & vbCrLf & _
                      "宜しいですか？", vbQuestion Or vbYesNo, "メール受信") = vbYes Then
                ' メーラー起動
                Shell "C:\Program Files\Outlook Express\msimn.exe", vbNormalFocus
            End If
            ' プログラム起動済みフラグを設定
            AlreadyExecFlag = True
        End If
    Else
        ' 受信メール無し
        ' プログラム起動済みフラグをクリア
        AlreadyExecFlag = False
    End If
    
End Sub