📄 listner.frm
字号:
VERSION 5.00
Begin VB.Form frmListner
BorderStyle = 0 'None
Caption = "Listener"
ClientHeight = 4950
ClientLeft = 150
ClientTop = 720
ClientWidth = 7710
ControlBox = 0 'False
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4950
ScaleWidth = 7710
ShowInTaskbar = 0 'False
StartUpPosition = 3 'Windows Default
Begin VB.TextBox txtLog
Height = 2505
Left = 120
MultiLine = -1 'True
ScrollBars = 3 'Both
TabIndex = 11
Top = 2280
Width = 7515
End
Begin VB.Frame Frame4
Caption = "Miscellaneous"
Height = 975
Left = 4110
TabIndex = 9
Top = 30
Width = 3465
Begin VB.CheckBox chkNetSend
Caption = "Allow Net Send"
Height = 255
Left = 90
TabIndex = 10
ToolTipText = "Allow net send message"
Top = 240
Value = 1 'Checked
Width = 1665
End
End
Begin VB.Frame Frame2
Caption = "System"
Height = 1155
Left = 120
TabIndex = 7
Top = 1050
Width = 3885
Begin VB.CheckBox chkAllowStopService
Caption = "Allow Stop Service"
Enabled = 0 'False
Height = 195
Left = 90
TabIndex = 13
Top = 780
Width = 1815
End
Begin VB.CheckBox chkStartService
Caption = "Allow Start Service"
Enabled = 0 'False
Height = 195
Left = 90
TabIndex = 12
Top = 510
Width = 1815
End
Begin VB.CheckBox chkLoggedInUser
Caption = "Logged in user"
Height = 195
Left = 90
TabIndex = 8
Top = 240
Value = 1 'Checked
Width = 1395
End
End
Begin VB.Frame Frame1
Height = 1005
Left = 120
TabIndex = 1
Top = 30
Width = 3885
Begin VB.TextBox txtSubject
Height = 315
Left = 1350
TabIndex = 5
Text = "AirTel Email from +984071xxxx"
Top = 570
Width = 2415
End
Begin VB.TextBox txtInterval
Height = 315
Left = 1350
TabIndex = 3
Text = "60"
Top = 180
Width = 495
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "Check Subject"
Height = 195
Index = 2
Left = 90
TabIndex = 6
Top = 600
Width = 1050
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "Second(s)"
Height = 195
Index = 1
Left = 1950
TabIndex = 4
Top = 240
Width = 720
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "Check Interval"
Height = 195
Index = 0
Left = 90
TabIndex = 2
Top = 180
Width = 1035
End
End
Begin VB.PictureBox pichook
Height = 555
Left = 360
ScaleHeight = 495
ScaleWidth = 795
TabIndex = 0
Top = 2880
Visible = 0 'False
Width = 855
End
Begin VB.Timer Timer1
Interval = 200
Left = 690
Top = 2160
End
Begin VB.Timer Timer2
Interval = 60000
Left = 2820
Top = 2220
End
Begin VB.Image imgIcon
Height = 480
Index = 0
Left = 1500
Picture = "Listner.frx":0000
Top = 2955
Visible = 0 'False
Width = 480
End
Begin VB.Image imgIcon
Height = 480
Index = 1
Left = 2055
Picture = "Listner.frx":030A
Top = 2940
Visible = 0 'False
Width = 480
End
Begin VB.Image imgIcon
Height = 480
Index = 2
Left = 2580
Picture = "Listner.frx":0614
Top = 2955
Visible = 0 'False
Width = 480
End
Begin VB.Menu mnuPopUp
Caption = "Listener"
Begin VB.Menu mnuSetup
Caption = "Set up"
End
Begin VB.Menu mnuMM
Caption = "Minimise"
End
Begin VB.Menu mnuLine
Caption = "-"
End
Begin VB.Menu mnuExit
Caption = "Exit"
End
End
End
Attribute VB_Name = "frmListner"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*`**`**`**`**`**`**`**`**`**`**`**`**`**`**`**`**`**`**`**`**`*
'Author : Rasheed
'Description: This application used to control the PC using
' mobile phone through SMS.
'Disclaimer : This article is published as is. Author is not responsible
' for any damage of your system or data using this application
' Any comments or feedback please send it to rasheed1979@hotmail.com
'*`**`**`**`**`**`**`**`**`**`**`**`**`**`**`**`**`**`**`**`**`*
'Option Explicit
Private Type NOTIFYICONDATA
cbSize As Long
hWnd As Long
uId As Long
uFlags As Long
ucallbackMessage As Long
hIcon As Long
szTip As String * 64
End Type
Private Const NIM_ADD = &H0
Private Const NIM_MODIFY = &H1
Private Const NIM_DELETE = &H2
Private Const NIF_MESSAGE = &H1
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Const WM_MBUTTONDBLCLK = &H209
Private Const WM_MBUTTONDOWN = &H207
Private Const WM_MBUTTONUP = &H208
Private Const WM_RBUTTONDBLCLK = &H206
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205
Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
Dim TrayI As NOTIFYICONDATA
Dim sParam As String
Dim sAlertedMails As String
Private Sub Form_Load()
On Error GoTo ErrTrap
'
'Parameters :
'
'Purpose : Load this application into systray
'
'Comments :
'
'Returns :
'
'Change History
'Date Edit Author Comment
'-----------+-------+-------+---------------------------------------------
'29-May-04 [100] Rasheed Created
'-----------+-------+-------+---------------------------------------------
'
TrayI.cbSize = Len(TrayI)
TrayI.hWnd = pichook.hWnd 'Link the trayicon to this picturebox
TrayI.uId = 1&
TrayI.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
TrayI.ucallbackMessage = WM_LBUTTONDOWN
TrayI.hIcon = imgIcon(2).Picture
TrayI.szTip = "Listener 0.1.1" & Chr$(0)
'Create the icon
Shell_NotifyIcon NIM_ADD, TrayI
Me.Hide
sAlertedMails = ""
Exit Sub
ErrTrap:
txtLog = txtLog & "Error In Form_Load(): "
txtLog = txtLog & Err.Description & vbCrLf
End Sub
Private Sub mnuExit_Click()
On Error GoTo ErrTrap
'
'
'Parameters :
'
'Purpose : Load this application into systray
'
'Comments :
'
'Returns :
'
'Change History
'Date Edit Author Comment
'-----------+-------+-------+---------------------------------------------
'7-jul-04 [100] Rasheed Created
'-----------+-------+-------+---------------------------------------------
'
Unload Me
Exit Sub
ErrTrap:
txtLog = txtLog & "Error In mnuExit_Click(): "
txtLog = txtLog & Err.Description & vbCrLf
End Sub
Private Sub mnuMM_Click()
'Minimise Form
Timer2.Interval = Val(Trim(txtInterval.Text)) * 1000
Me.Hide
End Sub
Private Sub mnuSetup_Click()
Me.Show
End Sub
Private Sub Timer2_Timer()
On Error GoTo ErrTrap
'
'Parameters
'
'Purpose This procedure will check every minute if any mails sent from my mobile
' If any mails sent then the system will act accordingly
'
'Comments
'
'Returns
'
'Change History
'Date Edit Author Comment
'-----------+-------+-------+---------------------------------------------
'29-May-04 [100] Rasheed Created
'-----------+-------+-------+---------------------------------------------
'
Dim iDir As Integer
Dim iFile As Integer
Dim sParam1 As String
Dim sParam2 As String
Dim sParam3 As String
Dim sStr As String
Dim i As Integer
Select Case (UCase(Trim(ParseMail)))
Case "SHUTDOWN"
'"SHUTDOWN"
InitiateShutdownMachine GetMyMachineName, True, False, True, 10, "You initiated a system shutdown..."
Case "FILELIST"
'"FILELIST~c:\~MTO"
sParam1 = Mid(sParam, 1, InStr(1, sParam, "~") - 1)
sParam2 = Mid(sParam, InStr(1, sParam, "~") + 1)
FileList sParam1, "*.*", iFile, iDir, "c:\filelist.txt"
SendMail sParam2, "File List" & Now, "c:\filelist.txt"
Case "SENDFILE"
'"SENDFILE~c:\test.txt~MTO"
sParam1 = Mid(sParam, 1, InStr(1, sParam, "~") - 1)
sParam2 = Mid(sParam, InStr(1, sParam, "~") + 1)
SendMail sParam2, "File List" & Now, sParam1
Case "WHO"
'To get logged in user
If chkLoggedInUser.Value = 1 Then
sStr = LoggedInUser
SendSMS "Loggend In user: " & sStr
End If
Case "NETSEND"
If chkNetSend.Value = 1 Then
sParam1 = Mid(sParam, 1, InStr(1, sParam, "~") - 1)
sParam2 = Mid(sParam, InStr(1, sParam, "~") + 1)
Call NetSend(sParam1, sParam2)
End If
Case "CHECKMAIL"
SendSMS "U have " & CheckMail & " Unread Mails"
Case "READMAILHEADER"
ReadMailHeader
Case "READMSG"
'READMSG~msgid
ReadMail sParam
End Select
Exit Sub
ErrTrap:
txtLog = txtLog & "Error In ParseMail(): "
txtLog = txtLog & Err.Description & vbCrLf
End Sub
Private Sub mnuPop_Click(Index As Integer)
On Error GoTo ErrTrap
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -