Microsoft KB Archive/275004

= How To Transfer a Bitmap to a PocketPC Using the Winsock Control =

Article ID: 275004

Article Last Modified on 7/13/2004

-

APPLIES TO


 * Microsoft eMbedded Visual Basic 3.0

-



This article was previously published under Q275004



SUMMARY
This article illustrates how to transfer a bitmap to a PocketPC device by using the Winsock control.



Step by Step Example
To transfer a bitmap, follow these steps:  Create a desktop Microsoft Visual Basic (VB) Standard EXE application. To do this, follow these steps:  In Visual Basic, create a new Standard EXE project. On the Project menu, click Components and select the Microsoft Winsock control. Place three command buttons, two Winsock controls, and two labels on Form1. The placement of the controls is unimportant.  Paste the following code in Form1: Option Explicit Private Const WS_VERSION_REQD = &H101 Private Const WS_VERSION_MAJOR = WS_VERSION_REQD \ &H100 And &HFF& Private Const WS_VERSION_MINOR = WS_VERSION_REQD And &HFF& Private Const MIN_SOCKETS_REQD = 1 Private Const SOCKET_ERROR = -1 Private Const WSADescription_Len = 256 Private Const WSASYS_Status_Len = 128

Private Type HOSTENT hName As Long hAliases As Long hAddrType As Integer hLength As Integer hAddrList As Long End Type

Private Type WSADATA wversion As Integer wHighVersion As Integer szDescription(0 To WSADescription_Len) As Byte szSystemStatus(0 To WSASYS_Status_Len) As Byte iMaxSockets As Integer iMaxUdpDg As Integer lpszVendorInfo As Long End Type

Private Declare Function WSAGetLastError Lib &quot;WSOCK32.DLL&quot; As Long

Private Declare Function WSAStartup Lib &quot;WSOCK32.DLL&quot; ( _   ByVal wVersionRequired As Long, _    lpWSAData As WSADATA) As Long Private Declare Function WSACleanup Lib &quot;WSOCK32.DLL&quot; As Long

Private Declare Function gethostname Lib &quot;WSOCK32.DLL&quot; ( _   ByVal hostname As String, _    ByVal HostLen As Long) As Long Private Declare Function gethostbyname Lib &quot;WSOCK32.DLL&quot; ( _   ByVal hostname As String) As Long Private Declare Sub RtlMoveMemory Lib &quot;KERNEL32&quot; ( _   hpvDest As Any, _    ByVal hpvSource As Long, _    ByVal cbCopy As Long)

Private Function hibyte(ByVal wParam As Integer) hibyte = wParam \ &H100 And &HFF& End Function

Private Function lobyte(ByVal wParam As Integer) lobyte = wParam And &HFF& End Function

Private Sub Form_Load Label1.Move 120, 120, 2535, 255 Label2.Move 1920, 600, 2535, 255 Command1.Move 120, 600, 1575, 475 Command2.Move 120, 1200, 1575, 475 Command3.Move 120, 1800, 1575, 475 Form1.Height = 2850 Form1.Width = 4080 Label1.Caption = &quot;Host IP: &quot; & GetHostIP Label2.Caption = GetWinsockState SocketsInitialize Command1.Caption = &quot;Listen&quot; Command2.Caption = &quot;Send Data&quot; Command3.Caption = &quot;Close Connections&quot; Command2.Enabled = False Command3.Enabled = False End Sub

Private Sub Form_Unload(Cancel As Integer) SocketsCleanup End Sub

Private Sub Command1_Click Winsock1.Protocol = sckTCPProtocol Winsock1.LocalPort = 5149 Winsock1.RemotePort = 5150 Winsock1.Listen Label2.Caption = GetWinsockState Command1.Enabled = False MsgBox &quot;Go hit &quot;&quot;Connect&quot;&quot; button on device&quot; End Sub

Private Sub Command2_Click Dim sFileName As String Dim lOffset As Long Dim bTemp As Byte Dim bFileData As Byte Dim lLength As Long 'NOTE: BMP must be 256 color or less. sFileName = &quot;d:\mnu.bmp&quot; Open sFileName For Binary Access Read As #1 ReDim bFileData(FileLen(sFileName)) lLength = FileLen(sFileName) + 1 For lOffset = 1 To lLength If Not lOffset = lLength Then Get #1, lOffset, bTemp bFileData(lOffset - 1) = bTemp Else bFileData(lOffset - 1) = CByte(26) End If   Next lOffset Close #1 Winsock2.SendData bFileData Command2.Enabled = False Command3.Enabled = True End Sub

Private Sub Command3_Click Winsock1.Close Winsock2.Close Label2.Caption = GetWinsockState Command1.Enabled = True Command2.Enabled = False Command3.Enabled = False End Sub

Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long) Winsock2.Accept requestID Command2.Enabled = True Label2.Caption = &quot;Listening: Connected&quot; End Sub

Private Sub SocketsInitialize Dim WSAD As WSADATA Dim iReturn As Integer Dim sLowByte As String, sHighByte As String, sMsg As String iReturn = WSAStartup(WS_VERSION_REQD, WSAD) If iReturn <> 0 Then MsgBox &quot;Winsock.dll is not responding.&quot; End End If

