📄 frmmain.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "mscomm32.ocx"
Begin VB.Form frmMain
BorderStyle = 1 'Fixed Single
Caption = "手机短信发送服务程序"
ClientHeight = 4725
ClientLeft = 45
ClientTop = 615
ClientWidth = 10515
Icon = "frmMain.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 4725
ScaleWidth = 10515
StartUpPosition = 1 '所有者中心
Begin VB.CommandButton bntSTOP
Caption = "中断"
Height = 345
Left = 9090
TabIndex = 12
Top = 780
Width = 1305
End
Begin VB.CommandButton bntDelete
Appearance = 0 'Flat
Height = 300
Left = 8310
Picture = "frmMain.frx":0442
Style = 1 'Graphical
TabIndex = 11
Top = 1110
Width = 300
End
Begin VB.CommandButton bntNew
Appearance = 0 'Flat
Height = 300
Left = 8310
Picture = "frmMain.frx":049B
Style = 1 'Graphical
TabIndex = 10
Top = 390
Width = 300
End
Begin VB.CommandButton bntEdit
Appearance = 0 'Flat
Height = 300
Left = 8310
Picture = "frmMain.frx":0501
Style = 1 'Graphical
TabIndex = 9
Top = 750
Width = 300
End
Begin VB.CheckBox Check1
Caption = "优先采用服务商一致原则"
Height = 225
Left = 5850
TabIndex = 7
Top = 3990
Width = 2385
End
Begin MSComctlLib.ListView ListView
Height = 3435
Left = 90
TabIndex = 6
Top = 390
Width = 8115
_ExtentX = 14314
_ExtentY = 6059
View = 3
LabelEdit = 1
LabelWrap = -1 'True
HideSelection = 0 'False
Checkboxes = -1 'True
FullRowSelect = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 6
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Key = "Port"
Text = "端口"
Object.Width = 1411
EndProperty
BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 1
Key = "ServiceTelphone"
Text = "服务中心号码"
Object.Width = 3528
EndProperty
BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 2
Key = "Status"
Text = "当前状态"
Object.Width = 3528
EndProperty
BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 3
Text = "提供商"
Object.Width = 1764
EndProperty
BeginProperty ColumnHeader(5) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 4
Text = "打头号码"
Object.Width = 5292
EndProperty
BeginProperty ColumnHeader(6) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 5
Object.Width = 2540
EndProperty
End
Begin VB.CheckBox chkSendAttend
Caption = "允许发送与考勤相关的短信"
Height = 255
Left = 2970
TabIndex = 5
Top = 3990
Value = 1 'Checked
Width = 2595
End
Begin VB.CheckBox chkSendWebSM
Caption = "允许发送由网站提交的短信"
Height = 285
Left = 60
TabIndex = 4
Top = 3990
Value = 1 'Checked
Width = 2565
End
Begin MSComctlLib.StatusBar StatusBar
Align = 2 'Align Bottom
Height = 345
Left = 0
TabIndex = 3
Top = 4380
Width = 10515
_ExtentX = 18547
_ExtentY = 609
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 3
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Object.Width = 3528
MinWidth = 3528
Text = "网络短信:"
TextSave = "网络短信:"
EndProperty
BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Object.Width = 3528
MinWidth = 3528
Text = "考勤短信:"
TextSave = "考勤短信:"
EndProperty
BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Object.Width = 88194
MinWidth = 88194
Text = "状态："
TextSave = "状态："
EndProperty
EndProperty
End
Begin VB.CommandButton bntSend
Caption = "启动"
Height = 345
Left = 9090
TabIndex = 2
Top = 330
Width = 1305
End
Begin VB.Timer Timer
Left = 9120
Top = 3780
End
Begin VB.CommandButton bntCancel
Caption = "退出"
Height = 345
Left = 9090
TabIndex = 1
Top = 1230
Width = 1305
End
Begin VB.Frame frmLine
Height = 3615
Left = 8790
TabIndex = 0
Top = 180
Width = 30
End
Begin MSCommLib.MSComm MSComm
Index = 1
Left = 8220
Top = 1680
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
DTREnable = -1 'True
End
Begin MSCommLib.MSComm MSComm
Index = 2
Left = 9390
Top = 1650
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
DTREnable = -1 'True
End
Begin MSCommLib.MSComm MSComm
Index = 3
Left = 9450
Top = 2310
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
DTREnable = -1 'True
End
Begin MSCommLib.MSComm MSComm
Index = 4
Left = 8820
Top = 2310
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
DTREnable = -1 'True
End
Begin MSCommLib.MSComm MSComm
Index = 5
Left = 8220
Top = 2310
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
DTREnable = -1 'True
End
Begin MSCommLib.MSComm MSComm
Index = 6
Left = 8220
Top = 2970
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
DTREnable = -1 'True
End
Begin MSCommLib.MSComm MSComm
Index = 7
Left = 8850
Top = 2970
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
DTREnable = -1 'True
End
Begin MSCommLib.MSComm MSComm
Index = 8
Left = 9480
Top = 2970
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
DTREnable = -1 'True
End
Begin VB.Label Label1
Caption = "TC35短信发送设备列表(&L)"
Height = 195
Left = 90
TabIndex = 8
Top = 120
Width = 2265
End
Begin VB.Menu menuTray
Caption = "系统(&S)"
Begin VB.Menu menuTray_Open
Caption = "显示窗口(&S)"
Enabled = 0 'False
End
Begin VB.Menu menuTray_Hide
Caption = "隐含窗口(&H)"
End
Begin VB.Menu menuSplit
Caption = "-"
End
Begin VB.Menu menuExit
Caption = "退出系统(&E)"
End
End
Begin VB.Menu menuTC35
Caption = "终端(&T)"
Begin VB.Menu menuTC35_Add
Caption = "添加(&A)..."
End
Begin VB.Menu menuTC35_Edit
Caption = "修改(&E)..."
End
Begin VB.Menu split00
Caption = "-"
End
Begin VB.Menu menuTC35_Delete
Caption = "删除(&R)"
End
End
Begin VB.Menu menuHelp
Caption = "帮助(&H)"
Begin VB.Menu menuHelp_About
Caption = "关于(&A)"
End
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Const isDebug = False
Dim OkTC35Number As Integer
Dim LastStatus As Integer
Dim bExit As Boolean
Dim bResult As Long
Dim bInit As Boolean
Dim SetTC35(8) As TC35
Dim WithEvents TC35S1 As TC35
Attribute TC35S1.VB_VarHelpID = -1
Dim WithEvents TC35S2 As TC35
Attribute TC35S2.VB_VarHelpID = -1
Dim WithEvents TC35S3 As TC35
Attribute TC35S3.VB_VarHelpID = -1
Dim WithEvents TC35S4 As TC35
Attribute TC35S4.VB_VarHelpID = -1
Dim WithEvents TC35S5 As TC35
Attribute TC35S5.VB_VarHelpID = -1
Dim WithEvents TC35S6 As TC35
Attribute TC35S6.VB_VarHelpID = -1
Dim WithEvents TC35S7 As TC35
Attribute TC35S7.VB_VarHelpID = -1
Dim WithEvents TC35S8 As TC35
Attribute TC35S8.VB_VarHelpID = -1
Private Sub TC35SChangeStatus(ByVal Index As Integer, ByVal Status As EventStatus)
Dim ss As String
With SetTC35(Index)
Select Case Status '取得当前的发送情况状态
Case STATUS_UNKNOWS '未知，表示未启动异步发送SM
'Call SetTC35(Index).AsynSend
ss = "等待处理"
Case STATUS_OK '发送成功
OpenCN
If .Para3 = "SysSM" Then
cn.Execute "Update Info_AttendItem set dtSend=getdate(),isSendOK=1,ToMobile='" & .Telphone & "',nTry=nTry+1,ToUser=" & toSQL(.Para2) & " WHERE AttendItemID=" & .Para1
Else
cn.Execute "Update Info_SMItem set dtSend=getdate(),isSendOK=1,nTry=nTry+1 WHERE SMItemID=" & .Para1
cn.Execute "Update Info_SM set nSended=nSended+1 WHERE SMID=" & .Para2
End If
CloseCN
ss = "发送成功"
Case STATUS_ERROR
If .Para3 = "SysSM" Then '系统SM
cn.Execute "Update Info_AttendItem set dtSend=getdate(),isSendOk=0,ToMobile='" & .Telphone & "',nTry=nTry+1,ToUser=" & toSQL(.Para2) & " WHERE AttendItemID=" & .Para1
Else 'WEBSM
cn.Execute "Update Info_SMItem set dtSend=getdate(),isSendOK=0,nTry=nTry+1 WHERE SMItemID=" & .Para1
End If
ss = "发送出错"
Case STATUS_OUTTIME
If .Para3 = "SysSM" Then '系统SM
cn.Execute "Update Info_AttendItem set dtSend=getdate(),isSendOk=0,ToMobile='" & .Telphone & "',nTry=nTry+1,ToUser=" & toSQL(.Para2) & " WHERE AttendItemID=" & .Para1
Else 'WEBSM
cn.Execute "Update Info_SMItem set dtSend=getdate(),isSendOK=0,nTry=nTry+1 WHERE SMItemID=" & .Para1
End If
ss = "发送超时"
Case STATUS_SENDING '其它状态，继续进行
ss = "正在发送..."
Case STATUS_GETTING
ss = "正在接收..."
Case STATUS_SENDED
ss = "命令发完"
End Select
ListView.ListItems(.Key).SubItems(2) = ss
End With
End Sub
Private Sub Command1_Click()
End Sub
Private Sub bntSTOP_Click()
If ShowYesNo("您想中断当前的服务？") = True Then
bExit = True
Timer.Interval = 0
SetSendStatus True
End If
End Sub
Private Sub TC35S1_ChangeStatus(ByVal Status As EventStatus)
TC35SChangeStatus 1, Status
End Sub
Private Sub TC35S2_ChangeStatus(ByVal Status As EventStatus)
TC35SChangeStatus 2, Status
End Sub
Private Sub TC35S3_ChangeStatus(ByVal Status As EventStatus)
TC35SChangeStatus 3, Status
End Sub
Private Sub TC35S4_ChangeStatus(ByVal Status As EventStatus)
TC35SChangeStatus 4, Status
End Sub
Private Sub TC35S5_ChangeStatus(ByVal Status As EventStatus)
TC35SChangeStatus 5, Status
End Sub
Private Sub TC35S6_ChangeStatus(ByVal Status As EventStatus)
TC35SChangeStatus 6, Status
End Sub
Private Sub TC35S7_ChangeStatus(ByVal Status As EventStatus)
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -