⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 soj1.frm

📁 用vb写的motorola手机短消息管理软件
💻 FRM
📖 第 1 页 / 共 2 页
字号:
VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   3825
   ClientLeft      =   165
   ClientTop       =   870
   ClientWidth     =   7740
   LinkTopic       =   "Form1"
   ScaleHeight     =   3825
   ScaleWidth      =   7740
   StartUpPosition =   3  '窗口缺省
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   2000
      Left            =   480
      Top             =   2880
   End
   Begin VB.CommandButton Command2 
      Caption         =   "发送消息"
      Height          =   495
      Left            =   5160
      TabIndex        =   4
      Top             =   3120
      Width           =   1215
   End
   Begin VB.TextBox Text2 
      Height          =   495
      Left            =   2280
      TabIndex        =   1
      Text            =   "13913009767"
      Top             =   3120
      Width           =   2055
   End
   Begin VB.TextBox Text1 
      Height          =   1935
      Left            =   1080
      TabIndex        =   0
      Text            =   "ok1"
      Top             =   840
      Width           =   5340
   End
   Begin MSCommLib.MSComm MSComm1 
      Left            =   6600
      Top             =   1560
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      CommPort        =   2
      DTREnable       =   -1  'True
   End
   Begin VB.Label Label3 
      Caption         =   "手机类型:"
      Height          =   375
      Left            =   120
      TabIndex        =   5
      Top             =   120
      Width           =   7335
   End
   Begin VB.Label Label2 
      Caption         =   "发送手机号码"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   360
      TabIndex        =   3
      Top             =   3240
      Width           =   1575
   End
   Begin VB.Label Label1 
      Caption         =   "发送短信内容"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   14.25
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   1815
      Left            =   480
      TabIndex        =   2
      Top             =   720
      Width           =   495
   End
   Begin VB.Menu search 
      Caption         =   "查询手机(&S)"
   End
   Begin VB.Menu savereceive 
      Caption         =   "保存接受消息(&R)"
   End
   Begin VB.Menu savesend 
      Caption         =   "保存发送消息(&S)"
   End
   Begin VB.Menu about 
      Caption         =   "关于(&A)"
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'相比于手机短信的发送而言,手机短信的接收主要的工作正好与之相反。手机短信的发送需要将待发送的短信内容转换为Unicode码,而短信的接收则需要将接收到的Unicode码转换成中文字符。下面的函数将实现解码功能。同手机短信发送的编码函数一样,这里也应用了一个VB内置的函数AscW()函数来将Unicode码转换为中文:
Dim commonport As Integer
Dim delayflag As Boolean
Public Function ascg(smsg As String) As String

  Dim si, sb As Integer
  Dim stmp As Integer
  Dim stemp As String

  sb = Len(smsg)
  ascg = ""
  For si = 1 To sb
    stmp = AscW(Mid(smsg, si, 1))
    If Abs(stmp) < 127 Then
      stemp = "00" & Hex(stmp)
    Else
      stemp = Hex(stmp)
    End If
    ascg = ascg & stemp
  Next si
  ascg = Trim(ascg)
End Function

Public Function chg(rmsg As String) As String

  Dim tep As String
  Dim temp As String
  Dim i As Integer
  Dim b As Integer

  tep = rmsg
  i = Len(tep)
  b = i / 4
  If i = b * 4 Then
    b = b
    tep = Left(tep, b * 4)
  Else
    tep = Left(tep, b * 4)
  End If

  chg = ""
  For i = 1 To b
    temp = "&H" & Mid(tep, (i - 1) * 4 + 1, 4)
    chg = chg & ChrW(CInt(Val(temp)))
  Next i
End Function

Function Searchrecord(source As String, set1 As String, ByRef t() As String, num As Integer) As Integer
Dim j As String
Dim i As Integer
Dim cur As Integer
Dim cur_end As Integer
i = 1
cur = 1
ReDim t(100)
Do
cur = InStr(cur, source, set1)
If cur = 0 Then
Exit Do
Else
cur_end = InStr(cur, source, ",")
cur = cur + Len(set1)
j = Mid(source, cur, cur_end - cur)
t(i) = j
i = i + 1
End If
Loop While cur + Len(set1) < Len(source)
Searchrecord = i
ReDim Preserve t(i - 1)
End Function

