form1.vb

VB.NET编写的利用蓝牙技术在PPC之间发短信的程序

Imports System.Runtime.InteropServices
Public Class Form1
    Inherits System.Windows.Forms.Form

#Region " Windows Form Designer generated code "

    Public Sub New()
        MyBase.New()

        'This call is required by the Windows Form Designer.
        InitializeComponent()

        'Add any initialization after the InitializeComponent() call

    End Sub

    Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
        MyBase.Dispose(disposing)
    End Sub

    'NOTE: The following procedure is required by the Windows Form Designer
    'It can be modified using the Windows Form Designer.  
    'Do not modify it using the code editor.
    'Friend WithEvents InputPanel1 As Microsoft.WindowsCE.Forms.InputPanel
    Friend WithEvents MainMenu1 As System.Windows.Forms.MainMenu
    Friend WithEvents Button1 As System.Windows.Forms.Button
    Friend WithEvents txtMessage As System.Windows.Forms.TextBox
    Friend WithEvents txtMessageLog As System.Windows.Forms.TextBox
    Friend WithEvents MenuItem1 As System.Windows.Forms.MenuItem
    Friend WithEvents MenuItem2 As System.Windows.Forms.MenuItem
    Friend WithEvents MenuItem3 As System.Windows.Forms.MenuItem
    <System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
        Me.MainMenu1 = New System.Windows.Forms.MainMenu
        Me.MenuItem1 = New System.Windows.Forms.MenuItem
        Me.txtMessage = New System.Windows.Forms.TextBox
        Me.Button1 = New System.Windows.Forms.Button
        Me.txtMessageLog = New System.Windows.Forms.TextBox
        Me.MenuItem2 = New System.Windows.Forms.MenuItem
        Me.MenuItem3 = New System.Windows.Forms.MenuItem
        '
        'MainMenu1
        '
        Me.MainMenu1.MenuItems.Add(Me.MenuItem1)
        '
        'MenuItem1
        '
        Me.MenuItem1.MenuItems.Add(Me.MenuItem2)
        Me.MenuItem1.MenuItems.Add(Me.MenuItem3)
        Me.MenuItem1.Text = "Settings"
        '
        'txtMessage
        '
        Me.txtMessage.Location = New System.Drawing.Point(8, 8)
        Me.txtMessage.Size = New System.Drawing.Size(224, 22)
        Me.txtMessage.Text = ""
        '
        'Button1
        '
        Me.Button1.Location = New System.Drawing.Point(160, 40)
        Me.Button1.Text = "Send"
        '
        'txtMessageLog
        '
        Me.txtMessageLog.Location = New System.Drawing.Point(8, 64)
        Me.txtMessageLog.Multiline = True
        Me.txtMessageLog.ScrollBars = System.Windows.Forms.ScrollBars.Vertical
        Me.txtMessageLog.Size = New System.Drawing.Size(224, 192)
        Me.txtMessageLog.Text = ""
        '
        'MenuItem2
        '
        Me.MenuItem2.Text = "Connect"
        '
        'MenuItem3
        '
        Me.MenuItem3.Text = "Disconnect"
        '
        'Form1
        '
        Me.Controls.Add(Me.txtMessageLog)
        Me.Controls.Add(Me.Button1)
        Me.Controls.Add(Me.txtMessage)
        Me.Menu = Me.MainMenu1
        Me.Text = "Chat"

    End Sub