If lobyte(WSAD.wversion) < WS_VERSION_MAJOR Or _ (lobyte(WSAD.wversion) = _       WS_VERSION_MAJOR And hibyte(WSAD.wversion) < WS_VERSION_MINOR) Then sHighByte = Trim$(Str$(hibyte(WSAD.wversion))) sLowByte = Trim$(Str$(lobyte(WSAD.wversion))) sMsg = &quot;Windows Sockets version &quot; & sLowByte & &quot;.&quot; & sHighByte sMsg = sMsg & &quot; is not supported by winsock.dll &quot; MsgBox sMsg End End If

'iMaxSockets is not used in Winsock 2, so the following check is only 'necessary for Winsock 1. If Winsock 2 is requested, 'the following check can be skipped.

If WSAD.iMaxSockets < MIN_SOCKETS_REQD Then sMsg = &quot;This application requires a minimum of &quot; sMsg = sMsg & Trim$(Str$(MIN_SOCKETS_REQD)) & &quot; supported sockets.&quot; MsgBox sMsg End End If

End Sub

Private Function GetWinsockState As String Select Case Winsock1.State Case 0 'sckClosed GetWinsockState = &quot;Closed&quot; Case 1 'sckOpen GetWinsockState = &quot;Open&quot; Case 2 'sckListening GetWinsockState = &quot;Listening&quot; Case 3 'sckConnectionPending GetWinsockState = &quot;Connection pending&quot; Case 4 'sckResolvingHost GetWinsockState = &quot;Resolving host&quot; Case 5 'sckHostResolved GetWinsockState = &quot;Host resolved&quot; Case 6 'sckConnecting GetWinsockState = &quot;Connecting&quot; Case 7 'sckConnected GetWinsockState = &quot;Connected&quot; Case 8 'sckClosing GetWinsockState = &quot;Peer is closing the connection&quot; Case 9 'sckError GetWinsockState = &quot;Error&quot; End Select End Function

Private Function GetHostIP As String Dim sHostName As String * 256 Dim lHostEnt_Addr As Long Dim Host As HOSTENT Dim lHostIP_Addr As Long Dim bTempIP_Addr As Byte Dim i As Integer Dim sIP_Addr As String If gethostname(sHostName, 256) = SOCKET_ERROR Then MsgBox &quot;Windows Sockets error &quot; & Str(WSAGetLastError) Exit Function Else sHostName = Trim$(sHostName) End If   lHostEnt_Addr = gethostbyname(sHostName) If lHostEnt_Addr = 0 Then MsgBox &quot;Winsock.dll is not responding.&quot; Exit Function End If   RtlMoveMemory Host, lHostEnt_Addr, LenB(Host) RtlMoveMemory lHostIP_Addr, Host.hAddrList, 4 'Get all of the IP addresses if the computer is multi-homed. Do       ReDim bTempIP_Addr(1 To Host.hLength) RtlMoveMemory bTempIP_Addr(1), lHostIP_Addr, Host.hLength For i = 1 To Host.hLength sIP_Addr = sIP_Addr & bTempIP_Addr(i) & &quot;.&quot; Next sIP_Addr = Mid$(sIP_Addr, 1, Len(sIP_Addr) - 1) GetHostIP = sIP_Addr sIP_Addr = &quot;&quot; Host.hAddrList = Host.hAddrList + LenB(Host.hAddrList) RtlMoveMemory lHostIP_Addr, Host.hAddrList, 4 Loop While (lHostIP_Addr <> 0)

End Function

Private Sub SocketsCleanup Dim lReturn As Long lReturn = WSACleanup If lReturn <> 0 Then MsgBox &quot;Socket error &quot; & Trim$(Str$(lReturn)) & _ &quot; occurred in cleanup.&quot; End End If End Sub   Create an eMbedded Visual Basic (eVB) PocketPC application. To do this, follow these steps:  Create a new PocketPC application in eVB.</li> On the Project menu, click Components and select the Microsoft CE Winsock Control and the Microsoft CE Image Control.</li> Place two command buttons, one label, one image control, and one Winsock control on Form1. The placement of the controls is unimportant.</li>  Paste the following code in Form1: Option Explicit

Dim inBytes As Variant Dim MyString As String Dim bLast As Boolean Dim bNotFirst As Boolean Dim hFile As Long

Private Sub Command1_Click WaitCursor True Label1.Caption = &quot;Connecting....&quot; WinSock1.LocalPort = 5150 WinSock1.RemotePort = 5149 WinSock1.RemoteHost = &quot;111.111.111.111&quot; 'Put your IP address here WinSock1.Connect Label1.Caption = &quot;Connected&quot; Command1.Enabled = False Command2.Enabled = True WaitCursor False End Sub

Private Sub Command2_Click WinSock1.Close Command1.Enabled = True Command2.Enabled = False End Sub