Function Searchrecord2(source As String, set1 As String, ByRef t() As String, num As Integer) As Integer
Dim j As String
Dim i As Integer
Dim cur As Integer
Dim cur_end As Integer
i = 1
cur = 1
ReDim t(100)
Do
cur = InStr(cur, source, set1)
If cur = 0 Then
Exit Do
Else
cur_end = InStr(cur, source, Chr$(13))
cur = cur + Len(set1)
j = Mid(source, cur, cur_end - cur)
t(i) = j
i = i + 1
End If
Loop While cur + Len(set1) < Len(source)
Searchrecord2 = i
ReDim Preserve t(i - 1)
End Function

Private Sub about_Click()
    MsgBox "版本:     " & App.Major & "." & App.Minor & "." & App.Revision & Chr$(13) & "作者:   何成军 " & Chr$(13) & "Email:  hcj2002@sohu.com" & Chr$(13) & "copyright:南京航空航天大学飞控所" & Chr$(13) & " QQ :       121994363"
End Sub

Private Sub Command2_Click()
Dim k As Integer
Dim obj1 As String
Dim aa() As String


' 保存输入子串的缓冲区
    '   Dim buffer As String
   ' 使用 COM1。
   MSComm1.CommPort = commonport
   ' 9600 波特,无奇偶校验,8 位数据,一个停止位。
   MSComm1.Settings = "9600,N,8,1"
   ' 当输入占用时,
   ' 告诉控件读入整个缓冲区。
    'MSComm1.InputLen = 0
   ' 打开端口。
   MSComm1.PortOpen = True
   ' 将 attention 命令送到调制解调器。
  
   
  


MSComm1.Output = "ATE0" & Chr$(13) ' 确保
   ' 调制解调器以"OK"响应。
   ' 等待数据返回到串行端口。
   Do
      DoEvents
   buffer$ = buffer$ & MSComm1.Input
   Loop Until InStr(buffer$, "OK" & vbCrLf)
   ' 从串行端口读 "OK" 响应。



MSComm1.Output = "AT+CMGF=1" & Chr$(13) ' 确保
   ' 调制解调器以"OK"响应。
   ' 等待数据返回到串行端口。
   buffer = ""
   Do
      DoEvents
   buffer$ = buffer$ & MSComm1.Input
   Loop Until InStr(buffer$, "OK" & vbCrLf)
   ' 从串行端口读 "OK" 响应。

   ' 关闭串行端口。

MSComm1.Output = "AT+CPMS=" & Chr(34) & "OM" + Chr(34) & Chr$(13) ' 确保

   ' 调制解调器以"OK"响应。
   ' 等待数据返回到串行端口。
   buffer = ""
   Do
      DoEvents
   buffer$ = buffer$ & MSComm1.Input
   Loop Until InStr(buffer$, "OK" & vbCrLf)

MSComm1.Output = "AT+CSCS=" & Chr(34) & "GSM" + Chr(34) & Chr$(13) ' 确保

   ' 调制解调器以"OK"响应。
   ' 等待数据返回到串行端口。
   buffer = ""
   Do
      DoEvents
   buffer$ = buffer$ & MSComm1.Input
   Loop Until InStr(buffer$, "OK" & vbCrLf)

MSComm1.Output = "AT+CSCS=" & Chr(34) & "UCS2" + Chr(34) & Chr$(13) ' 确保

   ' 调制解调器以"OK"响应。
   ' 等待数据返回到串行端口。
   buffer = ""
   Do
      DoEvents
   buffer$ = buffer$ & MSComm1.Input
   Loop Until InStr(buffer$, "OK" & vbCrLf)
   ' 从串行端口读 "OK" 响应。

   ' 关闭串行端口。

