Как из VB.NET кода определить подключен ли PocketPC к ПК?

[Anatoliy]

Добрый день. Как в VB.NET определить с настольного ПК, подключен ли к нему PoketPC.
В VB6 я использовал следующий модуль:

Код: Выделить всё

Option Explicit

Public Type CEOSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type

Public Declare Function CeGetVersionEx Lib "rapi.dll" ( _
    lpVersionInformation As CEOSVERSIONINFO) As Boolean

Private Function GetSub(Addr As Long) As Long
    'Used for the init Call.
    GetSub = Addr
End Function

Public Function ConnectedRapi()
    'Used for the init Call - Do not remove.
End Function

Public Function RapiConnect() As Boolean
    'Initiates a connection and returns true
    ' if it connected, false if it did not.
   
    Dim pRapiInit As RAPIINIT
   
    On Error GoTo RapiConnect_Err
   
    With pRapiInit
        .cbSize = Len(pRapiInit)
        .heRapiInit = GetSub(AddressOf ConnectedRapi)
    End With
    Call CeRapiInitEx(pRapiInit)
    RapiConnect = RapiGetCEOSVersionString <> ""
    Exit Function
   
RapiConnect_Err:
    RapiConnect = False
End Function

Public Function RapiGetCEOSVersionString() As String
    ' Returns the Major, Minor, and Build number of the OS In a string.
    Dim ceosver As CEOSVERSIONINFO
   
    ceosver.dwOSVersionInfoSize = Len(ceosver)
   
    If CeGetVersionEx(ceosver) Then
        RapiGetCEOSVersionString = ceosver.dwMajorVersion & "." & _
            ceosver.dwMinorVersion & "." & _
            ceosver.dwBuildNumber & " " & _
            Left$(ceosver.szCSDVersion, _
            InStr(ceosver.szCSDVersion, Chr$(0)) - 1)
    Else
        RapiGetCEOSVersionString = ""
    End If
End Function

Вызываю функцию из RapiConnect модуля:

Код: Выделить всё

   
   Dim bConnected As Boolean
    bConnected = RapiConnect

Получаю значение - присоединен ли КПК к ПК.

К сожалению в VB.NET он не работает.
Есть неплохая статья http://msdn.microsoft.com/library/rus/default.asp?url=/library/RUS/vbcon/html/vbup1048.aspкак заменить AddressOf.
Я попробовал таким образом выкрутиться:

Код: Выделить всё

    Delegate Sub ConnectedRapiDelegate()

    Private Function GetSub(ByVal Addr As ConnectedRapiDelegate) As Integer
        'Used for the init Call.
        GetSub = Addr
    End Function

    Public Sub ConnectedRapi()
        'Used for the init Call - Do not remove.
    End Sub

    Public Function RapiConnect() As Boolean
        'Initiates a connection and returns true
        ' if it connected, false if it did not.

        Dim pRapiInit As RAPIINIT
        Dim a As Integer
        Try
            With pRapiInit
                .cbSize = Len(pRapiInit)
                Dim myDlg As ConnectedRapiDelegate
                myDlg = AddressOf ConnectedRapi
                .heRapiInit = GetSub(myDlg) 'AddressOf ConnectedRapi)
            End With
            Call CeRapiInitEx(pRapiInit)
            RapiConnect = RapiGetCEOSVersionString() <> ""
            Exit Function
        Catch ex As Exception
            RapiConnect = False
        End Try
    End Function

Но в данном случае, что-то не стыкуется в строке GetSub = Addr. Выдает ругательство "Value of Type 'ConnectedRapiDelegate' cannot be converted to 'Integer'"

[mad_Max]

