home *** CD-ROM | disk | FTP | other *** search
/ CD Shareware Magazine 1999 April / CD_Shareware_Magazine_31.iso / Free / Prg / e-checker.exe / frmNotify.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1998-08-07  |  12.7 KB  |  388 lines
  1. VERSION 5.00
  2. Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
  3. Begin VB.Form frmMain 
  4.    BorderStyle     =   1  'Fixed Single
  5.    Caption         =   "E-mail checker"
  6.    ClientHeight    =   2355
  7.    ClientLeft      =   45
  8.    ClientTop       =   615
  9.    ClientWidth     =   4665
  10.    Icon            =   "frmNotify.frx":0000
  11.    LinkTopic       =   "Form1"
  12.    MaxButton       =   0   'False
  13.    MinButton       =   0   'False
  14.    ScaleHeight     =   2355
  15.    ScaleWidth      =   4665
  16.    ShowInTaskbar   =   0   'False
  17.    StartUpPosition =   2  'CenterScreen
  18.    Visible         =   0   'False
  19.    Begin MSWinsockLib.Winsock wsock 
  20.       Left            =   240
  21.       Top             =   1680
  22.       _ExtentX        =   741
  23.       _ExtentY        =   741
  24.       _Version        =   327681
  25.    End
  26.    Begin VB.PictureBox TrayIcon 
  27.       BorderStyle     =   0  'None
  28.       Height          =   555
  29.       Left            =   1260
  30.       Picture         =   "frmNotify.frx":030A
  31.       ScaleHeight     =   555
  32.       ScaleWidth      =   495
  33.       TabIndex        =   3
  34.       Top             =   1680
  35.       Visible         =   0   'False
  36.       Width           =   495
  37.    End
  38.    Begin VB.CommandButton cmdOpenEmail 
  39.       Caption         =   "Ver e-mail"
  40.       Height          =   435
  41.       Left            =   3480
  42.       TabIndex        =   1
  43.       Top             =   1740
  44.       Width           =   1035
  45.    End
  46.    Begin VB.CommandButton cmdAceptar 
  47.       Caption         =   "Aceptar"
  48.       Default         =   -1  'True
  49.       Height          =   435
  50.       Left            =   2280
  51.       TabIndex        =   0
  52.       Top             =   1740
  53.       Width           =   1035
  54.    End
  55.    Begin VB.Timer tmrCheck 
  56.       Interval        =   60000
  57.       Left            =   720
  58.       Top             =   1680
  59.    End
  60.    Begin VB.Label lblMsg 
  61.       Alignment       =   2  'Center
  62.       BeginProperty Font 
  63.          Name            =   "MS Sans Serif"
  64.          Size            =   9.75
  65.          Charset         =   0
  66.          Weight          =   400
  67.          Underline       =   0   'False
  68.          Italic          =   0   'False
  69.          Strikethrough   =   0   'False
  70.       EndProperty
  71.       Height          =   375
  72.       Index           =   1
  73.       Left            =   1200
  74.       TabIndex        =   4
  75.       Top             =   60
  76.       Width           =   2595
  77.    End
  78.    Begin VB.Image imgNewMail 
  79.       Height          =   675
  80.       Left            =   180
  81.       Top             =   360
  82.       Width           =   675
  83.    End
  84.    Begin VB.Label lblMsg 
  85.       Alignment       =   2  'Center
  86.       BeginProperty Font 
  87.          Name            =   "MS Sans Serif"
  88.          Size            =   13.5
  89.          Charset         =   0
  90.          Weight          =   400
  91.          Underline       =   0   'False
  92.          Italic          =   0   'False
  93.          Strikethrough   =   0   'False
  94.       EndProperty
  95.       Height          =   840
  96.       Index           =   0
  97.       Left            =   960
  98.       TabIndex        =   2
  99.       Top             =   360
  100.       Width           =   3525
  101.    End
  102.    Begin VB.Menu mnuOptions 
  103.       Caption         =   " "
  104.       Enabled         =   0   'False
  105.       Begin VB.Menu mnuOptionsCheckNow 
  106.          Caption         =   "Chequear ahora"
  107.       End
  108.       Begin VB.Menu mnuOptionsExecutemail 
  109.          Caption         =   "Ejecutar programa mail"
  110.       End
  111.       Begin VB.Menu mnuOptionsSep1 
  112.          Caption         =   "-"
  113.       End
  114.       Begin VB.Menu mnuOptionsConfigurar 
  115.          Caption         =   "Configurar..."
  116.       End
  117.       Begin VB.Menu mnuOptionsHabilitado 
  118.          Caption         =   "Habilitado"
  119.          Checked         =   -1  'True
  120.       End
  121.       Begin VB.Menu mnuOptionsAbout 
  122.          Caption         =   "Acerca de ..."
  123.       End
  124.       Begin VB.Menu mnuOptionsSep2 
  125.          Caption         =   "-"
  126.       End
  127.       Begin VB.Menu mnuOptionsCerrar 
  128.          Caption         =   "Cerrar"
  129.       End
  130.    End
  131. Attribute VB_Name = "frmMain"
  132. Attribute VB_GlobalNameSpace = False
  133. Attribute VB_Creatable = False
  134. Attribute VB_PredeclaredId = True
  135. Attribute VB_Exposed = False
  136. 'e-checker
  137. 'Checks for incoming mail (POP3)
  138. 'starts in the system tray
  139. 'by Julio Daniel Moreyra
  140. 'Rawson - Chubut - Argentina
  141. '21/07/98
  142. 'This program and the source code are freeware
  143. 'Feel free to use and modify it.
  144. 'Just say who made it.
  145. Option Explicit
  146. Dim result As Long
  147. Dim Response As String
  148. Dim TimeToCheck As Integer
  149. Dim ShowAlert As Boolean
  150. 'Code taken (or stolen) from
  151. 'www.brianharper.demon.co.uk
  152. 'thanks Brian !!
  153. Private Sub ShowProgramInTray()
  154.     NI.cbSize = Len(NI) 'set the length of this structure
  155.     NI.hwnd = TrayIcon.hwnd 'control to receive messages from
  156.     NI.uID = 0 'uniqueID
  157.     NI.uID = NI.uID + 1
  158.     NI.uFlags = NIF_MESSAGE Or NIF_ICON Or NIF_TIP 'operation flags
  159.     NI.uCallbackMessage = WM_MOUSEMOVE 'recieve messages from mouse activities
  160.     TrayIcon.Picture = LoadResPicture(20, vbResIcon)
  161.     NI.hIcon = TrayIcon.Picture  'the location of the icon to display
  162.     NI.szTip = LoadResString(Language) + Chr$(0)  'the tool tip to display
  163.     result = Shell_NotifyIconA(NIM_ADD, NI) 'add the icon to the system tray
  164. End Sub
  165. 'Changes icon and tip in the system tray
  166. Private Sub ShowIconInTray(NroIcon As Integer, msg As String)
  167.     NI.szTip = msg + Chr(0)
  168.     TrayIcon.Picture = LoadResPicture(NroIcon, vbResIcon)
  169.     NI.hIcon = TrayIcon.Picture
  170.     result = Shell_NotifyIconA(NIM_MODIFY, NI) 'add the icon to the system tray
  171. End Sub
  172. 'Modify the menus for english
  173. Private Sub ChangeMenus()
  174.     mnuOptionsAbout.Caption = "About ..."
  175.     mnuOptionsCheckNow.Caption = "Check Now!!"
  176.     mnuOptionsCerrar.Caption = "Exit"
  177.     mnuOptionsExecutemail.Caption = "Run e-mail program"
  178.     mnuOptionsConfigurar.Caption = "Configure ..."
  179.     mnuOptionsHabilitado.Caption = "Enabled"
  180. End Sub
  181. 'Waits syncronically for server's answer
  182. Function WaitFor(ResponseCode As String, Respuesta As String) As Boolean
  183.     Dim start As Single, Tmr As Single
  184.     Static nIcon As Integer
  185.     If nIcon = 0 Then nIcon = 40
  186.     start = Timer ' Not forever
  187.     While Len(Response) = 0
  188.         Tmr = Timer - start
  189.         DoEvents
  190.         
  191.         ShowIconInTray nIcon, LoadResString(Language + 16)
  192.         If Tmr > Val(Timeout) Then  ' Time in seconds to wait
  193.             Exit Function
  194.         End If
  195.         
  196.         Sleep 200       'wait just that
  197.         nIcon = nIcon + 10 'change icon - spinning
  198.         If nIcon > 70 Then nIcon = 40
  199.           
  200.     Wend
  201.     Respuesta = Response
  202.     Response = "" ' **IMPORTANT:
  203.     WaitFor = True
  204. End Function
  205. 'Reads program configuration
  206. Private Sub LeerConfiguracion()
  207.     pop3Host = GetSetting(App.EXEName, "Config", "Host")
  208.     pop3User = GetSetting(App.EXEName, "Config", "User")
  209.     pop3Passwd = GetSetting(App.EXEName, "Config", "Passwd")
  210.     Interval = GetSetting(App.EXEName, "Config", "Interval", "15")
  211.     EmailProgram = GetSetting(App.EXEName, "Config", "Program")
  212.     Arguments = GetSetting(App.EXEName, "Config", "Arguments")
  213.     Timeout = GetSetting(App.EXEName, "Config", "TimeOut", "30")
  214.     Sound = GetSetting(App.EXEName, "Config", "Sound", "mail.wav")
  215.     Do While pop3Host = ""
  216.         If pop3Host = "" Then
  217.             MsgBox LoadResString(Language + 1), vbExclamation
  218.             frmConfigurar.Show 1
  219.         End If
  220.     Loop
  221. End Sub
  222. 'The user saw the warning. Hide form
  223. Private Sub cmdAceptar_Click()
  224.     result = SetWindowPos(frmMain.hwnd, -2, 0, 0, 0, 0, 3)
  225.     frmMain.Visible = False
  226. End Sub
  227. 'Call e-mail program
  228. Private Sub cmdOpenEmail_Click()
  229.     mnuOptionsExecutemail_Click
  230.     result = SetWindowPos(frmMain.hwnd, -2, 0, 0, 0, 0, 3)
  231.     frmMain.Visible = False
  232. End Sub
  233. Private Sub Form_Load()
  234.     'If the command line has a switch, then
  235.     'use english messages
  236.     If Command$ <> "" Then
  237.         Language = 300
  238.         ChangeMenus
  239.     Else
  240.         Language = 200
  241.     End If
  242.     cmdAceptar.Caption = LoadResString(Language + 2)
  243.     cmdOpenEmail.Caption = LoadResString(Language + 3)
  244.     ShowProgramInTray    'self explanatory
  245.     App.TaskVisible = False
  246.     LeerConfiguracion    'read program settings
  247.     mnuOptionsCheckNow_Click 'check now
  248. End Sub
  249. 'Delete the systray icon
  250. Private Sub Form_Unload(Cancel As Integer)
  251.     result = Shell_NotifyIconA(NIM_DELETE, NI) 'removes the icon from the tray
  252. End Sub
  253. 'Program about
  254. Private Sub mnuOptionsAbout_Click()
  255.     frmAbout.Show 1
  256. End Sub
  257. 'Program exit
  258. Private Sub mnuOptionsCerrar_Click()
  259.     Unload Me
  260. End Sub
  261. 'Configure the program
  262. Private Sub mnuOptionsConfigurar_Click()
  263.     frmConfigurar.Show 1
  264.     '
  265.     TimeToCheck = Val(Interval)
  266. End Sub
  267. 'Go for it!!
  268. Private Sub mnuOptionsCheckNow_Click()
  269.     Dim Respuesta As String
  270.     Dim cantmensajes As String
  271.     On Error GoTo errsock
  272.     wsock.RemoteHost = pop3Host
  273.     wsock.RemotePort = POP3Port
  274.     wsock.LocalPort = 0
  275.     'if localport <> 0 then I must wait 4 minutes
  276.     'for reuse the socket. A design behavior of the control
  277.     wsock.Connect
  278.     If Not WaitFor("+OK", Respuesta) Then
  279.         MsgBox LoadResString(Language + 4), vbCritical
  280.         ShowIconInTray 30, LoadResString(Language + 5)
  281.         wsock.Close
  282.         Exit Sub
  283.     End If
  284.     wsock.SendData "USER " & pop3User + vbCrLf
  285.     If Not WaitFor("+OK", Respuesta) Then
  286.         MsgBox LoadResString(Language + 6), vbCritical
  287.         ShowIconInTray 30, LoadResString(Language + 7)
  288.         wsock.Close
  289.         Exit Sub
  290.     End If
  291.     wsock.SendData "PASS " & pop3Passwd + vbCrLf
  292.     If Not WaitFor("+OK", Respuesta) Then
  293.         MsgBox LoadResString(Language + 8), vbCritical
  294.         ShowIconInTray 30, LoadResString(Language + 9)
  295.         wsock.Close
  296.         Exit Sub
  297.     End If
  298.     wsock.SendData "STAT" + vbCrLf
  299.     If Not WaitFor("+OK", Respuesta) Then
  300.         MsgBox LoadResString(Language + 10), vbCritical
  301.         ShowIconInTray 30, LoadResString(Language + 11)
  302.         wsock.Close
  303.         Exit Sub
  304.     End If
  305.     cantmensajes = Mid$(Respuesta, 5, InStr(5, Respuesta, " ", vbTextCompare) - 5)
  306.     lblMsg(0).Caption = LoadResString(Language + 12) + " " + cantmensajes + " " + LoadResString(Language + 13)
  307.     lblMsg(1).Caption = Format$(Now, "General Date")
  308.     imgNewMail.Picture = LoadResPicture(IIf(cantmensajes > 0, 80, 90), vbResIcon)
  309.     If Val(cantmensajes) > 0 Then
  310.         ShowIconInTray 10, lblMsg(0).Caption
  311.         If HasSound() Then
  312.             PlayWarningSound Sound
  313.         Else
  314.             Beep
  315.         End If
  316.     Else
  317.         ShowIconInTray 20, lblMsg(0).Caption
  318.     End If
  319.     wsock.SendData "QUIT" + vbCrLf
  320.     wsock.Close
  321.     TimeToCheck = Val(Interval)
  322.     'If time expires or the user requires a check
  323.     If ShowAlert Or cantmensajes > 0 Then
  324.         tmrCheck.Enabled = False
  325.         frmMain.Visible = True
  326.         result = SetWindowPos(frmMain.hwnd, -1, 0, 0, 0, 0, 3)
  327.         tmrCheck.Enabled = True
  328.     End If
  329.     ShowAlert = True
  330.     Exit Sub
  331. errsock:
  332.     MsgBox Err.Description, vbCritical
  333.     ShowIconInTray 30, LoadResString(Language + 14)
  334.     wsock.Close
  335.     Exit Sub
  336. End Sub
  337. 'Call e-mail program
  338. Private Sub mnuOptionsExecutemail_Click()
  339.     Dim rc As Double
  340.     On Error Resume Next
  341.     If EmailProgram <> "" Then
  342.         Screen.MousePointer = vbHourglass
  343.         rc = Shell(EmailProgram + " " + Arguments, vbMaximizedFocus)
  344.         Screen.MousePointer = vbNormal
  345.         If rc = 0 Then
  346.             MsgBox LoadResString(Language + 15), vbExclamation
  347.         End If
  348.     End If
  349. End Sub
  350. 'Enable / disable the timer
  351. Private Sub mnuOptionsHabilitado_Click()
  352.     mnuOptionsHabilitado.Checked = Not mnuOptionsHabilitado.Checked
  353.     tmrCheck.Enabled = mnuOptionsHabilitado.Checked
  354. End Sub
  355. 'When is moment to check ?
  356. Private Sub tmrCheck_Timer()
  357.         
  358.     TimeToCheck = TimeToCheck - 1
  359.     If TimeToCheck = 0 Then
  360.         ShowAlert = False
  361.         mnuOptionsCheckNow_Click
  362.     End If
  363. End Sub
  364. 'Captura de los mensajes del mouse
  365. Private Sub Trayicon_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
  366.     Dim msg As Long
  367.     msg = (x And &HFF) * &H100
  368.     Select Case msg
  369.         Case 0 'mouse moves
  370.         
  371.         Case &HF00  'left mouse button down
  372.         
  373.         Case &H1E00 'left mouse button up
  374.         
  375.         Case &H3C00  'right mouse button down
  376.         PopupMenu mnuOptions 'show the popoup menu
  377.         Case &H2D00 'left mouse button double click
  378.         mnuOptionsCheckNow_Click
  379.         Case &H4B00 'right mouse button up
  380.         
  381.         Case &H5A00 'right mouse button double click
  382.         
  383.     End Select
  384. End Sub
  385. Private Sub wsock_DataArrival(ByVal bytesTotal As Long)
  386.     wsock.GetData Response
  387. End Sub
  388.