HB_EXPORT char * hb_parcstruct( int iParam, ... )
{
   HB_THREAD_STUB_ANY

   HB_TRACE(HB_TR_DEBUG, ("hb_parcstruct(%d, ...)", iParam));

   if( s_pHB_CSTRUCTURE == NULL )
   {
      s_pHB_CSTRUCTURE = hb_dynsymFind( "HB_CSTRUCTURE" );

      s_pPOINTER       = hb_dynsymGetCase( "POINTER" );
      s_pVALUE         = hb_dynsymGetCase( "VALUE" );
      s_pBUFFER        = hb_dynsymGetCase( "BUFFER" );
      s_pDEVALUE       = hb_dynsymGetCase( "DEVALUE" );
   }

   if( ( iParam >= 0 && iParam <= hb_pcount() ) || ( iParam == -1 ) )
   {
      PHB_ITEM pItem = ( iParam == -1 ) ? hb_stackReturnItem() : hb_stackItemFromBase( iParam );
      BOOL bRelease = FALSE;

      if( HB_IS_BYREF( pItem ) )
         pItem = hb_itemUnRef( pItem );

      if( HB_IS_ARRAY( pItem ) && ! HB_IS_OBJECT( pItem ) )
      {
         va_list va;
         ULONG ulArrayIndex;
         PHB_ITEM pArray = pItem;

         va_start( va, iParam );
         ulArrayIndex = va_arg( va, ULONG );
         va_end( va );

         pItem = hb_itemNew( NULL );
         bRelease = TRUE;

         hb_arrayGet( pArray, ulArrayIndex, pItem );
      }

      if( strncmp( hb_objGetClsName( pItem ), "C Structure", 11 ) == 0 )
      {
         hb_vmPushDynSym( s_pVALUE );
         hb_vmPush( pItem );
         hb_vmSend( 0 );

         if( bRelease )
            hb_itemRelease( pItem );

         return hb_itemGetCPtr( hb_stackReturnItem() );
      }
   }

   return NULL;
}

#endif

/* ==================================================================
 * DynaCall support comments below
 * ------------------------------------------------------------------
 *
 *   This part used modified code of Vic McClung.
 *   The modifications were to separate the library loading and 
 *   getting the procedure address from the actual function call.
 *   The parameters have been slightly re-arranged to allow for 
 *   C-like syntax, on function declaration. The changes allow to 
 *   load the library and to get the procedure addresses in advance,
 *   which makes it work similarly to C import libraries. From 
 *   experience, when using dynamic libraries, loading the library 
 *   and getting the address of the procedure part of using the DLL.
 *   Additionally the changes will allow to use standard [x]Harbour 
 *   C type defines, as used with structure types, and defined in 
 *   cstruct.ch.
 *
 *   Andrew Wos.
 *   20/07/2002.
 */

/* Calling conventions */
#define DLL_CDECL                DC_CALL_CDECL
#define DLL_STDCALL              DC_CALL_STD

/* Parameter passing mode */
#define DLL_CALLMODE_NORMAL      0x0000
#define DLL_CALLMODE_COPY        0x2000

#define DC_MICROSOFT             0x0000      /* Default */
#define DC_BORLAND               0x0001      /* Borland compatible */
#define DC_CALL_CDECL            0x0010      /* __cdecl */
#define DC_CALL_STD              0x0020      /* __stdcall */
#define DC_RETVAL_MATH4          0x0100      /* Return value in ST */
#define DC_RETVAL_MATH8          0x0200      /* Return value in ST */

#define DC_CALL_STD_BO           ( DC_CALL_STD | DC_BORLAND )
#define DC_CALL_STD_MS           ( DC_CALL_STD | DC_MICROSOFT )
#define DC_CALL_STD_M8           ( DC_CALL_STD | DC_RETVAL_MATH8 )

#define DC_FLAG_ARGPTR           0x00000002

#define CTYPE_VOID               9
#define CTYPE_CHAR               1
#define CTYPE_UNSIGNED_CHAR      -1
#define CTYPE_CHAR_PTR           10
#define CTYPE_UNSIGNED_CHAR_PTR  -10
#define CTYPE_SHORT              2
#define CTYPE_UNSIGNED_SHORT     -2
#define CTYPE_SHORT_PTR          20
#define CTYPE_UNSIGNED_SHORT_PTR -20
#define CTYPE_INT                3
#define CTYPE_UNSIGNED_INT       -3
#define CTYPE_INT_PTR            30
#define CTYPE_UNSIGNED_INT_PTR   -30
#define CTYPE_LONG               4
#define CTYPE_UNSIGNED_LONG      -4
#define CTYPE_LONG_PTR           40
#define CTYPE_UNSIGNED_LONG_PTR  -40
#define CTYPE_FLOAT              5
#define CTYPE_FLOAT_PTR          50
#define CTYPE_DOUBLE             6
#define CTYPE_DOUBLE_PTR         60
#define CTYPE_VOID_PTR           7
#define CTYPE_BOOL               8
#define CTYPE_STRUCTURE          1000
#define CTYPE_STRUCTURE_PTR      10000

#pragma pack(1)

typedef union RESULT
{                                /* Various result types */
   int     Int;                  /* Generic four-byte type */
   long    Long;                 /* Four-byte long */
   void *  Pointer;              /* 32-bit pointer */
   float   Float;                /* Four byte real */
   double  Double;               /* 8-byte real */
   __int64 int64;                /* big int (64-bit) */
} RESULT;

typedef struct DYNAPARM
{
   DWORD       dwFlags;          /* Parameter flags */
   int         nWidth;           /* Byte width */
   union
   {
      BYTE     bArg;             /* 1-byte argument */
      SHORT    usArg;            /* 2-byte argument */
      DWORD    dwArg;            /* 4-byte argument */
      double   dArg;             /* double argument */
   } numargs;
   void *      pArg;             /* Pointer to argument */
} DYNAPARM;

RESULT DynaCall( int iFlags,      LPVOID lpFunction, int nArgs,
                 DYNAPARM Parm[], LPVOID pRet,       int nRetSiz )
{
   /* Call the specified function with the given parameters. Build a
      proper stack and take care of correct return value processing. */
   RESULT  Res = { 0 };
#if defined(HB_WINCE) || defined(HB_OS_WIN_64)
   HB_SYMBOL_UNUSED( iFlags );
   HB_SYMBOL_UNUSED( lpFunction );
   HB_SYMBOL_UNUSED( nArgs );
   HB_SYMBOL_UNUSED( Parm );
   HB_SYMBOL_UNUSED( pRet );
   HB_SYMBOL_UNUSED( nRetSiz );
#else
   int     i, nInd, nSize, nLoops;
   DWORD   dwEAX, dwEDX, dwVal, * pStack, dwStSize = 0;
   BYTE *  pArg;

   #if defined( __MINGW32__ )
   #elif defined( __BORLANDC__ ) || defined(__DMC__)
   #else
      DWORD *pESP;
   #endif

   /* Reserve 256 bytes of stack space for our arguments */
   #if defined( __MINGW32__ )
      asm volatile( "\tmovl %%esp, %0\n"
                    "\tsubl $0x100, %%esp\n"
                    : "=r" (pStack) );
   #elif defined( __BORLANDC__ ) || defined(__DMC__)
      pStack = (DWORD *)_ESP;
      _ESP -= 0x100;
   #else
      _asm mov pStack, esp
      _asm mov pESP, esp
      _asm sub esp, 0x100
   #endif

   /* Push args onto the stack. Every argument is aligned on a
      4-byte boundary. We start at the rightmost argument. */
   for( i = 0; i < nArgs; i++ )
   {
      nInd  = (nArgs - 1) - i;
      /* Start at the back of the arg ptr, aligned on a DWORD */
      nSize = (Parm[nInd].nWidth + 3) / 4 * 4;
      pArg  = (BYTE *) Parm[nInd].pArg + nSize - 4;
      dwStSize += ( DWORD ) nSize; /* Count no of bytes on stack */

      nLoops = ( nSize / 4 ) - 1;

      while( nSize > 0 )
      {
         /* Copy argument to the stack */
         if( Parm[nInd].dwFlags & DC_FLAG_ARGPTR )
         {
            /* Arg has a ptr to a variable that has the arg */
            dwVal = ( DWORD ) pArg; /* Get first four bytes */
            pArg -= 4;              /* Next part of argument */
         }
         else
         {
            /* Arg has the real arg */
            dwVal = *( (DWORD *)( (BYTE *) ( &( Parm[nInd].numargs.dwArg ) ) + ( nLoops * 4 ) ) );
         }

         /* Do push dwVal */
         pStack--;          /* ESP = ESP - 4 */
         *pStack = dwVal;   /* SS:[ESP] = dwVal */
         nSize -= 4;
         nLoops--;
      }
   }

   if( ( pRet != NULL ) && ( ( iFlags & DC_BORLAND ) || ( nRetSiz > 8 ) ) )
   {
      /* Return value isn't passed through registers, memory copy
         is performed instead. Pass the pointer as hidden arg. */
      dwStSize += 4;             /* Add stack size */
      pStack--;                  /* ESP = ESP - 4 */
      *pStack = ( DWORD ) pRet;  /* SS:[ESP] = pMem */
   }
   #if defined( __MINGW32__ )
      asm volatile( "\taddl $0x100, %%esp\n" /* Restore to original position */
                    "\tsubl %2, %%esp\n"     /* Adjust for our new parameters */

                    /* Stack is now properly built, we can call the function */
                    "\tcall *%3\n"
                    : "=a" (dwEAX), "=d" (dwEDX) /* Save eax/edx registers */
                    : "r" (dwStSize), "r" (lpFunction) );

      /* Possibly adjust stack and read return values. */
      if( iFlags & DC_CALL_CDECL )
      {
         asm volatile( "\taddl %0, %%esp\n" : : "r" (dwStSize) );
      }

      if( iFlags & DC_RETVAL_MATH4 )
      {
         asm volatile( "\tfstps (%0)\n" : "=r" (Res) );
      }
      else if( iFlags & DC_RETVAL_MATH8 )
      {
         asm volatile( "\tfstpl (%0)\n" : "=r" (Res) );
      }
      else if( pRet == NULL )
      {
         Res.Int = dwEAX;
         (&Res.Int)[1] = dwEDX;
      }
      else if( ( ( iFlags & DC_BORLAND ) == 0 ) && ( nRetSiz <= 8 ) )
      {
         /* Microsoft optimized less than 8-bytes structure passing */
         ((int *)pRet)[0] = dwEAX;
         ((int *)pRet)[1] = dwEDX;
      }
   #elif defined( __BORLANDC__ ) || defined(__DMC__)
      _ESP += (0x100 - dwStSize);
      _EDX =  ( DWORD ) &lpFunction;
      __emit__(0xff,0x12); /* call [edx]; */
      dwEAX = _EAX;
      dwEDX = _EDX;

      /* Possibly adjust stack and read return values. */
      if( iFlags & DC_CALL_CDECL )
      {
         _ESP += dwStSize;
      }

      if( iFlags & DC_RETVAL_MATH4 )
      {
         _EBX = ( DWORD ) &Res;
         _EAX = dwEAX;
         _EDX = dwEDX;
         __emit__(0xd9,0x1b);   /*     _asm fnstp float ptr [ebx] */
      }
      else if( iFlags & DC_RETVAL_MATH8 )
      {
         _EBX = ( DWORD ) &Res;
         _EAX = dwEAX;
         _EDX = dwEDX;
         __emit__(0xdd,0x1b);   /*     _asm fnstp qword ptr [ebx] */
      }
      else if( pRet == NULL )
      {
         _EBX = ( DWORD ) &Res;
         _EAX = dwEAX;
         _EDX = dwEDX;
/*       _asm mov DWORD PTR [ebx], eax */
/*       _asm mov DWORD PTR [ebx + 4], edx */
         __emit__(0x89,0x03,0x89,0x53,0x04);
      }
      else if( ( ( iFlags & DC_BORLAND ) == 0 ) && ( nRetSiz <= 8 ) )
      {
         _EBX = ( DWORD ) pRet;
         _EAX = dwEAX;
         _EDX = dwEDX;
/*       _asm mov DWORD PTR [ebx], eax */
/*       _asm mov DWORD PTR [ebx + 4], edx */
         __emit__(0x89,0x03,0x89,0x53,0x04);
      }
   #else
      _asm add esp, 0x100       /* Restore to original position */
      _asm sub esp, dwStSize    /* Adjust for our new parameters */

      /* Stack is now properly built, we can call the function */
      _asm call [lpFunction]

      _asm mov dwEAX, eax       /* Save eax/edx registers */
      _asm mov dwEDX, edx       /* */

      /* Possibly adjust stack and read return values. */
      if( iFlags & DC_CALL_CDECL )
      {
         _asm add esp, dwStSize
      }

      if( iFlags & DC_RETVAL_MATH4 )
      {
         _asm fstp dword ptr [Res]
      }
      else if( iFlags & DC_RETVAL_MATH8 )
      {
         _asm fstp qword ptr [Res]
      }
      else if( pRet == NULL )
      {
         _asm mov eax, [dwEAX]
         _asm mov DWORD PTR [Res], eax
         _asm mov edx, [dwEDX]
         _asm mov DWORD PTR [Res + 4], edx
      }
      else if( ( ( iFlags & DC_BORLAND ) == 0 ) && ( nRetSiz <= 8 ) )
      {
         /* Microsoft optimized less than 8-bytes structure passing */
         _asm mov ecx, DWORD PTR [pRet]
         _asm mov eax, [dwEAX]
         _asm mov DWORD PTR [ecx], eax
         _asm mov edx, [dwEDX]
         _asm mov DWORD PTR [ecx + 4], edx
      }

      _asm mov esp, pESP
   #endif
#endif

   return Res;
}

/*
 * ==================================================================
 */

typedef struct _XPP_DLLEXEC
{
   DWORD    dwType;     /* type info */
   char *   cDLL;       /* DLL */
   HMODULE  hDLL;       /* Handle */
   char *   cProc;      /* function name */
   WORD     wOrdinal;   /* function ordinal */
   DWORD    dwFlags;    /* Calling Flags */
   LPVOID   lpFunc;
} XPP_DLLEXEC, * PXPP_DLLEXEC;

