PC Plus SuperCD 24/PCPLUS115.iso/install/extern.pak/DBEXTERN.CPP

C/C++ Source or Header | 1994-08-02 | 19.7 KB | 673 lines

//============================================================================
//
// dbextern.cpp
//
// C++ part of the example that shows how the EXTERN system can be used.
//
// For a description of this example, see the dbextern.prg file.
//
//============================================================================

   // Include some headers.
#include "dbasevar.h"

//============================================================================
//
//  You can create an instance of class CSession in DBaseInitInstance()
//  and set it up. In subsequent call backs, a pointer to this instance
//  can be retrieved with a call to GetSession().  Data that is kept on
//  a per-instance basis (DBaseVars for example) should be kept in the
//  session object.
//
//============================================================================

class CSession {
public:
   DVar ThisSessionLocalObject;

   CSession(){
       // Initialize objects local to this session.

       time_t t = time( NULL );
       ThisSessionLocalObject->SetZString( ctime( &t ) );
   }
   ~CSession(){
       // Destroy objects local to this session.
   }

   char * UseLocalObject(){
       // Use objects local to this session.
       return ThisSessionLocalObject->String();
   }
};


extern "C" {
//============================================================================
//
//  Usual DLL functions.
//
//============================================================================

int FAR PASCAL LibMain(HINSTANCE, WORD, WORD, LPSTR){

   return 1;
}
int CALLBACK WEP(int /*nParam*/){return(1);}

//
//  This function is called every time an Instance of dBASE loads the DLL.
//  If for some reason the DLL determines that it cannot load, it can return
//  an error.  If the DLL loads properly it should return DBASE_INIT_OK.
//

int CALLBACK DBaseInitInstance(void){

   asm int 3;     // break point for the debugger.

   DBase()->SetSession(new CSession());

       //
       // Possible Error return Values
       //
       //return DBASE_INIT_NO_MULTI_INSTANCE;
       //return DBASE_INIT_ERROR;

   return DBASE_INIT_OK;
}

//
//  DBaseExitInstance() is called when an instance of dBASE terminates or
//  manually unloads a DLL through the RELEASE DLL command.  This give the
//  DLL a chance to free any resources associated with a running instance.
//

void CALLBACK DBaseExitInstance(void){
}

//============================================================================
//
// Example # 1.
//
// Some simple examples using the different types.
//
//============================================================================

BOOL _export _pascal TypeTest1( char * Str, int Int, DoubleType Double ) {
   if( strcmp( Str, "string" ) != 0 || Int != 123 || Double != 321.123L )
       return 0;
   return 1;
}

DoubleType _export _cdecl TypeTest2( char * Str, long Long, DBaseVar *Var ) {
   return strtod( Str, NULL ) + (DoubleType) Long + Var->Double();
}

//============================================================================
//
// Example # 3.
//
// dBASE objects can be of various types. With the Type() function you
// can recognize what kind of object you're dealing with.
//
//============================================================================

char* _export _pascal WhichType( DBaseVar *var ) {

   static char buffer[25];

       // Get the type and put it in buffer.
   switch( var->Type() ){
   case 'L':                          // Logical
       strcpy( buffer, "Logical " );
       strcat( buffer, var->Logical() ? ".T." : ".F.");
       break;
   case 'N':                          // Numeric double
       strcpy( buffer, "Double " );
       gcvt(var->Double(),10,buffer+7);
       break;
   case 'I':                          // Numeric long
       strcpy( buffer, "Long " );
       ltoa(var->Long(), buffer+5, 10);
       break;
   case 'C':                          // String
       strcpy( buffer, "String " );
       strcat( buffer, var->String() );
       break;
   case 'O':                          // Object
       strcpy( buffer, "Object" );
       break;
   case 'F':                          // Function or code block
       strcpy( buffer, "Code" );
       break;
   default:                           // Anybody else
      buffer[0] = var->Type();
      buffer[1] = ' ';
      strcpy( buffer+2, ":Unknown Type" );
   }
       // Return the type.
   return buffer;
}

//============================================================================
//
// Example # 4.
//
// You can modify dBASE objects passed in.  Since they are passed by
// reference, changes made here to objects show also on the dBASE side.
// It is also possible to use the CVAR type as the return type of dBASE
// functions.  On the dBASE side you simply declare the function
// with CVAR as the return type:
//
//   EXTERN CDECL CVAR ModifyAndAdd1( CVAR, CVAR ) dbextern.dll
//   EXTERN CVAR ModifyAndAdd2( CVAR, CVAR ) dbextern.dll
//
// but on the C/C++ side you use void as the return type of the function
// and list the CVAR return variable as the first parameter for CDECL
// functions or as the last parameter for PASCAL functions.
//
//============================================================================

void _export _cdecl ModifyAndAdd1( DBaseVar *ReturnValue,
                                   DBaseVar *D1, DBaseVar *D2 ) {

   ReturnValue->SetDouble( D1->Double() + (DoubleType)D2->Long() );
   D1->SetZString( "Changed to a string" );
   D2->SetLogical( 1 );
}

void _export _pascal ModifyAndAdd2( DBaseVar *D1, DBaseVar *D2,
                                    DBaseVar *ReturnValue ) {

   ReturnValue->SetDouble( D1->Double() + (DoubleType)D2->Long() );
   D1->SetZString( "Changed in ModifyAndAdd2" );
   D2->SetLogical( 1 );
}

//============================================================================
//
// Example # 5.
//
// Parts of dBASE class objects are accessible on this side.
// This example shows one way of how to implement Windows API calls
// that require the use of structs.
//
//============================================================================

void _export _cdecl WSetRect( DBaseVar *rect, WORD left, WORD top,
                               WORD right, WORD bottom ){
   RECT wrect;
   DVar Temp;

       // Call the Windows API.
   SetRect( &wrect, left, top, right, bottom );

       // Fill in the DBaseVar.
   rect->SetProperty( "left", DVar( (long)(wrect.left) ) );
   rect->SetProperty( "top", DVar( (long)(wrect.top) ) );
   rect->SetProperty( "right", DVar( (long)(wrect.right) ) );
   rect->SetProperty( "bottom", DVar( (long)(wrect.bottom) ) );
}

void _export _pascal WIntersectRect( DBaseVar *result,
                                     DBaseVar *rect1, DBaseVar *rect2 ){
   RECT one, two, three;
   DVar Temp;

       // Copy rect1 to one.
   rect1->Property( "left", Temp );
   one.left = Temp->Long();
   rect1->Property( "top", Temp );
   one.top = Temp->Long();
   rect1->Property( "right", Temp );
   one.right = Temp->Long();
   rect1->Property( "bottom", Temp );
   one.bottom = Temp->Long();

       // Copy rect2 to two.
   rect2->Property( "left", Temp );
   two.left = Temp->Long();
   rect2->Property( "top", Temp );
   two.top = Temp->Long();
   rect2->Property( "right", Temp );
   two.right = Temp->Long();
   rect2->Property( "bottom", Temp );
   two.bottom = Temp->Long();

       // Make the Windows API call
   IntersectRect( &three, &one, &two );

       // Copy three to result.
   Temp->SetLong( three.left );
   result->SetProperty( "left", Temp );
   Temp->SetLong( three.top );
   result->SetProperty( "top", Temp );
   Temp->SetLong( three.right );
   result->SetProperty( "right", Temp );
   Temp->SetLong( three.bottom );
   result->SetProperty( "bottom", Temp );
}

//============================================================================
//
// Example # 6.
//
// Through the use of code blocks dBASE code can be executed on the fly
// inside the DLL. The 2 objects that are passed in are compared, changed,
// and compared again, all through codeblocks.
//
//============================================================================

BOOL _cdecl AreEqual( DBaseVar *one, DBaseVar * two ){

   DVar Temp, Result;

       // Check that the types are equal.
   if( one->Type() != two->Type() )
       return 0;

       // Compare them and return the result.
   Temp->SetCodeBlock( "{|a,b| a=b}" );
   Temp->RunCodeBlock( Result,2,&one );
   return Result->Logical();
}

char * _export _pascal CheckAndChange( DBaseVar *one, DBaseVar *two ) {

   BOOL Result1, Result2;
   DVar Temp1, Temp2, Temp3( 3.0L );

       // Temp3Ptr is used to pass a DVar to a function that
       // expects a DBaseVar**.
   DBaseVar * Temp3Ptr = Temp3;

       // Announce that we arrived.
   Temp1->SetCodeBlock( "{ ;? 'Inside CheckAndChange' }" );
   Temp1->RunCodeBlock( Temp2, 0, (DVar*)0 );

       // Check if they are equal coming in.
   Result1 = AreEqual( one, two );

       // Change the 2 objects through codeblocks.
   Temp1->SetCodeBlock( "{ 4.0 }" );
   Temp1->RunCodeBlock( one, 0, (DVar*)0 );
   Temp1->SetCodeBlock( "{ |a| a }" );
   Temp1->RunCodeBlock( two, 1, &Temp3Ptr );

       // Check that they are not equal anymore.
   Result2 = AreEqual( one, two );

       // Return the result.
   if( Result1 == 1 && Result2 == 0 )
       return "passed"; else return "failed";
}

//============================================================================
//
// Example # 7.
//
// dBASE arrays can be accessed in the DLL.  This example computes the
// average of the members of an array created on the dBASE side.
// The DLL function is called without any parameters.  To be able to
// get at the array, the DLL function is executed through a function
// pointer that is a member of the same object as the array.  Inside
// the DLL you can get the "this" pointer of the object the caller
// belongs to, and through that "this" pointer you can access the
// array members.
// Normally ofcourse you can just pass the array into a DBaseVar.
//
//============================================================================

DoubleType _export _cdecl ComputeAverage(){

   DoubleType d = 0;
   long iSize;
   int iCount=0;
   int i = 1;
   DVar pValue;
   DVar Size;

       // pSize is used to pass Size to functions expecting a DBaseVar**.
   DBaseVar *pSize = Size;

       // Initialize pThis with the "this" of the object the caller
       // belongs to.
   DVar pThis(DBase()->GetThis());

       // If we're not inside the context of a memberfunction return.
   if(pThis == 0) return 0;

       // Get the Size of the array of the object.
   pThis->Property("SIZE",Size);
   iSize = Size->Long();

       // Loop thru the array and total the elements.
   while( i < iSize){
      Size->SetLong(i);
      pThis->Element(pValue,1,&pSize);
      DoubleType d1;
      d += pValue->Double();
      iCount++;
      i++;
   }
       // Return the average.
   return d/iCount;
}

//============================================================================
//
// Example # 8.
//
// This example puts into "practice" a majority of the available
// memberfunctions of the DBaseVar class.
//
//============================================================================

long _pascal _export TestABunch( DBaseVar *Var ){

   DVar Elems1[6], Elems2[6];
   DVar Temp;
   long Errors = 0;

       // Set up 6 different objects. Check returns of Set.. functions.
   if( Elems1[0]->SetLogical( 1 ) != 1 )
       Errors += 1;
   if( Elems1[1]->SetDouble( 2.0L ) != 2.0L )
       Errors += 2;
   if( Elems1[2]->SetLong( 3L ) != 3L )
       Errors += 4;
   if( strcmp( Elems1[3]->SetZString( "Hi" ), "Hi" ) != 0 )
       Errors += 8;
   if( Elems1[4]->SetLong( 100L ) != 100L )
       Errors += 16;
   if( Elems1[5]->SetDouble( 5.5L ) != 5.5L )
       Errors += 32;

       // pParams is used to be able to pass params in one block.
   DBaseVar *pParams[2];
   DVar      Param1;
   DVar      Param2;

       // Set up the array of params.
   pParams[0] = Param1;
   pParams[1] = Param2;

       // Make a 2 by 3 array.
   Temp->SetCodeBlock("{|a,b| new array(a,b)}");
   Param1->SetLong(2);
   Param2->SetLong(3);
   Temp->RunCodeBlock(Var,2,pParams);

       // Fill in the array.
   for( int i=0; i<6; i++ ){
       Param1->SetLong( 1 + i % 2 );    // 1 - 2
       Param2->SetLong( 1 + i % 3 );    // 1 - 3
       Var->SetElement( 2,pParams,Elems1[i] );
   }

       // Read back the array into a different variable.
   for( i=0; i<6; i++ ){
       Param1->SetLong( 1 + i % 2 );    // 1 - 2
       Param2->SetLong( 1 + i % 3 );    // 1 - 3
       Var->Element( Elems2[i],2,pParams );
   }

       // Now check if it worked.
   Temp->Set( Elems2[0] );
   if( Temp->Logical() != 1 || Temp->Type() != 'L' )
       Errors += 64;
   if( !AreEqual( Elems1[0], Elems2[0] ) )
       Errors += 64;
   Temp->Set( Elems2[1] );
   if( Temp->Double() != 2.0L || Temp->Type() != 'N' )
       Errors += 128;
   if( !AreEqual( Elems1[1], Elems2[1] ) )
       Errors += 128;
   Temp->Set( Elems2[2] );
   if( Temp->Long() != 3L || Temp->Type() != 'I' )
       Errors += 256;
   if( !AreEqual( Elems1[2], Elems2[2] ) )
       Errors += 256;
   Temp->Set( Elems2[3] );
   if( strcmp( Temp->String(), "Hi" ) != 0 || Temp->Type() != 'C' )
       Errors += 512;
   if( !AreEqual( Elems1[3], Elems2[3] ) )
       Errors += 512;
   Temp->Set( Elems2[4] );
   if( Temp->Long() != 100L || Temp->Type() != 'I' )
       Errors += 1024;
   if( !AreEqual( Elems1[4], Elems2[4] ) )
       Errors += 1024;
   Temp->Set( Elems2[5] );
   if( Temp->Double() != 5.5L || Temp->Type() != 'N' )
       Errors += 2048;
   if( !AreEqual( Elems1[5], Elems2[5] ) )
       Errors += 2048;

       // And check Var using properties.
   Var->Property( "SIZE", Temp );
   if( Temp->Long() != 6 )
       Errors += 4096;
   Var->Property( "DIMENSIONS", Temp );
   if( Temp->Long() != 2 )
       Errors += 4096;

   return Errors;
}

//============================================================================
//
// Example # 9.
//
// This example grabs the DOS environment, puts it in a string and sends
// it over to the dBASE side.
//
//============================================================================

void _export _cdecl GetEnvString(DBaseVar *pVarReturn){

   char *pEnviron = *environ;

       // Find the length and set it.
   while(strlen(pEnviron) != 0){
      pEnviron += strlen(pEnviron)+1;
   }
   int environLen = pEnviron - *environ;

       // Make room for the string and copy it.
   pVarReturn->SetStringLen(environLen);
   memcpy(pVarReturn->StringBuffer(),*environ,environLen);

       // Go through the string and change the zero characters into blanks.
   int count = 0;
   pEnviron = pVarReturn->StringBuffer();

   while( count < (environLen - 1) ) {
       if( *( pEnviron + count ) == 0x0 )
           *( pEnviron + count ) = ' ';
       count++;
   }
}

//============================================================================
//
// Example # 10.
//
// This example is called with a variable number of parameters using
// the func(...) syntax.
//
//============================================================================

DoubleType _cdecl _export AddNumbers( int pCount, DBaseVar *pFirstNum){

       // pFirstNum points to the parameters.
   DBaseVar **ppVars = &pFirstNum;
   DoubleType d = 0;

       // Go thru the parameters and add them.
   while(pCount--){
      d += (*ppVars)->Double();
      ppVars++;
   }
   return d;
}

//============================================================================
//
// Example 11.
//
// This example shows how a dBASE object can be combined with an "hidden"
// C++ sister object.  Each dBASE object has its own unique C++ object.
// This allows a dBASE object to "remember and store" its own details
// specific to the DLL in the C++ object instead of having to save it
// in the dBASE object. Examples are the storing of filehandles, and
// filepointers when the DLL is servicing files.
// Another possibility is a form of late binding where at the time of
// creation of the C++ part a choice can be made from several derived
// classes based on a common parent object.
//
//============================================================================

//
// Common parent object
//
class DLLObject {
protected:
   char Message[60];
   char ID[30];
public:
   DLLObject() {}
   virtual char * Doit() = 0;
};

//
// ObjectA
//
class ObjectA : public DLLObject {
public:
   ObjectA( char *In ) { strcpy( ID, In ); }
   char * Doit();
};

char * ObjectA::Doit() {
   strcpy( Message, ID );
   strcat( Message, "you can read this" );
   return Message;
}

//
// ObjectB
//
class ObjectB : public DLLObject {
public:
   ObjectB( char * In ) { strcpy( ID, In ); }
   char * Doit();
};

char * ObjectB::Doit() {
   strcpy( Message, ID );
   strcat( Message, "siht daer t'nac uoy" );
   return Message;
}

//
// Helper function to retrieve the C++ this pointer from
// the calling dBASE object.
//
DLLObject *GetCPlusPlusThis() {

       // Local vars. Get the this of the dBASEWin object.
   DVar CThis, DBaseThis( DBase()->GetThis() );

       // Get the this of the corresponding C++ object.
   DBaseThis->Property( "cthis", CThis );

   return (DLLObject*)(CThis->Long());
}

//
// Initializes the C++ object. Inserts the C++ this pointer into
// the calling dBASE object.
//
int _export _pascal DLLObjectInit( int Number ) {

   DLLObject * ThisDLLObject;
   char Message[50];
   static int Count = 0;

       // Get the this of the calling dBASE object.
   DVar CThis( DBase()->GetThis() );

       // Assign unique id, store object type.
   sprintf( Message, "ID# %d, Type: Object #%d ", ++Count, Number );

       // Choose what kind of C++ object to create.
   if( Number == 1 ) {

#ifdef NO_EXCEPTIONS

           // Create new C++ object.
       ThisDLLObject = new ObjectA( Message );
       if( ThisDLLObject == NULL )
           return 0;

           // Sneak this pointer into the dBASE object.
       CThis->SetProperty( "cthis", DVar( (long) ThisDLLObject ) );
   }
   else {
           // Create new C++ object.
       ThisDLLObject = new ObjectB( Message );
       if( ThisDLLObject == NULL )
           return 0;

           // Sneak this pointer into the dBASE object.
       CThis->SetProperty( "cthis", DVar( (long) ThisDLLObject ) );

#else  // NO_EXCEPTIONS

       try {
               // Create new C++ object.
           ThisDLLObject = new ObjectA( Message );
               // Sneak this pointer into the dBASE object.
           CThis->SetProperty( "cthis", DVar( (long) ThisDLLObject ) );
       }
       catch( ... ) {
           return 0;
       }
   }
   else {
       try {
               // Create new C++ object.
           ThisDLLObject = new ObjectB( Message );
               // Sneak this pointer into the dBASE object.
           CThis->SetProperty( "cthis", DVar( (long) ThisDLLObject ) );
       }
       catch( ... ) {
           return 0;
       }

#endif  // NO_EXCEPTIONS

   }

   return 1;
}

//
// Helper function to call the Doit function tied to the
// calling dBASE object.
//
char * _export _pascal Doit() {
   return GetCPlusPlusThis()->Doit();
}

//
// Helper function to delete the C++ object tied to the calling dBASE object.
//
void _export _pascal Release() {
   delete GetCPlusPlusThis();
}

   // extern "C"
}