📄 serverfrm.frm
字号:
VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form SeverFrm
Caption = "家校短信通服务器端 "
ClientHeight = 4035
ClientLeft = 60
ClientTop = 645
ClientWidth = 7830
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "ServerFrm.frx":0000
LinkTopic = "Form1"
Picture = "ServerFrm.frx":030A
ScaleHeight = 4035
ScaleWidth = 7830
StartUpPosition = 2 'CenterScreen
Begin MSWinsockLib.Winsock SockToCln
Index = 0
Left = 7680
Top = 0
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
Begin MSCommLib.MSComm MSComm1
Left = 7800
Top = 1080
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
DTREnable = -1 'True
End
Begin MSComctlLib.ListView LvCnn
Height = 3375
Left = 120
TabIndex = 0
Top = 120
Width = 7455
_ExtentX = 13150
_ExtentY = 5953
View = 3
Arrange = 2
Sorted = -1 'True
LabelWrap = -1 'True
HideSelection = -1 'True
FullRowSelect = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 4
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Text = "班别"
Object.Width = 2893
EndProperty
BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 1
Text = "连接状态"
Object.Width = 2540
EndProperty
BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 2
Text = "时间"
Object.Width = 4304
EndProperty
BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 3
Text = "通道号"
Object.Width = 2117
EndProperty
End
Begin MSComctlLib.StatusBar StatusMsg
Align = 2 'Align Bottom
Height = 255
Left = 0
TabIndex = 1
Top = 3780
Width = 7830
_ExtentX = 13811
_ExtentY = 450
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 3
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Style = 6
Alignment = 1
AutoSize = 2
TextSave = "2007-6-14"
EndProperty
BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Style = 5
Alignment = 1
AutoSize = 2
TextSave = "20:23"
EndProperty
BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Alignment = 2
AutoSize = 1
Object.Width = 8149
EndProperty
EndProperty
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.Menu conn
Caption = "连接"
End
End
Attribute VB_Name = "SeverFrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Const prex = "0891"
Const midx = "11000D91"
Const sufx = "0008FF"
Private Sub conn_Click()
conFrm.Visible = True
End Sub
Private Function SendSMS(phnum As String, Msg As String) As Boolean
Dim what As Boolean
Dim pduText As String, pSmsc As String, pNum As String, pMsg As String
Dim nTime As Date
Dim i As Integer, nLength As Integer
Dim commandLength As Integer
Dim dd As String
Dim strPdu As String, OneWord As String
Dim Temp1 As String, Temp2 As String
strPdu = ""
nLength = Len(Msg) '所要转换的所有字符长度
For i = 1 To nLength
OneWord = Mid(Msg, i, 1) '取其中一个字符
dd = Hex(AscW(OneWord)) '转换成Unicode码
If Len(dd) = 4 Then '长度不够时补足4位，即2个八位组
strPdu = strPdu + dd
Else
If Len(dd) = 2 Then
strPdu = strPdu + "00" + dd
Else
strPdu = strPdu + "000" + dd
End If
End If
Next i 'strPdu中的内容就是要传递的信息PDU码
Temp1 = Hex(Len(strPdu) / 2) 'strPdu中的内容就是要传递的信息PDU码
If Len(Temp1) = 1 Then
Temp2 = "0" + Temp1
Else
Temp2 = Temp1
End If 'temp2为数据PDU长度
commandLength = (Len(strPdu)) / 2 + 15 '发送PDU总长度．用于AT+CMGS
pSmsc = Trim(telc(CenterNum))
pNum = Trim(telc(phnum))
pduText = prex & pSmsc & midx & pNum & sufx & Temp2 & strPdu '全部的PDU数据
what = sendIt("AT+CMGS=" + CStr(commandLength) + vbCrLf, ">", "ERROR")
Delay (3)
If what = True Then
what = sendIt(Trim(pduText) & Chr(26), "OK", "ERROR")
End If
SendSMS = what
End Function
Private Sub MSComm1_OnComm()
On Error Resume Next
Dim strTemp, strNum, strTime, strLen, ReNum As String, msgStr As String
Dim nPos, nLen, nNum, nTime, i, j, k, index As Integer, nCount As Integer
Dim what As Boolean
Dim strSql, str(2), strback As String
Dim rs(3) As ADODB.Recordset
' LstState.AddItem "正在向端口发送数据....."
ReNum = "8613760525778"
MsgArrive = False
If Me.MSComm1.CommEvent = comEvReceive Then
strTemp = Me.MSComm1.Input
sData = sData & strTemp
If InStr(sData, "+CMTI") > 0 Then
MsgArrive = True
setDoit True
ElseIf InStr(sData, mOK) > 0 Then
'doit = True
setDoit True
ElseIf InStr(sData, mErr) > 0 Then
setDoit False
ElseIf InStr(sData, ">") > 0 Then
setDoit True
End If
'mResult = sData
' If Len(sData) > 0 Then
' ' LstState.AddItem "端口返回数据--> " & sData
' End If
txtOut = sData
If MsgArrive = True Then
nPos = InStr(sData, "+CMTI")
msgStr = Mid(sData, nPos)
nPos = InStr(msgStr, ",")
nCount = Trim(Val(Mid(msgStr, nPos + 1, 3)))
If InStr(msgStr, "ME") > 0 Then
what = sendIt("AT+CPMS=" & Chr(34) & "ME" & Chr(34), "OK", "ERROR")
If what = True Then
what = sendIt("AT+CMGR=" & nCount, "OK", "ERROR")
If what = True Then
nPos = InStr(sData, "+CMGR")
msgStr = Mid(sData, nPos)
nPos = InStr(msgStr, "0891")
strLen = Mid(msgStr, nPos + 20, 2)
nLen = CInt("&h" & strLen)
strNum = Mid(msgStr, nPos + 24, nLen + 1)
If nLen = 13 Then
strNum = Mid(ExChange(strNum), 3, nLen - 2)
Else
strNum = Mid(ExChange(strNum), 1, nLen)
End If
'frmRx.Label2.Caption = strNum
nPos = InStr(msgStr, "0008")
'MsgBox Mid(msgStr, nPos + 4, 12)
strTime = ExChange(Mid(msgStr, nPos + 4, 12))
'MsgBox strTime
strTime = Format(strTime, "##-##-## ##:##:##")
'frmRx.Label4.Caption = strTime
'Text1.Text = msgStr
msgStr = Mid(msgStr, nPos + 20)
msgStr = Unicode2AscII(msgStr)
'frmRx.txtMsgRecieve.Text = msgStr
'frmRx.Visible = True
str(1) = "select cl_id,s_name from student where s_phone='" & strNum & "'"
str(2) = "select cl_id,parent_name from student where parent_phone='" & strNum & "'"
For i = 1 To 2
Set rs(i) = DBCnn.Execute(str(i))
Next i
i = 0
For j = 1 To 2
If rs(j).RecordCount <> 0 Then
i = j
End If
Next j
If i <> 0 Then
k = LvCnn.ListItems.count
For j = 1 To k
If Trim(rs(i).Fields(0).Value) = Me.LvCnn.ListItems(j).Text Then
index = Me.LvCnn.ListItems(j).SubItems(3)
If Me.SockToCln(index).State <> sckConnected Then
Exit For
End If
'发送返回信息
strback = "SmsArrival*" & rs(i).Fields(1).Value & "*" & strTime & "*" & msgStr
Me.SockToCln(index).SendData strback
Exit For
End If
Next j
End If
strSql = "insert into message (sender,receiver,sm_content,sm_time,state)values('"
strSql = strSql & strNum & "','" & ReNum & "','" & msgStr & "','" & strTime & "'," & 0 & ")"
Set rs(3) = DBCnn.Execute(strSql)
End If
End If
End If
End If
End If
End Sub
Private Sub txtCenterNumber_KeyPress(KeyAscii As Integer)
If (Chr(KeyAscii) > "9" Or Chr(KeyAscii) < "0") And KeyAscii <> 8 Then
KeyAscii = 0 '取消本次按键事件。
Beep '提示输入错误
End If
End Sub
Private Sub txtMsg_Change()
txtMsg.MaxLength = 70
LabText.Caption = "字数:" & Len(txtMsg.Text) & "/70"
End Sub
' Const LB_SETHORIZONTALEXTENT = &H194
' Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
' (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
' lParam As Any) As Long
'List1 为 ListBox 的名称
'Call SendMessage(List1.hwnd, LB_SETHORIZONTALEXTENT, _
' 水平卷动轴的宽度, ByVal 0&)' 特别注意：以上的水平卷动轴宽度的单位是 pixel(像素)。
Private Sub txtPhoneNumber_KeyPress(KeyAscii As Integer)
If (Chr(KeyAscii) > "9" Or Chr(KeyAscii) < "0") And KeyAscii <> 8 Then
KeyAscii = 0 '取消本次按键事件。
Beep '提示输入错误
End If
End Sub
Private Sub CmdCancel_Click() '退出
Dim i As Integer
'检查sock连接是否关闭
For i = 1 To ClMax
If Me.SockToCln(i).State <> sckClosed Then
Me.SockToCln(i).Close
End If
Next i
'结束程序
End
End Sub
Private Sub Form_Load()
Dim SqlStr As String
'设置网络属性
'服务器端口
SvrPort = "1234"
'设置侦听Winsock
Me.SockToCln(0).LocalPort = SvrPort
Me.SockToCln(0).Listen
'连接数据库
' SqlStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
' App.Path & "\mdb\library.mdb;Persist Security Info=False"
' DBCnn.Open SqlStr
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -