PocketChat 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 PCChat Begin 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 |