/*
 * Xailer source code:
 *
 * WinOle.prg
 * Soporte de TOleauto a traves de Harbour
 *
 * Copyright 2012 Jose F. Gimenez
 * Copyright 2012 Xailer.com
 * All rights reserved
 *
 */

#include "Xailer.ch"
#include "Error.ch"

//------------------------------------------------------------------------------

INIT PROCEDURE XA_InitOle()

   __OleVariantNullDate( .T. )

RETURN

//------------------------------------------------------------------------------

FUNCTION GetActiveObject( ... )

   LOCAL oOleServer := win_OleGetActiveObject( ... ), oError

   IF Empty( oOleServer )
      WITH OBJECT oError := ErrorNew()
         :Args          := HB_aParams()
         :CanDefault    := .F.
         :CanRetry      := .F.
         :CanSubstitute := .T.
         :Description   := "OLE server not found"
         :Operation     := "GetActiveObject()"
         :Severity      := ES_ERROR
         :SubCode       := -1
         :SubSystem     := "WINOLE"
      END
      Eval( ErrorBlock(), oError )
   ENDIF

RETURN oOleServer

//------------------------------------------------------------------------------

FUNCTION CreateObject( ... )

   LOCAL oOleServer := win_OleCreateObject( ... ), oError

   IF Empty( oOleServer )
      WITH OBJECT oError := ErrorNew()
         :Args          := HB_aParams()
         :CanDefault    := .F.
         :CanRetry      := .F.
         :CanSubstitute := .T.
         :Description   := "OLE server not found"
         :Operation     := "CreateObject()"
         :Severity      := ES_ERROR
         :SubCode       := -1
         :SubSystem     := "WINOLE"
      END
      Eval( ErrorBlock(), oError )
   ENDIF

RETURN oOleServer

//------------------------------------------------------------------------------

FUNCTION Ole2TxtError()
RETURN win_OleErrorText()

//------------------------------------------------------------------------------

#xuntranslate HBClass() =>

CLASS TOleAuto FROM win_OleAuto

   METHOD New( uCLass )
   METHOD hObj()
   METHOD _hObj()

ENDCLASS

//------------------------------------------------------------------------------

METHOD New( uClass ) CLASS TOleAuto

   IF !Empty( uClass )
      IF ValType( uClass ) == "N"
         ::hObj := uClass
      ELSE
         ::__hObj := __OleCreateObject( uClass )
      ENDIF
   ENDIF

RETURN Self

//------------------------------------------------------------------------------

#pragma BEGINDUMP

#include "Windows.h"
#include "Xailer.h"
#include "hbwinole.h"

HB_FUNC_STATIC( TOLEAUTO_HOBJ )
{
   PHB_ITEM Self = hb_stackSelfItem();
   PHB_ITEM __hObj = XA_ObjGetItemCopy( Self, "__hObj" );

   hb_retnl( (long) hb_oleItemGet( __hObj ) );
   hb_itemRelease( __hObj );
}

//------------------------------------------------------------------------------

HB_FUNC_STATIC( TOLEAUTO__HOBJ )
{
   PHB_ITEM Self = hb_stackSelfItem();
   PHB_ITEM __hObj = hb_itemNew( NULL );

   hb_oleItemPut( __hObj, (LPVOID) hb_parnl( 1 ) );
   XA_ObjSendItem( Self, "___hObj", __hObj );
   hb_itemRelease( __hObj );
}

#pragma ENDDUMP