VERSION 5.00
Begin VB.Form nMailCheckerForm 
   BorderStyle     =   3  '固定ﾀﾞｲｱﾛｸﾞ
   Caption         =   "mail checker"
   ClientHeight    =   570
   ClientLeft      =   45
   ClientTop       =   615
   ClientWidth     =   2520
   BeginProperty Font 
      Name            =   "ＭＳ ゴシック"
      Size            =   12
      Charset         =   128
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "nMailCheckerFrom.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   570
   ScaleWidth      =   2520
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '画面の中央
   Visible         =   0   'False
   Begin VB.Timer tmrIconBlink 
      Enabled         =   0   'False
      Interval        =   1800
      Left            =   480
      Top             =   0
   End
   Begin VB.PictureBox picIconNonMail 
      Height          =   495
      Left            =   1800
      Picture         =   "nMailCheckerFrom.frx":0442
      ScaleHeight     =   435
      ScaleWidth      =   555
      TabIndex        =   1
      Top             =   0
      Width           =   615
   End
   Begin VB.PictureBox picIconGetMail 
      Height          =   495
      Left            =   1080
      Picture         =   "nMailCheckerFrom.frx":0884
      ScaleHeight     =   435
      ScaleWidth      =   555
      TabIndex        =   0
      Top             =   0
      Width           =   615
   End
   Begin VB.Timer tmrMailCheck 
      Enabled         =   0   'False
      Interval        =   30000
      Left            =   0
      Top             =   0
   End
   Begin VB.Menu MenuMain 
      Caption         =   "ファイル(&F)"
      Begin VB.Menu MenuSelectSetting 
         Caption         =   "環境設定(&S)"
      End
      Begin VB.Menu MenuSelectEnd 
         Caption         =   "プログラム終了(&E)"
      End
   End
End
Attribute VB_Name = "nMailCheckerForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

'表示メッセージ
Private pstrDisplayMessage As String
'メールチェック状態フラグ
Private pblnMailCheckIngFlg As Boolean

Private Sub Form_Load()
    Dim lngRet As Long

    '二重起動禁止
    If App.PrevInstance = True Then
        Unload Me
    End If

    '初期化
    pblnMailCheckIngFlg = False
    pstrDisplayMessage = "接続中..."

    'レジストリに読込
    Call RegisterEdit(1000, REG_DIR_NAME, App.EXEName)

    '環境設定が行われていない場合
    If gtypUser.UserID = "" Or _
       gtypUser.ServerAddress = "" Or _
       (gtypUser.MailerFlg <> 0 And gtypUser.MailerPath = "") Or _
       gtypUser.LastUpdate = "" Or _
       gtypUser.CheckSum = "" Then
        MsgBox "環境設定が不明確なため設定してください", vbQuestion, "環境設定"
        'メールチェック停止
        tmrMailCheck.Enabled = False
        '設定画面表示
        nMailSettingForm.Show vbModal
        'メールチェック開始の場合
        If tmrMailCheck.Enabled = True Then
            'メールチェック
            Call tmrMailCheck_Timer
        End If
    Else
        'メールチェック開始
        tmrMailCheck.Enabled = True
    End If

    'メールチェックインターバルを設定
    Select Case gtypUser.MailCheckInterval
    Case 0      '　２秒
        nMailCheckerForm.tmrMailCheck.Interval = 2000
    Case 1      '　５秒
        nMailCheckerForm.tmrMailCheck.Interval = 5000
    Case 2      '１０秒
        nMailCheckerForm.tmrMailCheck.Interval = 10000
    Case 3      '１５秒
        nMailCheckerForm.tmrMailCheck.Interval = 15000
    Case 4      '２０秒
        nMailCheckerForm.tmrMailCheck.Interval = 20000
    Case 5      '３０秒
        nMailCheckerForm.tmrMailCheck.Interval = 30000
    Case 6      '４５秒
        nMailCheckerForm.tmrMailCheck.Interval = 45000
    Case Else   '６０秒
        nMailCheckerForm.tmrMailCheck.Interval = 60000
    End Select

    'タスクバーにアイコン追加
    lngRet = SetTaskBerIcon(NIM_ADD, pstrDisplayMessage)

    'ソケットセットアップ
    lngRet = WSAStartup(MAKEWORD(2, 0), WinsockInfo)

    'ソケットバージョン
    Debug.Print StrConv(WinsockInfo.szDescription, vbUnicode)
    'システムステータス
    Debug.Print StrConv(WinsockInfo.szSystemStatus, vbUnicode)

    'メールチェック開始の場合
    If tmrMailCheck.Enabled = True Then
        'メールチェック
        Call tmrMailCheck_Timer
    End If
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim strRunMailerPath As String

    On Error Resume Next

    'マウスの操作によって分岐
    Select Case X \ Screen.TwipsPerPixelX
    Case WM_LBUTTONUP       '左ボタンアップ
        '起動メーラーが設定されている場合
        If (gtypUser.MailerFlg = 0 And Len(Trim(gtypUser.NormalMailerPath)) > 0) Or _
           (gtypUser.MailerFlg = 1000 And Len(Trim(gtypUser.MailerPath)) > 0) Then
            '起動メーラーのパスを設定
            Select Case gtypUser.MailerFlg
            Case 0      '標準メーラー
                strRunMailerPath = gtypUser.NormalMailerPath
            Case 1000   '独自メーラー
                strRunMailerPath = gtypUser.MailerPath
            End Select
            'メーラー起動
            Call Shell(strRunMailerPath, vbNormalFocus)
        End If
    Case WM_RBUTTONUP       '右ボタンアップ
        PopupMenu MenuMain
        Exit Sub
    End Select
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Dim lngRet As Long

    'ソケットクリーンアップ
    lngRet = WSACleanup()

    'タスクバーにアイコン追加
    lngRet = SetTaskBerIcon(NIM_DELETE, "")

    End
