By Chris Tacke, Timothy Bassett
PCChatPocketChat was designed to "talk" with another copy of PocketChat on another device. If you only have one Pocket PC device, you can use PCChat to simulate the other device. The PCChat project consists only of a single form, frmMain. You will need to add two component references: the Microsoft WinSock Control and the Microsoft Windows CE File Control. Nicely enough, the Windows CE controls work just fine under the full Win32 environment. The relevant form header code is in Listing 5.17. The full project code shown in Listing 5.18 should be placed in frmMain's code page. Listing 5.17 Heading Information from frmMain.frm of PCChatBegin VB.Form frmMain Caption = "PCChat" ClientHeight = 4335 ClientLeft = 60 ClientTop = 345 ClientWidth = 6360 Begin VB.CommandButton cmdXfer Caption = "Xfer" Height = 435 Left = 2160 Top = 3720 Width = 1155 End Begin FILECTLCtl.File filMain Left = 120 Top = 3660 End Begin VB.CommandButton cmdSend Caption = "Send" Height = 435 Left = 840 Top = 3720 Width = 1155 End Begin VB.TextBox txtRecv Height = 2595 Left = 60 Locked = -1 'True MultiLine = -1 'True Top = 960 Width = 6075 End Begin VB.TextBox txtSend Height = 855 Left = 60 MultiLine = -1 'True Top = 60 Width = 6075 End Begin MSWinsockLib.Winsock wskMain Left = 5040 Top = 60 End End Listing 5.18 Complete Code for PCChat
Option Explicit
Private Sub cmdSend_Click()
SendText
End Sub
Private Sub cmdXfer_Click()
SendFile
End Sub
Private Sub Form_Load()
' Set the port we'll be using - you may have to modify this
wskMain.LocalPort = SOCKET_PORT
' Set the port to listen mode
wskMain.Listen
End Sub
Private Sub wskMain_Close()
wskMain.Close
' Inform the user
txtRecv.Text = txtRecv.Text & "<Disconnected>"
wskMain.Listen
End Sub
Private Sub wskMain_ConnectionRequest(ByVal requestID As Long)
wskMain.Close
wskMain.Accept requestID
End Sub
Private Sub wskMain_DataArrival(ByVal bytesTotal As Long)
Dim InBuffer As String
Static strRecv As String
wskMain.GetData InBuffer
strRecv = strRecv & InBuffer
' If no end tag has been received, we'll keep appending
If InStr(strRecv, "</PocketChat Text>") Then
' We've received a Chat message
DisplayText strRecv
' Clear the input buffer
strRecv = "
ElseIf InStr(strRecv, "</PocketChat File>") Then
' We've received a file
WriteFile strRecv
' Clear the input buffer
strRecv = "
End If
End Sub
Private Sub WriteFile(FileString As String)
Dim strFileName As String
Dim iEndPos As Integer
' First strip the tags
FileString = Replace(FileString, "</PocketChat File>", ")
FileString = Replace(FileString, "<PocketChat File>", ")
' Next get the filename
FileString = Replace(FileString, "<Filename>", ")
iEndPos = InStr(FileString, "</Filename>")
strFileName = Left(FileString, iEndPos - 1)
' Strip the filename and tags from the file contents
FileString = Mid(FileString, iEndPos + 11)
'now write the file - We can use the CE File object!!
' 73k v. the 145k scrrun.dll (fso)
' Open the file
filMain.Open App.Path & "\" & strFileName, fsModeOutput
' Write the data
filMain.LinePrint FileString
' Close the file
filMain.Close
End Sub
Private Sub DisplayText(TextToDisplay As String)
' First strip the tags
TextToDisplay = Replace(TextToDisplay, "</PocketChat Text>", ")
TextToDisplay = Replace(TextToDisplay, "<PocketChat Text>", ")
'Display the text
txtRecv.Text = txtRecv.Text & TextToDisplay & vbCrLf
End Sub
Private Sub SendText()
Dim strSend As String
' Get the data to send
strSend = Trim(txtSend.Text)
' Append our local name
strSend = GetLocalHostName & ": " & strSend
' Send the data with our custom tags
wskMain.SendData "<PocketChat Text>" & strSend & "</PocketChat Text>"
' Move it to the "recv" textbox
txtRecv.Text = txtRecv.Text & strSend & vbCrLf
' Clear the "Send" textbox
txtSend.Text = "
' Set focus back to the send textbox
txtSend.SetFocus
End Sub
Private Function GetLocalHostName() As String
GetLocalHostName = "ctacke"
End Function
Public Sub SendFile()
Dim strPath As String
Dim strFileName As String
Dim strContents As String
Dim iStartPos As Integer
strPath = InputBox("Enter name of file to send (include full path)", "Send File")
' Get the file's contents
If GetFileTextContents(strPath, strContents) = True Then
' Bracket file contents in tags
' Add filename tags
iStartPos = InStrRev(strPath, "\")
If iStartPos <= 0 Then iStartPos = 1
strFileName = Mid(strPath, iStartPos)
strContents = "<Filename>" & strFileName & "</Filename>" & strContents
' Add PocketChat tags
strContents = "<PocketChat File>" & strContents & "</PocketChat File>"
' Send the file
frmMain.wskMain.SendData strContents
' Inform the user we've sent the file
frmMain.txtRecv.Text = frmMain.txtRecv.Text & "Sent File: " _
& strFileName & vbCrLf
Else
' failed to get contents. Likely file doesn't exist
MsgBox "Cannot locate file to send", vbCritical, "Error sending"
End If
End Sub
Public Function GetFileTextContents(Path As String, _
Contents As String) As Boolean
' I've just modified the CE version of the method to use filFile
On Error Resume Next
' Set our return value
GetFileTextContents = True
' Open the File
filMain.Open Path, fsModeInput, fsAccessRead
' Make sure the call to Open was successful
If Err.Number <> 0 Then
GetFileTextContents = False
Exit Function
End If
' Loop through file, filling our input buffer
Do While Not filMain.EOF
Contents = Contents & filMain.Input(1)
Loop
' Close the file
filMain.Close
End Function
|