form1.vb

用GSM模块发送短信,是个发送短信的平台

Option Strict Off
Option Explicit On
Friend Class Form1
	Inherits System.Windows.Forms.Form
	
	Dim blnInTimer As Boolean
	
	Private Sub Command1_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Command1.Click
		Dim lngResult As Integer
		
		Dim lastCommand(256) As Byte
		Dim intLastCommandLen As Short
		Dim lastResponse(2048) As Byte
		Dim intLastResponseLen As Short
		
		Label3.Text = ""
		
		lngResult = OpenSMSDevice(CInt(VB6.GetItemString(Combo1, Combo1.SelectedIndex)))
		If lngResult = 0 Then
			Command2.Enabled = True
			Command3.Enabled = True
			Command4.Enabled = True
			Command2_Click(Command2, New System.EventArgs())
			Label3.Text = "OK"
			Label3.ForeColor = System.Drawing.Color.Blue
		Else
			intLastCommandLen = UBound(lastCommand) + 1
			intLastResponseLen = UBound(lastResponse) + 1
			GetLastCommand(lastCommand(0), intLastCommandLen, lastResponse(0), intLastResponseLen)
			MsgBox("打开短信猫失败，错误码=" & lngResult & vbCrLf & ConvertToStringSingle(lastCommand, intLastCommandLen) & ConvertToStringSingle(lastResponse, intLastResponseLen))
		End If
	End Sub
	
	Function ConvertToStringSingle(ByRef bytes() As Byte, ByRef intLen As Short) As String
		Dim i As Short
        Dim s As String = String.Empty
		
		For i = 0 To intLen - 1
			s = s & Chr(bytes(i))
		Next 
		ConvertToStringSingle = s
	End Function
	
	Function ConvertToStringDouble(ByRef bytes() As Byte, ByRef intLen As Short) As String
		Dim i As Short
        Dim s As String = String.Empty
		Dim lngCode As Integer
		
		For i = 0 To intLen - 2 Step 2
			lngCode = bytes(i + 1)
			lngCode = lngCode * 256 + bytes(i)
			s = s & ChrW(lngCode)
		Next 
		ConvertToStringDouble = s
	End Function
	
	Function ConvertToHexText(ByRef bytes() As Byte, ByRef intLen As Short) As String
		Dim i As Short
        Dim s As String = String.Empty
		
		For i = 0 To intLen - 1
			If bytes(i) < 16 Then
				s = s & " 0" & Hex(bytes(i))
			Else
				s = s & " " & Hex(bytes(i))
			End If
		Next 
		ConvertToHexText = s
	End Function
	
	Sub FetchNewMessages(ByRef nStartIndex As Short, ByRef nSMSCount As Short)
		Dim lngResult As Integer
		Dim i As Short
		Dim content(164) As Byte
		Dim phoneNumber(15) As Byte
		Dim intContentType As Short
		Dim intContentLen As Short
		Dim intPhoneNumberLen As Short
        Dim s As String = String.Empty
		Dim objItem As System.Windows.Forms.ListViewItem
		
		For i = nStartIndex To nStartIndex + nSMSCount - 1
			intContentLen = UBound(content) + 1
			intPhoneNumberLen = UBound(phoneNumber) + 1
			lngResult = GetSMS(i, content(0), intContentLen, phoneNumber(0), intPhoneNumberLen, intContentType)
			If lngResult = 0 Then
				Select Case intContentType
					Case SMS_ASCII
						s = ConvertToStringSingle(content, intContentLen)
					Case SMS_UNICODE
						s = ConvertToStringDouble(content, intContentLen)
					Case SMS_BINARY
						s = ConvertToHexText(content, intContentLen)
				End Select
				objItem = ListView1.Items.Add(ConvertToStringSingle(phoneNumber, intPhoneNumberLen))
				'UPGRADE_WARNING: 集合 objItem 的下限已由 1 更改为 0。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="A3B628A0-A810-4AE2-BFA2-9E7A29EB9AD0"”
				If objItem.SubItems.Count > 1 Then
					objItem.SubItems(1).Text = CStr(intContentLen)
				Else
					objItem.SubItems.Insert(1, New System.Windows.Forms.ListViewItem.ListViewSubItem(Nothing, CStr(intContentLen)))
				End If
				'UPGRADE_WARNING: 集合 objItem 的下限已由 1 更改为 0。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="A3B628A0-A810-4AE2-BFA2-9E7A29EB9AD0"”
				If objItem.SubItems.Count > 2 Then
					objItem.SubItems(2).Text = s
				Else
					objItem.SubItems.Insert(2, New System.Windows.Forms.ListViewItem.ListViewSubItem(Nothing, s))
				End If
			Else
				MsgBox("获取短信出错！错误码=" & lngResult, MsgBoxStyle.Information, "")
			End If
		Next 
	End Sub
	
	Private Sub Command2_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Command2.Click
		ListView1.Items.Clear()
		FetchNewMessages(0, GetSMSCount)
		If ListView1.Items.Count > 0 Then
			'UPGRADE_WARNING: 集合 ListView1.ListItems 的下限已由 1 更改为 0。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="A3B628A0-A810-4AE2-BFA2-9E7A29EB9AD0"”
			ListView1.FocusedItem = ListView1.Items.Item(1)
		End If
		'UPGRADE_ISSUE: MSComctlLib.ListView 事件 ListView1.ItemClick 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="ABD9AF39-7E24-4AFF-AD8D-3675C1AA3054"”
		ListView1_ItemClick(Nothing)
	End Sub
	
	Private Sub Command3_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Command3.Click
		Dim lngResult As Integer
		Dim lastRecv(1024) As Byte
		Dim intLastRecvLen As Short
		Dim intNext As Short
		
		If ListView1.FocusedItem Is Nothing Then Exit Sub
		
		If ListView1.Items.Count > 1 Then
			If ListView1.FocusedItem.Index = ListView1.Items.Count Then
				intNext = ListView1.Items.Count - 1
			Else
				intNext = ListView1.FocusedItem.Index
			End If
		Else
			intNext = 0
		End If
		
		lngResult = DeleteSMS(ListView1.FocusedItem.Index - 1)
		If lngResult = 0 Then
			ListView1.Items.RemoveAt(ListView1.FocusedItem.Index)
			If intNext > 0 Then
				'UPGRADE_WARNING: 集合 ListView1.ListItems 的下限已由 1 更改为 0。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="A3B628A0-A810-4AE2-BFA2-9E7A29EB9AD0"”
				ListView1.FocusedItem = ListView1.Items.Item(intNext)
			Else
				'UPGRADE_NOTE: 在对对象 ListView1.SelectedItem 进行垃圾回收前，不可以将其销毁。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="6E35BFF6-CD74-4B09-9689-3E1A43DF8969"”
				ListView1.FocusedItem = Nothing
			End If
			'UPGRADE_ISSUE: MSComctlLib.ListView 事件 ListView1.ItemClick 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="ABD9AF39-7E24-4AFF-AD8D-3675C1AA3054"”
			ListView1_ItemClick(Nothing)
			MsgBox("删除短信成功！", MsgBoxStyle.OKOnly, "")
		Else
			intLastRecvLen = UBound(lastRecv) + 1
			GetLastRecvForDelete(lastRecv(0), intLastRecvLen)
			MsgBox("删除短信出错！错误码=" & lngResult & vbCrLf & ConvertToStringSingle(lastRecv, intLastRecvLen), MsgBoxStyle.Information, "")
		End If
		ListView1.Focus()
	End Sub
	
	Function GetHex(ByRef content() As Byte) As Short
		Dim i As Short
		Dim intPos As Short
		Dim s As String
		Dim intCount As Short
		
		Text1.Text = Trim(Text1.Text)
		i = 1
		Do 
			intPos = InStr(i, Text1.Text, " ")
			If intPos = 0 Then
				s = Mid(Text1.Text, i, Len(Text1.Text) - i + 1)
				i = Len(Text1.Text) + 1
			Else
				s = Mid(Text1.Text, i, intPos - i)
				i = intPos + 1
			End If
			
			content(intCount) = HexadecimalStringToNumber(s)
			intCount = intCount + 1
		Loop Until i > Len(Text1.Text)
		GetHex = intCount
	End Function
	
	Function GetUnicode(ByRef content() As Byte) As Short
		Dim i As Short
		Dim s As String
		Dim lngCode As Integer
		
		For i = 1 To Len(Text1.Text)
			s = Mid(Text1.Text, i, 1)
			lngCode = AscW(s)
			lngCode = lngCode And 65535
			content((i - 1) * 2) = (lngCode And &HFFs)
			content((i - 1) * 2 + 1) = (lngCode And &HFF00s) \ 256
		Next 
		GetUnicode = Len(Text1.Text) * 2
	End Function
	
	Function GetAsc(ByRef content() As Byte) As Short
		Dim i As Short
		Dim s As String
		
		For i = 1 To Len(Text1.Text)
			s = Mid(Text1.Text, i, 1)
			content(i - 1) = Asc(s)
		Next 
		GetAsc = Len(Text1.Text)
	End Function
	
	Private Sub Command4_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Command4.Click

        Dim intType As Short
		Dim intCount As Short
		Dim content(164) As Byte
		
		Dim lngResult As Integer
		Dim lastRecv(1024) As Byte
		Dim intLastRecvLen As Short
		
		intLastRecvLen = UBound(lastRecv) + 1
		
		If Option1.Checked Then
			intCount = GetHex(content)
			intType = SMS_BINARY
		ElseIf Option2.Checked Then 
			intCount = GetAsc(content)
			intType = SMS_ASCII
		ElseIf Option3.Checked Then 
			intCount = GetUnicode(content)
			intType = SMS_UNICODE
		End If
		
		lngResult = SendSMS(Text2.Text, content(0), intCount, intType)
		If lngResult = 0 Then
			MsgBox("发送短信成功！", MsgBoxStyle.OKOnly, "")
		Else
			GetLastRecvForDelete(lastRecv(0), intLastRecvLen)
			MsgBox("发送短信出错！错误码=" & lngResult & vbCrLf & ConvertToStringSingle(lastRecv, intLastRecvLen))
		End If
	End Sub
	
	Private Sub Form1_Load(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Load
		Combo1.SelectedIndex = 0
		With ListView1.Columns
			.Add("电话号码")
			.Add("内容字节长度")
			.Add("内容").Width = VB6.TwipsToPixelsX(15 * 300)
		End With
	End Sub
	
	Private Sub Form1_FormClosed(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.FormClosedEventArgs) Handles Me.FormClosed
		CloseSMSDevice()
	End Sub
	
	'UPGRADE_ISSUE: MSComctlLib.ListView 事件 ListView1.ItemClick 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="ABD9AF39-7E24-4AFF-AD8D-3675C1AA3054"”
	Private Sub ListView1_ItemClick(ByVal Item As System.Windows.Forms.ListViewItem)
		If ListView1.FocusedItem Is Nothing Then
			Text3.Text = ""
			Exit Sub
		End If
		
		'UPGRADE_WARNING: 集合 ListView1.SelectedItem 的下限已由 1 更改为 0。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="A3B628A0-A810-4AE2-BFA2-9E7A29EB9AD0"”
		Text3.Text = ListView1.FocusedItem.SubItems(2).Text
	End Sub
	
	Private Sub Timer1_Tick(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Timer1.Tick

        Dim lngCount As Integer

		Dim modemResponse(256) As Byte
		Dim intResponseLen As Short
		Dim intOldCount As Short
		
		If blnInTimer Then Exit Sub
		
		blnInTimer = True
		If Label3.Text = "" Or Label3.Text = "OK" Then
			intResponseLen = UBound(modemResponse) + 1
			If HasError(modemResponse(0), intResponseLen) Then
				Label3.Text = "短信猫出错！"
				Label3.ForeColor = System.Drawing.Color.Red
			End If
		End If
		
		lngCount = GetSMSCount
		intOldCount = ListView1.Items.Count
		If lngCount > ListView1.Items.Count Then
			FetchNewMessages(ListView1.Items.Count, lngCount - ListView1.Items.Count)
			If intOldCount = 0 And ListView1.Items.Count > 0 Then
				'UPGRADE_WARNING: 集合 ListView1.ListItems 的下限已由 1 更改为 0。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="A3B628A0-A810-4AE2-BFA2-9E7A29EB9AD0"”
				ListView1.FocusedItem = ListView1.Items.Item(1)
				'UPGRADE_ISSUE: MSComctlLib.ListView 事件 ListView1.ItemClick 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="ABD9AF39-7E24-4AFF-AD8D-3675C1AA3054"”
				ListView1_ItemClick(Nothing)
			End If
		End If
		blnInTimer = False
	End Sub

    Private Sub ListView1_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ListView1.SelectedIndexChanged

    End Sub
End Class