End Sub

Private Sub MenuSelectEnd_Click()
    'メールチェックタイマー停止
    tmrMailCheck.Enabled = False

    'メールチェックが終了するまで待機
    Do
        'メールチェック終了の場合
        If pblnMailCheckIngFlg = False Then
            '待機解除
            Exit Do
        End If
    Loop

    'プログラム終了
    Unload Me
End Sub

Private Sub MenuSelectSetting_Click()
    '設定画面表示
    nMailSettingForm.Show vbModal
End Sub

Private Sub tmrIconBlink_Timer()
    Dim lngRet As Long

    'アイコン初期化
    Me.Icon = Nothing

    'タスクバーのアイコン更新
    lngRet = SetTaskBerIcon(NIM_MODIFY, pstrDisplayMessage)

    'スリープ
    Call Sleep(800)

    'メール有りアイコン設定
    Me.Icon = picIconGetMail

    'タスクバーのアイコン更新
    lngRet = SetTaskBerIcon(NIM_MODIFY, pstrDisplayMessage)
End Sub

Private Sub tmrMailCheck_Timer()
    Dim lngRet As Long

    'メールチェック中の場合は終了
    If pblnMailCheckIngFlg = True Then
        Exit Sub
    End If

    'メールチェック中
    pblnMailCheckIngFlg = True

    'メール取得
    lngRet = ConnectSocketMailPort()

    'アイコン変更
    If CLng(lngRet) > 0 Then
        'メール有りアイコン設定
        Me.Icon = picIconGetMail
        'アイコンブリンク起動
        tmrIconBlink.Enabled = True
    Else
        'メール無しアイコン設定
        Me.Icon = picIconNonMail
        'アイコンブリンク停止
        tmrIconBlink.Enabled = False
    End If

    '受信件数設定
    pstrDisplayMessage = "Mail受信 : " & CLng(lngRet) & " 件"

    'タスクバーのアイコン更新
    lngRet = SetTaskBerIcon(NIM_MODIFY, pstrDisplayMessage)

    'メールチェック終了
    pblnMailCheckIngFlg = False

End Sub

Private Function SetTaskBerIcon(ByVal lngNotifyIcon As Long, ByVal strDisplayMsg As String)
    Dim lngi As Long
    Dim lngRet As Long
    Dim bytTip() As Byte
    Dim nidIconData As NOTIFYICONDATA

    'アイコン各種設定
    With nidIconData
        .cbSize = Len(nidIconData)                      '構造体のサイズを設定
        .hWnd = Me.hWnd                                 'ウィンドウハンドルを設定
        .uID = 0
        .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE    'どれが有効なデータを含むかを設定
        .uCallbackMessage = WM_MOUSEMOVE                '通知メッセージを設定
        .hIcon = Me.Icon                                'アイコンハンドルを設定
        'タスクトレイのコメントテキストを設定
        bytTip = StrConv(strDisplayMsg & Chr(0), vbFromUnicode)
        For lngi = 0 To UBound(bytTip)
            .szTip(lngi) = bytTip(lngi)
        Next lngi
    End With
    'タスクトレイのアイコンを追加
    lngRet = Shell_NotifyIcon(lngNotifyIcon, nidIconData)
    Me.Refresh