static void DllExec( int iFlags, int iRtype, LPVOID lpFunction, PXPP_DLLEXEC xec, int iParams, int iFirst )
{
   DYNAPARM Parm[ _DLLEXEC_MAXPARAM ];
   RESULT rc;
   int i, iCnt, iArgCnt;

   if( xec )
   {
      iFlags     = xec->dwFlags;
      lpFunction = xec->lpFunc;

      /* TODO: Params maybe explictly specified in xec! */
   }

   if( ! lpFunction )
      return;

   iArgCnt = iParams - iFirst + 1;

   iFlags &= 0x00ff;  /* Calling Convention */

   if( iRtype == 0 )
      iRtype = CTYPE_UNSIGNED_LONG;

   memset( Parm, 0, sizeof( Parm ) );

   if( iArgCnt > 0 )
   {
      for( i = iFirst, iCnt = 0; i <= iParams && iCnt < _DLLEXEC_MAXPARAM; i++, iCnt++ )
      {
         PHB_ITEM pParam = hb_param( i, HB_IT_ANY );

         switch( HB_ITEM_TYPE( pParam ) )
         {
            case HB_IT_NIL:
               Parm[ iCnt ].nWidth = sizeof( void * );
               /* TOFIX: Store NULL pointer in pointer variable. */
               Parm[ iCnt ].numargs.dwArg = 0;
               break;

            case HB_IT_POINTER:
               Parm[ iCnt ].nWidth = sizeof( void * );
               /* TOFIX: Store pointer in pointer variable. */
               Parm[ iCnt ].numargs.dwArg = ( DWORD ) hb_itemGetPtr( pParam );

               if( hb_parinfo( i ) & HB_IT_BYREF )
               {
                  Parm[ iCnt ].pArg = &( Parm[ iCnt ].numargs.dwArg );
                  Parm[ iCnt ].dwFlags = DC_FLAG_ARGPTR;  /* use the pointer */
               }
               break;

            case HB_IT_INTEGER:
            case HB_IT_LONG:
            case HB_IT_DATE:
            case HB_IT_LOGICAL:
               Parm[ iCnt ].nWidth = sizeof( DWORD );
               Parm[ iCnt ].numargs.dwArg = ( DWORD ) hb_itemGetNL( pParam );

               if( hb_parinfo( i ) & HB_IT_BYREF )
               {
                  Parm[ iCnt ].pArg = &( Parm[ iCnt ].numargs.dwArg );
                  Parm[ iCnt ].dwFlags = DC_FLAG_ARGPTR;  /* use the pointer */
               }
               break;

            case HB_IT_DOUBLE:
               Parm[ iCnt ].nWidth = sizeof( double );
               Parm[ iCnt ].numargs.dArg = hb_itemGetND( pParam );

               if( hb_parinfo( i ) & HB_IT_BYREF )
               {
                  Parm[ iCnt ].nWidth = sizeof( void * );
                  Parm[ iCnt ].pArg = &( Parm[ iCnt ].numargs.dArg );
                  Parm[ iCnt ].dwFlags = DC_FLAG_ARGPTR;  /* use the pointer */
               }

               iFlags |= DC_RETVAL_MATH8;
               break;

            case HB_IT_STRING:
            case HB_IT_MEMO:
               Parm[ iCnt ].nWidth = sizeof( void * );

               if( hb_parinfo( i ) & HB_IT_BYREF )
               {
                  Parm[ iCnt ].pArg = hb_xgrab( hb_itemGetCLen( pParam ) + 1 );
                  memcpy( Parm[ iCnt ].pArg, hb_itemGetCPtr( pParam ), hb_itemGetCLen( pParam ) + 1 );
               }
               else
               {
                  if( iFlags & DLL_CALLMODE_COPY )
                     pParam = hb_itemUnShareString( pParam );

                  Parm[ iCnt ].pArg = ( void * ) hb_itemGetCPtr( pParam );
               }

               Parm[ iCnt ].dwFlags = DC_FLAG_ARGPTR;  /* use the pointer */
               break;
#ifdef __XHARBOUR__
            case HB_IT_ARRAY:
               if( strncmp( hb_objGetClsName( hb_param( i, HB_IT_ANY ) ), "C Structure", 11 ) == 0 )
               {
                  Parm[ iCnt ].nWidth = sizeof( void * );
                  Parm[ iCnt ].numargs.dwArg = ( DWORD ) hb_parcstruct( i );
                  break;
               }
#endif
            case HB_IT_HASH:
            case HB_IT_SYMBOL:
            case HB_IT_ALIAS:
            case HB_IT_MEMOFLAG:
            case HB_IT_BLOCK:
            case HB_IT_MEMVAR:

            default:
               hb_errRT_BASE( EG_ARG, 2010, "Unknown parameter type to DLL function", HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
               return;
         }
      }
   }

   rc = DynaCall( iFlags, lpFunction, iArgCnt, Parm, NULL, 0 );

   if( iArgCnt > 0 )
   {
      for( i = iFirst, iCnt = 0; i <= iParams && iCnt < _DLLEXEC_MAXPARAM; i++, iCnt++ )
      {
         if( ISBYREF( i ) )
         {
            switch( HB_ITEM_TYPE( hb_param( i, HB_IT_ANY ) ) )
            {
               case HB_IT_NIL:
                  hb_stornl( Parm[ iCnt ].numargs.dwArg, i );
                  break;

               case HB_IT_POINTER:
                  hb_storptr( ( void * ) Parm[ iCnt ].numargs.dwArg, i );
                  break;

               case HB_IT_INTEGER:
               case HB_IT_LONG:
               case HB_IT_DATE:
               case HB_IT_LOGICAL:
                  hb_stornl( Parm[ iCnt ].numargs.dwArg, i );
                  break;

               case HB_IT_DOUBLE:
                  hb_stornd( Parm[ iCnt ].numargs.dArg, i );
                  break;

               case HB_IT_STRING:
               case HB_IT_MEMO:
                  if( ! hb_storclen_buffer( ( char * ) Parm[ iCnt ].pArg, hb_parclen( i ), i ) )
                     hb_xfree( Parm[ iCnt ].pArg );
                  break;
#ifdef __XHARBOUR__
               case HB_IT_ARRAY:
                  if( strncmp( hb_objGetClsName( hb_param( i, HB_IT_ANY ) ), "C Structure", 11 ) == 0 )
                  {
                     hb_vmPushDynSym( s_pDEVALUE );
                     hb_vmPush( hb_param( i, HB_IT_ANY ) );
                     hb_vmSend( 0 );

                     break;
                  }
#endif
               default:
                  hb_errRT_BASE( EG_ARG, 2010, "Unknown reference parameter type to DLL function", HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
                  return;
            }
         }
      }
   }

   /* return the correct value */
   switch( iRtype )
   {
      case CTYPE_BOOL:
         hb_retl( rc.Long != 0 );
         break;

      case CTYPE_VOID:
         hb_retni( 0 );
         break;

      case CTYPE_CHAR:
      case CTYPE_UNSIGNED_CHAR:
         hb_retni( ( char ) rc.Int );
         break;

      case CTYPE_SHORT:
      case CTYPE_UNSIGNED_SHORT:
         hb_retni( ( int ) rc.Int );
         break;

      case CTYPE_INT:
         hb_retni( ( int ) rc.Long );
         break;

      case CTYPE_LONG:
         hb_retnl( ( long ) rc.Long );
         break;

      case CTYPE_CHAR_PTR:
      case CTYPE_UNSIGNED_CHAR_PTR:
         hb_retc( ( char * ) rc.Long );
         break;

      case CTYPE_UNSIGNED_INT:
      case CTYPE_UNSIGNED_LONG:
         hb_retnint( ( ULONG ) rc.Long );
         break;

      case CTYPE_INT_PTR:
      case CTYPE_UNSIGNED_SHORT_PTR:
      case CTYPE_UNSIGNED_INT_PTR:
      case CTYPE_STRUCTURE_PTR:
      case CTYPE_LONG_PTR:
      case CTYPE_UNSIGNED_LONG_PTR:
      case CTYPE_VOID_PTR:
      case CTYPE_FLOAT_PTR:
      case CTYPE_DOUBLE_PTR:
         hb_retptr( ( void * ) rc.Long );
         break;

      case CTYPE_FLOAT:
         hb_retnd( rc.Float );
         break;

      case CTYPE_DOUBLE:
         hb_retnd( rc.Double );
         break;

      default:
         hb_errRT_BASE( EG_ARG, 2010, "Unknown return type from DLL function", HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
         break;
   }
}

static HB_GARBAGE_FUNC( _DLLUnload )
{
   PXPP_DLLEXEC xec = ( PXPP_DLLEXEC ) Cargo;

   if( xec->dwType == _DLLEXEC_SIGNATURE )
   {
      if( xec->cDLL )
      {
         if( xec->hDLL )
            FreeLibrary( xec->hDLL );

         hb_xfree( xec->cDLL );
      }

      if( xec->cProc )
         hb_xfree( xec->cProc );

      xec->dwType = 0;
   }
}

HB_FUNC( DLLPREPARECALL )
{
#if !defined(HB_WINCE)
   PXPP_DLLEXEC xec = ( PXPP_DLLEXEC ) hb_gcAlloc( sizeof( XPP_DLLEXEC ), _DLLUnload );
   char * pszErrorText;

   memset( xec, 0, sizeof( XPP_DLLEXEC ) );

   if( ISCHAR( 1 ) )
   {
      xec->cDLL = hb_strdup( hb_parc( 1 ) );
      xec->hDLL = LoadLibraryA( xec->cDLL );
   }
   else if( ISNUM( 1 ) )
      xec->hDLL = ( HMODULE ) ( HB_PTRDIFF ) hb_parnint( 1 );

   if( xec->hDLL )
   {
      if( ISCHAR( 3 ) )
      {
         xec->cProc = ( char * ) hb_xgrab( hb_parclen( 3 ) + 2 ); /* Reserving space for possible ANSI "A" suffix. */
         hb_strncpy( xec->cProc, hb_parc( 3 ), hb_parclen( 3 ) );
      }
      else if( ISNUM( 3 ) )
         xec->wOrdinal = ( WORD ) hb_parni( 3 );

      xec->lpFunc = ( LPVOID ) GetProcAddress( xec->hDLL, xec->cProc ? ( LPCSTR ) xec->cProc : ( LPCSTR ) ( HB_PTRDIFF ) xec->wOrdinal );
      
      if( ! xec->lpFunc && xec->cProc ) /* try with ANSI suffix? */
         xec->lpFunc = ( LPVOID ) GetProcAddress( xec->hDLL, ( LPCSTR ) hb_strncat( xec->cProc, "A", hb_parclen( 3 ) + 1 ) );
      
      if( xec->lpFunc )
      {
         xec->dwType = _DLLEXEC_SIGNATURE;
         xec->dwFlags = ISNUM( 2 ) ? hb_parnl( 2 ) : DC_CALL_STD;
         hb_retptrGC( xec );
         return;
      }

      if( ISCHAR( 1 ) )
         FreeLibrary( xec->hDLL );

      pszErrorText = ISCHAR( 3 ) ? ( char * ) "Invalid function name" : ( char * ) "Invalid function ordinal";
   }
   else
      pszErrorText = ISCHAR( 1 ) ? ( char * ) "Invalid library name" : ( char * ) "Invalid library handle";

   hb_gcFree( xec );

   hb_errRT_BASE( EG_ARG, 2010, pszErrorText, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
#endif
}

HB_FUNC( DLLLOAD )
{
   hb_retnint( ( HB_PTRDIFF ) LoadLibraryA( ( LPCSTR ) hb_parcx( 1 ) ) ) ;
}

HB_FUNC( DLLUNLOAD )
{
   hb_retl( FreeLibrary( ( HMODULE ) ( HB_PTRDIFF ) hb_parnint( 1 ) ) ) ;
}

HB_FUNC( DLLEXECUTECALL )
{
   PXPP_DLLEXEC xec = ( PXPP_DLLEXEC ) hb_parptr( 1 );

   if( xec && xec->dwType == _DLLEXEC_SIGNATURE && xec->hDLL && xec->lpFunc )
      DllExec( 0, 0, NULL, xec, hb_pcount(), 2 );
}

static LPVOID hb_getprocaddress( HMODULE hDLL, int i )
{
#if defined(HB_WINCE)
   HB_SYMBOL_UNUSED( hDLL );
   HB_SYMBOL_UNUSED( i );
   return NULL;
#else
   LPVOID lpFunction = ( LPVOID ) GetProcAddress( hDLL, ISCHAR( i ) ? ( LPCSTR ) hb_parc( i ) : ( LPCSTR ) hb_parni( i ) );

   if( ! lpFunction && ISCHAR( i ) ) /* try with ANSI suffix? */
   {
      char * pszFuncName = ( char * ) hb_xgrab( hb_parclen( i ) + 2 );
      hb_strncpy( pszFuncName, hb_parc( i ), hb_parclen( i ) );
      lpFunction = ( LPVOID ) GetProcAddress( hDLL, hb_strncat( pszFuncName, "A", hb_parclen( i ) + 1 ) );
      hb_xfree( pszFuncName );
   }

   return lpFunction;
#endif
}

HB_FUNC( DLLCALL )
{
   HMODULE hDLL = ISCHAR( 1 ) ? LoadLibraryA( hb_parc( 1 ) ) : ( HMODULE ) ( HB_PTRDIFF ) hb_parnint( 1 );

   if( hDLL && ( HB_PTRDIFF ) hDLL >= 32 )
   {
      DllExec( hb_parni( 2 ), 0, hb_getprocaddress( ( HMODULE ) hDLL, 3 ), NULL, hb_pcount(), 4 );
      
      if( ISCHAR( 1 ) )
         FreeLibrary( hDLL );
   }
}

HB_FUNC( LOADLIBRARY )
{
   HB_FUNC_EXEC( DLLLOAD );
}

HB_FUNC( FREELIBRARY )
{
   HB_FUNC_EXEC( DLLUNLOAD );
}

HB_FUNC( GETLASTERROR )
{
   hb_retnl( GetLastError() );
}

HB_FUNC( SETLASTERROR )
{
   hb_retnl( GetLastError() );
   SetLastError( hb_parnl( 1 ) );
}

HB_FUNC( GETPROCADDRESS )
{
   hb_retptr( ( void * ) hb_getprocaddress( ( HMODULE ) ( HB_PTRDIFF ) hb_parnint( 1 ), 2 ) );
}

HB_FUNC( CALLDLL )
{
   DllExec( DC_CALL_STD, 0, ( LPVOID ) hb_parptr( 1 ), NULL, hb_pcount(), 2 );
}

HB_FUNC( CALLDLLBOOL )
{
   DllExec( DC_CALL_STD, CTYPE_BOOL, ( LPVOID ) hb_parptr( 1 ), NULL, hb_pcount(), 2 );
}

HB_FUNC( CALLDLLTYPED )
{
   DllExec( DC_CALL_STD, hb_parni( 2 ), ( LPVOID ) hb_parptr( 1 ), NULL, hb_pcount(), 3 );
}

static void hb_itemPushForward( PHB_ITEM pItem )
{
   hb_itemMove( hb_stackAllocItem(), pItem );
}

static void hb_vmRequestReset( void )
{
   hb_stackSetActionRequest( 0 ); /* TOFIX */
}

/* ----------------------------------------------------------------------- */
static EXCEPINFO s_excep;

static DISPID s_lPropPut = DISPID_PROPERTYPUT;
static UINT s_uArgErr;

HRESULT hb_oleVariantToItem( PHB_ITEM pItem, VARIANT *pVariant );
static PHB_ITEM SafeArrayToArray( SAFEARRAY * parray, UINT iDim, long * rgIndices, VARTYPE vt );

HB_EXPORT BSTR hb_oleAnsiToSysString( const char * cString )
{
   int nConvertedLen = MultiByteToWideChar( CP_ACP, MB_PRECOMPOSED, cString, -1, NULL, 0 );

   if( nConvertedLen )
   {
      BSTR bstrString = SysAllocStringLen( NULL, nConvertedLen - 1 );

      if( MultiByteToWideChar( CP_ACP, 0, cString, -1, bstrString, nConvertedLen ) )
         return bstrString;
      else
         SysFreeString( bstrString );
   }

   return NULL;
}

HB_EXPORT LPWSTR hb_oleAnsiToWide( LPSTR cString )
{
   int nConvertedLen = MultiByteToWideChar( CP_ACP, MB_PRECOMPOSED, cString, -1, NULL, 0 );

   if( nConvertedLen )
   {
      LPWSTR wString = ( LPWSTR ) hb_xgrab( nConvertedLen * 2 + 1 );

      if( MultiByteToWideChar( CP_ACP, MB_PRECOMPOSED, cString, -1, wString, nConvertedLen ) )
         return wString;
      else
         hb_xfree( wString );
   }

   return NULL;
}

static HB_GARBAGE_FUNC( hb_oleRelease )
{
   HB_SYMBOL_UNUSED( Cargo );

   if( s_bInit )
   {
      OleUninitialize();
      s_bInit = FALSE;
      if( s_pOleAuto )
      {
         hb_itemRelease( s_pOleAuto );
         s_pOleAuto = NULL;
      }
   }
}

HB_FUNC( __HB_OLE_INIT )
{
   if( s_pSym_TOleAuto == NULL )
   {
      s_pSym_TOleAuto       = hb_dynsymFind( "TOLEAUTO" );
      s_pSym_New            = hb_dynsymFind( "NEW" );
      s_pSym_hObj           = hb_dynsymFind( "HOBJ" );
      s_pSym_cClassName     = hb_dynsymFind( "CCLASSNAME" );

      s_pSym_VTWrapper      = hb_dynsymFind( "VTWRAPPER" );
      s_pSym_VTArrayWrapper = hb_dynsymFind( "VTARRAYWRAPPER" );
      s_pSym_vt             = hb_dynsymGetCase( "VT" );
      s_pSym_Value          = hb_dynsymFind( "VALUE" );

      s_EmptyDispParams.rgvarg            = NULL;
      s_EmptyDispParams.cArgs             = 0;
      s_EmptyDispParams.rgdispidNamedArgs = 0;
      s_EmptyDispParams.cNamedArgs        = 0;

      if( ! s_bInit )
      {
         OleInitialize( NULL );
         hb_retptrGC( hb_gcAlloc( 1, hb_oleRelease ) );
         s_bInit = TRUE;
      }

      VariantInit( &s_RetVal );
      VariantInit( &s_OleVal );
   }
}

HB_FUNC( ANSITOWIDE )  /* ( cAnsiStr ) -> cWideStr */
{
   char *cString = hb_parc( 1 );

   if( cString )
   {
      BSTR wString = hb_oleAnsiToWide( cString );

      if( wString )
         hb_retclen_buffer( ( char * ) wString, SysStringLen( wString ) );
   }
}

HB_EXPORT LPSTR hb_oleWideToAnsi( BSTR wString )
{
   int nConvertedLen = WideCharToMultiByte( CP_ACP, 0, wString, -1, NULL, 0, NULL, NULL );

   if( nConvertedLen )
   {
      char * cString = ( char * ) hb_xgrab( nConvertedLen + 1 );

      if( WideCharToMultiByte( CP_ACP, 0, wString, -1, cString, nConvertedLen + 1, NULL, NULL ) )
         return cString;
      else
         hb_xfree( cString );
   }

#if 0
   wprintf( L"\nWide: '%s'\n", wString );
   printf( "\nAnsi: '%s'\n", cString );
#endif

   return NULL;
}

HB_FUNC( WIDETOANSI )  /* ( cWideStr, nLen ) -> cAnsiStr */
{
   BSTR wString = ( BSTR ) hb_parc( 1 );

   if( wString )
   {
      char *cString = hb_oleWideToAnsi( wString );

      if( cString )
         hb_retclen_buffer( cString, strlen( cString ) );
   }
}

HB_EXPORT void hb_oleItemToVariant( VARIANT *pVariant, PHB_ITEM pItem )
{
   BOOL bByRef;
   VARIANT mVariant;
   VARTYPE vt;
   SAFEARRAYBOUND rgsabound;
   void *pSource;/* = NULL;*/
   unsigned long i;
   char *sString;

   if( HB_IS_BYREF( pItem ) )
   {
      pItem = hb_itemUnRef( pItem );
      bByRef = TRUE;
   }
   else
      bByRef = FALSE;

   VariantClear( pVariant );

   switch( hb_itemType( pItem ) )
   {
      case HB_IT_NIL:
        /*pVariant->n1.n2.vt = VT_EMPTY;*/
        break;

      case HB_IT_STRING:
      case HB_IT_MEMO:
      {
        ULONG ulLen = hb_itemGetCLen( pItem );

        sString = hb_itemGetCPtr( pItem );

        /* Check for hidden signature of SafeArrayToArray(). */
        if( ( int ) ( pItem->item.asString.allocated - ulLen ) >= 5 && /* TOFIX */
            sString[ ulLen ] == 0x7A && sString[ ulLen + 1 ] == 0x7B && sString[ ulLen + 2 ] == 0x7C && sString[ ulLen + 3 ] == 0x7D )
        {
           vt = (VARTYPE) sString[ ulLen + 4 ];
           goto ItemToVariant_StringArray;
        }

        if( bByRef )
        {
           hb_itemPutCLConst( pItem, ( char * ) hb_oleAnsiToSysString( sString ), ulLen * 2 + 1 );

           pVariant->n1.n2.vt   = VT_BYREF | VT_BSTR;
           pVariant->n1.n2.n3.pbstrVal = ( BSTR * ) &( pItem->item.asString.value ); /* TOFIX */
           /*wprintf( L"*** BYREF >%s<\n", *pVariant->n1.n2.n3.bstrVal );*/
        }
        else
        {
           pVariant->n1.n2.vt   = VT_BSTR;
           pVariant->n1.n2.n3.bstrVal = hb_oleAnsiToSysString( sString );
           /*wprintf( L"*** >%s<\n", pVariant->n1.n2.n3.bstrVal );*/
        }
        break;
      }

      case HB_IT_LOGICAL:
        if( bByRef )
        {
           pVariant->n1.n2.vt = VT_BYREF | VT_BOOL;
           pVariant->n1.n2.n3.pboolVal = ( short * ) &( pItem->item.asLogical.value ) ; /* TOFIX */
           *pVariant->n1.n2.n3.pboolVal = hb_itemGetL( pItem ) ? VARIANT_TRUE : VARIANT_FALSE;
           /*pItem->type = HB_IT_LONG;*/
        }
        else
        {
           pVariant->n1.n2.vt = VT_BOOL;
           pVariant->n1.n2.n3.boolVal = hb_itemGetL( pItem ) ? VARIANT_TRUE : VARIANT_FALSE;
        }
        break;

      case HB_IT_INTEGER:
#if HB_INT_MAX == INT16_MAX
         if( bByRef )
         {
            pVariant->n1.n2.vt = VT_BYREF | VT_I2;
            pVariant->n1.n2.n3.piVal = &( pItem->item.asInteger.value ) ; /* TOFIX */
         }
         else
         {
            pVariant->n1.n2.vt = VT_I2;
            pVariant->n1.n2.n3.iVal = hb_itemGetNI( pItem );
         }
         break;
#else
         if( bByRef )
         {
            pVariant->n1.n2.vt = VT_BYREF | VT_I4;
            pVariant->n1.n2.n3.plVal = ( long * ) &( pItem->item.asInteger.value ) ; /* TOFIX */
         }
         else
         {
            pVariant->n1.n2.vt = VT_I4;
            pVariant->n1.n2.n3.lVal = hb_itemGetNL( pItem );
         }
         break;
#endif
      case HB_IT_LONG:
#if HB_LONG_MAX == INT32_MAX || defined( HB_LONG_LONG_OFF )
         if( bByRef )
         {
            pVariant->n1.n2.vt = VT_BYREF | VT_I4;
            pVariant->n1.n2.n3.plVal = ( long * ) &( pItem->item.asLong.value ) ; /* TOFIX */
         }
         else
         {
            pVariant->n1.n2.vt = VT_I4;
            pVariant->n1.n2.n3.lVal = hb_itemGetNL( pItem );
         }
#else
         if( bByRef )
         {
            pVariant->n1.n2.vt = VT_BYREF | VT_I8;
            pVariant->n1.n2.n3.pllVal = &( pItem->item.asLong.value ) ; /* TOFIX */
         }
         else
         {
            pVariant->n1.n2.vt = VT_I8;
            pVariant->n1.n2.n3.llVal = hb_itemGetNLL( pItem );
         }
#endif
         break;

      case HB_IT_DOUBLE:
         if( bByRef )
         {
            pVariant->n1.n2.vt = VT_BYREF | VT_R8;
            pVariant->n1.n2.n3.pdblVal = &( pItem->item.asDouble.value ) ; /* TOFIX */
            pItem->type = HB_IT_DOUBLE;
         }
         else
         {
            pVariant->n1.n2.vt   = VT_R8;
            pVariant->n1.n2.n3.dblVal = hb_itemGetND( pItem );
         }
         break;

      case HB_IT_DATE:
         {
            long lDate = hb_itemGetDL( pItem );
            
            if( lDate == 0 )
               pVariant->n1.n2.vt = VT_NULL;
            else if( bByRef )
            {
               hb_itemPutND( pItem, (double) ( lDate - 2415019 ) );
            
               pVariant->n1.n2.vt = VT_BYREF | VT_DATE;
               pVariant->n1.n2.n3.pdblVal = &( pItem->item.asDouble.value );
            }
            else
            {
               pVariant->n1.n2.vt = VT_DATE;
               pVariant->n1.n2.n3.dblVal = (double) ( lDate - 2415019 );
            }
         }
         break;

      case HB_IT_POINTER:
         pVariant->n1.n2.vt = VT_PTR;
         pVariant->n1.n2.n3.byref = hb_itemGetPtr( pItem );
         break;

      case HB_IT_ARRAY:
      {
         if( HB_IS_OBJECT( pItem ) )
         {
            if( hb_clsIsParent( hb_objGetClass( pItem ), "TOLEAUTO" ) )
            {
               IDispatch *pDisp;/* = NULL;*/

               hb_vmPushDynSym( s_pSym_hObj );
               hb_vmPush( pItem );
               hb_vmSend( 0 );

               pDisp = ( IDispatch * ) hb_parnl( -1 );
               pDisp->lpVtbl->AddRef( pDisp );

               /*HB_TRACE(HB_TR_INFO, ("Dispatch: in: %s(%i)%ld\n", pDisp, __FILE__, __LINE__));*/

               if( bByRef )
               {
                  pVariant->n1.n2.vt = ( VT_DISPATCH | VT_BYREF );
                  /* Hack!!! Using high 4 bytes of the union (llVal) */
                  *( ( IDispatch ** ) ( &pVariant->n1.n2.n3.lVal ) + 1 ) = pDisp;
                  pVariant->n1.n2.n3.ppdispVal = ( IDispatch ** ) ( &pVariant->n1.n2.n3.lVal ) + 1;
               }
               else
               {
                  pVariant->n1.n2.vt = VT_DISPATCH;
                  pVariant->n1.n2.n3.pdispVal = pDisp;
               }
            }
            /* MUST be before "VTWRAPPER" */
            else if( hb_clsIsParent( hb_objGetClass( pItem ), "VTARRAYWRAPPER" ) )
            {
               /* vt := oVTArray:vt */
               hb_vmPushDynSym( s_pSym_vt );
               hb_vmPush( pItem );
               hb_vmSend( 0 );

               vt = (VARTYPE) hb_parnl(-1);

               /* aArray := oVTArray:Value */
               hb_vmPushDynSym( s_pSym_Value );
               hb_vmPush( pItem );
               hb_vmSend( 0 );

               /* Intentionally not using hb_itemCopy() or hb_itemForwardValue() */
               pItem = hb_stackReturnItem();

               if( ( vt == VT_I1 || vt == VT_UI1 ) && HB_IS_STRING( pItem ) )
               {
                  SAFEARRAY *parray;

                  sString = hb_itemGetCPtr( pItem );

ItemToVariant_StringArray:

                  rgsabound.cElements = hb_itemGetCLen( pItem );
                  rgsabound.lLbound = 0;

                  parray = SafeArrayCreate( vt, 1, &rgsabound );

                  if( bByRef )
                  {
                     pVariant->n1.n2.vt = ( VT_ARRAY | VT_BYREF | vt );
                     /* Hack!!! Using high 4 bytes of the union (llVal) */
                     *( ( SAFEARRAY ** ) ( &pVariant->n1.n2.n3.lVal ) + 1 ) = parray;
                     pVariant->n1.n2.n3.pparray = ( SAFEARRAY ** ) ( &pVariant->n1.n2.n3.lVal ) + 1;
                  }
                  else
                  {
                     pVariant->n1.n2.vt = ( VT_ARRAY | vt );
                     pVariant->n1.n2.n3.parray = parray;
                  }

                  for( i = 0; i < rgsabound.cElements; i++ )
                     SafeArrayPutElement( parray, ( LONG * ) &i, &( sString[ i ] ) );

                  break;
               }

               VariantInit( &mVariant );
               pSource = &mVariant.n1.n2.n3.cVal;

               goto ItemToVariant_ProcessArray;
            }
            else if( hb_clsIsParent( hb_objGetClass( pItem ), "VTWRAPPER" ) )
            {
               /* vt := oVT:vt */
               hb_vmPushDynSym( s_pSym_vt );
               hb_vmPush( pItem );
               hb_vmSend( 0 );

               pVariant->n1.n2.vt = (VARTYPE) hb_parnl(-1);

               /* value := oVT:value */
               hb_vmPushDynSym( s_pSym_Value );
               hb_vmPush( pItem );
               hb_vmSend( 0 );

               switch( pVariant->n1.n2.vt )
               {
                  case VT_UNKNOWN:
                     pVariant->n1.n2.n3.punkVal = ( IUnknown * ) hb_parptr( -1 );
                     break;

                  case ( VT_UNKNOWN | VT_BYREF ):
                     /* Hack!!! Using high 4 bytes of the union (llVal) */
                     *( ( IUnknown ** ) ( &pVariant->n1.n2.n3.lVal ) + 1 ) = ( IUnknown * ) hb_parptr( -1 );
                     pVariant->n1.n2.n3.ppunkVal = ( IUnknown ** ) ( &pVariant->n1.n2.n3.lVal ) + 1;
                     break;

                  default:
                     HB_TRACE(HB_TR_INFO, ("Unexpected VT type %p in: %s(%i)!\n", pVariant->n1.n2.vt, __FILE__, __LINE__));
               }

               break;
            }
            else
            {
               HB_TRACE(HB_TR_INFO, ("Class: '%s' not suported!\n", hb_objGetClsName( pItem )));
            }
         }
         else
         {
            unsigned long i;
            SAFEARRAY *parray;

            vt = VT_VARIANT;
            VariantInit( &mVariant );
            pSource = &mVariant;

ItemToVariant_ProcessArray:

            rgsabound.cElements = hb_arrayLen( pItem );
            rgsabound.lLbound = 0;

            /*HB_TRACE(HB_TR_INFO, ("ItemToVariant() Array len: %i type: %i ByRef: %i in: %s(%i) \n", rgsabound.cElements, vt, bByRef, __FILE__, __LINE__));*/

            parray = SafeArrayCreate( vt, 1, &rgsabound );

            if( bByRef )
            {
               pVariant->n1.n2.vt = ( VT_ARRAY | VT_BYREF | vt );
               /* Hack!!! Using high 4 bytes of the union (llVal) */
               *( ( SAFEARRAY ** ) ( &pVariant->n1.n2.n3.lVal ) + 1 ) = parray;
               pVariant->n1.n2.n3.pparray = ( SAFEARRAY ** ) ( &pVariant->n1.n2.n3.lVal ) + 1;
            }
            else
            {
               pVariant->n1.n2.vt = ( VT_ARRAY | vt );
               pVariant->n1.n2.n3.parray = parray;
            }

            for( i = 0; i < rgsabound.cElements; i++ )
            {
               hb_oleItemToVariant( &mVariant, hb_arrayGetItemPtr( pItem, i + 1 ) );
               SafeArrayPutElement( parray, ( LONG * ) &i, pSource );
               VariantClear( &mVariant );
            }
         }
      }
      break;

      default:
      {
         /*HB_TRACE(HB_TR_INFO, ("Unexpected type %p in: %s(%i)!\n", hb_itemType( pItem ), __FILE__, __LINE__));*/
      }
   }
}

static PHB_ITEM * GetParams( DISPPARAMS *pDispParams, int nOffset )
{
   VARIANTARG * pArgs = NULL;
   int n, nArgs, nArg;
   /*BOOL bByRef;*/
   PHB_ITEM *aPrgParams = NULL;

   nArgs = hb_pcount() - nOffset;

   if( nArgs > 0 )
   {
      pArgs = ( VARIANTARG * ) hb_xgrab( sizeof( VARIANTARG ) * nArgs );
      aPrgParams = ( PHB_ITEM * ) hb_xgrab( sizeof( PHB_ITEM ) * nArgs );

      /*printf( "Args: %i\n", nArgs );*/

      for( n = 0; n < nArgs; n++ )
      {
         /* Parameters are processed in reversed order. */
         nArg = nArgs - n;
         VariantInit( &( pArgs[ n ] ) );

         aPrgParams[ n ] = hb_stackItemFromBase( nArg + nOffset );

         /*HB_TRACE(HB_TR_INFO, ("N: %i Arg: %i Type: %i %i ByRef: %i\n", n, nArg, hb_itemType( pParam ), hb_itemType( aPrgParams[ n ] ), bByRef));*/

         hb_oleItemToVariant( &( pArgs[ n ] ), aPrgParams[ n ] );
      }
   }

   pDispParams->rgvarg            = pArgs;
   pDispParams->cArgs             = nArgs;
   pDispParams->rgdispidNamedArgs = 0;
   pDispParams->cNamedArgs        = 0;

   return aPrgParams;
}

static void FreeParams( DISPPARAMS *pDispParams, PHB_ITEM *aPrgParams )
{
   if( pDispParams->cArgs > 0 )
   {
      IDispatch *pDisp = NULL;
      int n; /*, nParam;*/
      char *sString;
      VARIANT *pVariant;
      PHB_ITEM pItem;
      BOOL bByRef;

      for( n = 0; n < ( int ) pDispParams->cArgs; n++ )
      {
         pVariant = &( pDispParams->rgvarg[ n ] );
         pItem = aPrgParams[ n ];

         if( HB_IS_BYREF( pItem ) )
         {
            bByRef = TRUE;
            pItem = hb_itemUnRef( pItem );
         }
         else
            bByRef = FALSE;

         /*nParam = pDispParams->cArgs - n;*/

         /*HB_TRACE(HB_TR_INFO, ("*** N: %i, Param: %i Type: %i\n", n, nParam, pVariant->n1.n2.vt));*/

         if( bByRef )
         {
            switch( pVariant->n1.n2.vt )
            {
               case VT_BYREF | VT_BSTR:
                 SysFreeString( *pVariant->n1.n2.n3.pbstrVal );
                 sString = hb_oleWideToAnsi( *( pVariant->n1.n2.n3.pbstrVal ) );
                 hb_itemPutCPtr2( pItem, sString );
                 break;

               case VT_BSTR:
                 sString = hb_oleWideToAnsi( pVariant->n1.n2.n3.bstrVal );
                 hb_itemPutCPtr2( pItem, sString );
                 break;

               case VT_BYREF | VT_BOOL:
                 /*( pItem )->type = HB_IT_LOGICAL;*/
                 hb_itemPutL( pItem, *pVariant->n1.n2.n3.pboolVal == VARIANT_FALSE ? FALSE : TRUE );
                 break;

               case VT_BOOL:
                 hb_itemPutL( pItem, pVariant->n1.n2.n3.boolVal == VARIANT_FALSE ? FALSE : TRUE );
                 break;

               case ( VT_BYREF | VT_DISPATCH ):
                 if( *pVariant->n1.n2.n3.ppdispVal == NULL )
                 {
                    hb_itemClear( pItem );
                    break;
                 }
                 else
                 {
                    pDisp = *pVariant->n1.n2.n3.ppdispVal;
                 }
                 /* Intentionally fall through. */

               case VT_DISPATCH:
                 if( pVariant->n1.n2.vt == VT_DISPATCH )
                 {
                    if( pVariant->n1.n2.n3.pdispVal == NULL )
                    {
                       hb_itemClear( pItem );
                       break;
                    }
                    else
                       pDisp = pVariant->n1.n2.n3.pdispVal;
                 }

                 if( s_pOleAuto == NULL )
                    s_pOleAuto = hb_itemNew( NULL );
                 else
                    hb_itemClear( s_pOleAuto );

                 if( s_pSym_TOleAuto )
                 {
                    hb_vmPushDynSym( s_pSym_TOleAuto );
                    hb_vmPushNil();
                    hb_vmDo( 0 );

                    hb_itemForwardValue( s_pOleAuto, hb_stackReturnItem() );
                 }

                 if( s_pSym_New && hb_itemType( s_pOleAuto ) )
                 {
                    /* Implemented in :New() */
                    /*pDisp->lpVtbl->AddRef( pDisp );*/

                    /*TOleAuto():New( nDispatch )*/
                    hb_vmPushDynSym( s_pSym_New );
                    hb_itemPushForward( s_pOleAuto );
                    hb_vmPushLong( ( LONG ) pDisp );
                    hb_vmSend( 1 );

                    hb_itemForwardValue( pItem, hb_stackReturnItem() );
                 }
                 break;

               case VT_BYREF | VT_I2:
                 hb_itemPutNI( pItem, ( int ) *pVariant->n1.n2.n3.piVal );
                 break;

               case VT_I2:
                 hb_itemPutNI( pItem, ( int ) pVariant->n1.n2.n3.iVal );
                 break;

               case VT_BYREF | VT_I4:
                 hb_itemPutNL( pItem, ( LONG ) *pVariant->n1.n2.n3.plVal );
                 break;

               case VT_I4:
                 hb_itemPutNL( pItem, ( LONG ) pVariant->n1.n2.n3.lVal );
                 break;

  #ifndef HB_LONG_LONG_OFF
               case VT_BYREF | VT_I8:
                 hb_itemPutNLL( pItem, ( LONGLONG ) *pVariant->n1.n2.n3.pllVal );
                 break;
  #endif

  #ifndef HB_LONG_LONG_OFF
               case VT_I8:
                 hb_itemPutNLL( pItem, ( LONGLONG ) pVariant->n1.n2.n3.llVal );
                 break;
  #endif

               case VT_BYREF | VT_R8:
                 hb_itemPutND( pItem, *pVariant->n1.n2.n3.pdblVal );
                 break;

               case VT_R8:
                 hb_itemPutND( pItem, pVariant->n1.n2.n3.dblVal );
                 break;

               case VT_BYREF | VT_DATE:
                 hb_itemPutDL( pItem, ( long ) ( *( pVariant->n1.n2.n3.pdblVal ) ) + 2415019 );
                 break;

               case VT_DATE:
                 hb_itemPutDL( pItem, ( long ) ( pVariant->n1.n2.n3.dblVal ) + 2415019 );
                 break;

               case VT_BYREF | VT_EMPTY:
               case VT_EMPTY:
                 hb_itemClear( pItem );
                 break;

               case VT_BYREF | VT_VARIANT:
                 hb_oleItemToVariant( pVariant->n1.n2.n3.pvarVal, pItem );
                 break;

               default:
                 if( (VARTYPE) ( pVariant->n1.n2.vt & ( VT_BYREF | VT_ARRAY ) ) == (VARTYPE) ( VT_BYREF | VT_ARRAY ) )
                 {
                    VARTYPE vt;
                    PHB_ITEM pArray;
                    UINT iDims = SafeArrayGetDim( *pVariant->n1.n2.n3.pparray );
                    long * rgIndices = ( long * ) hb_xgrab( sizeof( long ) * iDims );

                    vt = pVariant->n1.n2.vt;
                    vt &= ~VT_ARRAY;
                    vt &= ~VT_BYREF;

                    pArray = SafeArrayToArray( *pVariant->n1.n2.n3.pparray, iDims, rgIndices, vt );

                    hb_xfree( ( void * ) rgIndices );

                    hb_itemForwardValue( pItem, pArray );
                    hb_itemRelease( pArray );
                 }
                 else
                 {
                    HB_TRACE(HB_TR_INFO, ("Unexpected type %p in: %s(%i)!\n", pVariant->n1.n2.vt, __FILE__, __LINE__));
                 }
            }
         }
         else
         {
            if( pVariant->n1.n2.vt & VT_BYREF )
            {
               HB_TRACE(HB_TR_INFO, ("Unexpected type %p in: %s(%i)!\n", pVariant->n1.n2.vt, __FILE__, __LINE__));
            }
         }

         VariantClear( &(pDispParams->rgvarg[ n ] ) );
      }

      hb_xfree( ( LPVOID ) pDispParams->rgvarg );
      hb_xfree( ( LPVOID ) aPrgParams );
   }
}

static PHB_ITEM SafeArrayToArray( SAFEARRAY * parray, UINT iDim, long * rgIndices, VARTYPE vt )
{
   long iFrom, iTo, iLen, i;
   PHB_ITEM pArray = hb_itemNew( NULL );

   if( parray == NULL )
   {
      hb_arrayNew( pArray, 0 );
      return pArray;
   }

   SafeArrayGetLBound( parray, iDim, &iFrom );
   SafeArrayGetUBound( parray, iDim, &iTo );

   iLen = iTo - iFrom + 1;

   if( iDim > 1 )
   {
      PHB_ITEM pSubArray;

      hb_arrayNew( pArray, iLen );

      for( i = iFrom; i <= iTo; i++ )
      {
         rgIndices[ iDim - 1 ] = i;

         /*printf( "   Sub: %i\n", i );*/

         pSubArray = SafeArrayToArray( parray, iDim - 1, rgIndices, vt );
         hb_arraySetForward( pArray, i - iFrom + 1, pSubArray );
         hb_itemRelease( pSubArray );
      }
   }
   else
   {
      VARIANT mElem;
      void * pTarget;
      char * sArray = NULL;

      VariantInit( &mElem );

      if( vt == VT_VARIANT )
      {
         hb_arrayNew( pArray, iLen );

         pTarget = &mElem;
      }
      else
      {
         if( vt == VT_I1 || vt == VT_UI1 )
         {
            /* Ugly hack, but needed to allocate our signature as hidden bytes! */
            hb_itemPutC( pArray, NULL );
            HB_STRING_ALLOC( pArray, ( ULONG )( iLen + 5 ) );
            pArray->item.asString.length = iLen; /* TOFIX */

            sArray = hb_itemGetCPtr( pArray );

            sArray[ iLen ]     = 0x7A;
            sArray[ iLen + 1 ] = 0x7B;
            sArray[ iLen + 2 ] = 0x7C;
            sArray[ iLen + 3 ] = 0x7D;
            sArray[ iLen + 4 ] = ( char ) vt;

            pTarget = NULL;
         }
         else
         {
            hb_arrayNew( pArray, iLen );

            pTarget = &mElem.n1.n2.n3.cVal;
         }
      }

      for( i = iFrom; i <= iTo; i++ )
      {
         rgIndices[ iDim - 1 ] = i;

         if( vt != VT_VARIANT )
         {
            /* Get cleared on VariantClear() - don't place out of loop! */
            mElem.n1.n2.vt = vt;

            if( vt == VT_I1 || vt == VT_UI1 )
            {
               SafeArrayGetElement( parray, rgIndices, &( sArray[ i - iFrom ] ) );

               continue;
            }
         }

         if( SUCCEEDED( SafeArrayGetElement( parray, rgIndices, pTarget ) ) )
         {
            /*HB_TRACE(HB_TR_INFO, ("Type: %p in: %s(%i)\n", mElem.n1.n2.vt, __FILE__, __LINE__));*/

            hb_oleVariantToItem( hb_arrayGetItemPtr( pArray, i - iFrom + 1 ), &mElem );

            VariantClear( &mElem );
         }
      }
   }

   /*HB_TRACE(HB_TR_INFO, ("Return len: %i\n", hb_arrayLen( pArray )));*/

   /* Wrap our array with VTArrayWrapper() class ( aArray := VTArrayWrapper( vt, aArray) ) */
   if( HB_IS_ARRAY( pArray ) && vt != VT_VARIANT )
   {
      PHB_ITEM pVT = hb_itemPutNL( hb_itemNew( NULL ), ( LONG ) vt );

      hb_vmPushDynSym( s_pSym_VTArrayWrapper );
      hb_vmPushNil();
      hb_itemPushForward( pVT );
      hb_itemPushForward( pArray );
      hb_vmDo( 2 );

      hb_itemForwardValue( pArray, hb_stackReturnItem() );

      hb_itemRelease( pVT );
   }

   return pArray;
}

HRESULT hb_oleVariantToItem( PHB_ITEM pItem, VARIANT *pVariant )
{
   PHB_ITEM pOleAuto;
   IUnknown  *pUnk   = NULL;
   IDispatch *pDisp  = NULL;
   SAFEARRAY *parray;/* = NULL;*/

   hb_itemClear( pItem );

   /* Don't "optimize" (VT_ARRAY | VT_VARIANT) must not match! */
   while( pVariant->n1.n2.vt == ( VT_BYREF | VT_VARIANT ) || pVariant->n1.n2.vt == VT_VARIANT || pVariant->n1.n2.vt == VT_BYREF )
      pVariant = pVariant->n1.n2.n3.pvarVal;

   switch( pVariant->n1.n2.vt )
   {
      case VT_BSTR | VT_BYREF:
      case VT_BSTR:
      {
         char *sString;

         if( pVariant->n1.n2.vt & VT_BYREF )
            sString = hb_oleWideToAnsi( *pVariant->n1.n2.n3.pbstrVal );
         else
            sString = hb_oleWideToAnsi( pVariant->n1.n2.n3.bstrVal );

         if( sString )
            hb_itemPutCPtr2( pItem, sString );
         else
            hb_itemPutC( pItem, NULL );

         break;
      }

      case VT_BOOL | VT_BYREF:
         hb_itemPutL( pItem, *pVariant->n1.n2.n3.pboolVal == VARIANT_FALSE ? FALSE : TRUE );
         break;

      case VT_BOOL:
         hb_itemPutL( pItem, pVariant->n1.n2.n3.boolVal == VARIANT_FALSE ? FALSE : TRUE );
         break;

      case ( VT_UNKNOWN | VT_BYREF ):
         pUnk = *pVariant->n1.n2.n3.ppunkVal;
         /* Intentionally fall through */

      case VT_UNKNOWN:
         if( pVariant->n1.n2.vt == VT_UNKNOWN )
            pUnk = pVariant->n1.n2.n3.punkVal;

         if( pUnk )
         {
            IDispatch ** pDispPtr = &pDisp;
            pUnk->lpVtbl->QueryInterface( pUnk, HB_ID_REF( REFIID, IID_IDispatch ), ( void ** ) pDispPtr );
         }
         /* Intentionally fall through */

      case ( VT_DISPATCH | VT_BYREF ):
         if( pVariant->n1.n2.vt == ( VT_DISPATCH | VT_BYREF ) )
            pDisp = *pVariant->n1.n2.n3.ppdispVal;
         /* Intentionally fall through */

      case VT_DISPATCH:
         if( pVariant->n1.n2.vt == VT_DISPATCH )
            pDisp = pVariant->n1.n2.n3.pdispVal;

         if( pDisp == NULL )
         {
            if( pUnk )
            {
               PHB_ITEM pVT = hb_itemPutNL( hb_itemNew( NULL ), ( LONG ) pVariant->n1.n2.vt );
               PHB_ITEM pUnknown = hb_itemPutPtr( hb_itemNew( NULL ), ( void * ) pUnk );

               hb_vmPushDynSym( s_pSym_VTWrapper );
               hb_vmPushNil();
               hb_itemPushForward( pVT );
               hb_itemPushForward( pUnknown );
               hb_vmDo( 2 );

               if( pItem != hb_stackReturnItem() )
                  hb_itemForwardValue( pItem, hb_stackReturnItem() );

               hb_itemRelease( pVT );
               hb_itemRelease( pUnknown );
            }

            break;
         }

         pOleAuto = hb_itemNew( NULL );

         hb_vmPushDynSym( s_pSym_TOleAuto );
         hb_vmPushNil();
         hb_vmDo( 0 );

         /* Safety! */
         hb_vmRequestReset();

         hb_itemForwardValue( pOleAuto, hb_stackReturnItem() );

         if( hb_itemType( pOleAuto ) )
         {
            /*TOleAuto():New( nDispatch )*/
            hb_vmPushDynSym( s_pSym_New );
            hb_itemPushForward( pOleAuto );
            hb_vmPushLong( ( LONG ) pDisp );
            hb_vmSend( 1 );

            /* If retrieved from IUnknown than doubly added! */
            if( pVariant->n1.n2.vt == VT_UNKNOWN || pVariant->n1.n2.vt == ( VT_UNKNOWN | VT_BYREF ) )
               pDisp->lpVtbl->Release( pDisp );

            hb_itemRelease( pOleAuto );

            /* Safety! */
            hb_vmRequestReset();

            if( pItem != hb_stackReturnItem() )
               hb_itemForwardValue( pItem, hb_stackReturnItem() );
         }
         break;

      case VT_I1 | VT_BYREF:     /* Byte */
      case VT_UI1 | VT_BYREF:
         hb_itemPutNI( pItem, ( short ) *pVariant->n1.n2.n3.pbVal );
         break;

      case VT_I1:     /* Byte */
      case VT_UI1:
         hb_itemPutNI( pItem, ( short ) pVariant->n1.n2.n3.bVal );
         break;

      case VT_I2 | VT_BYREF:     /* Short (2 bytes) */
      case VT_UI2 | VT_BYREF:
         hb_itemPutNI( pItem, ( short ) *pVariant->n1.n2.n3.piVal );
         break;

      case VT_I2:     /* Short (2 bytes) */
      case VT_UI2:
         hb_itemPutNI( pItem, ( short ) pVariant->n1.n2.n3.iVal );
         break;

      case VT_I4 | VT_BYREF:     /* Long (4 bytes) */
      case VT_UI4 | VT_BYREF:
      case VT_INT | VT_BYREF:
      case VT_UINT | VT_BYREF:
         hb_itemPutNL( pItem, ( LONG ) *pVariant->n1.n2.n3.plVal );
         break;

      case VT_I4:     /* Long (4 bytes) */
      case VT_UI4:
      case VT_INT:
      case VT_UINT:
         hb_itemPutNL( pItem, ( LONG ) pVariant->n1.n2.n3.lVal );
         break;

      case VT_R4 | VT_BYREF:     /* Single */
         hb_itemPutND( pItem, *pVariant->n1.n2.n3.pfltVal );
         break;

      case VT_R4:     /* Single */
         hb_itemPutND( pItem, pVariant->n1.n2.n3.fltVal );
         break;

      case VT_R8 | VT_BYREF:     /* Double */
         hb_itemPutND( pItem, *pVariant->n1.n2.n3.pdblVal );
         break;

      case VT_R8:     /* Double */
         hb_itemPutND( pItem, pVariant->n1.n2.n3.dblVal );
         break;

      case VT_CY | VT_BYREF:     /* Currency */
      case VT_CY:     /* Currency */
      {
         double tmp = 0;

         if( pVariant->n1.n2.vt & VT_BYREF )
            VarR8FromCy( *pVariant->n1.n2.n3.pcyVal, &tmp );
         else
            VarR8FromCy( pVariant->n1.n2.n3.cyVal, &tmp );

         hb_itemPutND( pItem, tmp );
         break;
      }

      case VT_DECIMAL | VT_BYREF: /* Decimal */
      case VT_DECIMAL: /* Decimal */
      {
         double tmp = 0;

         if( pVariant->n1.n2.vt & VT_BYREF )
            VarR8FromDec( pVariant->n1.n2.n3.pdecVal, &tmp );
         else
            VarR8FromDec( &pVariant->n1.decVal, &tmp );

         hb_itemPutND( pItem, tmp );
         break;
      }

      case VT_DATE | VT_BYREF:
         hb_itemPutDL( pItem, ( long ) ( *pVariant->n1.n2.n3.pdblVal ) + 2415019 );
         break;

      case VT_DATE:
         hb_itemPutDL( pItem, ( long ) ( pVariant->n1.n2.n3.dblVal ) + 2415019 );
         break;

      case VT_EMPTY | VT_BYREF:
      case VT_NULL | VT_BYREF:
      case VT_EMPTY:
      case VT_NULL:
         break;

        /*
        case VT_VARIANT:
           hb_oleVariantToItem( pItem, pVariant->n1.n2.n3.pvarVal );
           break;
        */

      case VT_PTR:
         hb_itemPutPtr( pItem, pVariant->n1.n2.n3.byref );
         break;

      default:
         if( pVariant->n1.n2.vt & VT_ARRAY )
         {
            UINT iDims;
            long * rgIndices;
            PHB_ITEM pArray;
            VARTYPE vt;

            if( pVariant->n1.n2.vt & VT_BYREF )
               parray = *pVariant->n1.n2.n3.pparray;
            else
               parray = pVariant->n1.n2.n3.parray;

            if( parray )
            {
               iDims = SafeArrayGetDim( parray );
               rgIndices = ( long * ) hb_xgrab( sizeof( long ) * iDims );

               vt = pVariant->n1.n2.vt;
               vt &= ~VT_ARRAY;
               vt &= ~VT_BYREF;

               /*HB_TRACE(HB_TR_INFO, ("Type: %p in: %s(%i)\n", vt, __FILE__, __LINE__));*/

               pArray = SafeArrayToArray( parray, iDims, rgIndices, vt );

               hb_xfree( ( void * ) rgIndices );

               hb_itemForwardValue( pItem, pArray );
               hb_itemRelease( pArray );
            }
            else
               hb_arrayNew( pItem, 0 );
         }
         else
         {
            HB_TRACE(HB_TR_INFO, ("Unexpected type %p in: %s(%i)!\n", pVariant->n1.n2.vt, __FILE__, __LINE__));
            return E_FAIL;
         }
   }

   /*VariantClear( pVariant );*/

   return S_OK;
}

static void RetValue( void )
{
   hb_oleVariantToItem( hb_stackReturnItem(), &s_RetVal );

   VariantClear( &s_RetVal );

   return;
}

HB_FUNC( __OLEENUMNEXT )
{
    IEnumVARIANT *pEnumVariant = ( IEnumVARIANT * ) hb_parptr( 1 );
    ULONG *pcElementFetched = NULL;

    if( pEnumVariant->lpVtbl->Next( pEnumVariant, 1, &s_RetVal, pcElementFetched ) == S_OK )
    {
       hb_oleVariantToItem( hb_stackReturnItem(), &s_RetVal );
       VariantClear( &s_RetVal );
       hb_storl( TRUE, 2 );
    }
    else
       hb_storl( FALSE, 2 );
}

HB_FUNC( __OLEENUMSTOP )
{
    IEnumVARIANT *pEnumVariant = ( IEnumVARIANT * ) hb_parptr( 1 );
    pEnumVariant->lpVtbl->Release( pEnumVariant );
}

HB_FUNC( OLEEXCEPTIONSOURCE )
{
   if( ( LONG ) s_nOleError == DISP_E_EXCEPTION )
      hb_retc_buffer( hb_oleWideToAnsi( s_excep.bstrSource ) );
}

HB_FUNC( OLEEXCEPTIONDESCRIPTION )
{
   if( ( LONG ) s_nOleError == DISP_E_EXCEPTION )
      hb_retc_buffer( hb_oleWideToAnsi( s_excep.bstrDescription ) );
}

HB_FUNC( OLEERROR )
{
   hb_retnl( ( long ) s_nOleError );
}

static char * Ole2TxtError( void )
{
   switch( ( LONG ) s_nOleError )
   {
      case S_OK:                     return "S_OK";
      case CO_E_CLASSSTRING:         return "CO_E_CLASSSTRING";
      case OLE_E_WRONGCOMPOBJ:       return "OLE_E_WRONGCOMPOBJ";
      case REGDB_E_CLASSNOTREG:      return "REGDB_E_CLASSNOTREG";
      case REGDB_E_WRITEREGDB:       return "REGDB_E_WRITEREGDB";
      case E_FAIL:                   return "E_FAIL";
      case E_OUTOFMEMORY:            return "E_OUTOFMEMORY";
      case E_NOTIMPL:                return "E_NOTIMPL";
      case E_INVALIDARG:             return "E_INVALIDARG";
      case E_UNEXPECTED:             return "E_UNEXPECTED";
      case DISP_E_UNKNOWNNAME:       return "DISP_E_UNKNOWNNAME";
      case DISP_E_UNKNOWNLCID:       return "DISP_E_UNKNOWNLCID";
      case DISP_E_BADPARAMCOUNT:     return "DISP_E_BADPARAMCOUNT";
      case DISP_E_BADVARTYPE:        return "DISP_E_BADVARTYPE";
      case DISP_E_EXCEPTION:         return "DISP_E_EXCEPTION";
      case DISP_E_MEMBERNOTFOUND:    return "DISP_E_MEMBERNOTFOUND";
      case DISP_E_NONAMEDARGS:       return "DISP_E_NONAMEDARGS";
      case DISP_E_OVERFLOW:          return "DISP_E_OVERFLOW";
      case DISP_E_PARAMNOTFOUND:     return "DISP_E_PARAMNOTFOUND";
      case DISP_E_TYPEMISMATCH:      return "DISP_E_TYPEMISMATCH";
      case DISP_E_UNKNOWNINTERFACE:  return "DISP_E_UNKNOWNINTERFACE";
      case DISP_E_PARAMNOTOPTIONAL:  return "DISP_E_PARAMNOTOPTIONAL";
      case CO_E_SERVER_EXEC_FAILURE: return "CO_E_SERVER_EXEC_FAILURE";
      case MK_E_UNAVAILABLE:         return "MK_E_UNAVAILABLE";
   }

   HB_TRACE(HB_TR_INFO, ("TOleAuto Error %p\n", s_nOleError));

   return "Unknown error";
}

HB_FUNC( OLE2TXTERROR )
{
   hb_retc( Ole2TxtError() );
}

HB_FUNC( MESSAGEBOX )
{
   LPTSTR lpStr1 = HB_TCHAR_CONVTO( hb_parcx( 2 ) );
   LPTSTR lpStr2 = HB_TCHAR_CONVTO( hb_parcx( 3 ) );
   HWND hWnd = ISNUM( 1 ) ? ( HWND ) ( HB_PTRDIFF ) hb_parnint( 1 ) :
                            ( HWND ) hb_parptr( 1 );
   hb_retni( MessageBox( hWnd, lpStr1, lpStr2, hb_parni( 4 ) ) );
   HB_TCHAR_FREE( lpStr1 );
   HB_TCHAR_FREE( lpStr2 );
}

HB_FUNC( CREATEOLEOBJECT ) /* ( cOleName | cCLSID [, cIID ] [, cLicense ] ) */
{
   BSTR bstrClassID;
   IID ClassID, iid;
   LPIID riid = ( LPIID ) &IID_IDispatch;
   void *pDisp = NULL; /* IDispatch */
   /* void *
    * used intentionally to inform compiler that there is no
    * strict-aliasing
    */
   bstrClassID = hb_oleAnsiToSysString( hb_parcx( 1 ) );

   if( hb_parcx( 1 )[ 0 ] == '{' )
      s_nOleError = CLSIDFromString( bstrClassID, ( LPCLSID ) &ClassID );
   else
      s_nOleError = CLSIDFromProgID( bstrClassID, ( LPCLSID ) &ClassID );

   SysFreeString( bstrClassID );

   /*HB_TRACE(HB_TR_INFO, ("Result: %p\n", s_nOleError));*/

   if( ISCHAR( 2 ) )
   {
      if( hb_parcx( 2 )[ 0 ] == '{' )
      {
         bstrClassID = hb_oleAnsiToSysString( hb_parcx( 2 ) );
         s_nOleError = CLSIDFromString( bstrClassID, &iid );
         SysFreeString( bstrClassID );
      }
      else
         memcpy( ( LPVOID ) &iid, hb_parcx( 2 ), sizeof( iid ) );

      riid = &iid;
   }

   if( SUCCEEDED( s_nOleError ) )
   {
      if( ISCHAR( 3 ) )
      {
         LPVOID * pCFPtr = NULL;

         s_nOleError = CoGetClassObject( HB_ID_REF( REFCLSID, ClassID ), CLSCTX_SERVER, NULL, HB_ID_REF( REFIID, IID_IClassFactory2 ), pCFPtr );

         if( SUCCEEDED( s_nOleError ) )
         {
            IClassFactory2 * pCF = ( IClassFactory2 * ) pCFPtr;
            BSTR bstrLic = hb_oleAnsiToSysString( hb_parc( 3 ) );

            s_nOleError = pCF->lpVtbl->CreateInstanceLic( pCF, NULL, NULL, (REFIID) riid, bstrLic, &pDisp );

            SysFreeString( bstrLic );
            pCF->lpVtbl->Release( pCF );
         }
      }
      else
      {
         /*HB_TRACE(HB_TR_INFO, ("Class: %i\n", ClassID));*/
         s_nOleError = CoCreateInstance( HB_ID_REF( REFCLSID, ClassID ), NULL, CLSCTX_SERVER, (REFIID) riid, &pDisp );
         /*HB_TRACE(HB_TR_INFO, ("Result: %p\n", s_nOleError));*/
      }
   }

   hb_retnl( ( LONG ) pDisp );
}

HB_FUNC( GETOLEOBJECT ) /* ( cOleName | cCLSID  [, cIID ] ) */
{
   BSTR bstrClassID;
   IID ClassID, iid;
   LPIID riid = ( LPIID ) &IID_IDispatch;
   IUnknown *pUnk = NULL;
   void *pDisp = NULL; /* IDispatch */
   /* void *
    * used intentionally to inform compiler that there is no
    * strict-aliasing
    */

   bstrClassID = hb_oleAnsiToSysString( hb_parcx( 1 ) );

   if( hb_parcx( 1 )[ 0 ] == '{' )
      s_nOleError = CLSIDFromString( bstrClassID, ( LPCLSID ) &ClassID );
   else
      s_nOleError = CLSIDFromProgID( bstrClassID, ( LPCLSID ) &ClassID );

   /*s_nOleError = ProgIDFromCLSID( &ClassID, &pOleStr );*/
   /*wprintf( L"Result %i ProgID: '%s'\n", s_nOleError, pOleStr );*/

   SysFreeString( bstrClassID );

   if( hb_pcount() == 2 )
   {
      if( hb_parcx( 2 )[ 0 ] == '{' )
      {
         bstrClassID = hb_oleAnsiToSysString( hb_parcx( 2 ) );
         s_nOleError = CLSIDFromString( bstrClassID, &iid );
         SysFreeString( bstrClassID );
      }
      else
         memcpy( ( LPVOID ) &iid, hb_parcx( 2 ), sizeof( iid ) );

      riid = &iid;
   }

   if( SUCCEEDED( s_nOleError ) )
   {
      s_nOleError = GetActiveObject( HB_ID_REF( REFCLSID, ClassID ), NULL, &pUnk );

      if( SUCCEEDED( s_nOleError ) )
      {
         s_nOleError = pUnk->lpVtbl->QueryInterface( pUnk, (REFIID) riid, &pDisp );

         pUnk->lpVtbl->Release( pUnk );

         if( SUCCEEDED( s_nOleError ) )
            hb_retnl( ( LONG ) pDisp );
      }
   }
}

HB_FUNC( OLEADDREF ) /* ( hOleObject, szMethodName, uParams... ) */
{
   IDispatch *pDisp = ( IDispatch * ) hb_parnl( 1 );

   /*HB_TRACE(HB_TR_INFO, ("OleAddRef( %p )\n", pDisp));*/

   s_nOleError = pDisp->lpVtbl->AddRef( pDisp );

   hb_retnl( s_nOleError );
}

HB_FUNC( OLERELEASEOBJECT ) /* ( hOleObject, szMethodName, uParams... ) */
{
   IDispatch *pDisp = ( IDispatch * ) hb_parnl( 1 );

   /*HB_TRACE(HB_TR_INFO, ("OleReleaseObject( %p )\n", pDisp));*/

   s_nOleError = pDisp->lpVtbl->Release( pDisp );

   hb_retnl( s_nOleError );
}

static HRESULT OleSetProperty( IDispatch *pDisp, DISPID DispID, DISPPARAMS *pDispParams )
{
   pDispParams->rgdispidNamedArgs = &s_lPropPut;
   pDispParams->cNamedArgs = 1;

   /* 1 Based!!! */
   if( ( ISBYREF( 1 ) ) || ISARRAY( 1 ) )
   {
      memset( ( LPBYTE ) &s_excep, 0, sizeof( s_excep ) );

      s_nOleError = pDisp->lpVtbl->Invoke( pDisp,
                                           DispID,
                                           HB_ID_REF( REFIID, IID_NULL ),
                                           LOCALE_SYSTEM_DEFAULT,
                                           DISPATCH_PROPERTYPUTREF,
                                           pDispParams,
                                           NULL,    /* No return value */
                                           &s_excep,
                                           &s_uArgErr );

      if( SUCCEEDED( s_nOleError ) )
         return s_nOleError;
   }

   memset( ( LPBYTE ) &s_excep, 0, sizeof( s_excep ) );

   s_nOleError = pDisp->lpVtbl->Invoke( pDisp,
                                        DispID,
                                        HB_ID_REF( REFIID, IID_NULL ),
                                        LOCALE_SYSTEM_DEFAULT,
                                        DISPATCH_PROPERTYPUT,
                                        pDispParams,
                                        NULL,    /* No return value */
                                        &s_excep,
                                        &s_uArgErr );

   pDispParams->rgdispidNamedArgs = NULL;
   pDispParams->cNamedArgs = 0;

   return s_nOleError;
}

static HRESULT OleInvoke( IDispatch *pDisp, DISPID DispID, DISPPARAMS *pDispParams )
{
   memset( ( LPBYTE ) &s_excep, 0, sizeof( s_excep ) );

   s_nOleError = pDisp->lpVtbl->Invoke( pDisp,
                                        DispID,
                                        HB_ID_REF( REFIID, IID_NULL ),
                                        LOCALE_SYSTEM_DEFAULT,
                                        DISPATCH_METHOD,
                                        pDispParams,
                                        &s_RetVal,
                                        &s_excep,
                                        &s_uArgErr );

   return s_nOleError;
}

static HRESULT OleGetProperty( IDispatch *pDisp, DISPID DispID, DISPPARAMS *pDispParams )
{
   memset( ( LPBYTE ) &s_excep, 0, sizeof( s_excep ) );

   s_nOleError = pDisp->lpVtbl->Invoke( pDisp,
                                        DispID,
                                        HB_ID_REF( REFIID, IID_NULL ),
                                        LOCALE_SYSTEM_DEFAULT,
                                        DISPATCH_PROPERTYGET,
                                        pDispParams,
                                        &s_RetVal,
                                        &s_excep,
                                        &s_uArgErr );

   /*HB_TRACE(HB_TR_INFO, ("OleGetValue: %p\n", s_nOleError));*/

   return s_nOleError;
}

static HRESULT OleGetValue( IDispatch *pDisp )
{
   VariantClear( &s_RetVal );

   /* Try to apply the requested message to the DEFAULT Property of the object if any. */
   if( SUCCEEDED( OleGetProperty( pDisp, DISPID_VALUE, &s_EmptyDispParams ) ) &&  ( s_RetVal.n1.n2.vt == VT_DISPATCH || s_RetVal.n1.n2.vt == ( VT_DISPATCH | VT_BYREF ) ) )
   {
      VariantCopy( &s_OleVal, &s_RetVal );
      VariantClear( &s_RetVal );

      return s_nOleError;
   }

   return E_FAIL;
}

static void OleThrowError( void )
{
   PHB_ITEM pReturn;
   char *sDescription;
   BOOL fFree = FALSE;

   hb_vmPushDynSym( s_pSym_cClassName );
   hb_vmPush( hb_stackSelfItem() );
   hb_vmSend( 0 );

   if( s_nOleError == DISP_E_EXCEPTION )
   {
      sDescription = hb_oleWideToAnsi( s_excep.bstrDescription );
      fFree = TRUE;
   }
   else
      sDescription = Ole2TxtError();

   /*HB_TRACE(HB_TR_INFO, ("Desc: '%s'\n", sDescription));*/

   pReturn = hb_errRT_SubstParams( hb_parcx( -1 ), EG_OLEEXCEPTION, (ULONG) s_nOleError, sDescription, hb_itemGetSymbol( hb_stackBaseItem() )->szName );

   if( fFree )
   {
      hb_xfree( ( void * ) sDescription );
   }

   if( pReturn )
      hb_itemReturnRelease( pReturn );
}

HB_FUNC( TOLEAUTO_OLEVALUE )
{
   if( hb_pcount() == 0 )
   {
      IDispatch *pDisp;

      hb_vmPushDynSym( s_pSym_hObj );
      hb_vmPush( hb_stackSelfItem() );
      hb_vmSend( 0 );

      pDisp = ( IDispatch * ) hb_parnl( -1 );

      VariantClear( &s_RetVal );

      OleGetProperty( pDisp, DISPID_VALUE, &s_EmptyDispParams );
      /*HB_TRACE(HB_TR_INFO, ("GetDefault: %p\n", s_nOleError));*/

      if( SUCCEEDED( s_nOleError ) )
         RetValue();
      else
         OleThrowError();
   }
}

HB_FUNC( TOLEAUTO__OLEVALUE )
{
   if( hb_pcount() >= 1 )
   {
      IDispatch *pDisp;
      DISPPARAMS DispParams;
      PHB_ITEM *aPrgParams;

      hb_vmPushDynSym( s_pSym_hObj );
      hb_vmPush( hb_stackSelfItem() );
      hb_vmSend( 0 );

      pDisp = ( IDispatch * ) hb_parnl( -1 );

      VariantClear( &s_RetVal );

      aPrgParams = GetParams( &DispParams, 0 );

      OleSetProperty( pDisp, DISPID_VALUE, &DispParams );
      /*HB_TRACE(HB_TR_INFO, ("SetDefault: %p\n", s_nOleError));*/

      FreeParams( &DispParams, aPrgParams );

      if( SUCCEEDED( s_nOleError ) )
         hb_itemReturn( hb_stackItemFromBase( 1 ) );
      else
         OleThrowError();
   }
}

HB_FUNC( TOLEAUTO_OLENEWENUMERATOR ) /* ( hOleObject, szMethodName, uParams... ) */
{
   IDispatch *pDisp;

   hb_vmPushDynSym( s_pSym_hObj );
   hb_vmPush( hb_stackSelfItem() );
   hb_vmSend( 0 );

   pDisp = ( IDispatch * ) hb_parnl( -1 );

   VariantClear( &s_RetVal );

   if( SUCCEEDED( OleGetProperty( pDisp, DISPID_NEWENUM, &s_EmptyDispParams ) ) ||
       SUCCEEDED( OleInvoke( pDisp, DISPID_NEWENUM, &s_EmptyDispParams ) ) )
   {
      LPVOID pEnumVariant = NULL; /* IEnumVARIANT */

      if( s_RetVal.n1.n2.vt == ( VT_UNKNOWN | VT_BYREF ) )
         s_nOleError = (*s_RetVal.n1.n2.n3.ppunkVal)->lpVtbl->QueryInterface( *s_RetVal.n1.n2.n3.ppunkVal, HB_ID_REF( REFIID, IID_IEnumVARIANT ), &pEnumVariant );
      else if( s_RetVal.n1.n2.vt == VT_UNKNOWN )
         s_nOleError = s_RetVal.n1.n2.n3.punkVal->lpVtbl->QueryInterface( s_RetVal.n1.n2.n3.punkVal, HB_ID_REF( REFIID, IID_IEnumVARIANT ), &pEnumVariant );
      else if( s_RetVal.n1.n2.vt == ( VT_DISPATCH | VT_BYREF ) )
         s_nOleError = (*s_RetVal.n1.n2.n3.ppdispVal)->lpVtbl->QueryInterface( *s_RetVal.n1.n2.n3.ppdispVal, HB_ID_REF( REFIID, IID_IEnumVARIANT ), &pEnumVariant );
      else if( s_RetVal.n1.n2.vt == VT_DISPATCH )
         s_nOleError = s_RetVal.n1.n2.n3.pdispVal->lpVtbl->QueryInterface( s_RetVal.n1.n2.n3.pdispVal, HB_ID_REF( REFIID, IID_IEnumVARIANT ), &pEnumVariant );
      else
         s_nOleError = E_FAIL;

      VariantClear( &s_RetVal );

      if( SUCCEEDED( s_nOleError ) )
         hb_retptr( pEnumVariant );
   }
   else
      OleThrowError();
}

static HRESULT OleGetID( IDispatch *pDisp, const char *szName, DISPID *pDispID, BOOL *pbSetFirst )
{
   BSTR bstrMessage;

   if( pbSetFirst )
      *pbSetFirst = FALSE;

   /*
   if( strcmp( szName, "OLEVALUE" ) == 0 || strcmp( szName, "_OLEVALUE" ) == 0 )
   {
      DispID = DISPID_VALUE;
      s_nOleError = S_OK;
   }
   else*/ if( szName[0] == '_' && szName[1] && hb_pcount() >= 1 )
   {
      bstrMessage = hb_oleAnsiToSysString( szName + 1 );
      s_nOleError = pDisp->lpVtbl->GetIDsOfNames( pDisp, HB_ID_REF( REFIID, IID_NULL ), ( wchar_t ** ) &bstrMessage, 1, LOCALE_SYSTEM_DEFAULT, pDispID );
      SysFreeString( bstrMessage );
      /*HB_TRACE(HB_TR_INFO, ("1. ID of: '%s' -> %i Result: %p\n", hb_itemGetSymbol( hb_stackBaseItem() )->szName + 1, DispID, s_nOleError));*/

      if( SUCCEEDED( s_nOleError ) )
      {
         if( pbSetFirst )
            *pbSetFirst = TRUE;
      }
   }
   else
      s_nOleError = E_PENDING;

   if( FAILED( s_nOleError ) )
   {
      /* Try again without removing the assign prefix (_). */
      bstrMessage = hb_oleAnsiToSysString( szName );
      s_nOleError = pDisp->lpVtbl->GetIDsOfNames( pDisp, HB_ID_REF( REFIID, IID_NULL ), ( wchar_t ** ) &bstrMessage, 1, 0, pDispID );
      SysFreeString( bstrMessage );
      /*HB_TRACE(HB_TR_INFO, ("2. ID of: '%s' -> %i Result: %p\n", szName, *pDispID, s_nOleError));*/
   }

   return s_nOleError;
}

HB_FUNC( TOLEAUTO_INVOKE )
{
   IDispatch *pDisp;
   char *szName = hb_parc(1);
   DISPID DispID;
   DISPPARAMS DispParams;

   hb_vmPushDynSym( s_pSym_hObj );
   hb_vmPush( hb_stackSelfItem() );
   hb_vmSend( 0 );

   pDisp = ( IDispatch * ) hb_parnl( -1 );

   if( szName && SUCCEEDED( OleGetID( pDisp, szName, &DispID, NULL ) ) )
   {
      PHB_ITEM *aPrgParams = GetParams( &DispParams, 1 );

      if( SUCCEEDED( OleInvoke( pDisp, DispID, &DispParams ) ) )
         RetValue();

      FreeParams( &DispParams, aPrgParams );
   }
}

HB_FUNC( TOLEAUTO_SET )
{
   IDispatch *pDisp;
   char *szName = hb_parc( 1 );
   DISPID DispID;
   DISPPARAMS DispParams;

   hb_vmPushDynSym( s_pSym_hObj );
   hb_vmPush( hb_stackSelfItem() );
   hb_vmSend( 0 );
   pDisp = ( IDispatch * ) hb_parnl( -1 );

   if( szName && SUCCEEDED( OleGetID( pDisp, szName, &DispID, NULL ) ) )
   {
      PHB_ITEM *aPrgParams = GetParams( &DispParams, 1 );

      if( SUCCEEDED( OleSetProperty( pDisp, DispID, &DispParams ) ) )
         RetValue();

      FreeParams( &DispParams, aPrgParams );
   }
}

HB_FUNC( TOLEAUTO_GET )
{
   IDispatch *pDisp;
   char *szName = hb_parc(1);
   DISPID DispID;
   DISPPARAMS DispParams;

   hb_vmPushDynSym( s_pSym_hObj );
   hb_vmPush( hb_stackSelfItem() );
   hb_vmSend( 0 );
   pDisp = ( IDispatch * ) hb_parnl( -1 );

   if( szName && SUCCEEDED( OleGetID( pDisp, szName, &DispID, NULL ) ) )
   {
      PHB_ITEM *aPrgParams = GetParams( &DispParams, 1 );

      if( SUCCEEDED( OleGetProperty( pDisp, DispID, &DispParams ) ) )
         RetValue();

      FreeParams( &DispParams, aPrgParams );
   }
}

HB_FUNC( TOLEAUTO_ONERROR )
{
   IDispatch *pDisp;
   DISPID DispID;
   DISPPARAMS DispParams;
   BOOL bSetFirst = FALSE, bTryDefault = TRUE;
   PHB_ITEM *aPrgParams = GetParams( &DispParams, 0 );

   /*HB_TRACE(HB_TR_INFO, ("Class: '%s' Message: '%s', Params: %i Arg1: %i\n", hb_objGetClsName( hb_stackSelfItem() ), hb_itemGetSymbol( hb_stackBaseItem() )->szName, hb_pcount(), hb_parinfo(1)));*/

   hb_vmPushDynSym( s_pSym_hObj );
   hb_vmPush( hb_stackSelfItem() );
   hb_vmSend( 0 );
   pDisp = ( IDispatch * ) hb_parnl( -1 );

OleGetID:

   if( SUCCEEDED( OleGetID( pDisp, hb_itemGetSymbol( hb_stackBaseItem() )->szName, &DispID, &bSetFirst ) ) )
   {
      VariantClear( &s_RetVal );

      if( bSetFirst )
      {
         if( SUCCEEDED( OleSetProperty( pDisp, DispID, &DispParams ) ) )
            hb_itemReturn( hb_stackItemFromBase( 1 ) );

         /*HB_TRACE(HB_TR_INFO, ("FIRST OleSetProperty %i\n", s_nOleError));*/
      }
      else
         s_nOleError = E_PENDING;

      if( FAILED( s_nOleError ) )
      {
         if( SUCCEEDED( OleInvoke( pDisp, DispID, &DispParams ) ) )
            RetValue();

         /*HB_TRACE(HB_TR_INFO, ("OleInvoke %i\n", s_nOleError));*/
      }

      if( FAILED( s_nOleError ) )
      {
         if( SUCCEEDED( OleGetProperty( pDisp, DispID, &DispParams ) ) )
            RetValue();

         /*HB_TRACE(HB_TR_INFO, ("OleGetProperty(%i) %i\n", DispParams.cArgs, s_nOleError));*/
      }

      if( FAILED( s_nOleError ) && bSetFirst == FALSE && hb_pcount() >= 1 )
      {
         if( SUCCEEDED( OleSetProperty( pDisp, DispID, &DispParams ) ) )
            hb_itemReturn( hb_stackItemFromBase( 1 ) );

         /*HB_TRACE(HB_TR_INFO, ("OleSetProperty %i\n", s_nOleError));*/
      }
   }

   if( SUCCEEDED( s_nOleError ) )
   {
      /*HB_TRACE(HB_TR_INFO, ("Invoke Succeeded!\n"));*/
      if( HB_IS_OBJECT( hb_stackReturnItem() ) && hb_clsIsParent( hb_objGetClass( hb_stackReturnItem() ), "TOLEAUTO" ) )
      {
         PHB_ITEM pReturn = hb_itemNew( NULL );
         PHB_ITEM pOleClassName = hb_itemNew( NULL );
         char *sOleClassName;
         int iClassNameLen, iMsgNameLen;

         hb_itemForwardValue( pReturn, hb_stackReturnItem() );

         hb_vmPushDynSym( s_pSym_cClassName );
         hb_vmPush( hb_stackSelfItem() );
         hb_vmSend( 0 );

         iClassNameLen = hb_parclen( -1 );
         iMsgNameLen = strlen( hb_itemGetSymbol( hb_stackBaseItem() )->szName );

         sOleClassName = ( char * ) hb_xgrab( iClassNameLen + 1 + iMsgNameLen + 1 );

         hb_strncpy( sOleClassName, hb_parc( - 1 ), iClassNameLen );
         sOleClassName[ iClassNameLen ] = ':';
         hb_strncpy( sOleClassName + iClassNameLen + 1, hb_itemGetSymbol( hb_stackBaseItem() )->szName, iMsgNameLen );

         /*HB_TRACE(HB_TR_INFO, ("Class: '%s'\n", sOleClassName));*/

         hb_itemPutCLPtr( pOleClassName, sOleClassName, iClassNameLen + 1 + iMsgNameLen );

         hb_vmPushDynSym( s_pSym_cClassName );
         hb_vmPush( pReturn );
         hb_itemPushForward( pOleClassName );
         hb_vmSend( 1 );

         hb_itemReturnForward( pReturn );

         hb_itemRelease( pReturn );
         hb_itemRelease( pOleClassName );
      }
   }
   else
   {
      /* Try to apply the requested message to the DEFAULT Method of the object if any. */
      if( bTryDefault )
      {
         if( SUCCEEDED( ( /* s_nOleError = */ OleGetValue( pDisp ) ) ) )
         {
            bTryDefault = FALSE;

            /*HB_TRACE(HB_TR_INFO, ("Try using DISPID_VALUE\n"));*/
            pDisp = s_OleVal.n1.n2.n3.pdispVal;
            goto OleGetID;
         }
      }

      /*HB_TRACE(HB_TR_INFO, ("Invoke Failed!\n"));*/
      OleThrowError();
   }

   FreeParams( &DispParams, aPrgParams );

   /* We are responsible to release the Default Interface which we retrieved */
   if( bTryDefault == FALSE && pDisp )
      pDisp->lpVtbl->Release( pDisp );
}

static void getwinver( OSVERSIONINFO * pOSvi )
{
   pOSvi->dwOSVersionInfoSize = sizeof( OSVERSIONINFO );
   GetVersionEx( pOSvi );
}

HB_FUNC( OS_ISWINNT )
{
   OSVERSIONINFO osvi;
   getwinver( &osvi );
   hb_retl( osvi.dwPlatformId == VER_PLATFORM_WIN32_NT );
}

HB_FUNC( OS_ISWINNT351 )
{
   OSVERSIONINFO osvi;
   getwinver( &osvi );
   hb_retl( osvi.dwPlatformId == VER_PLATFORM_WIN32_NT
         && osvi.dwMajorVersion == 3 && osvi.dwMinorVersion == 51 );
}

HB_FUNC( OS_ISWINNT4 )
{
   OSVERSIONINFO osvi;
   getwinver( &osvi );
   hb_retl( osvi.dwPlatformId == VER_PLATFORM_WIN32_NT
         && osvi.dwMajorVersion == 4 && osvi.dwMinorVersion == 0 );
}

HB_FUNC( OS_ISWIN2000_OR_LATER )
{
   OSVERSIONINFO osvi;
   getwinver( &osvi );
   hb_retl( osvi.dwMajorVersion >= 5 );
}

HB_FUNC( OS_ISWIN2000 )
{
   OSVERSIONINFO osvi;
   getwinver( &osvi );
   hb_retl( osvi.dwMajorVersion == 5 && osvi.dwMinorVersion == 0 );
}

HB_FUNC( OS_ISWINXP )
{
   OSVERSIONINFO osvi;
   getwinver( &osvi );
   hb_retl( osvi.dwMajorVersion == 5 && osvi.dwMinorVersion == 1 );
}

HB_FUNC( OS_ISWIN2003 )
{
   OSVERSIONINFO osvi;
   getwinver( &osvi );
   hb_retl( osvi.dwMajorVersion == 5 && osvi.dwMinorVersion == 2 );
}

HB_FUNC( OS_ISWINVISTA )
{
   OSVERSIONINFO osvi;
   getwinver( &osvi );
   hb_retl( osvi.dwMajorVersion == 6 && osvi.dwMinorVersion == 0 );
}

HB_FUNC( OS_ISWIN9X )
{
   OSVERSIONINFO osvi;
   getwinver( &osvi );
   hb_retl( osvi.dwPlatformId == VER_PLATFORM_WIN32_WINDOWS );
}

HB_FUNC( OS_ISWIN95 )
{
   OSVERSIONINFO osvi;
   getwinver( &osvi );
   hb_retl( osvi.dwPlatformId == VER_PLATFORM_WIN32_WINDOWS
         && osvi.dwMajorVersion == 4 && osvi.dwMinorVersion == 0 );
}

HB_FUNC( OS_ISWIN98 )
{
   OSVERSIONINFO osvi;
   getwinver( &osvi );
   hb_retl( osvi.dwPlatformId == VER_PLATFORM_WIN32_WINDOWS
         && osvi.dwMajorVersion == 4 && osvi.dwMinorVersion == 10 );
}

HB_FUNC( OS_ISWINME )
{
   OSVERSIONINFO osvi;
   getwinver( &osvi );
   hb_retl( osvi.dwPlatformId == VER_PLATFORM_WIN32_WINDOWS
         && osvi.dwMajorVersion == 4 && osvi.dwMinorVersion == 90 );
}

HB_FUNC( OS_ISWTSCLIENT )
{
   BOOL iResult = FALSE;
   OSVERSIONINFO osvi;
   getwinver( &osvi );
   if( osvi.dwPlatformId == VER_PLATFORM_WIN32_NT && osvi.dwMajorVersion >= 4 )
   {
      /* Only supported on NT 4.0 SP3 & higher */
      #ifndef SM_REMOTESESSION
         #define SM_REMOTESESSION        0x1000
      #endif
      iResult = GetSystemMetrics( SM_REMOTESESSION ) != 0;
   }
   hb_retl( iResult );
}

HB_FUNC( OS_VERSIONINFO )
{
   PHB_ITEM pArray = hb_itemArrayNew( 5 );
   OSVERSIONINFO osvi;
   char * szCSDVersion;

   getwinver( &osvi );
   hb_arraySetNL( pArray, 1, osvi.dwMajorVersion );
   hb_arraySetNL( pArray, 2, osvi.dwMinorVersion );
   if( osvi.dwPlatformId == VER_PLATFORM_WIN32_WINDOWS )
      osvi.dwBuildNumber = LOWORD( osvi.dwBuildNumber );
   hb_arraySetNL( pArray, 3, osvi.dwBuildNumber );
   hb_arraySetNL( pArray, 4, osvi.dwPlatformId );
   szCSDVersion = HB_TCHAR_CONVFROM( osvi.szCSDVersion );
   hb_arraySetC(  pArray, 5, szCSDVersion );
   HB_TCHAR_FREE( szCSDVersion );
   hb_itemReturnRelease( pArray );
}

static HB_GARBAGE_FUNC( win32_HDC_release )
{
   void ** phDC = ( void ** ) Cargo;

   /* Check if pointer is not NULL to avoid multiple freeing */
   if( phDC && * phDC )
   {
      /* Destroy the object */
      DeleteDC( ( HDC ) * phDC );

      /* set pointer to NULL to avoid multiple freeing */
      * phDC = NULL;
   }
}

static HDC win32_HDC_par( int iParam )
{
   void ** phDC = ( void ** ) hb_parptrGC( win32_HDC_release, iParam );

   return phDC ? ( HDC ) * phDC : NULL;
}

static HB_GARBAGE_FUNC( win32_HPEN_release )
{
   void ** phPEN = ( void ** ) Cargo;

   /* Check if pointer is not NULL to avoid multiple freeing */
   if( phPEN && * phPEN )
   {
      /* Destroy the object */
      DeleteObject( ( HDC ) * phPEN );

      /* set pointer to NULL to avoid multiple freeing */
      * phPEN = NULL;
   }
}

HB_FUNC( WIN32_CREATEDC )
{
   if( ISCHAR( 1 ) )
   {
      LPTSTR lpText = HB_TCHAR_CONVTO( hb_parc( 1 ) );
      void ** phDC = ( void ** ) hb_gcAlloc( sizeof( HDC * ), win32_HDC_release );
      * phDC = ( void * ) CreateDC( TEXT( "" ), lpText, NULL, NULL );
      hb_retptrGC( phDC );
      HB_TCHAR_FREE( lpText );
   }
   else
      hb_ret();
}

HB_FUNC( WIN32_STARTDOC )
{
   HDC hDC = win32_HDC_par( 1 );
   DOCINFO sDoc;
   BOOL Result = FALSE;

   if( hDC )
   {
      char * szDocName = hb_parc( 2 );
      LPTSTR lpDocName = szDocName ? HB_TCHAR_CONVTO( szDocName ) : NULL;
      sDoc.cbSize = sizeof( DOCINFO );
      sDoc.lpszDocName = lpDocName;
      sDoc.lpszOutput = NULL;
      sDoc.lpszDatatype = NULL;
      sDoc.fwType = 0;
      Result = ( BOOL ) ( StartDoc( hDC, &sDoc ) > 0 );

      if( lpDocName )
         HB_TCHAR_FREE( lpDocName );
   }

   hb_retl( Result );
}

HB_FUNC( WIN32_ENDDOC )
{
   BOOL Result = FALSE;
   HDC hDC = win32_HDC_par( 1 );

   if( hDC )
   {
      if( ISLOG( 2 ) && hb_parl( 2 ) )
         Result = ( AbortDoc( hDC ) > 0 );
      else
         Result = ( EndDoc( hDC ) > 0 );
   }

   hb_retl( Result );
}

HB_FUNC( WIN32_DELETEDC )
{
   void ** phDC = ( void ** ) hb_parptrGC( win32_HDC_release, 1 );

   /* Check if pointer is not NULL to avoid multiple freeing */
   if( phDC && * phDC )
   {
      /* Destroy the object */
      DeleteDC( ( HDC ) * phDC );

      /* set pointer to NULL to avoid multiple freeing */
      * phDC = NULL;
   }

   hb_retni( 0 );               /* Return zero as a new handle even if fails */
}

HB_FUNC( WIN32_STARTPAGE )
{
   HDC hDC = win32_HDC_par( 1 );

   hb_retl( hDC && StartPage( hDC ) > 0 );
}

HB_FUNC( WIN32_ENDPAGE )
{
   HDC hDC = win32_HDC_par( 1 );

   hb_retl( hDC && EndPage( hDC ) > 0 );
}

HB_FUNC( WIN32_TEXTOUT )
{
   LONG Result = 0;
   HDC hDC = win32_HDC_par( 1 );
   ULONG ulLen = hb_parclen( 4 );
   SIZE sSize;

   if( hDC && ulLen )
   {
      int iLen = ( int ) hb_parnl( 5 );

      if( iLen > ( int ) ulLen )
         iLen = ( int ) ulLen;

      if( iLen > 0 )
      {
         int iRow = ( int ) hb_parnl( 2 );
         int iCol = ( int ) hb_parnl( 3 );
         int iWidth = ISNUM( 6 ) ? ( int ) hb_parnl( 6 ) : 0;
         LPTSTR lpData = HB_TCHAR_CONVNTO( hb_parc( 4 ), iLen );

         if( ISNUM( 7 ) && ( hb_parnl( 7 ) == 1 || hb_parnl( 7 ) == 2 ) )
         {
            if( hb_parnl( 7 ) == 1 )
               SetTextAlign( ( HDC ) hDC, TA_BOTTOM | TA_RIGHT | TA_NOUPDATECP );
            else
               SetTextAlign( ( HDC ) hDC, TA_BOTTOM | TA_CENTER | TA_NOUPDATECP );
         }
         else
            SetTextAlign( ( HDC ) hDC, TA_BOTTOM | TA_LEFT | TA_NOUPDATECP );

         if( iWidth < 0 && iLen < 1024 )
         {
            int n = iLen, aFixed[1024];

            iWidth = -iWidth;

            while( n )
               aFixed[--n] = iWidth;

            if( ExtTextOut( hDC, iRow, iCol, 0, NULL, lpData, iLen, aFixed ) )
               Result = ( LONG ) ( iLen * iWidth );
         }
         else if( TextOut( hDC, iRow, iCol, lpData, iLen ) )
         {
            GetTextExtentPoint32( hDC, lpData, iLen, &sSize ); /* Get the length of the text in device size */
            Result = ( LONG ) sSize.cx; /* return the width so we can update the current pen position (::PosY) */
         }

         HB_TCHAR_FREE( lpData );
      }
   }

   hb_retnl( Result );
}

HB_FUNC( WIN32_GETTEXTSIZE )
{
   LONG Result = 0;
   HDC hDC = win32_HDC_par( 1 );
   ULONG ulLen = hb_parclen( 2 );
   SIZE sSize;

   if( hDC && ulLen )
   {
      int iLen = ( int ) hb_parnl( 3 );
      LPTSTR lpData;

      if( ( ULONG ) iLen > ulLen )
         iLen = ulLen;

      lpData = HB_TCHAR_CONVNTO( hb_parc( 2 ), iLen );

      GetTextExtentPoint32( hDC, lpData, iLen, &sSize );       /* Get the length of the text in device size */

      if( ISLOG( 4 ) && !hb_parl( 4 ) )
         Result = ( LONG ) sSize.cy;    /* return the height */
      else
         Result = ( LONG ) sSize.cx;    /* return the width */

      HB_TCHAR_FREE( lpData );
   }

   hb_retnl( Result );
}

HB_FUNC( WIN32_GETCHARSIZE )
{
   LONG Result = 0;
   HDC hDC = win32_HDC_par( 1 );

   if( hDC )
   {
      TEXTMETRIC tm;

      GetTextMetrics( hDC, &tm );
      if( ISLOG( 2 ) && hb_parl( 2 ) )
         Result = ( LONG ) tm.tmHeight;
      else
         Result = ( LONG ) tm.tmAveCharWidth;
   }

   hb_retnl( Result );
}

HB_FUNC( WIN32_GETDEVICECAPS )
{
   HDC hDC = win32_HDC_par( 1 );

   hb_retnl( hDC && ISNUM( 2 ) ? ( long ) GetDeviceCaps( hDC, hb_parnl( 2 ) ) : 0 );
}

HB_FUNC( WIN32_SETMAPMODE )
{
   HDC hDC = win32_HDC_par( 1 );

   hb_retnl( hDC && ISNUM( 2 ) ? SetMapMode( hDC, hb_parnl( 2 ) ) : 0 );
}

HB_FUNC( WIN32_MULDIV )
{
   hb_retnl( MulDiv( hb_parnl( 1 ), hb_parnl( 2 ), hb_parnl( 3 ) ) );
}

HB_FUNC( WIN32_CREATEFONT )
{
   BOOL Result = FALSE;
   HDC hDC = win32_HDC_par( 1 );
   HFONT hFont, hOldFont;
   char *pszFont = hb_parc( 2 );
   LPTSTR lpFont = pszFont ? HB_TCHAR_CONVTO( pszFont ) : NULL;
   int iHeight = ( int ) hb_parnl( 3 );
   int iMul = ( int ) hb_parnl( 4 );
   int iDiv = ( int ) hb_parnl( 5 );
   int iWidth;
   int iWeight = ( int ) hb_parnl( 6 );
   DWORD dwUnderLine = ( DWORD ) hb_parl( 7 );
   DWORD dwItalic = ( DWORD ) hb_parl( 8 );
   DWORD dwCharSet = ( DWORD ) hb_parnl( 9 );

   iWeight = iWeight > 0 ? iWeight : FW_NORMAL;
   iHeight = -MulDiv( iHeight, GetDeviceCaps( hDC, LOGPIXELSY ), 72 );
   if( iDiv )
      iWidth = MulDiv( abs( iMul ), GetDeviceCaps( hDC, LOGPIXELSX ), abs( iDiv ) );
   else
      iWidth = 0;               /* Use the default font width */

   hFont = CreateFont( iHeight, iWidth, 0, 0, iWeight, dwItalic, dwUnderLine, 0,
                       dwCharSet, OUT_DEVICE_PRECIS, CLIP_DEFAULT_PRECIS, DRAFT_QUALITY,
                       DEFAULT_PITCH | FF_DONTCARE, lpFont );
   if( lpFont )
      HB_TCHAR_FREE( lpFont );

   if( hFont )
   {
      Result = TRUE;
      hOldFont = ( HFONT ) SelectObject( hDC, hFont );

      if( hOldFont )
         DeleteObject( hOldFont );
   }

   hb_retl( Result );
}

HB_FUNC( WIN32_GETPRINTERFONTNAME )
{
   HDC hDC = win32_HDC_par( 1 );

   if( hDC )
   {
      unsigned char cFont[ 128 ];

      GetTextFace( hDC, sizeof( cFont ) - 1, ( LPTSTR ) cFont );

      hb_retc( ( char * ) cFont );
   }
   else
      hb_retc( NULL );
}

HB_FUNC( WIN32_BITMAPSOK )
{
   HDC hDC = win32_HDC_par( 1 );

   hb_retl( hDC && ( GetDeviceCaps( hDC, RASTERCAPS ) & RC_STRETCHDIB ) );
}

HB_FUNC( WIN32_SETDOCUMENTPROPERTIES )
{
   BOOL Result = FALSE;
   HDC hDC = win32_HDC_par( 1 );

   if( hDC )
   {
      HANDLE hPrinter;
      char * pszPrinterName = hb_parc( 2 );
      LPTSTR lpPrinterName = pszPrinterName ? HB_TCHAR_CONVTO( pszPrinterName ) : NULL;

      if( OpenPrinter( lpPrinterName, &hPrinter, NULL ) )
      {
         PDEVMODE pDevMode = NULL;
         LONG lSize = DocumentProperties( 0, hPrinter, lpPrinterName, pDevMode, pDevMode, 0 );

         if( lSize > 0 )
         {
            pDevMode = ( PDEVMODE ) hb_xgrab( lSize );

            if( pDevMode )
            {
               DocumentProperties( 0, hPrinter, lpPrinterName, pDevMode, pDevMode, DM_OUT_BUFFER );

               if( ISNUM( 3 ) && hb_parnl( 3 ) )        /* 22/02/2007 don't change if 0 */
                  pDevMode->dmPaperSize = ( short ) hb_parnl( 3 );

               if( ISLOG( 4 ) )
                  pDevMode->dmOrientation = ( short ) ( hb_parl( 4 ) ? 2 : 1 );

               if( ISNUM( 5 ) && hb_parnl( 5 ) > 0 )
                  pDevMode->dmCopies = ( short ) hb_parnl( 5 );

               if( ISNUM( 6 ) && hb_parnl( 6 ) )        /* 22/02/2007 don't change if 0 */
                  pDevMode->dmDefaultSource = ( short ) hb_parnl( 6 );

               if( ISNUM( 7 ) && hb_parnl( 7 ) )        /* 22/02/2007 don't change if 0 */
                  pDevMode->dmDuplex = ( short ) hb_parnl( 7 );

               if( ISNUM( 8 ) && hb_parnl( 8 ) )        /* 22/02/2007 don't change if 0 */
                  pDevMode->dmPrintQuality = ( short ) hb_parnl( 8 );

               Result = ( ResetDC( hDC, pDevMode ) != NULL );

               hb_xfree( pDevMode );
            }
         }

         ClosePrinter( hPrinter );
      }

      if( lpPrinterName )
         HB_TCHAR_FREE( lpPrinterName );
   }

   hb_retl( Result );
}

HB_FUNC( WIN32_LOADBITMAPFILE )
{
   char * pstrFileName = hb_parc( 1 );
   BOOL bSuccess = FALSE;
   DWORD dwFileSize = 0, dwHighSize, dwBytesRead;
   HANDLE hFile;
   BITMAPFILEHEADER *pbmfh = NULL;

   hFile = CreateFileA( pstrFileName, GENERIC_READ, FILE_SHARE_READ, NULL, OPEN_EXISTING,
                        FILE_FLAG_SEQUENTIAL_SCAN, NULL );

   if( hFile != INVALID_HANDLE_VALUE )
   {
      dwFileSize = GetFileSize( hFile, &dwHighSize );

      if( ( dwFileSize != INVALID_FILE_SIZE ) && !dwHighSize )  /* Do not continue if File size error or TOO big for memory */
      {
         pbmfh = ( BITMAPFILEHEADER * ) hb_xgrab( dwFileSize );

         if( pbmfh )
         {
            bSuccess = ReadFile( hFile, pbmfh, dwFileSize, &dwBytesRead, NULL );
            bSuccess = bSuccess && ( dwBytesRead == dwFileSize ) && ( pbmfh->bfType == *( WORD * ) "BM" );      /*&& (pbmfh->bfSize == dwFileSize) ;*/
         }
      }

      CloseHandle( hFile );
   }

   if( bSuccess )
   {
      hb_retclen( ( char * ) pbmfh, dwFileSize );       /* hb_retclenAdoptRaw */

      if( pbmfh )
         hb_xfree( pbmfh );
   }
   else
   {
      hb_retc( NULL );

      if( pbmfh != NULL )
         hb_xfree( pbmfh );
   }
}

HB_FUNC( WIN32_DRAWBITMAP )
{
   HDC hDC = win32_HDC_par( 1 );
   BITMAPFILEHEADER *pbmfh = ( BITMAPFILEHEADER * ) hb_parc( 2 );
   BITMAPINFO *pbmi;
   BYTE *pBits;
   int cxDib, cyDib;

   pbmi = ( BITMAPINFO * ) ( pbmfh + 1 );
   pBits = ( BYTE * ) pbmfh + pbmfh->bfOffBits;

   if( pbmi->bmiHeader.biSize == sizeof( BITMAPCOREHEADER ) )
   {                            /* Remember there are 2 types of BitMap File */
      cxDib = ( ( BITMAPCOREHEADER * ) pbmi )->bcWidth;
      cyDib = ( ( BITMAPCOREHEADER * ) pbmi )->bcHeight;
   }
   else
   {
      cxDib = pbmi->bmiHeader.biWidth;
      cyDib = abs( pbmi->bmiHeader.biHeight );
   }

   SetStretchBltMode( hDC, COLORONCOLOR );

   hb_retl( StretchDIBits( hDC, hb_parni( 3 ), hb_parni( 4 ), hb_parni( 5 ), hb_parni( 6 ),
                           0, 0, cxDib, cyDib, pBits, pbmi,
                           DIB_RGB_COLORS, SRCCOPY ) != ( int ) GDI_ERROR );
}

static int CALLBACK FontEnumCallBack( LOGFONT * lplf, TEXTMETRIC * lpntm, DWORD FontType,
                                      LPVOID pArray )
{
   PHB_ITEM SubItems = hb_itemNew( NULL );
   char * pszFaceName = HB_TCHAR_CONVFROM( lplf->lfFaceName );

   hb_arrayNew( SubItems, 4 );
   hb_itemPutC( hb_arrayGetItemPtr( SubItems, 1 ), pszFaceName );
   hb_itemPutL( hb_arrayGetItemPtr( SubItems, 2 ), lplf->lfPitchAndFamily & FIXED_PITCH );
   hb_itemPutL( hb_arrayGetItemPtr( SubItems, 3 ), FontType & TRUETYPE_FONTTYPE );
   hb_itemPutNL( hb_arrayGetItemPtr( SubItems, 4 ), lpntm->tmCharSet );
   hb_arrayAddForward( ( PHB_ITEM ) pArray, SubItems );
   hb_itemRelease( SubItems );
   HB_TCHAR_FREE( pszFaceName );

   return TRUE;
}

HB_FUNC( WIN32_ENUMFONTS )
{
   HDC hDC = win32_HDC_par( 1 );

   if( hDC )
   {
      PHB_ITEM pArray = hb_itemNew( NULL );

      hb_arrayNew( pArray, 0 );

      EnumFonts( hDC, ( LPCTSTR ) NULL, ( FONTENUMPROC ) FontEnumCallBack, ( LPARAM ) pArray );

      hb_itemReturnRelease( pArray );
   }
}

HB_FUNC( WIN32_GETEXEFILENAME )
{
   unsigned char pBuf[ 1024 ];

   GetModuleFileName( NULL, ( LPTSTR ) pBuf, 1023 );

   hb_retc( ( char * ) pBuf );
}

HB_FUNC( WIN32_SETCOLOR )
{
   HDC hDC = win32_HDC_par( 1 );

   SetTextColor( hDC, ( COLORREF ) hb_parnl( 2 ) );

   if( ISNUM( 3 ) )
      SetBkColor( hDC, ( COLORREF ) hb_parnl( 3 ) );

   if( ISNUM( 4 ) )
      SetTextAlign( hDC, hb_parni( 4 ) );
}

HB_FUNC( WIN32_SETPEN )
{
   HDC hDC = win32_HDC_par( 1 );
   HPEN hOldPen;

   void ** phPEN = ( void ** ) hb_gcAlloc( sizeof( HPEN * ), win32_HPEN_release );

   * phPEN = ( void * ) CreatePen( hb_parni( 2 ),                /* pen style */
                                   hb_parni( 3 ),                /* pen width */
                                   ( COLORREF ) hb_parnl( 4 )    /* pen color */
                                 );

   hOldPen = ( HPEN ) SelectObject( hDC, ( HPEN ) * phPEN );

   if( hOldPen )
      DeleteObject( hOldPen );

   hb_retptrGC( phPEN );
}

HB_FUNC( WIN32_FILLRECT )
{
   HDC hDC = win32_HDC_par( 1 );
   int x1 = hb_parni( 2 );
   int y1 = hb_parni( 3 );
   int x2 = hb_parni( 4 );
   int y2 = hb_parni( 5 );
   HBRUSH hBrush = CreateSolidBrush( ( COLORREF ) hb_parnl( 6 ) );
   RECT rct;

   rct.top = y1;
   rct.left = x1;
   rct.bottom = y2;
   rct.right = x2;

   FillRect( hDC, &rct, hBrush );

   DeleteObject( hBrush );
}

HB_FUNC( WIN32_LINETO )
{
   HDC hDC = win32_HDC_par( 1 );
   int x1 = hb_parni( 2 );
   int y1 = hb_parni( 3 );
   int x2 = hb_parni( 4 );
   int y2 = hb_parni( 5 );

   MoveToEx( hDC, x1, y1, NULL );

   hb_retl( LineTo( hDC, x2, y2 ) );
}

HB_FUNC( WIN32_RECTANGLE )
{
   HDC hDC = win32_HDC_par( 1 );
   int x1 = hb_parni( 2 );
   int y1 = hb_parni( 3 );
   int x2 = hb_parni( 4 );
   int y2 = hb_parni( 5 );
   int iWidth = hb_parni( 6 );
   int iHeight = hb_parni( 7 );

   if( iWidth && iHeight )
      hb_retl( RoundRect( hDC, x1, y1, x2, y2, iWidth, iHeight ) );
   else
      hb_retl( Rectangle( hDC, x1, y1, x2, y2 ) );
}

HB_FUNC( WIN32_ARC )
{
   HDC hDC = win32_HDC_par( 1 );
   int x1 = hb_parni( 2 );
   int y1 = hb_parni( 3 );
   int x2 = hb_parni( 4 );
   int y2 = hb_parni( 5 );

   hb_retl( Arc( hDC, x1, y1, x2, y2, 0, 0, 0, 0 ) );
}

HB_FUNC( WIN32_ELLIPSE )
{
   HDC hDC = win32_HDC_par( 1 );
   int x1 = hb_parni( 2 );
   int y1 = hb_parni( 3 );
   int x2 = hb_parni( 4 );
   int y2 = hb_parni( 5 );

   hb_retl( Ellipse( hDC, x1, y1, x2, y2 ) );
}

HB_FUNC( WIN32_SETBKMODE )
{
   hb_retnl( SetBkMode( win32_HDC_par( 1 ), hb_parnl( 2 ) ) );
}

HB_FUNC( WIN32_OS_ISWIN9X )
{
   OSVERSIONINFO osvi;

   osvi.dwOSVersionInfoSize = sizeof( OSVERSIONINFO );
   GetVersionEx( &osvi );
   hb_retl( osvi.dwPlatformId == VER_PLATFORM_WIN32_WINDOWS );
}

BOOL hb_isLegacyDevice( LPSTR pPrinterName )
{
   BOOL bLegacyDev = FALSE;
   int n = 0;
   LPSTR pszPrnDev[] =
      { "lpt1", "lpt2", "lpt3", "lpt4", "lpt5", "lpt6", "com1", "com2", "com3", "com4", NULL };
   while( pszPrnDev[n] && !bLegacyDev )
   {
      bLegacyDev = ( hb_strnicmp( pPrinterName, pszPrnDev[n], strlen( pszPrnDev[n] ) ) == 0 );
      n++;
   }
   return ( bLegacyDev );
}

BOOL hb_PrinterExists( LPSTR pPrinterName )
{
   BOOL Result = FALSE;
   DWORD Flags = PRINTER_ENUM_LOCAL | PRINTER_ENUM_CONNECTIONS;
   PRINTER_INFO_4 *buffer4, *pPrinterEnum4;
   HANDLE hPrinter;
   ULONG needed = 0, returned = 0, a;

   HB_TRACE( HB_TR_DEBUG, ( "hb_PrinterExists(%s)", pPrinterName ) );

   if( !strchr( pPrinterName, HB_OS_PATH_LIST_SEP_CHR ) && !hb_isLegacyDevice( pPrinterName ) )

   {                            /* Don't bother with test if '\' in string */
      if( hb_iswinnt() )
      {                         /* Use EnumPrinter() here because much faster than OpenPrinter() */
         EnumPrinters( Flags, NULL, 4, ( LPBYTE ) NULL, 0, &needed, &returned );
         if( needed > 0 )
         {
            pPrinterEnum4 = buffer4 = ( PRINTER_INFO_4 * ) hb_xgrab( needed );
            if( pPrinterEnum4 )
            {
               if( EnumPrinters
                   ( Flags, NULL, 4, ( LPBYTE ) pPrinterEnum4, needed, &needed, &returned ) )
               {
                  for( a = 0; !Result && a < returned; a++, pPrinterEnum4++ )
                  {
                     Result = strcmp( ( const char * ) pPrinterName,
                                      ( const char * ) pPrinterEnum4->pPrinterName ) == 0;
                  }
               }
               hb_xfree( buffer4 );
            }
         }
      }
      else
      {
         LPTSTR lpPrinterName = HB_TCHAR_CONVTO( pPrinterName );
         if( OpenPrinter( lpPrinterName, &hPrinter, NULL ) )
         {
            ClosePrinter( hPrinter );
            Result = TRUE;
         }
         HB_TCHAR_FREE( lpPrinterName );
      }
   }
   return Result;
}

HB_FUNC( PRINTEREXISTS )
{
   BOOL Result = FALSE;

   if( ISCHAR( 1 ) )
   {
      Result = hb_PrinterExists( hb_parc( 1 ) );
   }
   hb_retl( Result );
}

BOOL hb_GetDefaultPrinter( char * pPrinterName, LPDWORD pdwBufferSize )
{
   BOOL Result = FALSE;
   OSVERSIONINFO osvi;

   osvi.dwOSVersionInfoSize = sizeof( OSVERSIONINFO );
   GetVersionEx( &osvi );

   if( osvi.dwPlatformId == VER_PLATFORM_WIN32_NT && osvi.dwMajorVersion >= 5 ) /* Windows 2000 or later */
   {
      typedef BOOL( WINAPI * DEFPRINTER ) ( LPSTR, LPDWORD );  /* stops warnings */
      DEFPRINTER fnGetDefaultPrinter;
      HMODULE hWinSpool = LoadLibrary( TEXT( "winspool.drv" ) );

      if( hWinSpool )
      {
         fnGetDefaultPrinter = ( DEFPRINTER ) GetProcAddress( hWinSpool, "GetDefaultPrinterA" );

         if( fnGetDefaultPrinter )
         {
            Result = ( *fnGetDefaultPrinter ) ( pPrinterName, pdwBufferSize );
         }
         FreeLibrary( hWinSpool );
      }
   }

   if( !Result )                /* Win9X and Windows NT 4.0 or earlier & 2000+ if necessary for some reason i.e. dll could not load!!!! */
   {
      DWORD dwSize = GetProfileStringA( "windows", "device", "", pPrinterName, *pdwBufferSize );

      if( dwSize && dwSize < *pdwBufferSize )
      {
         dwSize = 0;
         while( pPrinterName[dwSize] != '\0' && pPrinterName[dwSize] != ',' )
         {
            dwSize++;
         }
         pPrinterName[dwSize] = '\0';
         *pdwBufferSize = dwSize + 1;
         Result = TRUE;
      }
      else
      {
         *pdwBufferSize = dwSize + 1;
      }
   }

   if( !Result && osvi.dwPlatformId == VER_PLATFORM_WIN32_WINDOWS )
   {
/*
      This option should never be required but is included because of this article

          http://support.microsoft.com/kb/246772/en-us

      This option will not enumerate any network printers.

      From the SDK technical reference for EnumPrinters();

      If Level is 2 or 5, Name is a pointer to a null-terminated string that specifies
      the name of a server whose printers are to be enumerated.
      If this string is NULL, then the function enumerates the printers installed on the local machine.
*/

      DWORD dwNeeded, dwReturned;
      PRINTER_INFO_2 *ppi2;

      if( EnumPrinters( PRINTER_ENUM_DEFAULT, NULL, 2, NULL, 0, &dwNeeded, &dwReturned ) )
      {
         if( dwNeeded > 0 )
         {
            ppi2 = ( PRINTER_INFO_2 * ) hb_xgrab( dwNeeded );
            if( ppi2 )
            {
               if( EnumPrinters
                   ( PRINTER_ENUM_DEFAULT, NULL, 2, ( LPBYTE ) ppi2, dwNeeded, &dwNeeded,
                     &dwReturned ) && dwReturned > 0 )
               {
                  DWORD dwSize = ( DWORD ) lstrlen( ppi2->pPrinterName );

                  if( dwSize && dwSize < *pdwBufferSize )
                  {
                     HB_TCHAR_GETFROM( pPrinterName, ppi2->pPrinterName,
                                       lstrlen( ppi2->pPrinterName ) );
                     *pdwBufferSize = dwSize + 1;
                     Result = TRUE;
                  }
               }
               hb_xfree( ppi2 );
            }
         }
      }
   }
   return ( Result );
}

HB_FUNC( GETDEFAULTPRINTER )
{
   char szDefaultPrinter[MAXBUFFERSIZE];
   DWORD pdwBufferSize = MAXBUFFERSIZE;

   if( hb_GetDefaultPrinter( szDefaultPrinter, &pdwBufferSize ) )
   {
      hb_retclen( szDefaultPrinter, pdwBufferSize - 1 );
   }
   else
   {
      hb_retc( NULL );
   }
}

BOOL hb_GetPrinterNameByPort( char * pPrinterName, LPDWORD pdwBufferSize,
                              char * pPortName, BOOL bSubStr )
{
   BOOL Result = FALSE, bFound = FALSE;
   ULONG needed, returned, a;
   PRINTER_INFO_5 *pPrinterEnum, *buffer;

   HB_TRACE( HB_TR_DEBUG, ( "hb_GetPrinterNameByPort(%p,%p)", pPrinterName, pPortName ) );

   EnumPrinters( PRINTER_ENUM_LOCAL | PRINTER_ENUM_CONNECTIONS, NULL, 5, ( LPBYTE ) NULL, 0,
                 &needed, &returned );
   if( needed > 0 )
   {
      pPrinterEnum = buffer = ( PRINTER_INFO_5 * ) hb_xgrab( needed );

      if( EnumPrinters( PRINTER_ENUM_LOCAL | PRINTER_ENUM_CONNECTIONS, NULL, 5,
                        ( LPBYTE ) buffer, needed, &needed, &returned ) )
      {
         for( a = 0; a < returned && !bFound; a++, pPrinterEnum++ )
         {
            char * szPortName = HB_TCHAR_CONVFROM( pPrinterEnum->pPortName );

            if( bSubStr )
            {
               bFound = hb_strnicmp( szPortName, pPortName, strlen( pPortName ) ) == 0;
            }
            else
            {
               bFound = ( hb_stricmp( szPortName, pPortName ) == 0 );
            }
            HB_TCHAR_FREE( szPortName );
            if( bFound )
            {
               char * szPrinterName = HB_TCHAR_CONVFROM( pPrinterEnum->pPrinterName );
               if( *pdwBufferSize >= strlen( szPrinterName ) + 1 )
               {
                  hb_strncpy( pPrinterName, szPrinterName, *pdwBufferSize );
                  Result = TRUE;
               }
               /* Store name length + \0 char for return */
               *pdwBufferSize = ( DWORD ) strlen( szPrinterName ) + 1;
               HB_TCHAR_FREE( szPrinterName );
            }
         }
      }
      hb_xfree( buffer );
   }
   return Result;
}

HB_FUNC( PRINTERPORTTONAME )
{
   char szDefaultPrinter[ MAXBUFFERSIZE ];
   DWORD pdwBufferSize = sizeof( szDefaultPrinter );

   if( ISCHAR( 1 ) && hb_parclen( 1 ) > 0 &&
       hb_GetPrinterNameByPort( szDefaultPrinter, &pdwBufferSize, hb_parcx( 1 ),
                                ISLOG( 2 ) ? hb_parl( 2 ) : FALSE ) )
   {
      hb_retc( szDefaultPrinter );
   }
   else
   {
      hb_retc( NULL );
   }
}

LONG hb_PrintFileRaw( UCHAR * cPrinterName, UCHAR * cFileName, UCHAR * cDocName )
{
   UCHAR printBuffer[BIG_PRINT_BUFFER];
   HANDLE hPrinter, hFile;
   DOC_INFO_1 DocInfo;
   DWORD nRead, nWritten;
   LONG Result;
   LPTSTR lpPrinterName = HB_TCHAR_CONVTO( ( char * ) cPrinterName );

   if( OpenPrinter( lpPrinterName, &hPrinter, NULL ) != 0 )
   {
      LPTSTR lpDocName = HB_TCHAR_CONVTO( ( char * ) cDocName );
      DocInfo.pDocName = lpDocName;
      DocInfo.pOutputFile = NULL;
      DocInfo.pDatatype = TEXT( "RAW" );
      if( StartDocPrinter( hPrinter, 1, ( UCHAR * ) & DocInfo ) != 0 )
      {
         if( StartPagePrinter( hPrinter ) != 0 )
         {
            hFile =
               CreateFileA( ( char * ) cFileName, GENERIC_READ, 0, NULL, OPEN_EXISTING,
                            FILE_ATTRIBUTE_NORMAL, NULL );
            if( hFile != INVALID_HANDLE_VALUE )
            {
               while( ReadFile( hFile, printBuffer, BIG_PRINT_BUFFER, &nRead, NULL )
                      && ( nRead > 0 ) )
               {
                  if( printBuffer[nRead - 1] == 26 )
                  {
                     nRead--;   /* Skip the EOF() character */
                  }
                  WritePrinter( hPrinter, printBuffer, nRead, &nWritten );
               }
               Result = 1;
               CloseHandle( hFile );
            }
            else
            {
               Result = -6;
            }
            EndPagePrinter( hPrinter );
         }
         else
         {
            Result = -4;
         }
         EndDocPrinter( hPrinter );
      }
      else
      {
         Result = -3;
      }
      HB_TCHAR_FREE( lpDocName );
      ClosePrinter( hPrinter );
   }
   else
   {
      Result = -2;
   }

   HB_TCHAR_FREE( lpPrinterName );

   return Result;
}

HB_FUNC( PRINTFILERAW )
{
   UCHAR *cPrinterName, *cFileName, *cDocName;
   LONG Result = -1;

   if( ISCHAR( 1 ) && ISCHAR( 2 ) )
   {
      cPrinterName = ( UCHAR * ) hb_parcx( 1 );
      cFileName = ( UCHAR * ) hb_parcx( 2 );
      cDocName = ( ISCHAR( 3 ) ? ( UCHAR * ) hb_parcx( 3 ) : cFileName );
      Result = hb_PrintFileRaw( cPrinterName, cFileName, cDocName );
   }
   hb_retnl( Result );
}

HB_FUNC( GETPRINTERS )
{
   HANDLE hPrinter;
   DWORD Flags = PRINTER_ENUM_LOCAL | PRINTER_ENUM_CONNECTIONS;
   BOOL bPrinterNamesOnly = TRUE;
   BOOL bLocalPrintersOnly;
   PRINTER_INFO_4 *buffer4, *pPrinterEnum4;
   PRINTER_INFO_5 *buffer, *pPrinterEnum;
   PRINTER_INFO_2 *pPrinterInfo2;
   ULONG needed = 0, returned = 0, a;
   PHB_ITEM SubItems, File, Port, Net, Driver, ArrayPrinter;
   char *pszData;

   ArrayPrinter = hb_itemNew( NULL );
   SubItems = hb_itemNew( NULL );
   File = hb_itemNew( NULL );
   Port = hb_itemNew( NULL );
   Net = hb_itemNew( NULL );
   Driver = hb_itemNew( NULL );


   hb_arrayNew( ArrayPrinter, 0 );

   buffer = NULL;
   HB_TRACE( HB_TR_DEBUG, ( "GETPRINTERS()" ) );

   if( ISLOG( 1 ) )
   {
      bPrinterNamesOnly = !hb_parl( 1 );
   }

   bLocalPrintersOnly = ISLOG( 2 ) ? hb_parl( 2 ) : FALSE;

   if( hb_iswinnt() )
   {
      EnumPrinters( Flags, NULL, 4, ( LPBYTE ) NULL, 0, &needed, &returned );

      if( needed > 0 )
      {
         pPrinterEnum4 = buffer4 = ( PRINTER_INFO_4 * ) hb_xgrab( needed );
         if( pPrinterEnum4 )
         {
            if( EnumPrinters
                ( Flags, NULL, 4, ( LPBYTE ) pPrinterEnum4, needed, &needed, &returned ) )
            {
               if( bPrinterNamesOnly )
               {
                  for( a = 0; a < returned; a++, pPrinterEnum4++ )
                  {
                     if( !bLocalPrintersOnly
                         || pPrinterEnum4->Attributes & PRINTER_ATTRIBUTE_LOCAL )
                     {
                        pszData = HB_TCHAR_CONVFROM( pPrinterEnum4->pPrinterName );
                        hb_itemPutC( File, pszData );
                        HB_TCHAR_FREE( pszData );
                        hb_arrayAddForward( ArrayPrinter, File );
                     }
                  }
               }
               else
               {
                  for( a = 0; a < returned; a++, pPrinterEnum4++ )
                  {
                     if( !bLocalPrintersOnly
                         || pPrinterEnum4->Attributes & PRINTER_ATTRIBUTE_LOCAL )
                     {
                        if( OpenPrinter( pPrinterEnum4->pPrinterName, &hPrinter, NULL ) )
                        {
                           GetPrinter( hPrinter, 2, NULL, 0, &needed );
                           if( needed > 0 )
                           {
                              pPrinterInfo2 = ( PRINTER_INFO_2 * ) hb_xgrab( needed );
                              if( pPrinterInfo2 )
                              {
                                 pszData = HB_TCHAR_CONVFROM( pPrinterEnum4->pPrinterName );
                                 hb_itemPutC( File, pszData );
                                 HB_TCHAR_FREE( pszData );

                                 hb_arrayNew( SubItems, 0 );

                                 if( GetPrinter
                                     ( hPrinter, 2, ( LPBYTE ) pPrinterInfo2, needed, &needed ) )
                                 {
                                    pszData = HB_TCHAR_CONVFROM( pPrinterInfo2->pPortName );
                                    hb_itemPutC( Port, pszData );
                                    HB_TCHAR_FREE( pszData );
                                    pszData = HB_TCHAR_CONVFROM( pPrinterInfo2->pDriverName );
                                    hb_itemPutC( Driver, pszData );
                                    HB_TCHAR_FREE( pszData );
                                 }
                                 else
                                 {
                                    hb_itemPutC( Port, "Error" );
                                    hb_itemPutC( Driver, "Error" );
                                 }

                                 if( pPrinterEnum4->Attributes & PRINTER_ATTRIBUTE_LOCAL )
                                 {
                                    hb_itemPutC( Net, "LOCAL" );
                                 }
                                 else
                                 {
                                    if( pPrinterEnum4->Attributes & PRINTER_ATTRIBUTE_NETWORK )
                                    {
                                       hb_itemPutC( Net, "NETWORK" );
                                    }
                                    else
                                    {
                                       hb_itemPutC( Net, "ERROR" );
                                    }
                                 }

                                 hb_arrayAddForward( SubItems, File );
                                 hb_arrayAddForward( SubItems, Port );
                                 hb_arrayAddForward( SubItems, Net );
                                 hb_arrayAddForward( SubItems, Driver );
                                 hb_arrayAddForward( ArrayPrinter, SubItems );
                                 hb_xfree( pPrinterInfo2 );
                              }
                           }
                        }
                        CloseHandle( hPrinter );
                     }
                  }
               }
            }
            hb_xfree( buffer4 );
         }
      }
   }
   else
   {
      EnumPrinters( Flags, NULL, 5, ( LPBYTE ) buffer, 0, &needed, &returned );

      if( needed > 0 )
      {
         pPrinterEnum = buffer = ( PRINTER_INFO_5 * ) hb_xgrab( needed );
         if( pPrinterEnum )
         {
            if( EnumPrinters( Flags, NULL, 5, ( LPBYTE ) buffer, needed, &needed, &returned ) )
            {
               for( a = 0; a < returned; a++, pPrinterEnum++ )
               {
                  if( !bLocalPrintersOnly || pPrinterEnum->Attributes & PRINTER_ATTRIBUTE_LOCAL )
                  {
                     if( bPrinterNamesOnly )
                     {
                        pszData = HB_TCHAR_CONVFROM( pPrinterEnum->pPrinterName );
                        hb_itemPutC( File, pszData );
                        HB_TCHAR_FREE( pszData );
                        hb_arrayAddForward( ArrayPrinter, File );
                     }
                     else
                     {
                        /* Tony (ABC)   11/1/2005        1:40PM. */
                        for( a = 0; a < returned; a++, pPrinterEnum++ )
                        {
                           if( !bLocalPrintersOnly
                               || pPrinterEnum->Attributes & PRINTER_ATTRIBUTE_LOCAL )
                           {
                              if( OpenPrinter( pPrinterEnum->pPrinterName, &hPrinter, NULL ) )
                              {
                                 GetPrinter( hPrinter, 2, NULL, 0, &needed );
                                 if( needed > 0 )
                                 {
                                    pPrinterInfo2 = ( PRINTER_INFO_2 * ) hb_xgrab( needed );
                                    if( pPrinterInfo2 )
                                    {
                                       hb_arrayNew( SubItems, 0 );
                                       pszData = HB_TCHAR_CONVFROM( pPrinterEnum->pPrinterName );
                                       hb_itemPutC( File, pszData );
                                       HB_TCHAR_FREE( pszData );

                                       if( GetPrinter
                                           ( hPrinter, 2, ( LPBYTE ) pPrinterInfo2, needed,
                                             &needed ) )
                                       {
                                          pszData = HB_TCHAR_CONVFROM( pPrinterInfo2->pPortName );
                                          hb_itemPutC( Port, pszData );
                                          HB_TCHAR_FREE( pszData );
                                          pszData = HB_TCHAR_CONVFROM( pPrinterInfo2->pDriverName );
                                          hb_itemPutC( Driver, pszData );
                                          HB_TCHAR_FREE( pszData );
                                       }
                                       else
                                       {
                                          hb_itemPutC( Port, "Error" );
                                          hb_itemPutC( Driver, "Error" );
                                       }

                                       if( pPrinterEnum->Attributes & PRINTER_ATTRIBUTE_LOCAL )
                                       {
                                          hb_itemPutC( Net, "LOCAL" );
                                       }
                                       else
                                       {
                                          if( pPrinterEnum->Attributes & PRINTER_ATTRIBUTE_NETWORK )
                                          {
                                             hb_itemPutC( Net, "NETWORK" );
                                          }
                                          else
                                          {
                                             hb_itemPutC( Net, "ERROR" );
                                          }
                                       }

                                       hb_arrayAddForward( SubItems, File );
                                       hb_arrayAddForward( SubItems, Port );
                                       hb_arrayAddForward( SubItems, Net );
                                       hb_arrayAddForward( SubItems, Driver );
                                       hb_arrayAddForward( ArrayPrinter, SubItems );
                                       hb_xfree( pPrinterInfo2 );
                                    }
                                 }
                              }
                              CloseHandle( hPrinter );
                           }
                        }
                        /* Tony (ABC)   11/1/2005        1:40PM. Old Code... Justo in case. */
#if 0
                          hb_arrayNew( SubItems, 0 );
                          hb_itemPutC( File, pPrinterEnum->pPrinterName );
                          hb_itemPutC( Port, pPrinterEnum->pPortName );
 
                          if ( pPrinterEnum->Attributes & PRINTER_ATTRIBUTE_LOCAL)
                          {
                             hb_itemPutC( Net,"LOCAL" );
                          }
                          else
                          {
                             if ( pPrinterEnum->Attributes & PRINTER_ATTRIBUTE_NETWORK)
                             {
                                hb_itemPutC( Net,"NETWORK" );
                             }
                             else
                             {
                                hb_itemPutC( Net, "ERROR" );
                             }
                          }

                          hb_arrayAddForward( SubItems , File ) ;
                          hb_arrayAddForward( SubItems , Port ) ;
                          hb_arrayAddForward( SubItems, Net ) ;
                          hb_arrayAddForward( ArrayPrinter , SubItems );
#endif
                     }
                  }
               }
            }
            hb_xfree( buffer );
         }
      }
   }
   hb_itemReturnForward( ArrayPrinter );

   hb_itemRelease( ArrayPrinter );
   hb_itemRelease( SubItems );
   hb_itemRelease( File );
   hb_itemRelease( Port );
   hb_itemRelease( Net );
   hb_itemRelease( Driver );
}

HB_FUNC( WINPORTOPEN )
{
   int Port = hb_parni( 1 );
   LONG BaudRate = hb_parnl( 2 );
   int Parity = hb_parni( 3 );
   int ByteSize = hb_parni( 4 );
   int StopBits = hb_parni( 5 );
 /*LONG s_InQueue = hb_parnl( 6 ); */
 /*LONG s_OutQueue = hb_parnl( 7 ); */

   HANDLE hCommPort;
   COMMTIMEOUTS NewTimeouts;
   DCB NewDCB;

   s_WinFcn = FCNCREATEFILE;
   s_WinError = 0;
   if( ( hCommPort = CreateFile( s_PortData[ Port ].Name, 
                                 GENERIC_READ | GENERIC_WRITE,
                                 0,
                                 0,
                                 OPEN_EXISTING,
                                 FILE_FLAG_NO_BUFFERING, 0 ) ) == INVALID_HANDLE_VALUE )
   {
      s_WinError = GetLastError();
      hb_retnl( -1 );
      return;
   }

   s_WinFcn = FCNGETCOMMSTATE;
   s_WinError = 0;

   /* We'll put everything back */
   s_PortData2[ Port ].OldDCB.DCBlength = sizeof( DCB );
   if( ! GetCommState( hCommPort, &( s_PortData2[ Port ].OldDCB ) ) )
   {
      s_WinError = GetLastError();
      CloseHandle( hCommPort );
      hb_retnl( -1 );
      return;
   }

   NewDCB.DCBlength = sizeof( DCB );
   if( ! GetCommState( hCommPort, &NewDCB ) )
   {
      s_WinError = GetLastError();
      CloseHandle( hCommPort );
      hb_retnl( -1 );
      return;
   }

   /* Initialised with NO flow control or control signals! */
   NewDCB.BaudRate = ( DWORD ) BaudRate;
   NewDCB.fBinary = 1;
   NewDCB.fParity = 0;
   NewDCB.fOutxCtsFlow = 0;
   NewDCB.fOutxDsrFlow = 0;
   NewDCB.fDtrControl = DTR_CONTROL_DISABLE;
   NewDCB.fDsrSensitivity = 0;
   NewDCB.fTXContinueOnXoff = 1;
   NewDCB.fOutX = 0;
   NewDCB.fInX = 0;
   NewDCB.fErrorChar = 1;
   NewDCB.fNull = 0;
   NewDCB.fRtsControl = RTS_CONTROL_DISABLE;
   NewDCB.fAbortOnError = 0;
 /*NewDCB.XonLim*/
 /*NewDCB.XoffLim*/
   NewDCB.ByteSize = ( BYTE ) ByteSize;
   NewDCB.Parity = ( BYTE ) Parity;
   NewDCB.StopBits = ( BYTE ) StopBits;
 /*NewDCB.XonChar*/
 /*NewDCB.XoffChar*/
   NewDCB.ErrorChar = '?';
 /*NewDCB.EofChar*/
 /*NewDCB.EvtChar*/

   /* function reinitializes all hardware and control settings, but it does not empty output or input queues */
   s_WinFcn = FCNSETCOMMSTATE;
   s_WinError = 0;
   if( ! SetCommState( hCommPort, &NewDCB ) )
   {
      s_WinError = GetLastError();
      CloseHandle( hCommPort );
      hb_retnl( -1 );
      return;
   }

   /* We'll leave this to Windows, unless you really want it changed! */
   if( s_InQueue != -1 )
   {
      s_WinFcn = FCNSETUPCOMM;
      s_WinError = 0;
      if( ! SetupComm( hCommPort, s_InQueue, s_OutQueue ) )
      {
         s_WinError = GetLastError();
         CloseHandle( hCommPort );
         hb_retnl( -1 );
         return;
      }
   }

   /* We'll put everything back */
   s_WinFcn = FCNGETCOMMTIMEOUTS;
   s_WinError = 0;
   if( ! GetCommTimeouts( hCommPort, &( s_PortData2[ Port ].OldTimeouts ) ) )
   {
      s_WinError = GetLastError();
      CloseHandle( hCommPort );
      hb_retnl( -1 );
      return;
   }

   /* Maximum time, in milliseconds, allowed to elapse between the arrival of two characters on
      the communications line. During a ReadFile operation, the time period begins when the first
      character is received. If the interval between the arrival of any two characters exceeds this
      amount, the ReadFile operation is completed and any buffered data is returned. A value of zero
      indicates that interval time-outs are not used. */

   /* A value of MAXDWORD, combined with zero values for both the s_ReadTotalTimeoutConstant and
      s_ReadTotalTimeoutMultiplier members, specifies that the read operation is to return
      immediately with the characters that have already been received, even if no characters
      have been received. */
   NewTimeouts.ReadIntervalTimeout = ( s_ReadIntervalTimeout == -1 ? MAXDWORD : ( DWORD ) s_ReadIntervalTimeout );

   /* Multiplier, in milliseconds, used to calculate the total time-out period for read operations.
      For each read operation, this value is multiplied by the requested number of bytes to be read. */
   NewTimeouts.ReadTotalTimeoutMultiplier = ( s_ReadTotalTimeoutMultiplier == -1 ? 0 : s_ReadTotalTimeoutMultiplier );

   /* Constant, in milliseconds, used to calculate the total time-out period for read operations.
      For each read operation, this value is added to the product of the s_ReadTotalTimeoutMultiplier
      member and the requested number of bytes. */
   NewTimeouts.ReadTotalTimeoutConstant = ( s_ReadIntervalTimeout == -1 ? 0 : s_ReadTotalTimeoutConstant );

   /* A value of zero for both the s_ReadTotalTimeoutMultiplier and s_ReadTotalTimeoutConstant members
      indicates that total time-outs are not used for read operations ...
      and MAXDWORD, 0 and 0 are what we use by default */

   /* Multiplier, in milliseconds, used to calculate the total time-out period for write operations.
      For each write operation, this value is multiplied by the number of bytes to be written. */
   if( s_WriteTotalTimeoutMultiplier == -1 )
   {
       /* float of 1.0 makes whole expression float */
       NewTimeouts.WriteTotalTimeoutMultiplier = HB_MIN( 1, ( DWORD ) ( ( 1.0 / BaudRate ) *
           ( ByteSize + 1 + ( Parity == NOPARITY ? 0 : 1 ) + ( StopBits == ONESTOPBIT ? 1 : StopBits == ONE5STOPBITS ? 1.5 : 2 ) ) * 1000 ) );
   }
   /* Constant, in milliseconds, used to calculate the total time-out period for write operations.
      For each write operation, this value is added to the product of the s_WriteTotalTimeoutMultiplier member and the number of bytes to be written. */
   else
       NewTimeouts.WriteTotalTimeoutMultiplier = s_WriteTotalTimeoutMultiplier;

   /* 50 ms is a thumbsuck - seems long enough and not too long! */
   NewTimeouts.WriteTotalTimeoutConstant = s_WriteTotalTimeoutConstant == -1 ? 50 : s_WriteTotalTimeoutConstant;

   /* A value of zero for both the s_WriteTotalTimeoutMultiplier and s_WriteTotalTimeoutConstant members
      indicates that total time-outs are not used for write operations ...
      and if flow control is enabled the program will "hang" or if it is not enabled the data will
      be lost (potentially), so we set a minimum of 1ms (baud rates higher than 4800) */

   s_WinFcn = FCNSETCOMMTIMEOUTS;
   s_WinError = 0;
   if( ! SetCommTimeouts( hCommPort, &NewTimeouts ) )
   {
      s_WinError = GetLastError();
      CloseHandle( hCommPort );
      hb_retnl( -1 );
   }
   else
   {
      s_PortData[ Port ].Port = hCommPort;
      hb_retnl( hCommPort == INVALID_HANDLE_VALUE ? -1 : 0 );
   }
}

HB_FUNC( WINPORTCLOSE )
{
   int Port = hb_parni( 1 );
   long Drain = hb_parni( 2 );
   HANDLE hCommPort = s_PortData[ Port ].Port;

   s_WinFcn = FCNSETCOMMSTATE;
   s_WinError = 0;
   if( ! SetCommState( hCommPort, &( s_PortData2[ Port ].OldDCB ) ) )
   {
      s_WinError = GetLastError();
      CloseHandle( hCommPort );
      hb_retl( FALSE );
      return;
   }

   s_WinFcn = FCNSETCOMMTIMEOUTS;
   s_WinError = 0;
   if( ! SetCommTimeouts( hCommPort, &( s_PortData2[ Port ].OldTimeouts ) ) )
   {
      s_WinError = GetLastError();
      CloseHandle( hCommPort );
      hb_retl( FALSE );
      return;
   }

   s_PortData[ Port ].Port = INVALID_HANDLE_VALUE;

   s_WinFcn = FCNCLOSEHANDLE;
   s_WinError = 0;

   /* I honestly don't know if this helps */
   if( Drain > 0 )
      Sleep( Drain * 1000 );

   hb_retl( CloseHandle( hCommPort ) != 0 );
   s_WinError = GetLastError();
}

HB_FUNC( WINPORTWRITE )
{
   int Port = hb_parni( 1 );
   char * lpBuffer = hb_parc( 2 );
   LONG NumberofBytesToWrite = hb_parclen( 2 );
   HANDLE hCommPort = s_PortData[ Port ].Port;
   DWORD NumberofBytesWritten;

   s_WinFcn = FCNWRITEFILE;
   s_WinError = 0;
   if( ! WriteFile( hCommPort, lpBuffer, NumberofBytesToWrite, &NumberofBytesWritten, NULL ) )
   {
      s_WinError = GetLastError();
      hb_retnl( -1 );
   }
   else
      hb_retnl( NumberofBytesWritten );
}

HB_FUNC( WINPORTREAD )
{
   int Port = hb_parni( 1 );
   char * lpBuffer; /* = hb_parc( 2 ); */
   LONG NumberOfBytesToRead = hb_parclen( 2 );
   HANDLE hCommPort = s_PortData[ Port ].Port;
   DWORD NumberOfBytesRead;

   lpBuffer = ( char * ) hb_xgrab( NumberOfBytesToRead );
   s_WinFcn = FCNREADFILE;
   s_WinError = 0;
   if( ! ReadFile( hCommPort, lpBuffer, NumberOfBytesToRead, &NumberOfBytesRead, NULL ) )
   {
      s_WinError = GetLastError();
      hb_retnl( -1 );
   }
   else
   {
      if( ! hb_storclen_buffer( lpBuffer, NumberOfBytesRead, 2 ) )
         hb_xfree( lpBuffer );
      hb_retnl( NumberOfBytesRead );
   }
}

HB_FUNC( WINPORTSTATUS )
{
   int Port = hb_parni( 1 );
   HANDLE hCommPort = s_PortData[ Port ].Port;
   DWORD ModemStat;

   s_WinFcn = FCNGETCOMMMODEMSTATUS;
   s_WinError = 0;
   if( ! GetCommModemStatus( hCommPort, &ModemStat ) )
   {
      s_WinError = GetLastError();
      hb_retl( FALSE );
   }
   else
   {
      hb_storl( ( ModemStat & MS_CTS_ON )  != 0, 2 );     /* The CTS (clear-to-send) signal is on. */
      hb_storl( ( ModemStat & MS_DSR_ON )  != 0, 3 );     /* The DSR (data-set-ready) signal is on. */
      hb_storl( ( ModemStat & MS_RING_ON ) != 0, 4 );     /* The ring indicator signal is on. */
      hb_storl( ( ModemStat & MS_RLSD_ON ) != 0, 5 );     /* The RLSD (receive-line-signal-detect) signal is on. Also is DCD. */

      hb_retl( TRUE );
   }
}

HB_FUNC( WINPORTPURGE )
{
   int Port = hb_parni( 1 );
   HANDLE hCommPort = s_PortData[ Port ].Port;
   DWORD Flags;

   Flags = ( hb_parl( 2 ) ? PURGE_RXCLEAR : 0 ) | ( hb_parl( 3 ) ? PURGE_TXCLEAR : 0 );
   s_WinFcn = FCNPURGECOMM;
   s_WinError = 0;
   if( ! PurgeComm( hCommPort, Flags ) )
   {
      s_WinError = GetLastError();
      hb_retl( FALSE );
   }
   else
      hb_retl( TRUE );
}

HB_FUNC( WINPORTQUEUESTATUS )
{
   int Port = hb_parni( 1 );
   HANDLE hCommPort = s_PortData[ Port ].Port;
   DWORD Errors;
   COMSTAT ComStat;

   s_WinFcn = FCNCLEARCOMMERROR;
   s_WinError = 0;
   if( ! ClearCommError( hCommPort, &Errors, &ComStat ) )
   {
      s_WinError = GetLastError();
      hb_retl( FALSE );
   }
   else
   {
      hb_storl( ComStat.fCtsHold, 2 );
      hb_storl( ComStat.fDsrHold, 3 );
      hb_storl( ComStat.fRlsdHold, 4 );
      hb_storl( ComStat.fXoffHold, 5 );
      hb_storl( ComStat.fXoffSent, 6 );
      hb_stornl( ComStat.cbInQue, 7 );
      hb_stornl( ComStat.cbOutQue, 8 ); /* This value will be zero for a nonoverlapped write */
      
      hb_retl( TRUE );
   }
}

HB_FUNC( WINPORTSETRTS )
{
   int Port = hb_parni( 1 );
   HANDLE hCommPort = s_PortData[ Port ].Port;
   DWORD Func = hb_parl( 2 ) ? SETRTS : CLRRTS;

   s_WinFcn = ESCAPECOMMFUNCTION;
   s_WinError = 0;
   if( ! EscapeCommFunction( hCommPort, Func ) )
   {
      s_WinError = GetLastError();
      hb_retl( FALSE );
   }
   else
      hb_retl( TRUE );
}

HB_FUNC( WINPORTSETDTR )
{
   int Port = hb_parni( 1 );
   HANDLE hCommPort = s_PortData[ Port ].Port;
   DWORD Func = hb_parl( 2 ) ? SETDTR : CLRDTR;

   s_WinFcn = ESCAPECOMMFUNCTION;
   s_WinError = 0;
   if( ! EscapeCommFunction( hCommPort, Func ) )
   {
      s_WinError = GetLastError();
      hb_retl( FALSE );
   }
   else
      hb_retl( TRUE );
}

HB_FUNC( WINPORTRTSFLOW )
{
   int Port = hb_parni( 1 );
   HANDLE hCommPort = s_PortData[ Port ].Port;
   DCB CurDCB;
   int RtsControl = hb_parni( 2 );

   s_WinFcn = FCNGETCOMMSTATE;
   s_WinError = 0;
   CurDCB.DCBlength = sizeof( DCB );
   if( ! GetCommState( hCommPort, &CurDCB ) )
   {
      s_WinError = GetLastError();
      hb_retl( FALSE );
      return;
   }

   if( RtsControl == RTS_CONTROL_DISABLE )
   {
      CurDCB.fOutxCtsFlow = 0;
      CurDCB.fRtsControl = RTS_CONTROL_DISABLE;
   }
   else if( RtsControl == RTS_CONTROL_ENABLE )
   {
      CurDCB.fOutxCtsFlow = 1;
      CurDCB.fRtsControl = RTS_CONTROL_ENABLE;
   }
   else if( RtsControl == RTS_CONTROL_HANDSHAKE )
   {
      CurDCB.fOutxCtsFlow = 1;
      CurDCB.fRtsControl = RTS_CONTROL_HANDSHAKE;
   }
   else    /* RTS_CONTROL_TOGGLE - RS485? */
   {
      hb_retl( FALSE );
      return;
   }

   s_WinFcn = FCNSETCOMMSTATE;
   s_WinError = 0;
   if( ! SetCommState( hCommPort, &CurDCB ) )
   {
      s_WinError = GetLastError();
      hb_retl( FALSE );
   }
   else
      hb_retl( TRUE );
}

HB_FUNC( WINPORTDTRFLOW )
{
   int Port = hb_parni( 1 );
   HANDLE hCommPort = s_PortData[ Port ].Port;
   DCB CurDCB;
   int DtrControl = hb_parni( 2 );

   s_WinFcn = FCNGETCOMMSTATE;
   s_WinError = 0;
   CurDCB.DCBlength = sizeof( DCB );
   if( ! GetCommState( hCommPort, &CurDCB ) )
   {
      s_WinError = GetLastError();
      hb_retl( FALSE );
      return;
   }

   if( DtrControl == DTR_CONTROL_DISABLE )
   {
      CurDCB.fOutxDsrFlow = 0;
      CurDCB.fDtrControl = DTR_CONTROL_DISABLE;
   }
   else if( DtrControl == DTR_CONTROL_ENABLE )
   {
      CurDCB.fOutxDsrFlow = 1;
      CurDCB.fDtrControl = DTR_CONTROL_ENABLE;
   }
   else if( DtrControl == DTR_CONTROL_HANDSHAKE )
   {
      CurDCB.fOutxDsrFlow = 1;
      CurDCB.fDtrControl = DTR_CONTROL_HANDSHAKE;
   }
   else
   {
      hb_retl( FALSE );
      return;
   }

   s_WinFcn = FCNSETCOMMSTATE;
   s_WinError = 0;
   if( ! SetCommState( hCommPort, &CurDCB ) )
   {
      s_WinError = GetLastError();
      hb_retl( FALSE );
   }
   else
      hb_retl( TRUE );
}

HB_FUNC( WINPORTXONXOFFFLOW )
{
   int Port = hb_parni( 1 );
   HANDLE hCommPort = s_PortData[ Port ].Port;
   DCB CurDCB;

   s_WinFcn = FCNGETCOMMSTATE;
   s_WinError = 0;
   CurDCB.DCBlength = sizeof( DCB );
   if( ! GetCommState( hCommPort, &CurDCB ) )
   {
      s_WinError = GetLastError();
      hb_retl( FALSE );
      return;
   }

   if( hb_parl( 2 ) )
   {
      CurDCB.fInX = 1;
      CurDCB.fOutX = 1;
   }
   else
   {
      CurDCB.fInX = 0;
      CurDCB.fOutX = 0;
   }

   s_WinFcn = FCNSETCOMMSTATE;
   s_WinError = 0;
   if( ! SetCommState( hCommPort, &CurDCB ) )
   {
      s_WinError = GetLastError();
      hb_retl( FALSE );
   }
   else
      hb_retl( TRUE );
}

HB_FUNC( WINPORTTIMEOUTS )
{
   long Tmp;

   if( ISNUM( 1 ) )
   {
      Tmp = s_ReadIntervalTimeout;
      s_ReadIntervalTimeout = hb_parnl( 1 );
      hb_stornl( Tmp, 1 );
   }
   else
      s_ReadIntervalTimeout = -1;

   if( ISNUM( 2 ) )
   {
      Tmp = s_ReadTotalTimeoutMultiplier;
      s_ReadTotalTimeoutMultiplier = hb_parnl( 2 );
      hb_stornl( Tmp, 2 );
   }
   else
      s_ReadTotalTimeoutMultiplier = -1;

   if( ISNUM( 3 ) )
   {
      Tmp = s_ReadTotalTimeoutConstant;
      s_ReadTotalTimeoutConstant = hb_parnl( 3 );
      hb_stornl( Tmp, 3 );
   }
   else
      s_ReadTotalTimeoutConstant = -1;

   if( ISNUM( 4 ) )
   {
      Tmp = s_WriteTotalTimeoutMultiplier;
      s_WriteTotalTimeoutMultiplier = hb_parnl( 4 );
      hb_stornl( Tmp, 4 );
   }
   else
      s_WriteTotalTimeoutMultiplier = -1;

   if( ISNUM( 5 ) )
   {
      Tmp = s_WriteTotalTimeoutConstant;
      s_WriteTotalTimeoutConstant = hb_parnl( 5 );
      hb_stornl( Tmp, 5 );
   }
   else
      s_WriteTotalTimeoutConstant = -1;
}

HB_FUNC( WINPORTBUFFERS )
{
   s_InQueue = hb_parnl( 1 );
   s_OutQueue = hb_parnl( 2 );
}

HB_FUNC( WINPORTERROR )
{
   hb_retnl( s_WinError );
   s_WinError = 0;       /* Note - reset */
}

HB_FUNC( WINPORTFCN )
{
   hb_retni( s_WinFcn );
}

HB_FUNC( FORMATMESSAGE )
{
   char Buffer[ 256 ] = "";
   DWORD Messageid = ISNUM( 1 ) ? ( DWORD ) hb_parnl( 1 ) : GetLastError();

   if( FormatMessage( FORMAT_MESSAGE_FROM_SYSTEM, NULL, Messageid, MAKELANGID( LANG_NEUTRAL, SUBLANG_DEFAULT ), /* Default language */
           ( LPTSTR ) Buffer, sizeof( Buffer ), NULL) == 0 )
   {
      snprintf( Buffer, sizeof( Buffer ), "FormatMessage() failed for message %ld.", Messageid );
   }

   hb_retc( Buffer );
}

HB_FUNC( WINPORTDEBUGDCB )
{
   int Port = hb_parni( 1 );
   int DebugLevel = ISNUM(2) ? hb_parni( 2 ) : WPDBGBASIC;
   HANDLE hCommPort = s_PortData[ Port ].Port;
   DCB CurDCB;
   COMMTIMEOUTS CurCOMMTIMEOUTS;
   COMMPROP CurCOMMPROP;
   char DebugString[ 1024 ] = "";
   char Buffer[ 80 ];

   s_WinFcn = FCNGETCOMMSTATE;
   s_WinError = 0;
   CurDCB.DCBlength = sizeof( DCB );
   if( GetCommState( hCommPort, &CurDCB ) )
   {
      if( DebugLevel & WPDBGBASIC )
      {
         snprintf( Buffer, sizeof( Buffer ), "Baud     : %lu\n", CurDCB.BaudRate ) ; hb_strncat( DebugString, Buffer, sizeof( DebugString ) - 1 );
         snprintf( Buffer, sizeof( Buffer ), "ByteSize : %i\n" , CurDCB.ByteSize ) ; hb_strncat( DebugString, Buffer, sizeof( DebugString ) - 1 );
         snprintf( Buffer, sizeof( Buffer ), "Parity   : %i\n" , CurDCB.Parity   ) ; hb_strncat( DebugString, Buffer, sizeof( DebugString ) - 1 );
         snprintf( Buffer, sizeof( Buffer ), "StopBits : %i\n" , CurDCB.StopBits ) ; hb_strncat( DebugString, Buffer, sizeof( DebugString ) - 1 );
      }
      if( DebugLevel & WPDBGFLOW )
      {
         hb_strncat( DebugString, "fRtsControl : ", sizeof( DebugString ) - 1 );
         hb_strncat( DebugString, CurDCB.fRtsControl == RTS_CONTROL_DISABLE ? "RTS_CONTROL_DISABLE\n" :
                                  CurDCB.fRtsControl == RTS_CONTROL_ENABLE ? "RTS_CONTROL_ENABLE\n" :
                                  CurDCB.fRtsControl == RTS_CONTROL_HANDSHAKE ? "RTS_CONTROL_HANDSHAKE\n" : "RTS_CONTROL_TOGGLE\n", sizeof( DebugString ) - 1 );
         hb_strncat( DebugString, "fOutxCtsFlow : ", sizeof( DebugString ) - 1 );
         hb_strncat( DebugString, CurDCB.fOutxCtsFlow ? "true\n" : "false\n", sizeof( DebugString ) - 1 );
         hb_strncat( DebugString, "fOutX : ", sizeof( DebugString ) - 1 );
         hb_strncat( DebugString, CurDCB.fOutX ? "true\n" : "false\n", sizeof( DebugString ) - 1 );
         hb_strncat( DebugString, "fInX : ", sizeof( DebugString ) - 1 );
         hb_strncat( DebugString, CurDCB.fInX ? "true\n" : "false\n", sizeof( DebugString ) - 1 );
         hb_strncat( DebugString, "fDtrControl : ", sizeof( DebugString ) - 1 );
         hb_strncat( DebugString, CurDCB.fDtrControl == DTR_CONTROL_DISABLE ? "DTR_CONTROL_DISABLE\n" :
                                  CurDCB.fDtrControl == DTR_CONTROL_ENABLE ? "DTR_CONTROL_ENABLE\n" : "DTR_CONTROL_HANDSHAKE\n", sizeof( DebugString ) - 1 );
         hb_strncat( DebugString, "fOutxDsrFlow : ", sizeof( DebugString ) - 1 );
         hb_strncat( DebugString, CurDCB.fOutxDsrFlow ? "true\n" : "false\n", sizeof( DebugString ) - 1 );
      }
      if( DebugLevel & WPDBGXTRAFLOW )
      {
         hb_strncat( DebugString, "fDsrSensitivity : ", sizeof( DebugString ) - 1 );
         hb_strncat( DebugString, CurDCB.fDsrSensitivity ? "true\n" : "false\n", sizeof( DebugString ) - 1 );
         hb_strncat( DebugString, "fTXContinueOnXoff : ", sizeof( DebugString ) - 1 );
         hb_strncat( DebugString, CurDCB.fTXContinueOnXoff ? "true\n" : "false\n", sizeof( DebugString ) - 1 );
         snprintf( Buffer, sizeof( Buffer ), "XonLim : %i\n"    , CurDCB.XonLim   ) ; hb_strncat( DebugString, Buffer, sizeof( DebugString ) - 1 );
         snprintf( Buffer, sizeof( Buffer ), "XoffLim : %i\n"   , CurDCB.XoffLim  ) ; hb_strncat( DebugString, Buffer, sizeof( DebugString ) - 1 );
         snprintf( Buffer, sizeof( Buffer ), "XonChar : 0x%i\n" , CurDCB.XonChar  ) ; hb_strncat( DebugString, Buffer, sizeof( DebugString ) - 1 );
         snprintf( Buffer, sizeof( Buffer ), "XoffChar : 0x%i\n", CurDCB.XoffChar ) ; hb_strncat( DebugString, Buffer, sizeof( DebugString ) - 1 );
      }
      if( DebugLevel & WPDBGOTHER )
      {
         hb_strncat(DebugString, "fBinary : ", sizeof( DebugString ) - 1 );
         hb_strncat(DebugString, CurDCB.fBinary ? "true\n" : "false\n", sizeof( DebugString ) - 1 );
         hb_strncat(DebugString, "fParity : ", sizeof( DebugString ) - 1 );
         hb_strncat(DebugString, CurDCB.fParity ? "true\n" : "false\n", sizeof( DebugString ) - 1 );
         hb_strncat(DebugString, "fErrorChar : ", sizeof( DebugString ) - 1 );
         hb_strncat(DebugString, CurDCB.fErrorChar ? "true\n" : "false\n", sizeof( DebugString ) - 1 );
         hb_strncat(DebugString, "fNull : ", sizeof( DebugString ) - 1 );
         hb_strncat(DebugString, CurDCB.fNull ? "true\n" : "false\n", sizeof( DebugString ) - 1 );
         hb_strncat(DebugString, "fAbortOnError : ", sizeof( DebugString ) - 1 );
         hb_strncat(DebugString, CurDCB.fAbortOnError ? "true\n" : "false\n", sizeof( DebugString ) - 1 );
         snprintf( Buffer, sizeof( Buffer ), "ErrorChar : 0x%i\n", CurDCB.ErrorChar ) ; hb_strncat( DebugString, Buffer, sizeof( DebugString ) - 1 );
         snprintf( Buffer, sizeof( Buffer ), "EofChar : 0x%i\n"  , CurDCB.EofChar   ) ; hb_strncat( DebugString, Buffer, sizeof( DebugString ) - 1 );
         snprintf( Buffer, sizeof( Buffer ), "EvtChar : 0x%i\n"  , CurDCB.EvtChar   ) ; hb_strncat( DebugString, Buffer, sizeof( DebugString ) - 1 );
      }
   }
   else
   {
      s_WinError = GetLastError();
      hb_retc_null();
      return;
   }

   if( DebugLevel & WPDBGTIMEOUTS )
   {
      s_WinFcn = FCNGETCOMMTIMEOUTS;
      s_WinError = 0;
      if( GetCommTimeouts( hCommPort, &CurCOMMTIMEOUTS ) )
      {
         snprintf( Buffer, sizeof( Buffer ), "ReadIntervalTimeout : %lu\n"        , CurCOMMTIMEOUTS.ReadIntervalTimeout         ) ; hb_strncat( DebugString, Buffer, sizeof( DebugString ) - 1 );
         snprintf( Buffer, sizeof( Buffer ), "ReadTotalTimeoutMultiplier : %ld\n" , CurCOMMTIMEOUTS.ReadTotalTimeoutMultiplier  ) ; hb_strncat( DebugString, Buffer, sizeof( DebugString ) - 1 );
         snprintf( Buffer, sizeof( Buffer ), "ReadTotalTimeoutConstant : %ld\n"   , CurCOMMTIMEOUTS.ReadTotalTimeoutConstant    ) ; hb_strncat( DebugString, Buffer, sizeof( DebugString ) - 1 );
         snprintf( Buffer, sizeof( Buffer ), "WriteTotalTimeoutMultiplier : %ld\n", CurCOMMTIMEOUTS.WriteTotalTimeoutMultiplier ) ; hb_strncat( DebugString, Buffer, sizeof( DebugString ) - 1 );
         snprintf( Buffer, sizeof( Buffer ), "WriteTotalTimeoutConstant : %ld\n"  , CurCOMMTIMEOUTS.WriteTotalTimeoutConstant   ) ; hb_strncat( DebugString, Buffer, sizeof( DebugString ) - 1 );
      }
      else
      {
         s_WinError = GetLastError();
         hb_retc_null();
         return;
      }
   }

   if( DebugLevel & WPDBGQUEUE )
   {
      s_WinFcn = FCNGETCOMMPROPERTIES;
      s_WinError = 0;
      if( GetCommProperties( hCommPort, &CurCOMMPROP ) )
      {
         snprintf( Buffer, sizeof( Buffer ), "dwCurrentTxQueue : %lu\n", CurCOMMPROP.dwCurrentTxQueue ) ; hb_strncat( DebugString, Buffer, sizeof( DebugString ) - 1 );
         snprintf( Buffer, sizeof( Buffer ), "dwCurrentRxQueue : %lu\n", CurCOMMPROP.dwCurrentRxQueue ) ; hb_strncat( DebugString, Buffer, sizeof( DebugString ) - 1 );
      }
      else
      {
         s_WinError = GetLastError();
         hb_retc_null();
         return;
      }
   }

   hb_retc( DebugString );
}

static HKEY hb_regkeyconv( ULONG nKey )
{
   switch( nKey )
   {
   case 1:
      return ( HKEY ) HKEY_CLASSES_ROOT;
   case 2:
      return ( HKEY ) HKEY_CURRENT_USER;
   case 3:
      return ( HKEY ) HKEY_CURRENT_CONFIG;
   case 0:
   case 4:
      return ( HKEY ) HKEY_LOCAL_MACHINE;
   case 5:
      return ( HKEY ) HKEY_USERS;
   }
  
   return ( HKEY ) nKey;
}

HB_FUNC( WIN32_REGCREATEKEYEX )
{
   HKEY hWnd = ( HKEY ) hb_parnl( 8 );
   ULONG nResult = hb_parnl( 9 );
   LPTSTR lpText = HB_TCHAR_CONVTO( hb_parc( 2 ) );

   if( RegCreateKeyEx( hb_regkeyconv( hb_parnl( 1 ) ),
                       lpText,
                       0,
                       NULL,
                       hb_parnl( 5 ),
                       hb_parnl( 6 ),
                       NULL,
                       &hWnd,
                       &nResult ) == ERROR_SUCCESS )
   {
      hb_stornl( ( ULONG ) hWnd, 8 );
      hb_stornl( nResult, 9 );

      hb_retnl( ERROR_SUCCESS );
   }
   else
      hb_retnl( -1 );

   HB_TCHAR_FREE( lpText );
}

HB_FUNC( WIN32_REGOPENKEYEX )
{
   HKEY hWnd;
   LPTSTR lpText = HB_TCHAR_CONVTO( hb_parc( 2 ) );
   
   if( RegOpenKeyEx( hb_regkeyconv( hb_parnl( 1 ) ),
                     lpText,
                     0,
                     hb_parnl( 4 ),
                     &hWnd ) == ERROR_SUCCESS )
   {
      hb_stornl( ( ULONG ) hWnd, 5 );
      hb_retnl( ERROR_SUCCESS );
   }
   else
      hb_retnl( -1 );

   HB_TCHAR_FREE( lpText );
}

HB_FUNC( WIN32_REGQUERYVALUEEX )
{
   DWORD nType = 0;
   DWORD nSize = 0;
   LPTSTR lpKey = HB_TCHAR_CONVTO( hb_parc( 2 ) );

   if( RegQueryValueEx( hb_regkeyconv( hb_parnl( 1 ) ),
                        lpKey,
                        NULL,
                        &nType,
                        NULL,
                        &nSize ) == ERROR_SUCCESS )
   {
      if( nSize > 0 )
      {
         BYTE * cValue = ( BYTE * ) hb_xgrab( nSize + 1 );

         RegQueryValueEx( hb_regkeyconv( hb_parnl( 1 ) ),
                          lpKey,
                          NULL,
                          &nType,
                          ( BYTE * ) cValue,
                          &nSize );

         hb_stornl( nType, 4 );

         if( ! hb_storclen_buffer( ( char * ) cValue, nSize, 5 ) )
            hb_xfree( cValue );
      }
   }
   HB_TCHAR_FREE( lpKey );
  
   hb_retnl( nSize );
}

HB_FUNC( WIN32_REGSETVALUEEX )
{
   DWORD nType = hb_parnl( 4 );
   LPTSTR lpKey = HB_TCHAR_CONVTO( hb_parc( 2 ) );

   if( nType != REG_DWORD )
   {
      BYTE * cValue = ( BYTE * ) hb_parc( 5 );
      hb_retni( RegSetValueEx( hb_regkeyconv( hb_parnl( 1 ) ),
                               lpKey,
                               0,
                               nType,
                               ( BYTE * ) cValue,
                               hb_parclen( 5 ) + 1 ) );
   }
   else
   {
      DWORD nSpace = hb_parnl( 5 );
      hb_retni( RegSetValueEx( hb_regkeyconv( hb_parnl( 1 ) ),
                               lpKey,
                               0,
                               nType,
                               ( BYTE * ) &nSpace,
                               sizeof( REG_DWORD ) ) );
   }

   HB_TCHAR_FREE( lpKey );
}

HB_FUNC( WIN32_REGCLOSEKEY )
{
   hb_retnl( RegCloseKey( ( HKEY ) hb_parnl( 1 ) ) );
}

FUNCTION OS_NETREGOK( lSetIt, lDoVista )
   LOCAL rVal := .T.
   LOCAL cKeySrv
   LOCAL cKeyWks

   DEFAULT lSetIt TO .F.
   DEFAULT lDoVista TO .T.

   IF !lDoVista .AND. OS_ISWINVISTA()
      *
   ELSEIF OS_ISWIN9X()
      rVal := QueryRegistry( HKEY_LOCAL_MACHINE, "System\CurrentControlSet\Services\VxD\VREDIR", "DiscardCacheOnOpen", 1, lSetIt )
   ELSE
      cKeySrv := "System\CurrentControlSet\Services\LanmanServer\Parameters"
      cKeyWks := "System\CurrentControlSet\Services\LanmanWorkStation\Parameters"
     
      /* Server settings */
      rVal := rVal .AND. QueryRegistry( HKEY_LOCAL_MACHINE, cKeySrv, "CachedOpenLimit", 0, lSetIt )
      rVal := rVal .AND. QueryRegistry( HKEY_LOCAL_MACHINE, cKeySrv, "EnableOpLocks", 0, lSetIt ) /* Q124916 */
      rVal := rVal .AND. QueryRegistry( HKEY_LOCAL_MACHINE, cKeySrv, "EnableOpLockForceClose", 1, lSetIt )
      rVal := rVal .AND. QueryRegistry( HKEY_LOCAL_MACHINE, cKeySrv, "SharingViolationDelay", 0, lSetIt )
      rVal := rVal .AND. QueryRegistry( HKEY_LOCAL_MACHINE, cKeySrv, "SharingViolationRetries", 0, lSetIt )
     
      /* Workstation settings */
      rVal := rVal .AND. QueryRegistry( HKEY_LOCAL_MACHINE, cKeyWks, "UseOpportunisticLocking", 0, lSetIt )
      rVal := rVal .AND. QueryRegistry( HKEY_LOCAL_MACHINE, cKeyWks, "EnableOpLocks", 0, lSetIt )
      rVal := rVal .AND. QueryRegistry( HKEY_LOCAL_MACHINE, cKeyWks, "EnableOpLockForceClose", 1, lSetIt )
      rVal := rVal .AND. QueryRegistry( HKEY_LOCAL_MACHINE, cKeyWks, "UtilizeNtCaching", 0, lSetIt )
      rVal := rVal .AND. QueryRegistry( HKEY_LOCAL_MACHINE, cKeyWks, "UseLockReadUnlock", 0, lSetIt )
     
      IF OS_ISWIN2000_OR_LATER()
         rVal := rVal .AND. QueryRegistry( HKEY_LOCAL_MACHINE, "System\CurrentControlSet\Services\MRXSmb\Parameters", "OpLocksDisabled", 1, lSetIt )
      ENDIF
   ENDIF

   RETURN rVal

FUNCTION OS_NETVREDIROK( nResult )
   LOCAL cWinDir
   LOCAL cFile
   LOCAL a

   nResult := 0

   IF OS_ISWIN9X()
      cWinDir := GETENV( "WINDIR" )  /* Get the folder that Windows is installed in */
      IF EMPTY( cWinDir )
         cWinDir := "C:\WINDOWS"
      ENDIF
      cFile := cWinDir + "\SYSTEM\VREDIR.VXD"
      a := DIRECTORY( cFile )  /* Check for faulty files. */
      IF !EMPTY( a )
         IF a[ 1, F_SIZE ] == 156749 .AND. a[ 1, F_TIME ] == "11:11:10"
            nResult := 1111
         ELSEIF a[ 1, F_SIZE ] == 140343 .AND. a[ 1, F_TIME ] == "09:50:00"
            nResult := 950
         ENDIF
      ENDIF
   ENDIF
  
   RETURN EMPTY( nResult )

PROCEDURE w32_regPathSplit( cRegPath, nHKEY, cKey, cEntry )
   LOCAL cHKEY
   LOCAL tmp

   nHKEY := HKEY_CURRENT_USER
   cKey := ""
   cEntry := ""

   tmp := At( "\", cRegPath )
   IF tmp > 0
      cHKEY := Left( cRegPath, tmp - 1 )
      cRegPath := SubStr( cRegPath, tmp + 1 )

      tmp := RAt( "\", cRegPath )
      IF tmp > 0
         cKey := Left( cRegPath, tmp - 1 )
         cEntry := SubStr( cRegPath, tmp + 1 )
      ELSE
         cEntry := cRegPath
      ENDIF

      /* Len(  ) is optimized to a number by Harbour at compile time. */
      DO CASE
      CASE Left( cHKEY, Len( "HKCU"                  ) ) == "HKCU"                  ; nHKEY := HKEY_CURRENT_USER
      CASE Left( cHKEY, Len( "HKLM"                  ) ) == "HKLM"                  ; nHKEY := HKEY_LOCAL_MACHINE
      CASE Left( cHKEY, Len( "HKCR"                  ) ) == "HKCR"                  ; nHKEY := HKEY_CLASSES_ROOT
      CASE Left( cHKEY, Len( "HKU"                   ) ) == "HKU"                   ; nHKEY := HKEY_USERS
      CASE Left( cHKEY, Len( "HKPD"                  ) ) == "HKPD"                  ; nHKEY := HKEY_PERFORMANCE_DATA
      CASE Left( cHKEY, Len( "HKCC"                  ) ) == "HKCC"                  ; nHKEY := HKEY_CURRENT_CONFIG
      CASE Left( cHKEY, Len( "HKDD"                  ) ) == "HKDD"                  ; nHKEY := HKEY_DYN_DATA
      CASE Left( cHKEY, Len( "HKEY_CURRENT_USER"     ) ) == "HKEY_CURRENT_USER"     ; nHKEY := HKEY_CURRENT_USER
      CASE Left( cHKEY, Len( "HKEY_LOCAL_MACHINE"    ) ) == "HKEY_LOCAL_MACHINE"    ; nHKEY := HKEY_LOCAL_MACHINE
      CASE Left( cHKEY, Len( "HKEY_CLASSES_ROOT"     ) ) == "HKEY_CLASSES_ROOT"     ; nHKEY := HKEY_CLASSES_ROOT
      CASE Left( cHKEY, Len( "HKEY_USERS"            ) ) == "HKEY_USERS"            ; nHKEY := HKEY_USERS
      CASE Left( cHKEY, Len( "HKEY_PERFORMANCE_DATA" ) ) == "HKEY_PERFORMANCE_DATA" ; nHKEY := HKEY_PERFORMANCE_DATA
      CASE Left( cHKEY, Len( "HKEY_CURRENT_CONFIG"   ) ) == "HKEY_CURRENT_CONFIG"   ; nHKEY := HKEY_CURRENT_CONFIG
      CASE Left( cHKEY, Len( "HKEY_DYN_DATA"         ) ) == "HKEY_DYN_DATA"         ; nHKEY := HKEY_DYN_DATA
      ENDCASE
   ENDIF

   RETURN

FUNCTION w32_regRead( cRegPath )
   LOCAL nHKEY, cKey, cEntry

   w32_regPathSplit( cRegPath, @nHKEY, @cKey, @cEntry )

   RETURN GetRegistry( nHKEY, cKey, cEntry )

FUNCTION w32_regWrite( cRegPath, xValue )
   LOCAL nHKEY, cKey, cEntry

   w32_regPathSplit( cRegPath, @nHKEY, @cKey, @cEntry )

   RETURN SetRegistry( nHKEY, cKey, cEntry, xValue )

FUNCTION QueryRegistry( nHKEYHandle, cKeyName, cEntryName, xValue, lSetIt )
   LOCAL xKey := GetRegistry( nHKEYHandle, cKeyName, cEntryName )

   LOCAL cValType := VALTYPE( xValue )
   LOCAL rVal

   DEFAULT lSetIT TO .F.

   IF cValType == "L"
      xValue := IIF( xValue, 1, 0 )
      cValType := VALTYPE( xValue )
   ELSEIF cValType == "D"
      xValue := DTOS( xValue )
      cValType := VALTYPE( xValue )
   ENDIF

   rVal := ( xKey != NIL .AND. xValue != NIL .AND. cValType == VALTYPE( xKey ) .AND. xValue == xKey )
   IF ! rVal .AND. lSetIt
      rVal := SetRegistry( nHKEYHandle, cKeyName, cEntryName, xValue )
   ENDIF

   RETURN rVal

FUNCTION GetRegistry( nHKEYHandle, cKeyName, cEntryName )
   LOCAL xRetVal := NIL
   LOCAL nKeyHandle := 0
   LOCAL nValueType

   DEFAULT nHKeyHandle TO 0

   IF win32_RegOpenKeyEx( nHKEYHandle, cKeyName, 0, KEY_QUERY_VALUE, @nKeyHandle ) == ERROR_SUCCESS

      nValueType := 0
      /* retrieve the length of the value */
      IF win32_RegQueryValueEx( nKeyHandle, cEntryName, 0, @nValueType, @xRetVal ) > 0

         IF nValueType == REG_DWORD .OR. ;
            nValueType == REG_DWORD_LITTLE_ENDIAN .OR. ;
            nValueType == REG_DWORD_BIG_ENDIAN .OR. ;
            nValueType == REG_BINARY
            xRetVal := BIN2U( xRetVal )
         ELSE
            xRetVal := STRTRAN( xRetVal, CHR( 0 ) )
         ENDIF
      ENDIF

      win32_RegCloseKey( nKeyHandle )
   ENDIF

   RETURN xRetVal

FUNCTION SetRegistry( nHKEYHandle, cKeyName, cEntryName, xValue )
   LOCAL cName
   LOCAL nValueType
   LOCAL rVal := .F.
   LOCAL cType
   LOCAL nKeyHandle := 0
   LOCAL nResult := 1

   DEFAULT nHKeyHandle TO 0

   IF win32_RegCreateKeyEx( nHKEYHandle, cKeyName, 0, 0, 0, KEY_SET_VALUE, 0, @nKeyHandle, @nResult ) == ERROR_SUCCESS

      /* no support for Arrays, Codeblock ... */
      cType := VALTYPE( xValue )

      DO CASE
      CASE cType == "L"
         nValueType := REG_DWORD
         cName := IIF( xValue, 1, 0 )
      CASE cType == "D"
         nValueType := REG_SZ
         cName := DTOS( xValue )
      CASE cType == "N"
         nValueType := REG_DWORD
         cName := xValue
      CASE cType $ "CM"
         nValueType := REG_SZ
         cName := xValue
      ENDCASE

      IF cName != NIL
         rVal := ( win32_RegSetValueEx( nKeyHandle, cEntryName, 0, nValueType, cName ) == ERROR_SUCCESS )
      ENDIF

      win32_RegCloseKey( nKeyHandle )
   ENDIF

   RETURN rVal

  FUNCTION CreateObject()
     RETURN NIL

  FUNCTION GetActiveObject()
     RETURN NIL
#else

#define HB_CLS_NOTOBJECT

#include "common.ch"
#include "hbclass.ch"
#include "error.ch"

#ifndef __XHARBOUR__

#define EG_OLEEXCEPTION 1001

#xcommand TRY              => BEGIN SEQUENCE WITH s_bBreak
#xcommand CATCH [] => RECOVER [USING ] <-oErr->
#xcommand FINALLY          => ALWAYS

THREAD STATIC s_bBreak := { |oErr| break( oErr ) }

STATIC PROCEDURE THROW( oError )
   LOCAL lError := Eval( ErrorBlock(), oError )
   IF !HB_ISLOGICAL( lError ) .OR. lError
      __ErrInHandler()
   ENDIF
   Break( oError )
RETURN

FUNCTION CreateObject( cString, cLicense )

RETURN TOleAuto():New( cString, , cLicense )

FUNCTION GetActiveObject( cString )

RETURN TOleAuto():GetActiveObject( cString )

INIT PROCEDURE HB_OleInit()

   /* It's important to store value returned by __HB_OLE_INIT() in
    * STATIC variable. When HVM will clear STATICs on HVM exit
    * then it will execute destructor bound with this variable which
    * calls OleUninitialize() - such method causes that OleUninitialize()
    * will be called very lately after all user EXIT functions, ALWAYS
    * blocks and .prg object destructors which may also use OLE.
    */
   static s_ole

   s_ole := __HB_OLE_INIT()

RETURN

CLASS VTWrapper
   DATA vt
   DATA Value

   METHOD New( vt, xVal ) CONSTRUCTOR
ENDCLASS

METHOD New( vt, xVal ) CLASS VTWrapper

   ::vt := vt
   ::Value := xVal

   //TraceLog( vt, ::vt, xVal, ::Value )

RETURN Self

CLASS VTArrayWrapper FROM VTWrapper

   METHOD AsArray( nIndex, xValue ) OPERATOR "[]"
   METHOD __enumStart( enum, lDescend )

ENDCLASS

METHOD AsArray( nIndex, xValue ) CLASS VTArrayWrapper

RETURN IIF( PCount() == 1, ::Value[nIndex], ::Value[nIndex] := xValue )

METHOD __enumStart( enum, lDescend ) CLASS VTarrayWrapper

   HB_SYMBOL_UNUSED( lDescend )

   /* set base value for enumerator */
   (@enum):__enumBase( ::Value )

RETURN !Empty( ::Value )

CLASS TOleAuto

   DATA hObj
   DATA cClassName
   DATA pOleEnumerator

   METHOD New( uObj, cClass, cLicense ) CONSTRUCTOR
   METHOD GetActiveObject( cClass ) CONSTRUCTOR

   METHOD Invoke()
   MESSAGE CallMethod  METHOD Invoke()

   METHOD Set()
   MESSAGE SetProperty METHOD Set()

   METHOD Get()
   MESSAGE GetProperty METHOD Get()

   METHOD OleValue()
   METHOD _OleValue( xSetValue )

   METHOD OleNewEnumerator()

   METHOD OleCollection( xIndex, xValue ) OPERATOR "[]"

   METHOD OleValuePlus( xArg )            OPERATOR "+"
   METHOD OleValueMinus( xArg )           OPERATOR "-"
   METHOD OleValueMultiply( xArg )        OPERATOR "*"
   METHOD OleValueDivide( xArg )          OPERATOR "/"
   METHOD OleValueModulus( xArg )         OPERATOR "%"
   METHOD OleValueInc()                   OPERATOR "++"
   METHOD OleValueDec()                   OPERATOR "--"
   METHOD OleValuePower( xArg )           OPERATOR "^"

   METHOD OleValueEqual( xArg )           OPERATOR "="
   METHOD OleValueExactEqual( xArg )      OPERATOR "=="
   METHOD OleValueNotEqual( xArg )        OPERATOR "!="

   METHOD __enumStart( enum, lDescend )
   METHOD __enumSkip( enum, lDescend )
   METHOD __enumStop()

   ERROR HANDLER OnError()

   DESTRUCTOR Release()

   METHOD ForceSymbols() INLINE ::cClassName()

ENDCLASS

METHOD New( uObj, cClass, cLicense ) CLASS TOleAuto

   LOCAL oErr

   // Hack in case OLE Server already created and New() is attempted as an OLE Method.
   IF ::hObj != NIL
      RETURN HB_ExecFromArray( Self, "_New", HB_aParams() )
   ENDIF
   
   IF ValType( uObj ) == 'C'
      ::hObj := CreateOleObject( uObj, , cLicense )

      IF OleError() != 0
         IF Ole2TxtError() == "DISP_E_EXCEPTION"
            oErr := ErrorNew()
            oErr:Args          := HB_aParams()
            oErr:CanDefault    := .F.
            oErr:CanRetry      := .F.
            oErr:CanSubstitute := .T.
            oErr:Description   := OLEExceptionDescription()
            oErr:GenCode       := EG_OLEEXCEPTION
            oErr:Operation     := ProcName()
            oErr:Severity      := ES_ERROR
            oErr:SubCode       := -1
            oErr:SubSystem     := OLEExceptionSource()

            RETURN Throw( oErr )
         ELSE
            oErr := ErrorNew()
            oErr:Args          := HB_aParams()
            oErr:CanDefault    := .F.
            oErr:CanRetry      := .F.
            oErr:CanSubstitute := .T.
            oErr:Description   := Ole2TxtError()
            oErr:GenCode       := EG_OLEEXCEPTION
            oErr:Operation     := ProcName()
            oErr:Severity      := ES_ERROR
            oErr:SubCode       := -1
            oErr:SubSystem     := "TOleAuto"

            RETURN Throw( oErr )
         ENDIF
      ENDIF

      ::cClassName := uObj
   ELSEIF ValType( uObj ) == 'N'
      OleAddRef( uObj )
      ::hObj := uObj

      IF ValType( cClass ) == 'C'
         ::cClassName := cClass
      ELSE
         ::cClassName := LTrim( Str( uObj ) )
      ENDIF
   ELSE
      oErr := ErrorNew()
      oErr:Args          := HB_aParams()
      oErr:CanDefault    := .F.
      oErr:CanRetry      := .F.
      oErr:CanSubstitute := .T.
      oErr:Description   := "Invalid argument to contructor!"
      oErr:GenCode       := 0
      oErr:Operation     := ProcName()
      oErr:Severity      := ES_ERROR
      oErr:SubCode       := -1
      oErr:SubSystem     := "TOleAuto"

      RETURN Throw( oErr )
   ENDIF

RETURN Self

PROCEDURE Release() CLASS TOleAuto

   //TraceLog( ::cClassName, ::hObj )

   IF ! Empty( ::hObj )
      //TraceLog( ::cClassName, ::hObj )
      OleReleaseObject( ::hObj )
      //::hObj := NIL
   ENDIF

RETURN

METHOD GetActiveObject( cClass ) CLASS TOleAuto

   LOCAL oErr

   IF ValType( cClass ) == 'C'
      ::hObj := GetOleObject( cClass )

      IF OleError() != 0
         IF Ole2TxtError() == "DISP_E_EXCEPTION"
            oErr := ErrorNew()
            oErr:Args          := { cClass }
            oErr:CanDefault    := .F.
            oErr:CanRetry      := .F.
            oErr:CanSubstitute := .T.
            oErr:Description   := OLEExceptionDescription()
            oErr:GenCode       := EG_OLEEXCEPTION
            oErr:Operation     := ProcName()
            oErr:Severity      := ES_ERROR
            oErr:SubCode       := -1
            oErr:SubSystem     := OLEExceptionSource()

            RETURN Throw( oErr )
         ELSE
            oErr := ErrorNew()
            oErr:Args          := { cClass }
            oErr:CanDefault    := .F.
            oErr:CanRetry      := .F.
            oErr:CanSubstitute := .T.
            oErr:Description   := Ole2TxtError()
            oErr:GenCode       := EG_OLEEXCEPTION
            oErr:Operation     := ProcName()
            oErr:Severity      := ES_ERROR
            oErr:SubCode       := -1
            oErr:SubSystem     := "TOleAuto"

            RETURN Throw( oErr )
         ENDIF
      ENDIF

      ::cClassName := cClass
   ELSE
      Alert( "OLE interface: Invalid parameter type to constructor TOleAuto():GetActiveObject()" )
      ::hObj := 0
   ENDIF

RETURN Self

METHOD OleCollection( xIndex, xValue ) CLASS TOleAuto

   LOCAL xRet

   //TraceLog( PCount(), xIndex, xValue )

   IF PCount() == 1
      RETURN ::Item( xIndex )
   ENDIF

   IF ValType( xIndex ) == 'N' .AND. xIndex < 0
      xIndex += ( ::Count + 1 )
   ENDIF

   TRY
      // ASP Collection syntax.
      xRet := ::_Item( xIndex, xValue )
   CATCH
      xRet := ::SetItem( xIndex, xValue )
   END

RETURN xRet

METHOD OleValuePlus( xArg ) CLASS TOleAuto

   LOCAL xRet, oErr

   TRY
      xRet := ::OleValue + xArg
   CATCH
      oErr := ErrorNew()
      oErr:Args          := { Self, xArg }
      oErr:CanDefault    := .F.
      oErr:CanRetry      := .F.
      oErr:CanSubstitute := .T.
      oErr:Description   := "argument error"
      oErr:GenCode       := EG_ARG
      oErr:Operation     := '+'
      oErr:Severity      := ES_ERROR
      oErr:SubCode       := 1081
      oErr:SubSystem     := "BASE"

      RETURN Throw( oErr )
   END

RETURN xRet

METHOD OleValueMinus( xArg ) CLASS TOleAuto

   LOCAL xRet, oErr

   TRY
      xRet := ::OleValue - xArg
   CATCH
      oErr := ErrorNew()
      oErr:Args          := { Self, xArg }
      oErr:CanDefault    := .F.
      oErr:CanRetry      := .F.
      oErr:CanSubstitute := .T.
      oErr:Description   := "argument error"
      oErr:GenCode       := EG_ARG
      oErr:Operation     := '+'
      oErr:Severity      := ES_ERROR
      oErr:SubCode       := 1082
      oErr:SubSystem     := "BASE"

      RETURN Throw( oErr )
   END

RETURN xRet

METHOD OleValueMultiply( xArg ) CLASS TOleAuto

   LOCAL xRet, oErr

   TRY
      xRet := ::OleValue * xArg
   CATCH
      oErr := ErrorNew()
      oErr:Args          := { Self, xArg }
      oErr:CanDefault    := .F.
      oErr:CanRetry      := .F.
      oErr:CanSubstitute := .T.
      oErr:Description   := "argument error"
      oErr:GenCode       := EG_ARG
      oErr:Operation     := '*'
      oErr:Severity      := ES_ERROR
      oErr:SubCode       := 1083
      oErr:SubSystem     := "BASE"

      RETURN Throw( oErr )
   END

RETURN xRet

METHOD OleValueDivide( xArg ) CLASS TOleAuto

   LOCAL xRet, oErr

   TRY
      xRet := ::OleValue / xArg
   CATCH
      oErr := ErrorNew()
      oErr:Args          := { Self, xArg }
      oErr:CanDefault    := .F.
      oErr:CanRetry      := .F.
      oErr:CanSubstitute := .T.
      oErr:Description   := "argument error"
      oErr:GenCode       := EG_ARG
      oErr:Operation     := '/'
      oErr:Severity      := ES_ERROR
      oErr:SubCode       := 1084
      oErr:SubSystem     := "BASE"

      RETURN Throw( oErr )
   END

RETURN xRet

METHOD OleValueModulus( xArg ) CLASS TOleAuto

   LOCAL xRet, oErr

   TRY
      xRet := ::OleValue % xArg
   CATCH
      oErr := ErrorNew()
      oErr:Args          := { Self, xArg }
      oErr:CanDefault    := .F.
      oErr:CanRetry      := .F.
      oErr:CanSubstitute := .T.
      oErr:Description   := "argument error"
      oErr:GenCode       := EG_ARG
      oErr:Operation     := '%'
      oErr:Severity      := ES_ERROR
      oErr:SubCode       := 1085
      oErr:SubSystem     := "BASE"

      RETURN Throw( oErr )
   END

RETURN xRet

METHOD OleValueInc() CLASS TOleAuto

   LOCAL oErr

   TRY
      ++::OleValue
   CATCH
      oErr := ErrorNew()
      oErr:Args          := { Self }
      oErr:CanDefault    := .F.
      oErr:CanRetry      := .F.
      oErr:CanSubstitute := .T.
      oErr:Description   := "argument error"
      oErr:GenCode       := EG_ARG
      oErr:Operation     := '++'
      oErr:Severity      := ES_ERROR
      oErr:SubCode       := 1086
      oErr:SubSystem     := "BASE"

      RETURN Throw( oErr )
   END

RETURN Self

METHOD OleValueDec() CLASS TOleAuto

   LOCAL oErr

   TRY
      --::OleValue
   CATCH
      oErr := ErrorNew()
      oErr:Args          := { Self }
      oErr:CanDefault    := .F.
      oErr:CanRetry      := .F.
      oErr:CanSubstitute := .T.
      oErr:Description   := "argument error"
      oErr:GenCode       := EG_ARG
      oErr:Operation     := '--'
      oErr:Severity      := ES_ERROR
      oErr:SubCode       := 1087
      oErr:SubSystem     := "BASE"

      RETURN Throw( oErr )
   END

RETURN Self

METHOD OleValuePower( xArg ) CLASS TOleAuto

   LOCAL xRet, oErr

   TRY
      xRet := ::OleValue ^ xArg
   CATCH
      oErr := ErrorNew()
      oErr:Args          := { Self, xArg }
      oErr:CanDefault    := .F.
      oErr:CanRetry      := .F.
      oErr:CanSubstitute := .T.
      oErr:Description   := "argument error"
      oErr:GenCode       := EG_ARG
      oErr:Operation     := '^'
      oErr:Severity      := ES_ERROR
      oErr:SubCode       := 1088
      oErr:SubSystem     := "BASE"

      RETURN Throw( oErr )
   END

RETURN xRet

METHOD OleValueEqual( xArg ) CLASS TOleAuto

   LOCAL xRet, oErr

   TRY
      xRet := ( ::OleValue = xArg ) /* NOTE: Intentionally using '=' operator. */
   CATCH
      oErr := ErrorNew()
      oErr:Args          := { Self, xArg }
      oErr:CanDefault    := .F.
      oErr:CanRetry      := .F.
      oErr:CanSubstitute := .T.
      oErr:Description   := "argument error"
      oErr:GenCode       := EG_ARG
      oErr:Operation     := '='
      oErr:Severity      := ES_ERROR
      oErr:SubCode       := 1085
      oErr:SubSystem     := "BASE"

      RETURN Throw( oErr )
   END

RETURN xRet

METHOD OleValueExactEqual( xArg ) CLASS TOleAuto

   LOCAL xRet, oErr

   TRY
      xRet := ( ::OleValue == xArg )
   CATCH
      oErr := ErrorNew()
      oErr:Args          := { Self, xArg }
      oErr:CanDefault    := .F.
      oErr:CanRetry      := .F.
      oErr:CanSubstitute := .T.
      oErr:Description   := "argument error"
      oErr:GenCode       := EG_ARG
      oErr:Operation     := '=='
      oErr:Severity      := ES_ERROR
      oErr:SubCode       := 1085
      oErr:SubSystem     := "BASE"

      RETURN Throw( oErr )
   END

RETURN xRet

METHOD OleValueNotEqual( xArg ) CLASS TOleAuto

   LOCAL xRet, oErr

   TRY
      xRet := ::OleValue != xArg
   CATCH
      oErr := ErrorNew()
      oErr:Args          := { Self, xArg }
      oErr:CanDefault    := .F.
      oErr:CanRetry      := .F.
      oErr:CanSubstitute := .T.
      oErr:Description   := "argument error"
      oErr:GenCode       := EG_ARG
      oErr:Operation     := '!='
      oErr:Severity      := ES_ERROR
      oErr:SubCode       := 1085
      oErr:SubSystem     := "BASE"

      RETURN Throw( oErr )
   END

RETURN xRet

METHOD __enumStart( enum, lDescend ) CLASS TOleAuto

   /* TODO: add support for descend order */
   ::pOleEnumerator := ::OleNewEnumerator()

RETURN ::__enumSkip( @enum, lDescend )

METHOD __enumSkip( enum, lDescend ) CLASS TOleAuto

   LOCAL lContinue, xValue

   /* TODO: add support for descend order */
   HB_SYMBOL_UNUSED( lDescend )

   xValue := __OLEENUMNEXT( ::pOleEnumerator, @lContinue )

   /* set enumerator value */
   (@enum):__enumValue( xValue )

RETURN lContinue

METHOD PROCEDURE __enumStop() CLASS TOleAuto

   __OLEENUMSTOP( ::pOleEnumerator )
   ::pOleEnumerator := NIL

RETURN

PROCEDURE OleShowException()

   Alert( OleExceptionSource() + ": " + OleExceptionDescription() )

   RETURN

   Function Win32Prn()
   Return nil

#else

#include "hbclass.ch"
#include "common.ch"

// Cut from wingdi.h

#define MM_TEXT             1
#define MM_LOMETRIC         2
#define MM_HIMETRIC         3
#define MM_LOENGLISH        4
#define MM_HIENGLISH        5

// Device Parameters for GetDeviceCaps()

#define HORZSIZE      4     // Horizontal size in millimeters
#define VERTSIZE      6     // Vertical size in millimeters
#define HORZRES       8     // Horizontal width in pixels
#define VERTRES       10    // Vertical height in pixels
#define NUMBRUSHES    16    // Number of brushes the device has
#define NUMPENS       18    // Number of pens the device has
#define NUMFONTS      22    // Number of fonts the device has
#define NUMCOLORS     24    // Number of colors the device supports
#define RASTERCAPS    38    // Bitblt capabilities

#define LOGPIXELSX    88    // Logical pixels/inch in X
#define LOGPIXELSY    90    // Logical pixels/inch in Y

#define PHYSICALWIDTH   110 // Physical Width in device units
#define PHYSICALHEIGHT  111 // Physical Height in device units
#define PHYSICALOFFSETX 112 // Physical Printable Area x margin
#define PHYSICALOFFSETY 113 // Physical Printable Area y margin
#define SCALINGFACTORX  114 // Scaling factor x
#define SCALINGFACTORY  115 // Scaling factor y

/* bin selections */
#define DMBIN_FIRST         DMBIN_UPPER
#define DMBIN_UPPER         1
#define DMBIN_ONLYONE       1
#define DMBIN_LOWER         2
#define DMBIN_MIDDLE        3
#define DMBIN_MANUAL        4
#define DMBIN_ENVELOPE      5
#define DMBIN_ENVMANUAL     6
#define DMBIN_AUTO          7
#define DMBIN_TRACTOR       8
#define DMBIN_SMALLFMT      9
#define DMBIN_LARGEFMT      10
#define DMBIN_LARGECAPACITY 11
#define DMBIN_CASSETTE      14
#define DMBIN_FORMSOURCE    15
#define DMBIN_LAST          DMBIN_FORMSOURCE

CLASS WIN32PRN

  METHOD New(cPrinter)
  METHOD Create()                // CreatesDC and sets "Courier New" font, set Orientation, Copies, Bin#
                                 // Create() ( & StartDoc() ) must be called before printing can start.
  METHOD Destroy()               // Calls EndDoc() - restores default font, Deletes DC.
                                 // Destroy() must be called to avoid memory leaks
  METHOD StartDoc(cDocame)       // Calls StartPage()
  METHOD EndDoc(lAbortDoc)       // Calls EndPage() if lAbortDoc not .T.
  METHOD StartPage()
  METHOD EndPage(lStartNewPage)      // If lStartNewPage == .T. then StartPage() is called for the next page of output
  METHOD NewLine()
  METHOD NewPage()
  METHOD SetFont(cFontName, nPointSize, nWidth, nBold, lUnderline, lItalic, nCharSet)
                                                                // NB: nWidth is in "CharactersPerInch"
                                                                //     _OR_ { nMul, nDiv } which equates to "CharactersPerInch"
                                                                //     _OR_ ZERO ( 0 ) which uses the default width of the font
                                                                //          for the nPointSize
                                                                //   IF nWidth (or nDiv) is < 0 then Fixed font is emulated

  METHOD SetDefaultFont()

  METHOD GetFonts()                                   // Returns array of { "FontName", lFixed, lTrueType, nCharSetRequired }
  METHOD Bold(nBoldWeight)
  METHOD UnderLine(lOn)
  METHOD Italic(lOn)
  METHOD SetDuplexType(nDuplexType)                       // Get/Set current Duplexmode
  METHOD SetPrintQuality(nPrintQuality)               // Get/Set Printquality
  METHOD CharSet(nCharSet)


  METHOD SetPos(nX, nY)                               // **WARNING** : (Col,Row) _NOT_ (Row,Col)

  METHOD SetColor(nClrText, nClrPane, nAlign) INLINE (;
         ::TextColor:=nClrText, ::BkColor:=nClrPane, ::TextAlign:=nAlign,;
         win32_SetColor( ::hPrinterDC, nClrText, nClrPane, nAlign) )

  METHOD TextOut(cString, lNewLine, lUpdatePosX, nAlign)     // nAlign : 0 == left, 1 == right, 2 == centered
  METHOD TextOutAt(nPosX,nPosY, cString, lNewLine, lUpdatePosX, nAlign) // **WARNING** : (Col,Row) _NOT_ (Row,Col)

  METHOD SetPen(nStyle, nWidth, nColor) INLINE (;
         ::PenStyle:=nStyle, ::PenWidth:=nWidth, ::PenColor:=nColor,;
         win32_SetPen(::hPrinterDC, nStyle, nWidth, nColor) )

  METHOD Line(nX1, nY1, nX2, nY2) INLINE win32_LineTo(::hPrinterDC, nX1, nY1, nX2, nY2)

  METHOD Box(nX1, nY1, nX2, nY2, nWidth, nHeight) INLINE win32_Rectangle(::hPrinterDC, nX1, nY1, nX2, nY2, nWidth, nHeight)

  METHOD Arc(nX1, nY1, nX2, nY2) INLINE win32_Arc(::hPrinterDC, nX1, nY1, nX2, nY2)

  METHOD Ellipse(nX1, nY1, nX2, nY2) INLINE win32_Ellipse(::hPrinterDC, nX1, nY1, nX2, nY2)

  METHOD FillRect(nX1, nY1, nX2, nY2, nColor) INLINE win32_FillRect(::hPrinterDC, nX1, nY1, nX2, nY2, nColor)
  METHOD GetCharWidth()
  METHOD GetCharHeight()
  METHOD GetTextWidth(cString)
  METHOD GetTextHeight(cString)
  METHOD DrawBitMap(oBmp)

//  Clipper DOS compatible functions.
  METHOD SetPrc(nRow, nCol)        // Based on ::LineHeight and current ::CharWidth
  METHOD PRow()
  METHOD PCol()
  METHOD MaxRow()                  // Based on ::LineHeight & Form dimensions
  METHOD MaxCol()                  // Based on ::CharWidth & Form dimensions

  METHOD MM_TO_POSX( nMm )      // Convert position on page from MM to pixel location Column
  METHOD MM_TO_POSY( nMm )      //   "       "      "    "    "   "  "   "      "     Row
  METHOD INCH_TO_POSX( nInch )  // Convert position on page from INCH to pixel location Column
  METHOD INCH_TO_POSY( nInch )  //   "       "      "    "    "   "    "   "       "    Row

  METHOD TextAtFont( nPosX, nPosY, cString, cFont, nPointSize,;     // Print text string at location
                     nWidth, nBold, lUnderLine, lItalic, lNewLine,; // in specified font and color.
                     lUpdatePosX, nColor, nAlign )                  // Restore original font and colour

  METHOD SetBkMode( nMode )  INLINE win32_SetBkMode( ::hPrinterDc, nMode ) // OPAQUE == 2 or TRANSPARENT == 1

  METHOD GetDeviceCaps( nCaps ) INLINE win32_GetDeviceCaps( ::hPrinterDC, nCaps)

  VAR PrinterName      INIT ""
  VAR Printing         INIT .F.
  VAR HavePrinted      INIT .F.
  VAR hPrinterDc       INIT 0

// These next 4 variables must be set before calling ::Create() if
// you wish to alter the defaults
  VAR FormType         INIT 0
  VAR BinNumber        INIT 0
  VAR Landscape        INIT .F.
  VAR Copies           INIT 1

  VAR SetFontOk        INIT .F.
  VAR FontName         INIT ""                       // Current Point size for font
  VAR FontPointSize    INIT 12                       // Point size for font
  VAR FontWidth        INIT {0,0}                    // {Mul, Div} Calc width: nWidth:= MulDiv(nMul, GetDeviceCaps(shDC,LOGPIXELSX), nDiv)
                                                     // If font width is specified it is in "characters per inch" to emulate DotMatrix
  VAR fBold            INIT 0      HIDDEN            // font darkness weight ( Bold). See wingdi.h or WIN SDK CreateFont() for valid values
  VAR fUnderLine       INIT .F.    HIDDEN            // UnderLine is on or off
  VAR fItalic          INIT .F.    HIDDEN            // Italic is on or off
  VAR fCharSet         INIT 1      HIDDEN            // Default character set == DEFAULT_CHARSET ( see wingdi.h )

  VAR PixelsPerInchY
  VAR PixelsPerInchX
  VAR PageHeight       INIT 0
  VAR PageWidth        INIT 0
  VAR TopMargin        INIT 0
  VAR BottomMargin     INIT 0
  VAR LeftMargin       INIT 0
  VAR RightMargin      INIT 0
  VAR LineHeight       INIT 0
  VAR CharHeight       INIT 0
  VAR CharWidth        INIT 0
  VAR fCharWidth       INIT 0      HIDDEN
  VAR BitmapsOk        INIT .F.
  VAR NumColors        INIT 1
  VAR fDuplexType      INIT 0      HIDDEN            // DMDUP_SIMPLEX, 22/02/2007 change to 0 to use default printer settings
  VAR fPrintQuality    INIT 0      HIDDEN            // DMRES_HIGH, 22/02/2007 change to 0 to use default printer settings
  VAR fNewDuplexType   INIT 0      HIDDEN
  VAR fNewPrintQuality INIT 0      HIDDEN
  VAR fOldLandScape    INIT .F.    HIDDEN
  VAR fOldBinNumber    INIT 0      HIDDEN
  VAR fOldFormType     INIT 0      HIDDEN

  VAR PosX             INIT 0
  VAR PosY             INIT 0

  VAR TextColor
  VAR BkColor
  VAR TextAlign

  VAR PenStyle
  VAR PenWidth
  VAR PenColor

ENDCLASS

METHOD New(cPrinter) CLASS WIN32PRN
  ::PrinterName := IIF(!EMPTY(cPrinter), cPrinter, GetDefaultPrinter())
  RETURN(Self)

METHOD Create() CLASS WIN32PRN
  LOCAL Result:= .F.
  ::Destroy()                            // Finish current print job if any
  IF !EMPTY(::hPrinterDC:= win32_CreateDC(::PrinterName))

    // Set Form Type
    // Set Number of Copies
    // Set Orientation
    // Set Duplex mode
    // Set PrintQuality
    win32_SetDocumentProperties(::hPrinterDC, ::PrinterName, ::FormType, ::Landscape, ::Copies, ::BinNumber, ::fDuplexType, ::fPrintQuality)
    // Set mapping mode to pixels, topleft down
    win32_SetMapMode(::hPrinterDC,MM_TEXT)
//    win32_SetTextCharacterExtra(::hPrinterDC,0); // do not add extra char spacing even if bold
    // Get Margins etc... here
    ::PageWidth        := win32_GetDeviceCaps(::hPrinterDC,PHYSICALWIDTH)
    ::PageHeight       := win32_GetDeviceCaps(::hPrinterDC,PHYSICALHEIGHT)
    ::LeftMargin       := win32_GetDeviceCaps(::hPrinterDC,PHYSICALOFFSETX)
    ::RightMargin      := (::PageWidth - ::LeftMargin)+1
    ::PixelsPerInchY   := win32_GetDeviceCaps(::hPrinterDC,LOGPIXELSY)
    ::PixelsPerInchX   := win32_GetDeviceCaps(::hPrinterDC,LOGPIXELSX)
    ::LineHeight       := INT(::PixelsPerInchY / 6)  // Default 6 lines per inch == # of pixels per line
    ::TopMargin        := win32_GetDeviceCaps(::hPrinterDC,PHYSICALOFFSETY)
    ::BottomMargin     := (::PageHeight - ::TopMargin)+1

    // Set .T. if can print bitmaps
    ::BitMapsOk := win32_BitMapsOk(::hPrinterDC)

    // supports Colour
    ::NumColors := win32_GetDeviceCaps(::hPrinterDC,NUMCOLORS)

    // Set the standard font
    ::SetDefaultFont()
    ::HavePrinted:= ::Printing:= .F.
    ::fOldFormType:= ::FormType  // Last formtype used
    ::fOldLandScape:= ::LandScape
    ::fOldBinNumber:= ::BinNumber
    ::fNewDuplexType := ::fDuplexType
    ::fNewPrintQuality := ::fPrintQuality
    Result:= .T.
  ENDIF
  RETURN(Result)

METHOD Destroy() CLASS WIN32PRN
  IF !EMPTY(::hPrinterDc)
    IF ::Printing
      ::EndDoc()
    ENDIF
    ::hPrinterDC:= win32_DeleteDC(::hPrinterDC)
  ENDIF
  RETURN(.T.)

METHOD StartDoc(cDocName) CLASS WIN32PRN
  LOCAL Result:= .F.
  IF cDocName == NIL
    cDocName:= win32_GetExeFileName()+" ["+DTOC(DATE())+' - '+TIME()+"]"
  ENDIF
  IF (Result:= win32_StartDoc(::hPrinterDc, cDocName))
    IF !(Result:= ::StartPage(::hPrinterDc))
      ::EndDoc(.T.)
    ELSE
      ::Printing:= .T.
    ENDIF
  ENDIF
  RETURN(Result)

METHOD EndDoc(lAbortDoc) CLASS WIN32PRN
  IF lAbortDoc == NIL
    lAbortDoc:= .F.
  ENDIF
  IF !::HavePrinted
    lAbortDoc:= .T.
  ENDIF
  IF !lAbortDoc
    ::EndPage(.F.)
  ENDIF
  win32_EndDoc(::hPrinterDC,lAbortDoc)
  ::Printing:= .F.
  ::HavePrinted:= .F.
  RETURN(.T.)

METHOD StartPage() CLASS WIN32PRN
  LOCAL lLLandScape, nLBinNumber, nLFormType, nLDuplexType, nLPrintQuality
  LOCAL lChangeDP:= .F.
  IF ::LandScape != ::fOldLandScape  // Direct-modify property
    lLLandScape:= ::fOldLandScape := ::LandScape
    lChangeDP:= .T.
  ENDIF
  IF ::BinNumber != ::fOldBinNumber  // Direct-modify property
    nLBinNumber:= ::fOldBinNumber := ::BinNumber
    lChangeDP:= .T.
  ENDIF
  IF ::FormType != ::fOldFormType  // Direct-modify property
    nLFormType:= ::fOldFormType := ::FormType
    lChangeDP:= .T.
  ENDIF
  IF ::fDuplexType != ::fNewDuplexType  // Get/Set property
    nLDuplexType:= ::fDuplexType:= ::fNewDuplexType
    lChangeDP:= .T.
  ENDIF
  IF ::fPrintQuality != ::fNewPrintQuality  // Get/Set property
    nLPrintQuality:= ::fPrintQuality:= ::fNewPrintQuality
    lChangeDP:= .T.
  ENDIF
  IF lChangeDP
    win32_SetDocumentProperties(::hPrinterDC, ::PrinterName, nLFormType, lLLandscape, , nLBinNumber, nLDuplexType, nLPrintQuality)
  ENDIF
  win32_StartPage(::hPrinterDC)
  ::PosX:= ::LeftMargin
  ::PosY:= ::TopMargin
  RETURN(.T.)

METHOD EndPage(lStartNewPage) CLASS WIN32PRN
  IF lStartNewPage == NIL
    lStartNewPage:= .T.
  ENDIF
  win32_EndPage(::hPrinterDC)
  IF lStartNewPage
    ::StartPage()
    IF win32_OS_ISWIN9X() // Reset font on Win9X
      ::SetFont()
    ENDIF
  ENDIF
  RETURN(.T.)

METHOD NewLine() CLASS WIN32PRN
  ::PosX:= ::LeftMargin
  ::PosY+= ::LineHeight
  RETURN(::PosY)

METHOD NewPage() CLASS WIN32PRN
  ::EndPage(.T.)
  RETURN(.T.)

METHOD SetFont(cFontName, nPointSize, nWidth, nBold, lUnderline, lItalic, nCharSet) CLASS WIN32PRN
  LOCAL cType
  IF cFontName !=NIL
    ::FontName:= cFontName
  ENDIF
  IF nPointSize!=NIL
    ::FontPointSize:= nPointSize
  ENDIF
  IF nWidth != NIL
    cType:= VALTYPE(nWidth)
    IF cType='A'
      ::FontWidth     := nWidth
    ELSEIF cType='N' .AND. !EMPTY(nWidth)
      ::FontWidth     := {1,nWidth }
    ELSE
      ::FontWidth     := {0, 0 }
    ENDIF
  ENDIF
  IF nBold != NIL
    ::fBold := nBold
  ENDIF
  IF lUnderLine != NIL
    ::fUnderline:= lUnderLine
  ENDIF
  IF lItalic != NIL
    ::fItalic := lItalic
  ENDIF
  IF nCharSet != NIL
    ::fCharSet := nCharSet
  ENDIF
  IF (::SetFontOk:= win32_CreateFont( ::hPrinterDC, ::FontName, ::FontPointSize, ::FontWidth[1], ::FontWidth[2], ::fBold, ::fUnderLine, ::fItalic, ::fCharSet))
    ::fCharWidth        := ::GetCharWidth()
    ::CharWidth:= ABS(::fCharWidth)
    ::CharHeight:= ::GetCharHeight()
  ENDIF
  ::FontName:= win32_GetPrinterFontName(::hPrinterDC)  // Get the font name that Windows actually used
  RETURN(::SetFontOk)

METHOD SetDefaultFont()
  RETURN(::SetFont("Courier New",12,{1, 10}, 0, .F., .F., 0))

METHOD Bold(nWeight) CLASS WIN32PRN
  LOCAL Result:= ::fBold
  IF nWeight!= NIL
    ::fBold:= nWeight
    IF ::Printing
      ::SetFont()
    ENDIF
  ENDIF
  RETURN(Result)

METHOD Underline(lUnderLine) CLASS WIN32PRN
  LOCAL Result:= ::fUnderline
  IF lUnderLine!= NIL
    ::fUnderLine:= lUnderLine
    IF ::Printing
      ::SetFont()
    ENDIF
  ENDIF
  RETURN(Result)

METHOD Italic(lItalic) CLASS WIN32PRN
  LOCAL Result:= ::fItalic
  IF lItalic!= NIL
    ::fItalic:= lItalic
    IF ::Printing
      ::SetFont()
    ENDIF
  ENDIF
  RETURN(Result)

METHOD CharSet(nCharSet) CLASS WIN32PRN
  LOCAL Result:= ::fCharSet
  IF nCharSet!= NIL
    ::fCharSet:= nCharSet
    IF ::Printing
      ::SetFont()
    ENDIF
  ENDIF
  RETURN(Result)

METHOD SetDuplexType(nDuplexType) CLASS WIN32PRN
  LOCAL Result:= ::fDuplexType
  IF nDuplexType!= NIL
    ::fNewDuplexType:= nDuplexType
    IF !::Printing
      ::fDuplexType:= nDuplexType
    ENDIF
  ENDIF
  RETURN(Result)

METHOD SetPrintQuality(nPrintQuality) CLASS WIN32PRN
  LOCAL Result:= ::fPrintQuality
  IF nPrintQuality!= NIL
    ::fNewPrintQuality:= nPrintQuality
    IF !::Printing
      ::fPrintQuality:= nPrintQuality
    ENDIF
  ENDIF
  RETURN(Result)

METHOD GetFonts() CLASS WIN32PRN
  RETURN(win32_ENUMFONTS(::hPrinterDC))

METHOD SetPos(nPosX, nPosY) CLASS WIN32PRN
  LOCAL Result:= {::PosX, ::PosY}
  IF nPosX != NIL
    ::PosX:= INT(nPosX)
  ENDIF
  IF nPosY != NIL
    ::PosY:= INT(nPosY)
  ENDIF
  RETURN(Result)

METHOD TextOut(cString, lNewLine, lUpdatePosX, nAlign) CLASS WIN32PRN
  LOCAL nPosX
  IF nAlign == NIL
     nAlign:= 0
  ENDIF
  IF lUpdatePosX == NIL
     lUpdatePosX:=.T.
  ENDIF
  IF lNewLine == NIL
    lNewLine:= .F.
  ENDIF
  IF cString!=NIL
    nPosX:= win32_TextOut(::hPrinterDC,::PosX, ::PosY, cString, LEN(cString), ::fCharWidth, nAlign)
    ::HavePrinted:= .T.
    IF lUpdatePosX
      ::PosX+= nPosX
    ENDIF
    IF lNewLine
      ::NewLine()
    ENDIF
  ENDIF
  RETURN( .T. )

METHOD TextOutAt(nPosX,nPosY, cString, lNewLine, lUpdatePosX, nAlign) CLASS WIN32PRN
  IF lNewLine == NIL
    lNewLine:= .F.
  ENDIF
  IF lUpdatePosX == NIL
    lUpdatePosX:= .T.
  ENDIF
  ::SetPos(nPosX,nPosY)
  ::TextOut(cString, lNewLine, lUpdatePosX, nAlign)
  RETURN(.T.)

METHOD GetCharWidth() CLASS WIN32PRN
  LOCAL nWidth:= 0
  IF ::FontWidth[2] < 0 .AND. !EMPTY(::FontWidth[1])
    nWidth:= win32_MulDiv(::FontWidth[1], ::PixelsPerInchX,::FontWidth[2])
  ELSE
    nWidth:= win32_GetCharSize(::hPrinterDC)
  ENDIF
  RETURN(nWidth)

METHOD GetCharHeight() CLASS WIN32PRN
  RETURN win32_GetCharSize(::hPrinterDC, .T.)

METHOD GetTextWidth(cString) CLASS WIN32PRN
  LOCAL nWidth:= 0
  IF ::FontWidth[2] < 0 .AND. !EMPTY(::FontWidth[1])
    nWidth:= LEN(cString) * ::CharWidth
  ELSE
    nWidth:= win32_GetTextSize(::hPrinterDC, cString, LEN(cString))  // Return Width in device units
  ENDIF
  RETURN(nWidth)

METHOD GetTextHeight(cString) CLASS WIN32PRN
  RETURN(win32_GetTextSize(::hPrinterDC, cString, LEN(cString), .F.))  // Return Height in device units

METHOD DrawBitMap(oBmp) CLASS WIN32PRN
  LOCAL Result:= .F.
  IF ::BitMapsOk .AND. ::Printing .AND. !EMPTY(oBmp:BitMap)
    IF (Result:= win32_DrawBitMap(::hPrinterDc, oBmp:BitMap,oBmp:Rect[1], oBmp:Rect[2], oBmp:rect[3], oBmp:Rect[4]))
      ::HavePrinted:= .T.
    ENDIF
  ENDIF
  RETURN(Result)

METHOD SetPrc(nRow, nCol) CLASS WIN32PRN
  ::SetPos((nCol * ::CharWidth)+ ::LeftMArgin, (nRow * ::LineHeight) + ::TopMargin)
  RETURN(NIL)

METHOD PROW() CLASS WIN32PRN
  RETURN(INT((::PosY- ::TopMargin)/::LineHeight))   // No test for Div by ZERO

METHOD PCOL() CLASS WIN32PRN
  RETURN(INT((::PosX - ::LeftMargin)/::CharWidth))   // Uses width of current character

METHOD MaxRow() CLASS WIN32PRN
  RETURN(INT(((::BottomMargin-::TopMargin)+1) / ::LineHeight) - 1)

METHOD MaxCol() CLASS WIN32PRN
  RETURN(INT(((::RightMargin-::LeftMargin)+1 ) / ::CharWidth) - 1)

METHOD MM_TO_POSX( nMm ) CLASS WIN32PRN
  RETURN( INT( ( ( nMM * ::PixelsPerInchX ) / MM_TO_INCH ) - ::LeftMargin ) )

METHOD MM_TO_POSY( nMm ) CLASS WIN32PRN
  RETURN( INT( ( ( nMM * ::PixelsPerInchY ) / MM_TO_INCH ) - ::TopMargin ) )

METHOD INCH_TO_POSX( nInch ) CLASS WIN32PRN
  RETURN( INT( ( nInch * ::PixelsPerInchX  ) - ::LeftMargin ) )

METHOD INCH_TO_POSY( nInch ) CLASS WIN32PRN
  RETURN( INT( ( nInch * ::PixelsPerInchY ) - ::TopMargin ) )

METHOD TextAtFont( nPosX, nPosY, cString, cFont, nPointSize, nWidth, nBold, lUnderLine, lItalic, nCharSet, lNewLine, lUpdatePosX, nColor, nAlign ) CLASS WIN32PRN
  LOCAL lCreated:= .F., nDiv:= 0, cType
  DEFAULT nPointSize TO ::FontPointSize
  IF cFont != NIL
      cType:= VALTYPE(nWidth)
      IF cType='A'
        nDiv  := nWidth[ 1 ]
        nWidth:= nWidth[ 2 ]
      ELSEIF cType='N' .AND. !EMPTY(nWidth)
        nDiv:= 1
      ENDIF
      lCreated:= win32_CreateFont( ::hPrinterDC, cFont, nPointSize, nDiv, nWidth, nBold, lUnderLine, lItalic, nCharSet )
  ENDIF
  IF nColor != NIL
    nColor:= SetColor( ::hPrinterDC, nColor )
  ENDIF
  ::TextOutAt( nPosX, nPosY, cString, lNewLine, lUpdatePosX, nAlign)
  IF lCreated
    ::SetFont()  // Reset font
  ENDIF
  IF nColor != NIL
    SetColor( ::hPrinterDC, nColor )  // Reset Color
  ENDIF
  RETURN( .T. )

CLASS WIN32BMP

EXPORTED:

  METHOD New()
  METHOD LoadFile(cFileName)
  METHOD Create()
  METHOD Destroy()
  METHOD Draw(oPrn,arectangle)
  VAR Rect     INIT { 0,0,0,0 }        // Coordinates to print BitMap
                                       //   XDest,                    // x-coord of destination upper-left corner
                                       //   YDest,                    // y-coord of destination upper-left corner
                                       //   nDestWidth,               // width of destination rectangle
                                       //   nDestHeight,              // height of destination rectangle
                                       // See WinApi StretchDIBits()
  VAR BitMap   INIT ""
  VAR FileName INIT ""
ENDCLASS

METHOD New() CLASS WIN32BMP
  RETURN Self

METHOD LoadFile(cFileName) CLASS WIN32BMP
  ::FileName:= cFileName
  ::Bitmap := win32_LoadBitMapFile(::FileName)
  RETURN !EMPTY(::Bitmap)

METHOD Create() CLASS WIN32BMP  // Compatibility function for Alaska Xbase++
  Return Self

METHOD Destroy() CLASS WIN32BMP  // Compatibility function for Alaska Xbase++
  RETURN NIL

METHOD Draw(oPrn, aRectangle) CLASS WIN32BMP // Pass a TPRINT class reference & Rectangle array
  ::Rect := aRectangle
  RETURN oPrn:DrawBitMap(Self)

CLASS XBPBITMAP FROM WIN32BMP // Compatibility Class for Alaska Xbase++

ENDCLASS

   METHOD Init( cPortName, nBaudRate, nParity, nByteSize, nStopBits )

   METHOD Read( cString, nLength )

   METHOD Recv( nLength )

   METHOD RecvTo( cDelim, nMaxlen )

   METHOD Write( cString ) INLINE WinPortWrite( ::nPort, cString )

   METHOD Status( lCTS, lDSR, lRing, lDCD ) INLINE WinPortStatus( ::nPort, @lCTS, @lDSR, @lRing, @lDCD )

   METHOD QueueStatus( lCTSHold, lDSRHold, lDCDHold, lXoffHold, lXoffSent, nInQueue, nOutQueue ) INLINE ;
           WinPortQueueStatus( ::nPort, @lCTSHold, @lDSRHold, @lDCDHold, @lXoffHold, @lXoffSent, @nInQueue, @nOutQueue )

   METHOD SetRTS( lCTS ) INLINE WinPortSetRTS( ::nPort, lCTS )

   METHOD SetDTR( lDTR ) INLINE WinPortSetDTR( ::nPort, lDTR )

   METHOD RTSFlow( nRTS ) INLINE WinPortRTSFlow( ::nPort, nRTS )

   METHOD DTRFlow( nDTR ) INLINE WinPortDTRFlow( ::nPort, nDTR )

   METHOD XonXoffFlow( lXonXoff ) INLINE WinPortXonXoffFlow( ::nPort, lXonXoff )

   METHOD Purge( lRXBuffer, lTXBuffer ) INLINE WinPortPurge( ::nPort, lRXBuffer, lTXBuffer )

   METHOD PurgeRX() INLINE WinPortPurge( ::nPort, .T., .F. )

   METHOD PurgeTX() INLINE WinPortPurge( ::nPort, .F., .T. )

   METHOD Close( nDrain ) INLINE WinPortClose( ::nPort, iif( Empty( nDrain ), 0, nDrain ) )

   METHOD Error()

   METHOD DebugDCB( nDebug ) INLINE WinPortDebugDCB(::nPort, nDebug )

   METHOD TimeOuts( nReadInterval, nReadMultiplier, nReadConstant, nWriteMultiplier, nWriteConstant ) INLINE ;
           WinPortTimeOuts( nReadInterval, nReadMultiplier, nReadConstant, nWriteMultiplier, nWriteConstant )

   METHOD Buffers( nInQueue, nOutQueue ) INLINE WinPortBuffers( nInQueue, nOutQueue )

ENDCLASS

METHOD Init( cPortName, nBaudRate, nParity, nByteSize, nStopBits ) CLASS WinPort

   ::cPortName := Upper( cPortName )
   IF Left( ::cPortName, 3 ) == "COM" .AND. ( ::nPort := Val( SubStr( ::cPortName, 4 ) ) ) >= 1 .AND. ::nPort <= MAXSERIAL
      ::nPort--
      IF WinPortOpen( ::nPort, nBaudRate, nParity, nByteSize, nStopBits ) != INVALID_HANDLE_VALUE
         ::lOpen := .T.
      ENDIF
   ENDIF

   RETURN self

METHOD Read( /*@*/cString, nLength ) CLASS WinPort
   LOCAL nResult

   cString := Space( nlength )
   IF ( nResult := WinPortRead( ::nPort, @cString ) ) != INVALID_HANDLE_VALUE
      cString := Left( cString, nResult )
   ELSE
      cString := ""
   ENDIF

   RETURN nResult

METHOD Recv( nLength ) CLASS WinPort
   LOCAL nResult
   LOCAL cString := Space( nlength )

   IF ( nResult := WinPortRead( ::nPort, @cString ) ) != INVALID_HANDLE_VALUE
      cString := Left( cString, nResult )
   ELSE
      cString := ""
   ENDIF

   RETURN cString

METHOD RecvTo( cDelim, nMaxlen ) CLASS WinPort
   LOCAL nResult
   LOCAL cRecv := ""

   LOCAL cString

   DO WHILE .T.
      cString := Space( 1 )
      IF ( nResult := WinPortRead( ::nPort, @cString ) ) != INVALID_HANDLE_VALUE
         IF nResult == 0
            EXIT
         ELSE
            cRecv += cString
            IF cDelim != NIL .AND. cString == cDelim
               EXIT
            ENDIF
            IF Len( cRecv ) == nMaxlen
               EXIT
            ENDIF
         ENDIF
      ELSE
         EXIT
      ENDIF
   ENDDO

   RETURN cRecv

METHOD Error() CLASS WinPort
   LOCAL nFcn := WinPortFcn()
   LOCAL cString
   LOCAL nError
   LOCAL aWinPortFcns := { ;
      "CreateFile", ;
      "GetCommState", ;
      "SetCommState", ;
      "SetupComm", ;
      "GetCommTimeouts", ;
      "SetCommTimeouts", ;
      "CloseHandle", ;
      "WriteFile", ;
      "ReadFile", ;
      "GetCommModemStatus", ;
      "PurgeComm", ;
      "ClearCommError", ;
      "EscapeCommFunction", ;
      "GetCommProperties" }

   IF nFcn > 0 .AND. nFcn <= Len( aWinPortFcns )
      cString := aWinPortFcns[ nFcn ] + "(), "
   ELSE
      cString := "Function number invalid, "
   ENDIF

   // WinPortError clears the error - don't call it twice
   cString += "error (" + LTrim( Str( nError := WinPortError() ) ) + ") : " + FormatMessage( nError )

   RETURN cString