List of COM Port

[shark]

how to get list COM ports with installed on windows ?

[Antonio Linares]

You have to use WMI and "SELECT * FROM Win32_SerialPort"

Please review FWH\samples\pcinfo.prg

[shark]

What could be wrong with this method? oList variable does not receive values

Code: Select all

METHOD ReadPortInfo() CLASS TPCInfo

   local cRet  := "?"
   local aRet  := {}
   local oWmi, oList, oPorts

   oWmi        := WMIService()

   oList       := oWmi:ExecQuery( "SELECT * FROM Win32_SerialPort" )

   if oList:Count() > 0

      for each oPorts in oList

         if ValType( oPorts:Index ) == 'N'

            AAdd( aRet, { oPorts:Index, IfNil( oPorts:Caption, "" ) } )

         endif

      next

   else

      cRet     := "NO PORTS"

   endif

   ASort( aRet, nil, nil, { |x,y| x[ 1 ] < y[ 1 ] } )

   ::aPorts     := aRet

return cRet
 

[shark]

what is the solution Linares Master?

[Antonio Linares]

Shark,

I have modified FWH\samples\olebrow.prg to inspect what we get and I get this:



shark.prg

Code: Select all

// Docs: http://msdn.microsoft.com/en-us/library/cc237619.aspx

#include "FiveWin.ch"

#define  HKEY_CLASSES_ROOT       2147483648

function Main()

   local oLocator := CREATEOBJECT( "wbemScripting.SwbemLocator" )
   local oWMI     := oLocator:ConnectServer()
   local o        := oWMI:ExecQuery( "SELECT * FROM Win32_SerialPort" )

   XBrowser( GetTypeFuncs( o:hObj ) )   

return nil