Dim SENDSMS As String
Dim send_1 As String
Dim temp As String
SENDSMS = ascg(Text1.Text)
sendsms1 = ascg(Text2.Text)
send_1 = "AT+CMGW=" & Chr(34) & Text2.Text & Chr(34) & Chr$(13)
MSComm1.Output = send_1
send_1 = SENDSMS & Chr$(&H1A) & Chr$(13) ' 确保
MSComm1.Output = send_1
   ' 调制解调器以"OK"响应。
   ' 等待数据返回到串行端口。
   buffer = ""
   Do
      DoEvents
   buffer$ = buffer$ & MSComm1.Input
     
     Loop Until InStr(buffer$, "OK" & vbCrLf)
   ' 从串行端口读 "OK" 响应。
Dim M As Integer
   M = Searchrecord2(buffer, "+CMGW: ", aa(), 4)
  For i = 1 To M - 1
MSComm1.Output = "AT+CMSS=" & aa(i) & Chr$(13) ' 确保
   ' 调制解调器以"OK"响应。
   ' 等待数据返回到串行端口。
   buffer = ""
   Do
      DoEvents
   buffer = buffer & MSComm1.Input
   Loop Until InStr(buffer, "OK" & vbCrLf) Or InStr(buffer, "ERROR" & vbCrLf)
   
   ' 从串行端口读 "OK" 响应。
  'MSComm1.Output = "AT+CMSS=" & aa(i) & Chr$(13) ' 确保
   ' 调制解调器以"OK"响应。
   ' 等待数据返回到串行端口。
   'buffer = ""
  ' Do
  '    DoEvents
   'buffer = buffer & MSComm1.Input
  ' Loop Until InStr(buffer, "OK" & vbCrLf) Or InStr(buffer, "ERROR" & vbCrLf)
   MSComm1.Output = "AT+CMGD=" & aa(i) & Chr$(13) ' 确保
   ' 调制解调器以"OK"响应。
   ' 等待数据返回到串行端口。
   buffer = ""
   Do
      DoEvents
   buffer = buffer & MSComm1.Input
   Loop Until InStr(buffer, "OK" & vbCrLf) Or InStr(buffer, "ERROR" & vbCrLf)
MSComm1.PortOpen = False



If InStr(buffer, "OK" & vbCrLf) Then
MsgBox "已经发送"

Else
MsgBox "发送失败"
End If
' MsgBox "已经发送..."
'Else
'MsgBox "发送失败..."
'End If
   Next
   
End Sub

Private Sub Form_Deactivate()
MSComm1.PortOpen = False

End Sub






Private Sub savereceive_Click()
Dim k As Integer
Dim obj1 As String
' 保存输入子串的缓冲区
    '   Dim buffer As String
   ' 使用 COM1。
   MSComm1.CommPort = commonport
   ' 9600 波特,无奇偶校验,8 位数据,一个停止位。
   MSComm1.Settings = "9600,N,8,1"
   ' 当输入占用时,
   ' 告诉控件读入整个缓冲区。
   'MSComm1.InputLen = 0
   ' 打开端口。
   MSComm1.PortOpen = True
   ' 将 attention 命令送到调制解调器。
   MSComm1.Output = "ATV1Q0" & Chr$(13) ' 确保
   ' 调制解调器以"OK"响应。
   ' 等待数据返回到串行端口。
   'buffer = ""
   Do
      DoEvents
   buffer$ = buffer$ & MSComm1.Input
   Loop Until InStr(buffer$, "OK" & vbCrLf)
   ' 从串行端口读 "OK" 响应。

   ' 关闭串行端口。
   
   MSComm1.Output = "ATV1Q0" & Chr$(13) ' 确保
   ' 调制解调器以"OK"响应。
   ' 等待数据返回到串行端口。
   'buffer = ""
   Do
      DoEvents
   buffer$ = buffer$ & MSComm1.Input
   Loop Until InStr(buffer$, "OK" & vbCrLf)
   ' 从串行端口读 "OK" 响应。



MSComm1.Output = "ATE0" & Chr$(13) ' 确保
   ' 调制解调器以"OK"响应。
   ' 等待数据返回到串行端口。
 buffer = ""
   Do
      DoEvents
   buffer$ = buffer$ & MSComm1.Input

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -