IrDA, nogen som har et komplet eksempel til PDA
Hej!Jeg har siddet og kogt over noget IrDA kommunikation på en PDA, men jeg får en Exception når jeg ønsker at sende noget fra den1
Jeg har fundet et lille chat program som bør virke, men jeg kan ikke få det til at virke.
Public Class Form1
Inherits System.Windows.Forms.Form
Friend WithEvents StatusBar1 As System.Windows.Forms.StatusBar
Friend WithEvents MainMenu1 As System.Windows.Forms.MainMenu
Friend WithEvents MenuItem1 As System.Windows.Forms.MenuItem
Friend WithEvents MenuItem2 As System.Windows.Forms.MenuItem
Friend WithEvents txtMessage As System.Windows.Forms.TextBox
Friend WithEvents txtMessagesArchive As System.Windows.Forms.TextBox
Friend WithEvents cmdSend As System.Windows.Forms.Button
Const MAX_MESSAGE_SIZE = 128
Const MAX_TRIES = 3
Private ServiceName As String = "default"
Dim irDAClient As New System.Net.Sockets.IrDAClient
#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
'Form overrides dispose to clean up the component list.
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.
Private Sub InitializeComponent()
Me.StatusBar1 = New System.Windows.Forms.StatusBar
Me.MainMenu1 = New System.Windows.Forms.MainMenu
Me.MenuItem1 = New System.Windows.Forms.MenuItem
Me.MenuItem2 = New System.Windows.Forms.MenuItem
Me.txtMessage = New System.Windows.Forms.TextBox
Me.txtMessagesArchive = New System.Windows.Forms.TextBox
Me.cmdSend = New System.Windows.Forms.Button
'
'StatusBar1
'
Me.StatusBar1.Location = New System.Drawing.Point(0, 296)
Me.StatusBar1.Size = New System.Drawing.Size(234, 22)
'
'MainMenu1
'
Me.MainMenu1.MenuItems.Add(Me.MenuItem1)
'
'MenuItem1
'
Me.MenuItem1.MenuItems.Add(Me.MenuItem2)
Me.MenuItem1.Text = "Settings"
'
'MenuItem2
'
Me.MenuItem2.Text = "Service Name"
'
'txtMessage
'
Me.txtMessage.Location = New System.Drawing.Point(8, 48)
Me.txtMessage.Size = New System.Drawing.Size(224, 20)
Me.txtMessage.Text = ""
'
'txtMessagesArchive
'
Me.txtMessagesArchive.Location = New System.Drawing.Point(8, 120)
Me.txtMessagesArchive.Multiline = True
Me.txtMessagesArchive.ScrollBars = System.Windows.Forms.ScrollBars.Vertical
Me.txtMessagesArchive.Size = New System.Drawing.Size(224, 168)
Me.txtMessagesArchive.Text = ""
'
'cmdSend
'
Me.cmdSend.Location = New System.Drawing.Point(160, 80)
Me.cmdSend.Text = "Send"
Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedSingle
'
'Form1
'
Me.BackColor = System.Drawing.Color.Silver
Me.ClientSize = New System.Drawing.Size(234, 318)
Me.Controls.Add(Me.txtMessage)
Me.Controls.Add(Me.txtMessagesArchive)
Me.Controls.Add(Me.cmdSend)
Me.Controls.Add(Me.StatusBar1)
Me.Menu = Me.MainMenu1
Me.Text = "Form1"
End Sub
Public Shared Sub Main()
Application.Run(New Form1())
End Sub
#End Region
Private Sub Button1_Click(ByVal sender As System.Object, _
ByVal e As System.EventArgs) _
Handles cmdSend.Click
sendMessage(MAX_TRIES, _
stringToByteArray(txtMessage.Text), _
txtMessage.Text.Length)
End Sub
Private Sub sendMessage(ByVal NumRetries As Integer, _
ByVal Buffer() As Byte, _
ByVal BufferLen As Integer)
Dim client As System.Net.Sockets.IrDAClient = Nothing
Dim CurrentTries As Integer = 0
Do
Try
client = New System.Net.Sockets.IrDAClient(ServiceName)
Catch se As System.Net.Sockets.SocketException
If (CurrentTries >= NumRetries) Then
Throw se
End If
End Try
CurrentTries = CurrentTries + 1
Loop While client Is Nothing And _
CurrentTries < NumRetries
If (client Is Nothing) Then
'timeout occurred
MsgBox("Error establishing contact")
Return
End If
Dim stream As System.IO.Stream = Nothing
Try
stream = client.GetStream()
stream.Write(Buffer, 0, BufferLen)
Catch e As Exception
MsgBox("Error sending")
Finally
If (Not stream Is Nothing) Then
stream.Close()
End If
If (Not client Is Nothing) Then
client.Close()
End If
End Try
End Sub
Private Function receiveMessage(ByVal BufferLen As Integer) _
As String
Dim bytesRead As Integer = 0
Dim listener As System.Net.Sockets.IrDAListener = New System.Net.Sockets.IrDAListener(ServiceName)
Dim client As System.Net.Sockets.IrDAClient = Nothing
Dim stream As System.IO.Stream = Nothing
Dim Buffer(MAX_MESSAGE_SIZE) As Byte
Dim str As String
Try
listener.Start()
client = listener.AcceptIrDAClient() ' blocking call
stream = client.GetStream()
bytesRead = stream.Read(Buffer, 0, BufferLen)
str = client.RemoteMachineName + "->" + _
byteArrayToString(Buffer, bytesRead)
Catch e As Exception
MsgBox("Error listening to incoming message")
Finally
If (Not stream Is Nothing) Then
stream.Close()
End If
If (Not client Is Nothing) Then
client.Close()
End If
listener.Stop()
End Try
Return str
End Function
Private Sub Form1_Load(ByVal sender As System.Object, _
ByVal e As System.EventArgs) _
Handles MyBase.Load
Dim t1 As System.Threading.Thread
t1 = New Threading.Thread(AddressOf receiveLoop)
t1.Start()
End Sub
Public Sub receiveLoop()
Dim strReceived As String
strReceived = receiveMessage(MAX_MESSAGE_SIZE)
While True '---keep on listening for new message
If strReceived <> "" Then
Dim updateDelegate As New _
myDelegate(AddressOf UpdateTextBox)
updateDelegate.Invoke(strReceived)
strReceived = receiveMessage(MAX_MESSAGE_SIZE)
End If
End While
End Sub
Private Sub MenuItem2_Click(ByVal sender As System.Object, _
ByVal e As System.EventArgs) _
Handles MenuItem2.Click
Dim response As String = _
InputBox("Please enter a Service Name.", _
"Service Name", ServiceName)
If response <> "" Then
ServiceName = response 'change the service name
End If
End Sub
Private Delegate Sub myDelegate(ByVal str As String)
Private Sub UpdateTextBox(ByVal str As String)
'---delegate to update the textbox control
txtMessagesArchive.Text += str
End Sub
End Class
Module Module1
Dim receivedmessage As String
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
Public Function byteArrayToString(ByVal b As Byte(), ByVal len As Short) As String
Dim s As String
Dim i As Integer
For i = 0 To b.Length - 1
s += Convert.ToChar(b(i))
Next
Return s
End Function
End Module