function Rain()

   local nHandle, nHandle2, n := 1 
   local aValues := {}, cDesc, cValue, aDescriptors := {}

   if RegOpenKey( HKEY_CLASSES_ROOT, "CLSID", @nHandle ) == 0
      while RegEnumKey( nHandle, n++, @cDesc ) == 0
         if RegOpenKey( HKEY_CLASSES_ROOT, "CLSID\" + cDesc, @nHandle2 ) == 0
            if RegQueryValue( nHandle2, "ProgID", @cValue ) != 2 
               if ! Empty( cValue ) 
                  AAdd( aValues, { PadR( cValue, 40 ), PadR( ServerName( cDesc ), 85 ) } )
               endif
            endif      
            RegCloseKey( nHandle2 )
         endif
      end      
      RegCloseKey( nHandle )   
   endif   

   XBROWSER ASort( aValues,,, { | x, y | x[ 1 ] < y[ 1 ] }  ) TITLE "Available OLE classes" ;
      SELECT OleInspect( oBrw:aCols[ 1 ]:Value, oBrw:aCols[ 2 ]:Value ) ;
      VALID MsgYesNo( "want to end ?" ) ;
      SETUP ( oBrw:aCols[ 1 ]:cHeader := "ProgID",;
              oBrw:aCols[ 2 ]:cHeader := "Server filename",;
              oBrw:nMarqueeStyle := MARQSTYLE_HIGHLROW )

return nil
   
function OleInspect( cProgID, cValue )

   local o, aVars, aFuncs, cFuncs := ""

   try
      o := CreateObject( cProgID )
   catch
      MsgAlert( "can't create the object" )
      return nil
   end   

   if GetTypeInfoCount( o:hObj ) == 1 // There is info

      if Len( aVars := GetTypeVars( o:hObj ) ) > 0
         XBROWSER ASort( aVars ) TITLE "Variables"
      endif
      
      if Len( aFuncs := GetTypeFuncs( o:hObj ) ) > 0
         XBROWSER aFuncs ;
            TITLE "Functions for " + AllTrim( cProgID )
         // AEval( aFuncs, { | c | cFuncs += c + CRLF } )
         // MemoEdit( cFuncs )
      endif   
   endif

return nil

static function ServerName( cValue )

   local oReg := TReg32():New( HKEY_CLASSES_ROOT, "CLSID\" + cValue + ;
                               "\InprocServer32" )
   local cTypeLib := oReg:Get( "" )
   
   oReg:Close()
   
return cTypeLib   

#pragma BEGINDUMP

#include <hbapi.h>
#include "c:\harbour\contrib\hbwin\hbwinole.h"

HB_FUNC( GETTYPEINFOCOUNT )
{
   IDispatch * pDisp = hb_oleParam( 1 );
   HRESULT     lOleError;
   UINT        ctinfo;
   
   lOleError = HB_VTBL( pDisp )->GetTypeInfoCount( HB_THIS( pDisp ), &ctinfo );
   
   hb_retnl( ( lOleError == S_OK ) ? ctinfo: -1 ); 
}     

static LPSTR WideToAnsi( LPWSTR cWide )
{
   WORD wLen;
   LPSTR cString = NULL;

   wLen = WideCharToMultiByte( CP_ACP, 0, cWide, -1, cString, 0, NULL, NULL );

   cString = ( LPSTR ) hb_xgrab( wLen );
   WideCharToMultiByte( CP_ACP, 0, cWide, -1, cString, wLen, NULL, NULL );

   return cString;
}
   
HB_FUNC( GETTYPEVARS )
{
   IDispatch * pDisp = hb_oleParam( 1 );
   ITypeInfo * pInfo;
   TYPEATTR * pta;
   int i;

   if( HB_VTBL( pDisp )->GetTypeInfo( HB_THIS( pDisp ), 0, 0, &pInfo ) != S_OK )
      return;

   if( HB_VTBL( pInfo )->GetTypeAttr( HB_THIS( pInfo ), &pta ) != S_OK )
      return;

   hb_reta( pta->cVars );

   for( i = 0; i < pta->cVars; i++ )
   {
      BSTR bsName;
      VARDESC * pVar;
      char * pszName; 
   
      if( HB_VTBL( pInfo )->GetVarDesc( HB_THIS( pInfo ), i, &pVar ) != S_OK )
         break;

      if( HB_VTBL( pInfo )->GetDocumentation( HB_THIS( pInfo ), pVar->memid, &bsName, NULL, NULL, NULL ) != S_OK )
         break;

      pszName = WideToAnsi( bsName );
      hb_storvclen( pszName, strlen( pszName ), -1, i + 1 ); 
      hb_xfree( ( void * ) pszName );
      
      HB_VTBL( pInfo )->ReleaseVarDesc( HB_THIS( pInfo ), pVar );
   }

   HB_VTBL( pInfo )->Release( HB_THIS( pInfo ) );
}     
   
static char * GetType( unsigned int iType )
{
   char * pszType;
   
   switch( iType )
   {
      case VT_PTR:
           pszType = "PTR";
           break;
           
      case VT_ARRAY:
           pszType = "ARRAY";
           break;

      case VT_CARRAY:
           pszType = "CARRAY";
           break;

      case VT_USERDEFINED:
           pszType = "USERDEFINED";
           break;

      case VT_I2: 
           pszType = "short";
           break;
           
      case VT_I4: 
           pszType = "int";
           break;
           
      case VT_R4: 
           pszType = "float";
           break;
           
      case VT_R8: 
           pszType = "double";
           break;
           
      case VT_CY: 
           pszType = "CY";
           break;
           
      case VT_DATE: 
           pszType = "DATE";
           break;
           
      case VT_BSTR: 
           pszType = "BSTR";
           break;
           
      case VT_DECIMAL: 
           pszType = "DECIMAL";
           break;
           
      case VT_DISPATCH: 
           pszType = "IDispatch";
           break;
           
      case VT_ERROR: 
           pszType = "SCODE";
           break;
           
      case VT_BOOL: 
           pszType = "VARIANT_BOOL";
           break;
           
      case VT_VARIANT: 
           pszType = "VARIANT";
           break;
           
      case VT_UNKNOWN: 
           pszType = "IUnknown";
           break;
           
      case VT_UI1: 
           pszType = "BYTE";
           break;
           
      case VT_I1: 
           pszType = "char";
           break;
           
      case VT_UI2: 
           pszType = "unsigned short";
           break;
           
      case VT_UI4: 
           pszType = "unsigned long";
           break;
           
      case VT_I8: 
           pszType = "__int64";
           break;
           
      case VT_UI8: 
           pszType = "unsigned __int64";
           break;
           
      case VT_INT: 
           pszType = "int";
           break;
           
      case VT_UINT: 
           pszType = "unsigned int";
           break;
           
      case VT_HRESULT: 
           pszType = "HRESULT";
           break;
           
      case VT_VOID: 
           pszType = "void";
           break;
           
      case VT_LPSTR: 
           pszType = "char *";
           break;
           
      case VT_LPWSTR: 
           pszType = "wchar *";
           break;

      default:
           pszType = "Error";
           break;              
   }
   return pszType;
}   

static char * GetFuncKind( unsigned int iType )
{
   char * pszType;
   
   switch( iType )
   {
      case FUNC_PUREVIRTUAL:
           pszType = "virtual";
           break;

      case FUNC_STATIC:
           pszType = "static";
           break;
           
      case FUNC_DISPATCH:
           pszType = "dispatch";
           break;
           
      default:
           pszType = "error";
           break;
   }
   
   return pszType;
}                     

static char * GetInvKind( unsigned int iType )
{
   char * pszType;
   
   switch( iType )
   {
      case INVOKE_FUNC:
           pszType = "FUNC";
           break;

      case INVOKE_PROPERTYGET:
           pszType = "PROPERTYGET";
           break;
           
      case INVOKE_PROPERTYPUT:
           pszType = "PROPERTYPUT";
           break;
           
      case INVOKE_PROPERTYPUTREF:
           pszType = "PROPERTYPUTREF";
           break;     
           
      default:
           pszType = "error";
           break;
   }
   
   return pszType;
}                     

static char * GetCallConv( unsigned int iType )
{
   char * pszType;
   
   switch( iType )
   {
      case CC_CDECL:
           pszType = "CDECL";
           break;

      case CC_PASCAL:
           pszType = "PASCAL";
           break;
           
      case CC_STDCALL:
           pszType = "STDCALL";
           break;
           
      default:
           pszType = "error";
           break;
   }
   
   return pszType;
}                     

static char * GetParamType( USHORT iType )
{
   char * pszType = "error";
   
   if( iType & PARAMFLAG_NONE )
      pszType = "";
      
   if( iType & PARAMFLAG_FIN )
      pszType = "[in]";
      
   if( iType & PARAMFLAG_FOUT )
      pszType = "[out]";

   if( iType & PARAMFLAG_FLCID )
      pszType = "[lcid]";

   if( iType & PARAMFLAG_FRETVAL )
      pszType = "[retval]";

   if( iType & PARAMFLAG_FOPT )
      pszType = "[optional]";

   if( iType & PARAMFLAG_FHASDEFAULT )
      pszType = "[defaultvalue]";

   if( iType & PARAMFLAG_FHASCUSTDATA )
      pszType = "[custom]";
   
   return pszType;
}                     
   
HB_FUNC( GETTYPEFUNCS )
{
   IDispatch * pDisp = hb_oleParam( 1 );
   ITypeInfo * pInfo;
   HRESULT     lOleError;
   TYPEATTR * pta;
   int i;

   if( HB_VTBL( pDisp )->GetTypeInfo( HB_THIS( pDisp ), 0, 0, &pInfo ) != S_OK )
   {
      hb_ret();
      return;
   }   

   if( HB_VTBL( pInfo )->GetTypeAttr( HB_THIS( pInfo ), &pta ) != S_OK )
   {
      hb_ret();
      return;
   }   

   hb_reta( pta->cFuncs );

   for( i = 0; i < pta->cFuncs; i++ )
   {
      BSTR bsName;
      FUNCDESC * pfd;
      char * pszName; 
      char * pszType;
      char buffer[ 700 ];
      int n;
   
      if( HB_VTBL( pInfo )->GetFuncDesc( HB_THIS( pInfo ), i, &pfd ) != S_OK )
         break;

      if( HB_VTBL( pInfo )->GetDocumentation( HB_THIS( pInfo ), pfd->memid, &bsName, NULL, NULL, NULL ) != S_OK )
         break;

      pszName = WideToAnsi( bsName );

      sprintf( buffer, "%s %s %s %s %s(", GetCallConv( pfd->callconv ), 
               GetFuncKind( pfd->funckind ), GetInvKind( pfd->invkind ), 
               GetType( pfd->elemdescFunc.tdesc.vt ), pszName );
      
      for( n = 0; n < pfd->cParams; n++ )
      {
         if( n != 0 )
            strcat( buffer, ", " );
         else
            strcat( buffer, " " );   
         
         strcat( buffer, GetParamType( pfd->lprgelemdescParam[ n ].paramdesc.wParamFlags ) );
         strcat( buffer, " " );
         strcat( buffer, GetType( pfd->lprgelemdescParam[ n ].tdesc.vt ) );
         
         if( n == pfd->cParams - 1 )
            strcat( buffer, " " );
      }    

      strcat( buffer, ")" );
      hb_storvclen( buffer, strlen( buffer ), -1, i + 1 ); 
      hb_xfree( ( void * ) pszName );
      HB_VTBL( pInfo )->ReleaseFuncDesc( HB_THIS( pInfo ), pfd );
   }

   HB_VTBL( pInfo )->Release( HB_THIS( pInfo ) );
}     

#pragma ENDDUMP

[Antonio Linares]

This tool seems very very useful !!!

WMICodeCreator
http://www.microsoft.com/en-us/download ... px?id=8572

The problem is that o:Count() is reutning zero. Maybe WMICodeCreator may help us...

[Antonio Linares]

Shark,

I have adapted a C function from this thread to Harbour:
https://stackoverflow.com/questions/120 ... on-windows

Please test it on a computer that has COM ports. If your PC has no COM ports, then modify
this line to check how the function works:

// return GetDefaultCommConfig( buffer, &CommConfig, &size ) || size > sizeof( COMMCONFIG );
return TRUE;

shark.prg

Code: Select all

#include "FiveWin.ch"

function Main()

   XBrowser( FW_ComPorts() )

return nil

#pragma BEGINDUMP

#include <windows.h>
#include <hbapi.h>
#include <hbapiitm.h>

static char buffer[ 7 ];

static BOOL ComExists( int iPort )
{
   COMMCONFIG CommConfig;
   DWORD size = sizeof( COMMCONFIG );

   snprintf( buffer, sizeof( buffer ), "COM%d", iPort );

   return GetDefaultCommConfig( buffer, &CommConfig, &size ) || size > sizeof( COMMCONFIG );   
}

HB_FUNC( FW_COMPORTS )
{
   int i, iPorts = 0;
   PHB_ITEM itemReturn = hb_itemArrayNew( 0 );
    
   for( i = 1; i < 256; i++ )
      if( ComExists( i ) )
      {
         hb_arraySize( itemReturn, ++iPorts );
         hb_arraySetC( itemReturn, iPorts, buffer );
      }
      
   hb_itemReturnRelease( itemReturn );   
}

#pragma ENDDUMP

[bpd2000]

Result on my PC:

[bpd2000]

Code: Select all

// hbmk2 demo.prg hbcomm.hbc -run

function Main()

   LOCAL cCom       := "COM1"
   LOCAL nBaudeRate := 9600
   LOCAL nDatabits  := 8
   LOCAL nParity    := 0 /* none */
   LOCAL nStopbit   := 1
   LOCAL nBuff      := 8000
   Local aPorts := {}
   LOCAL I
   LOCAL  cPortName, s_nHandle
   

for i:=1 to 32
   cPortName := "COM"+alltrim(str(i))
   s_nHandle := INIT_PORT( cPortName, nBaudeRate, nDatabits, nParity, nStopbit, nBuff )
   IF s_nHandle > 0    
         ? cPortName
         aAdd(aPorts,cPortName)
   endif
  
next i
wait

return nil