#End Region
    Dim infileHandler As Long
    Dim outfileHandler As Long
    Dim numReadWrite As Integer
    Dim t1 As System.Threading.Thread
    Dim stopThread As Boolean = False

    Public Sub connect()
        '---port number for Bluetooth connection
        Dim inPort As Short = 7
        Dim outPort As Short = 8

        '---Opens the port for Bluetooth
        infileHandler = CreateFile("COM" & inPort & ":", _
                                    &HC0000000, 0, 0, 3, 0, 0)
        Application.DoEvents()
        outfileHandler = CreateFile("COM" & outPort & ":", _
                                    &HC0000000, 0, 0, 3, 0, 0)
        Application.DoEvents()

        '---invoke the thread to receive incoming messages
        stopThread = False
        t1 = New Threading.Thread(AddressOf receiveLoop)
        t1.Start()
    End Sub

    Public Sub disconnect()
        stopThread = True
        CloseHandle(infileHandler)
        CloseHandle(outfileHandler)
    End Sub


    Private Sub Form1_Load(ByVal sender As System.Object, _
                           ByVal e As System.EventArgs) _
                           Handles MyBase.Load

    End Sub
    Public Function stringToByteArray(ByVal str As String) As Byte()
        '---e.g. "abcdefg" to {a,b,c,d,e,f,g}
        Dim s As Char()
        s = str.ToCharArray
        Dim b(s.Length - 1) As Byte
        Dim i As Integer
        For i = 0 To s.Length - 1
            b(i) = Convert.ToByte(s(i))
        Next
        Return b
    End Function
    Function byteArrayToString(ByVal b() As Byte) As String
        '---e.g. {a,b,c,d,e,f,g} to "abcdefg" 
        Dim str As String
        Dim enc As System.Text.ASCIIEncoding
        enc = New System.Text.ASCIIEncoding
        str = enc.GetString(b, 0, b.Length())
        Return str
    End Function

    <DllImport("coredll.dll")> _
    Private Shared Function CreateFile(ByVal lpFileName As String, _
                                       ByVal dwDesiredAccess As Integer, _
                                       ByVal dwShareMode As Integer, _
                                       ByVal lpSecurityAttributes As Integer, _
                                       ByVal dwCreationDisposition As Integer, _
                                       ByVal dwFlagsAndAttributes As Integer, _
                                       ByVal hTemplateFile As Integer) As Integer
    End Function

    <DllImport("coredll.dll")> _
   Private Shared Function ReadFile(ByVal hFile As Integer, _
                                    ByVal Buffer() As Byte, _
                                    ByVal nNumberOfBytesToRead As Integer, _
                                    ByRef lpNumberOfBytesRead As Integer, _
                                    ByRef lpOverlapped As Integer) As Integer
    End Function

    <DllImport("coredll.dll")> _
    Private Shared Function WriteFile(ByVal hFile As Integer, _
                                      ByVal Buffer() As Byte, _
                                      ByVal nNumberOfBytesToWrite As Integer, _
                                      ByRef lpNumberOfBytesWritten As Integer, _
                                      ByVal lpOverlapped As Integer) As Boolean
    End Function

    <DllImport("coredll.dll")> _
    Private Shared Function CloseHandle(ByVal hObject As Integer) As Integer
    End Function

    Public Function send(ByVal message As String) As Integer
        '---send the message through the serial port
        Dim value As String = message & vbCrLf
        Dim retCode As Integer = WriteFile(outfileHandler, _
                                           stringToByteArray(value), _
                                           value.Length(), _
                                           numReadWrite, _
                                           0)
        txtMessageLog.Text += value
        Return retCode
    End Function

    Public Sub receiveLoop()
        '---receive the message through the serial port
        Dim inbuff(300) As Byte
        Dim retCode As Integer = ReadFile(infileHandler, _
                                          inbuff, _
                                          inbuff.Length, _
                                          numReadWrite, _
                                          0)
        Application.DoEvents()
        While True
            If retCode = 0 Or stopThread Then
                'MsgBox("Error reading message.")
                Exit While
            Else
                Dim updateDelegate As New _
                    myDelegate(AddressOf updateMessageLog)

                updateDelegate.Invoke(byteArrayToString(inbuff))
                ReDim inbuff(300)
                retCode = ReadFile(infileHandler, _
                                   inbuff, _
                                   inbuff.Length, _
                                   numReadWrite, _
                                   0)
                Application.DoEvents()
            End If
        End While
    End Sub

    Private Sub Button1_Click(ByVal sender As System.Object, _
                              ByVal e As System.EventArgs) _
                              Handles Button1.Click
        If send(txtMessage.Text) = 0 Then
            MsgBox("Error sending message.")
        End If
    End Sub

    Public Delegate Sub myDelegate(ByVal str As String)

    Public Sub updateMessageLog(ByVal str As String)
        If str.Length > 0 Then
            txtMessageLog.Text += "-->" & str
        End If
    End Sub

    Private Sub MenuItem1_Click(ByVal sender As System.Object, _
                                ByVal e As System.EventArgs) _
                                Handles MenuItem1.Click

    End Sub

    Private Sub MenuItem2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MenuItem2.Click
        connect()
        MenuItem2.Enabled = False
        MenuItem3.Enabled = True
    End Sub

    Private Sub MenuItem3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MenuItem3.Click
        disconnect()
        MenuItem2.Enabled = True
        MenuItem3.Enabled = False
    End Sub
End Class