Вообще, в документации написано, что для передачи CallBack-функций нужно использовать делегаты (типа .NET сам догадается и все сконвертирует куда надо), а не адреса функций. Там еще пример был с FindWindow или чем-то в этом роде. Я пробовал аналогичным образом определять поле в структуре RAPIINIT (As MyDelegateSub), но так и не смог добиться результата. Сейчас нашел OpenNETCF.org Desktop.Communication Library (OpenSource), там есть нужные тебе функции (исходники на C#, но есть и откомпилированная библиотека - скачал, подключил и готово)
Качать тут:
http://www.opennetcf.org/download.asp?product=Communication

[GSerg]

Структуру объявить:

Код: Выделить всё

<runtime.interopservices.structlayout(runtime.interopservices.layoutkind.sequential, pack:=1)>Public Structure RAPIINIT
  public cbSize As Integer
  public heRapiInit As ConnectedRapiDelegate
  public hrRapiInit As integer
End Structure

Потом присвоить:

Код: Выделить всё

pRapiInit.heRapiInit = addressof ConnectedRapi

Потом вызвать...

[Anatoliy]

To mad_Max:
Пробовал я эту библиотеку.
Что-то не выходит:

Вроде бы безобидный код:

Код: Выделить всё

    Public Function IsRapiConnect() As Boolean
        Dim oRAPI As New OpenNETCF.Desktop.Communication.RAPI
        Try
            oRAPI.Connect()
            If oRAPI.Connected Then
                oRAPI.Disconnect()
                Return True
            End If 'oRAPI.Connected
        Catch ex As Exception
            Return False
        End Try

    End Function

Но он работает ТОЛЬКО при подключенном устройстве.
Если PocketPC не подключен - на строке oRAPI.Connect() зависает и даже не попадает в Catch ex As Exception.
А ведь основная цель - узнать подключен ли PocketPC

[Anatoliy]

Да, там даже есть топик с примером использования библиотеки в VB.NET. (http://www.opennetcf.org/forums/topic.asp?TOPIC_ID=540)
Создал следующий тестовый код:

Код: Выделить всё

   Public Function TestRAPI()
        Dim oRAPI As New OpenNETCF.Desktop.Communication.RAPI
        Dim i As Integer
        Dim sNewFolder As String = "\My Documents\OnlyTest"
        oRAPI.Connect()
        If oRAPI.Connected Then
            For i = 0 To 2
                Try
                    Dim RAPIerr1 As RAPIException
                    oRAPI.CreateDeviceDirectory(sNewFolder & i.ToString)
                Catch RAPIerr1 As RAPIException 'trap the error but don't respond if it is a file exits error
                    MsgBox(RAPIerr1.ToString, MsgBoxStyle.Information, "Create Directory On Device Error")
                End Try
            Next
        End If 'oRAPI.Connected
        oRAPI.Disconnect()

    End Function

По логике в папке My Documents должны будут созданы 3 папки: OnlyTest0, OnlyTest1 и OnlyTest2
Но реально при первом вызове oRAPI.CreateDeviceDirectory возникает ошибка - "No Connected"
И только в последующие вызовы создаются директории OnlyTest1 и OnlyTest2.
Что-то я здесь не так делаю, но не нонятно, что.

[Anatoliy]

To GSerg
Сделал как вы советуете.
На всякий случай помещу здесь код всего модуля:

Код: Выделить всё

Option Strict Off
Option Explicit On
Module Module1
   
   Public Structure CEOSVERSIONINFO
      Dim dwOSVersionInfoSize As Integer
      Dim dwMajorVersion As Integer
      Dim dwMinorVersion As Integer
      Dim dwBuildNumber As Integer
      Dim dwPlatformId As Integer
      <VBFixedString(128),System.Runtime.InteropServices.MarshalAs(System.Runtime.InteropServices.UnmanagedType.ByValTStr,SizeConst:=128)> Public szCSDVersion As String
   End Structure
   
    <Runtime.interopservices.structlayout(Runtime.InteropServices.LayoutKind.Sequential, pack:=1)> Public Structure RAPIINIT
        Public cbSize As Integer
        Public heRapiInit As ConnectedRapiDelegate
        Public hrRapiInit As Integer
    End Structure

    'UPGRADE_WARNING: Structure CEOSVERSIONINFO may require marshalling attributes to be passed as an argument in this Declare statement. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1050"'
    Public Declare Function CeGetVersionEx Lib "rapi.dll" (ByRef lpVersionInformation As CEOSVERSIONINFO) As Boolean

    'UPGRADE_WARNING: Structure RAPIINIT may require marshalling attributes to be passed as an argument in this Declare statement. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1050"'
    Public Declare Function CeRapiInitEx Lib "rapi.dll" (ByRef pRapiInit As RAPIINIT) As Integer

    Delegate Function ConnectedRapiDelegate() As ConnectedRapiDelegate

    Private Function GetSub(ByRef Addr As ConnectedRapiDelegate) As ConnectedRapiDelegate
        'Used for the init Call.
        GetSub = Addr
    End Function

    Public Function ConnectedRapi() As ConnectedRapiDelegate
        'Used for the init Call - Do not remove.
    End Function

    Public Function RapiConnect() As Boolean
        'Initiates a connection and returns true
        ' if it connected, false if it did not.

        Dim pRapiInit As RAPIINIT

        On Error GoTo RapiConnect_Err

        With pRapiInit
            .cbSize = Len(pRapiInit)
            'UPGRADE_WARNING: Add a delegate for AddressOf ConnectedRapi Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1048"'
            .heRapiInit = GetSub(AddressOf ConnectedRapi)
        End With
        Call CeRapiInitEx(pRapiInit)
        RapiConnect = RapiGetCEOSVersionString() <> ""
        Exit Function

RapiConnect_Err:
        RapiConnect = False
    End Function

    Public Function RapiGetCEOSVersionString() As String
        ' Returns the Major, Minor, and Build number of the OS In a string.
        Dim ceosver As CEOSVERSIONINFO

        ceosver.dwOSVersionInfoSize = Len(ceosver)

        If CeGetVersionEx(ceosver) Then
            RapiGetCEOSVersionString = ceosver.dwMajorVersion & "." & ceosver.dwMinorVersion & "." & ceosver.dwBuildNumber & " " & Left(ceosver.szCSDVersion, InStr(ceosver.szCSDVersion, Chr(0)) - 1)
        Else
            RapiGetCEOSVersionString = ""
        End If
    End Function

End Module

Ошибки нигде не выскакивают, но функция CeRapiInitEx не выполняет инициализацию и в результате RapiGetCEOSVersionString не зависимо от подключения всегда возвращает False.
Меня смущает здесь уже первый параметр структуры - .cbSize. В приведенном выше коде его значение равно 8, в то время, как в исходном коде на VB6 - 12.
Я попытался разобраться в описании структуры вот здесь:
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/APISP/html/sp_rapi_zcgv.asp . Мне кажется все-таки объявление структуры должно быть следующим:

Код: Выделить всё

Public heRapiInit As

вместо

Код: Выделить всё

Public heRapiInit As ConnectedRapiDelegate

Хотя, конечно, не зная ни C++, ни C# трудно об этом судить.

[GSerg]

Мда.
Поверил, не проверив

Доблестная традиция передавать addressof туда, где должен быть HEVENT, снова возобновлена. Смех сквозь слёзы

Не знаю, почему работает код на VB6. Видимо потому, что передаваемое число просто не приносит никому вреда.
На самом деле нужно создать объект Event и передать его HANDLE как pRapiInit.heRapiInit.

[mad_Max]

Если использовать библиотеку:

Код: Выделить всё

        Dim objRAPI As New OpenNETCF.Desktop.Communication.RAPI
        objRAPI.Connect(False)
        Dim t As Integer = Environment.TickCount
        While (t + 1000 < Environment.TickCount) And objRAPI.Connected = False
            Application.DoEvents()
        End While
        MsgBox(IIf(objrapi.Connected, "Подключен", "Не подключен"))
        objrapi.Disconnect()

Здесь просто таймаут поставлен. Можно еще ловить событие RAPIConnected объекта RAPI (объявить его на уровне формы с WithEvents).
Черт, я тоже пытался перевести с VB6 "в лоб", даже не заглянув в MSDN. Но ведь на VB6 оно работало...

[mus-lk]

Тема старая, как мир, но я вот столкнулся с теми же проблемами. На VB6 все есть на VB.Net чет нема.

Я похимичил с кодом и получилось вот так:

Код: Выделить всё

Imports System.Runtime.InteropServices

''' <summary>
''' Взято тут: http://rapi.codeplex.com/SourceControl/latest#Source/RAPI.cs
''' </summary>
Public Class clsRAPI

    'RAPI (Remote API) библиотека позволяющая приложениям на ПК работать с устройствами Windows Mobile
    'подсоединненые через ActiveSync или WMDC (Windows Mobile Device Center)

    <StructLayout(LayoutKind.Sequential)>
    Private Structure RAPIINIT
        Public cbSize As Integer
        Public heRapiInit As IntPtr
        Public hrRapiInit As Integer
    End Structure

    <DllImport("rapi.dll", CharSet:=CharSet.Unicode)>
    Private Shared Function CeRapiInitEx(<MarshalAs(UnmanagedType.Struct)> ByRef pRapiInit As RAPIINIT) As Integer
    End Function

    <DllImport("rapi.dll", CharSet:=CharSet.Unicode)>
    Private Shared Function CeRapiUninit() As Integer
    End Function

    <DllImport("kernel32.dll", EntryPoint:="WaitForSingleObject", SetLastError:=True)>
    Private Shared Function WaitForSingleObject(hHandle As IntPtr, dwMilliseconds As UInt32) As UInt32
    End Function

    Private Const WAIT_OBJECT_0 As UInt32 = 0
    Private Const WAIT_ABANDONED As UInt32 = 128
    Private Const WAIT_FAILED As UInt32 = 4294967295

    ''' <summary>
    ''' Функция определяет подключен PocketРС к ПК или нет
    ''' </summary>
    ''' <returns>True - PPC подключен; False - нет</returns>
    Public Function CEConnected() As Boolean

        Try
            Dim uRet As UInt32 = 0
            Dim timeout As Integer = 1
            Dim WaitForSingleObjectTimeOut as uinteger = 250
            Dim rez As Boolean = True
            Dim m_ri As RAPIINIT = New RAPIINIT()

            m_ri.cbSize = Marshal.SizeOf(m_ri)

            Dim ret As Integer = CeRapiInitEx(m_ri)

            If (ret <> 0) Then
                Marshal.ThrowExceptionForHR(ret)
            End If

            Do

                uRet = WaitForSingleObject(m_ri.heRapiInit, WaitForSingleObjectTimeOut)

                If (uRet = WAIT_FAILED) Or (uRet = WAIT_ABANDONED) Then

                    rez = False : Exit Do

                End If

                timeout -= 1

                If timeout < 0 Then
                    rez = False : Exit Do
                End If

            Loop Until uRet = WAIT_OBJECT_0

            CeRapiUninit()

            Return rez

        Catch ex As Exception

            Return False

        End Try

    End Function

End Class


Вызываем CEConnected, ну и если True - подключен, иначе - нет.

За основу брал http://rapi.codeplex.com/SourceControl/ ... ce/RAPI.cs
Там куча функций дорабатывай не хочу.