End Function

Private Function ConnectSocketMailPort() As Long
    Dim lngCnt As Long
    Dim lngRet As Long
    Dim lngHostRet As Long
    Dim typHostent As hostent
    Dim lngHostAddress As Long
    Dim lngHostBaseAddress As Long
    Dim lngDescriptor As Long
    Dim typAddress As sockaddr_in
    Dim strRecvSplit() As String
    Dim strRecvWork As String

    '戻り値初期化
    ConnectSocketMailPort = 0

    'ソケット作成
    lngDescriptor = socket(AF_INET, SOCK_STREAM, 0)
    'ホスト名取得
    lngHostRet = gethostbyname(gtypUser.ServerAddress)
    'mail.rc4.so-net.ne.jp

    '取得成功の場合
    If lngHostRet <> 0 Then
        'ホスト情報コピー
        Call MoveMemory(typHostent, ByVal lngHostRet, Len(typHostent))
        'アドレスリストを取り出し
        Call MoveMemory(lngHostBaseAddress, ByVal typHostent.h_addr_list, Len(lngHostBaseAddress))
        'ベースアドレスを取り出し
        Call MoveMemory(lngHostAddress, ByVal lngHostBaseAddress, typHostent.h_length)
        'ソケット情報設定
        With typAddress
            .sin_family = AF_INET
            .sin_port = htons(ACCESS_PORT)
            .sin_addr.S_addr = lngHostAddress
        End With
        'ソケット接続
        lngRet = connect(lngDescriptor, typAddress, Len(typAddress))
        If lngRet = 0 Then
            'ソケットデータ受信
            strRecvWork = SocketRecv(lngDescriptor)
            Debug.Print strRecvWork
            strRecvSplit() = Split(strRecvWork, "<")
            strRecvSplit() = Split(strRecvSplit(1), ">")
            'メール情報取得
            lngRet = YouGetMail(lngDescriptor, strRecvSplit(0))
            '戻り値にメール件数を設定
            ConnectSocketMailPort = lngRet
        End If
    End If
    'ソケットをクローズ
    lngRet = closesocket(lngDescriptor)
End Function

Private Function SocketSend(ByVal lngDescriptor As Long, ByVal strSendCommand As String) As Long
    'ソケットデータ送信
    SocketSend = send(lngDescriptor, strSendCommand, Len(strSendCommand), 0)
End Function

Private Function SocketRecv(ByVal lngDescriptor As Long) As String
    Dim lngRet As Long
    Dim strRecvData As String * RECV_BUFF_SIZE

    'ソケットデータ受信
    lngRet = recv(lngDescriptor, strRecvData, Len(strRecvData), 0)
    If lngRet > 0 Then
        '改行コード削除
        SocketRecv = Left(strRecvData, InStr(1, strRecvData, vbCrLf, vbTextCompare) - 1)
    Else
        SocketRecv = ""
    End If
End Function

Private Function YouGetMail(ByVal lngDescriptor As Long, ByVal strAPOP_MD5 As String) As Long
    Dim lngRet As Long
    Dim lngSendCnt As Long
    Dim strSendData(3) As String
    Dim strRecvSplit() As String
    Dim strRecvWork As String

    '戻り値初期化
    YouGetMail = 0

    '送信データ設定
    lngSendCnt = 0
    strSendData(0) = "USER " & gtypUser.UserID & vbCrLf
    strSendData(1) = "PASS " & gtypUser.Password & vbCrLf
    strSendData(2) = "STAT" & vbCrLf
    strSendData(3) = "QUIT" & vbCrLf

    Do
        'ソケットデータ送信
        lngRet = SocketSend(lngDescriptor, strSendData(lngSendCnt))
        'ソケットデータ受信
        strRecvWork = SocketRecv(lngDescriptor)
        '受信データがある場合
        If Len(Trim(strRecvWork)) > 0 Then
            'メール件数を確認
            If strSendData(lngSendCnt) = "STAT" & vbCrLf Then
                strRecvSplit() = Split(strRecvWork, " ")
                Debug.Print "受信件数 : "; strRecvSplit(1)
                Debug.Print "受信容量 : "; strRecvSplit(2)
                '受信件数を戻り値に設定
                YouGetMail = CLng(strRecvSplit(1))
            End If
        Else
            Exit Do
        End If
        '送信コマンドカウントアップ
        lngSendCnt = lngSendCnt + 1
    Loop While lngSendCnt < UBound(strSendData) + 1
End Function