Private Sub Form_Load Command1.Move 120, 120, 1335, 495 Command2.Move 120, 720, 1335, 495 Label1.Move 1560, 120, 1695, 255 ImageCtl1.Move 120, 1320, 2775, 1575 Command1.Caption = &quot;Connect&quot; Command2.Caption = &quot;Close Winsock&quot; Command2.Enabled = False Label1.Caption = &quot;&quot; End Sub

Private Sub WinSock1_DataArrival(ByVal bytesTotal As Long) ReDim inBytes(bytesTotal) WinSock1.GetData inBytes, (vbByte + vbArray) If AscB(ChrB(inBytes(UBound(inBytes)))) = 26 Then bLast = True End If   MakeString WriteIt If bLast Then ImageCtl1.Picture = &quot;\MyFile.bmp&quot; End Sub

Private Sub MakeString Dim x As Integer Dim iEnd As Integer MyString = &quot;&quot; If Not bLast Then iEnd = UBound(inBytes) Else iEnd = UBound(inBytes) - 1 End If   For x = LBound(inBytes) To iEnd MyString = MyString & ChrB(inBytes(x)) Next End Sub

Private Function WriteIt As Boolean Dim retVal As Long, lWritten As Long If Not bNotFirst Then hFile = CreateFile(&quot;MyFile.bmp&quot;, GENERIC_READ + GENERIC_WRITE, _                          0, 0, CREATE_ALWAYS, 0, 0) bNotFirst = True End If   If hFile <> -1 Then retVal = WriteFile(hFile, MyString, LenB(MyString), lWritten, 0) If bLast Then retVal = CloseHandle(hFile) End If End Function

Private Sub Form_OKClick App.End End Sub </li> On the Project menu, click Add Module and add a new module to the project.</li>  Paste the following code in Module1: Option Explicit

Public Declare Function CreateFile Lib &quot;Coredll&quot; Alias &quot;CreateFileW&quot; ( _   ByVal lpFileName As String, _    ByVal dwDesiredAccess As Long, _    ByVal dwShareMode As Long, _    lpSecurityAttributes As Long, _    ByVal dwCreationDisposition As Long, _    ByVal dwFlagsAndAttributes As Long, _    ByVal hTemplateFile As Long) As Long

Public Declare Function ReadFile Lib &quot;Coredll&quot; ( _   ByVal hFile As Long, _    ByVal lpBuffer As String, _    ByVal nNumberOfBytesToRead As Long, _    lpNumberOfBytesRead As Long, _    ByVal lpOverlapped As Long) As Long

Public Declare Function WriteFile Lib &quot;Coredll&quot; ( _   ByVal hFile As Long, _    ByVal lpBuffer As String, _    ByVal nNumberOfBytesToWrite As Long, _    lpNumberOfBytesWritten As Long, _    ByVal lpOverlapped As Long) As Long

Public Declare Function CloseHandle Lib &quot;Coredll&quot; ( _   ByVal hObject As Long) As Long

Public Declare Function GetLastError Lib &quot;Coredll&quot; As Long

Public Declare Function LoadCursor Lib &quot;Coredll&quot; _ Alias &quot;LoadCursorW&quot; ( _   ByVal hInstance As Long, _    ByVal lpCursorName As Long) As Long

Public Declare Function SetCursor Lib &quot;Coredll&quot; ( _   ByVal hCursor As Long) As Long Public Const READ_CONTROL = &H20000 Public Const READ_WRITE = 2 Public Const FILE_READ_DATA = (&H1) Public Const FILE_READ_ATTRIBUTES = (&H80) Public Const FILE_READ_EA = (&H8) Public Const FILE_WRITE_ATTRIBUTES = (&H100) Public Const FILE_WRITE_DATA = (&H2) Public Const FILE_WRITE_EA = (&H10) Public Const FILE_APPEND_DATA = (&H4) Public Const SYNCHRONIZE = &H100000

Public Const CREATE_ALWAYS = 2 Public Const OPEN_EXISTING = 3 Public Const OPEN_ALWAYS = 4 Public Const STANDARD_RIGHTS_WRITE = &H20000 Public Const STANDARD_RIGHTS_READ = &H20000 Public Const GENERIC_READ = &H80000000 Public Const GENERIC_WRITE = &H40000000

Public Const IDC_WAIT = 32514

Public Function WaitCursor(bWait As Boolean) As Long Dim hCursor As Long 'Obtain the handle to the cursor. If bWait Then 'Get handle to the wait cursor. hCursor = LoadCursor(0, IDC_WAIT) Else 'Restore default cursor. hCursor = LoadCursor(0, 0) End If   'Set the cursor based on the cursor handle. WaitCursor = SetCursor(hCursor)

End Function </li></ol> </li> Test the samples. To do this, follow these steps:  Verify that the bitmap that the desktop VB application points to is a valid 256 color bitmap, then run the desktop VB project.</li> Note the IP address that is displayed on Form1, and change the IP address in the eVB code to match that IP address.</li> Run the eVB project, targeting the PocketPC device.</li> On the desktop VB application, click Listen.</li> On the eVB application, click Connect.</li> After the connection is established, click Send Data on the desktop VB application. The bitmap is transferred to the device and displayed on the eVB form.</li></ol> </li></ol>

<div class="references_section">