Please help me pass an array from VBA to Perl and populate it. Newbie at wits' end!

  • Thread starter david.f.jenkins
  • Start date
D

david.f.jenkins

Well, I went and looked at the PDK Samples I got with the distribution,
and found nothing that would help me.

Here's what I want - surely this is child's play to experienced
Perlers:

I want to pass an empty container for a set of strings from VBA into
Perl, do some stuff in Perl, and populate the Collection with a set of
strings. I've stolen most of the PDK Perlctrl regex sample and made
some small mods to it to meet my requirements.

In general, the VBA side is easy, but I do have these VBA questions:
should the array be typed in VBA as a Collection? Variant? Object?
Something else? And why? Where is that documented?

I'm at a complete loss as to what to do on the Perl side:

1. How do I specify the parameter to the method? My intuition tells me
that it ought to be a scalar that contains a pointer (reference?) to
the Collection. If I type the parameter in VBA as a Variant, say, can
I operatoe on it in Perl as an array? Should I show it as $something?
@something? Something else?
2. In the TypeLib, how do I show the parameter? VT_ARRAY? VT_VARIANT?
VT_BSTR? VT_something else?
3. Someplace I saw, while crashing thorugh endless Google references,
the notation "VT_VARIANT|VT_ARRAY" What does that mean? Where is that
documented? Is that what I should use?
4. Do I have to populate my own Perl array and then do something
special to get it into the VBA array? Or can I process directly into
it? If so, what would be the pointer/reference/dereference notation I'd
be most likely to use?
5. What notation do I use in Perl if the parameter is defined as
$something? Do I populate it by using @$something?
5. Would it be possible to populate an array in Perl and then allow the
VBA code to access the array using a get_xxx() function? If so, would
the name of that function be "get_arrayname()" where "arrayname" is the
name of the Perl array? Do all classes created by Perlctrl have such
methods created for them? Where is that documented?

Isn't there a simple example someplace that would show me how to do
this? I understand that it's not "Hello, world" but it ought to be a
common enough requirement that the problem's been solved over and over
again.

Do I sound extremely frustrated? Well, I am...
 
R

robic0

Well, I went and looked at the PDK Samples I got with the distribution,
and found nothing that would help me.

Here's what I want - surely this is child's play to experienced
Perlers:

I want to pass an empty container for a set of strings from VBA into
Perl, do some stuff in Perl, and populate the Collection with a set of
strings. I've stolen most of the PDK Perlctrl regex sample and made
some small mods to it to meet my requirements.

In general, the VBA side is easy, but I do have these VBA questions:
should the array be typed in VBA as a Collection? Variant? Object?
Something else? And why? Where is that documented?

I'm at a complete loss as to what to do on the Perl side:

1. How do I specify the parameter to the method? My intuition tells me
that it ought to be a scalar that contains a pointer (reference?) to
the Collection. If I type the parameter in VBA as a Variant, say, can
I operatoe on it in Perl as an array? Should I show it as $something?
@something? Something else?
2. In the TypeLib, how do I show the parameter? VT_ARRAY? VT_VARIANT?
VT_BSTR? VT_something else?
3. Someplace I saw, while crashing thorugh endless Google references,
the notation "VT_VARIANT|VT_ARRAY" What does that mean? Where is that
documented? Is that what I should use?
4. Do I have to populate my own Perl array and then do something
special to get it into the VBA array? Or can I process directly into
it? If so, what would be the pointer/reference/dereference notation I'd
be most likely to use?
5. What notation do I use in Perl if the parameter is defined as
$something? Do I populate it by using @$something?
5. Would it be possible to populate an array in Perl and then allow the
VBA code to access the array using a get_xxx() function? If so, would
the name of that function be "get_arrayname()" where "arrayname" is the
name of the Perl array? Do all classes created by Perlctrl have such
methods created for them? Where is that documented?

Isn't there a simple example someplace that would show me how to do
this? I understand that it's not "Hello, world" but it ought to be a
common enough requirement that the problem's been solved over and over
again.

Do I sound extremely frustrated? Well, I am...
Click to expand...

Here this should help you.....

enum VARENUM
{ VT_EMPTY = 0,
VT_NULL = 1,
VT_I2 = 2,
VT_I4 = 3,
VT_R4 = 4,
VT_R8 = 5,
VT_CY = 6,
VT_DATE = 7,
VT_BSTR = 8,
VT_DISPATCH = 9,
VT_ERROR = 10,
VT_BOOL = 11,
VT_VARIANT = 12,
VT_UNKNOWN = 13,
VT_DECIMAL = 14,
VT_I1 = 16,
VT_UI1 = 17,
VT_UI2 = 18,
VT_UI4 = 19,
VT_I8 = 20,
VT_UI8 = 21,
VT_INT = 22,
VT_UINT = 23,
VT_VOID = 24,
VT_HRESULT = 25,
VT_PTR = 26,
VT_SAFEARRAY = 27,
VT_CARRAY = 28,
VT_USERDEFINED = 29,
VT_LPSTR = 30,
VT_LPWSTR = 31,
VT_RECORD = 36,
VT_FILETIME = 64,
VT_BLOB = 65,
VT_STREAM = 66,
VT_STORAGE = 67,
VT_STREAMED_OBJECT = 68,
VT_STORED_OBJECT = 69,
VT_BLOB_OBJECT = 70,
VT_CF = 71,
VT_CLSID = 72,
VT_BSTR_BLOB = 0xfff,
VT_VECTOR = 0x1000,
VT_ARRAY = 0x2000,
VT_BYREF = 0x4000,
VT_RESERVED = 0x8000,
VT_ILLEGAL = 0xffff,
VT_ILLEGALMASKED = 0xfff,
VT_TYPEMASK = 0xfff
};
 
R

robic0

Here this should help you.....

enum VARENUM
{ VT_EMPTY = 0,
VT_NULL = 1,
VT_I2 = 2,
VT_I4 = 3,
VT_R4 = 4,
VT_R8 = 5,
VT_CY = 6,
VT_DATE = 7,
VT_BSTR = 8,
VT_DISPATCH = 9,
VT_ERROR = 10,
VT_BOOL = 11,
VT_VARIANT = 12,
VT_UNKNOWN = 13,
VT_DECIMAL = 14,
VT_I1 = 16,
VT_UI1 = 17,
VT_UI2 = 18,
VT_UI4 = 19,
VT_I8 = 20,
VT_UI8 = 21,
VT_INT = 22,
VT_UINT = 23,
VT_VOID = 24,
VT_HRESULT = 25,
VT_PTR = 26,
VT_SAFEARRAY = 27,
VT_CARRAY = 28,
VT_USERDEFINED = 29,
VT_LPSTR = 30,
VT_LPWSTR = 31,
VT_RECORD = 36,
VT_FILETIME = 64,
VT_BLOB = 65,
VT_STREAM = 66,
VT_STORAGE = 67,
VT_STREAMED_OBJECT = 68,
VT_STORED_OBJECT = 69,
VT_BLOB_OBJECT = 70,
VT_CF = 71,
VT_CLSID = 72,
VT_BSTR_BLOB = 0xfff,
VT_VECTOR = 0x1000,
VT_ARRAY = 0x2000,
VT_BYREF = 0x4000,
VT_RESERVED = 0x8000,
VT_ILLEGAL = 0xffff,
VT_ILLEGALMASKED = 0xfff,
VT_TYPEMASK = 0xfff
};
Click to expand...

Oh, this might help too .....

There's no getting around it. We'll have to look at the VARIANT structure before we can talk about what to do with it.

struct tagVARIANT {
VARTYPE vt;
WORD wReserved1;
WORD wReserved2;
WORD wReserved3;
union {
// C++ Type Union Name Type Tag Basic Type
// -------- ---------- -------- ----------
long lVal; // VT_I4 ByVal Long
unsigned char bVal; // VT_UI1 ByVal Byte
short iVal; // VT_I2 ByVal Integer
float fltVal; // VT_R4 ByVal Single
double dblVal; // VT_R8 ByVal Double
VARIANT_BOOL boolVal; // VT_BOOL ByVal Boolean
SCODE scode; // VT_ERROR
CY cyVal; // VT_CY ByVal Currency
DATE date; // VT_DATE ByVal Date
BSTR bstrVal; // VT_BSTR ByVal String
IUnknown *punkVal; // VT_UNKNOWN
IDispatch *pdispVal; // VT_DISPATCH ByVal Object
SAFEARRAY *parray; // VT_ARRAY|* ByVal array
// A bunch of other types that don't matter here...
VARIANT *pvarVal; // VT_BYREF|VT_VARIANT ByRef Variant
void * byref; // Generic ByRef
};
};
 
R

robic0

<snip>

I'm posting a ADO wrapper class (for recordsets) I did about 6 years ago.
Its intimitaly involved in VARIANTS, which has an intrinsic language _variant_t
cast.

I am posting because you don't know what it is and you think Perl can easily
process this type of information. Maybe someone has done it, dunno. If they
have, its probably wrong.

Variants are a way to have typeless data recorded and partitioned in memory
and on persistent media. They are machine dependent, in the standard ANSI
sense. Ie: an int is not necesarily 4 bytes. What a variant does is to partition
data in 1,2,4,8 (or more) byte, definable things.

As such, it (and this is the killer) defines a structure composed of a machine dependent
variable describing the type, ie: the number of bytes the data has, and the data itself.

Except, there are endian issues and all, and still the machine dependency on the variable type
parameter. Binary data? You bet!

So I leave you with this code (its very good code too), because I would hate for good code to
go to waste that I probably won't use again. This is the part where I have forgotten more than
you will ever probably learn in your lifetime. And I still remember alot. The memory bracket
is still wide, unfortunately, theres so much that passes through it.

In the days when this was written, to think of any of this was an instant in my mind.
So I pass it on to you. But you don't care about any of this, you want a quick fix.

The point I'm trying to make is that you could go through this code and get an understanding of
variants. This was heavily used in com servers. Primarily SAFEARRAY/BSTR/Ole allocation and conversions
will be over your head but you don't need that stuff, just pick out the context of VARIANT and I'm
sure you will be able to write a 1 liner in Perl to do your conversion.

If not you will have to pay me alot of money to do it for you, and I mean alot.

gluck
robic0@well_just_ask



HEADER ------------>>>>>>>>>>>>
// ADORsX1.h: interface for the CADORsX1 class.
//
//////////////////////////////////////////////////////////////////////

#if !defined(AFX_ADORSX1_H__5D210159_CADE_4352_8BC7_A904BA94DE31__INCLUDED_)
#define AFX_ADORSX1_H__5D210159_CADE_4352_8BC7_A904BA94DE31__INCLUDED_

#if _MSC_VER > 1000
#pragma once
#endif // _MSC_VER > 1000

typedef struct tagDATAMAP_REC
{
tagDATAMAP_REC() { nCurIndex = -1; nNextIndex = -1; sMapData_FldName = _T(""); nMapData_Rec = -1; }

// Define field information ...
BOOL PutRsFieldValues(Field **field, long recnum)
{
// field[0]->put_Value( _variant_t((long)recnum) );
field[0]->put_Value( _variant_t(sMapData_FldName) );
field[1]->put_Value( _variant_t((long)nCurIndex) );
field[2]->put_Value( _variant_t((long)nMapData_Rec) );
field[3]->put_Value( _variant_t((long)nNextIndex) );
return TRUE;
}
CString sMapData_FldName;
int nCurIndex;
int nMapData_Rec;
int nNextIndex;

} DATAMAP_REC;

typedef struct tagMAPDATA_REC
{
tagMAPDATA_REC () {nMapNdx = -1; nDRec = -1;}
tagMAPDATA_REC (int nMdx, int nDr, _variant_t &vtData) {nMapNdx = nMdx; nDRec = nDr; vtStoreData = vtData;}
struct tagMAPDATA_REC& operator= (const struct tagMAPDATA_REC &sdRec)
{nMapNdx = sdRec.nMapNdx; nDRec = sdRec.nDRec; vtStoreData = sdRec.vtStoreData; return *this;}
int nMapNdx;
int nDRec;
_variant_t vtStoreData;
} MAPDATA_REC;


#include <vector>
#include <algorithm>
using namespace std;


/////////////////////////////////
// ADO Recordset helper class
class CADORsX1
{
public:
CADORsX1(_RecordsetPtr &rs);
virtual ~CADORsX1();

public:
BOOL DIST_ChangeMapUnfiltered(_RecordsetPtr &rsStore1, CString sFldStore1, _RecordsetPtr &rsStore2, CString sFldStore2);
BOOL DIST_ChangeMapFiltered(_RecordsetPtr &rsStore1, CString sFldStore1, _RecordsetPtr &rsStore2, CString sFldStore2, CString sFiltFldStore2);
BOOL DIST_CreateMap(vector <DATAMAP_REC> &vaDataMap, int *pmaxsize);
BOOL DIST_FilterRecords(CString Sortflds, CString Flagfld);
BOOL CreateTable(CString sTable, CString sDatabase, CString sUser, CString sPassword, long nOptions);
BOOL PutSort(LPCTSTR sSort);
BOOL PutFilter(LPCTSTR sFltr);
BOOL PutFilter(VARIANT sCriteria);
BOOL AddNew();
BOOL GetBookmark(VARIANT *vbookMark);
BOOL GetBookmark(_RecordsetPtr &rset, VARIANT *vbookMark);
BOOL PutBookmark(VARIANT vbookMark);
BOOL PutBookmark(_RecordsetPtr &rset, VARIANT vbookMark);

BOOL RS_PutLong(LPCTSTR sFldName, long lval);
BOOL RS_PutLong(long idx, long lval);
BOOL RS_PutBool(LPCTSTR sFldName, bool bval);
BOOL RS_PutBool(long idx, bool bval);
BOOL RS_PutDouble(LPCTSTR sFldName, double dval);
BOOL RS_PutDouble(long idx, double dval);
BOOL RS_PutFloat(LPCTSTR sFldName, double dval);
BOOL RS_PutFloat(long idx, double dval);
BOOL RS_PutInt(LPCTSTR sFldName, int ival);
BOOL RS_PutInt(long idx, int ival);
BOOL RS_PutString(LPCTSTR sFldName, LPCTSTR sval);
BOOL RS_PutString(long idx, LPCTSTR sval);
BOOL RemoveUnfilteredRecords();
BOOL RemoveUnfilteredRecords(_RecordsetPtr &rsnew);
BOOL AppendField(CString sFldName, DataTypeEnum FldType, long FldSize, FieldAttributeEnum FldAttr);
void SetSrc(_RecordsetPtr &rs);
long m_FldCount;
BOOL Update();
BOOL Delete();
BOOL GetField(_RecordsetPtr &rset, VARIANT idx, VARIANT *newVal);
BOOL GetField(VARIANT idx, VARIANT *newVal);
BOOL PutField(VARIANT idx, VARIANT newVal);
BOOL GetFieldCount(long * newVal);
BOOL First();
BOOL Next();
BOOL Last();
BOOL Prev();
BOOL IsEOF();
BOOL IsEOF(_RecordsetPtr &rset);
BOOL IsBOF();
long GetRecordCount();
BOOL Empty();
CString RS_GetString(LPCTSTR sFldName);
CString RS_GetString(int nFieldIndex);
CString ConvertVarToStr(VARIANT &var);
double RS_GetDouble(LPCTSTR sFldName);
double RS_GetDouble(int nFieldIndex);
double ConvertVarToDouble(VARIANT &var);
int RS_GetInt(LPCTSTR sFldName);
int RS_GetInt(int nFieldIndex);
int ConvertVarToInt(VARIANT &var);
float RS_GetFloat(LPCTSTR sFldName);
float RS_GetFloat(int nFieldIndex);
float ConvertVarToFloat(VARIANT &var);
long RS_GetLong(LPCTSTR sFldName);
long RS_GetLong(int nFieldIndex);
long ConvertVarToLong(VARIANT &var);
bool RS_GetBool(LPCTSTR sFldName);
bool RS_GetBool(int nFieldIndex);
bool ConvertVarToBool(VARIANT &var);
void LogItem (const CString &s);
CString GetVariantString (int nId);
int ParseStringCSV(vector <CString> &vaUNS, CString sUnits, BOOL bMakeUpper);

private:
_RecordsetPtr &m_recordset;

protected:
};

#endif // !defined(AFX_ADORSX1_H__5D210159_CADE_4352_8BC7_A904BA94DE31__INCLUDED_)

CPP ------------>>>>>>>>>>>>
// ADORsX1.cpp: implementation of the CADORsX1 class.
//
//////////////////////////////////////////////////////////////////////

#include "stdafx.h"
#include "ADORsX1.h"
#include "ADOTierX1.h"

#ifdef _DEBUG
#undef THIS_FILE
static char THIS_FILE[]=__FILE__;
#define new DEBUG_NEW
#endif

//////////////////////////////////////////////////////////////////////
// Construction/Destruction
//////////////////////////////////////////////////////////////////////

void CADORsX1::SetSrc(_RecordsetPtr &rs)
{
m_recordset = rs;
GetFieldCount(&m_FldCount);
}

CADORsX1::CADORsX1(_RecordsetPtr &rs)
: m_recordset(rs)
{
m_FldCount = 0;
if (m_recordset)
GetFieldCount(&m_FldCount);
}

CADORsX1::~CADORsX1()
{
}

BOOL CADORsX1::Update()
{
if (m_recordset == NULL)
return FALSE;
HRESULT hr = m_recordset->Update();
if (SUCCEEDED(hr))
return TRUE;
return FALSE;
}

BOOL CADORsX1::Delete()
{
if (m_recordset == NULL)
return FALSE;
HRESULT hr = m_recordset->Delete(adAffectCurrent);
if (SUCCEEDED(hr))
return TRUE;
return FALSE;
}

BOOL CADORsX1::GetField(VARIANT idx, VARIANT *newVal)
{
if (m_recordset == NULL)
return FALSE;
Fields* fields = 0;
HRESULT hr = m_recordset->get_Fields(&fields);

Field* field = 0;
if (SUCCEEDED(hr))
hr = fields->get_Item(idx, &field);
if (SUCCEEDED(hr))
hr = field->get_Value(newVal);

if (SUCCEEDED(hr))
{
fields->Release();
field->Release();
}
if (SUCCEEDED(hr))
return TRUE;
return FALSE;
}

BOOL CADORsX1::GetField(_RecordsetPtr &rset, VARIANT idx, VARIANT *newVal)
{
if (rset == NULL)
return FALSE;
Fields* fields = 0;
HRESULT hr = rset->get_Fields(&fields);

Field* field = 0;
if (SUCCEEDED(hr))
hr = fields->get_Item(idx, &field);
if (SUCCEEDED(hr))
hr = field->get_Value(newVal);

if (SUCCEEDED(hr))
{
fields->Release();
field->Release();
}
if (SUCCEEDED(hr))
return TRUE;
return FALSE;
}

BOOL CADORsX1::putField(VARIANT idx, VARIANT newVal)
{
if (m_recordset == NULL)
return FALSE;
Fields* fields = 0;
HRESULT hr = m_recordset->get_Fields(&fields);
Field* field = 0;
if (SUCCEEDED(hr))
hr = fields->get_Item(idx, &field);
if (SUCCEEDED(hr))
hr = field->put_Value(newVal);

if (SUCCEEDED(hr))
{
fields->Release();
field->Release();
}
if (SUCCEEDED(hr))
return TRUE;
return FALSE;
}

BOOL CADORsX1::GetFieldCount(long * newVal)
{
if (m_recordset == NULL)
return FALSE;
Fields* fields = 0;
HRESULT hr = m_recordset->get_Fields(&fields);
if (SUCCEEDED(hr))
hr = fields->get_Count(newVal);
if (SUCCEEDED(hr))
fields->Release();
if (SUCCEEDED(hr))
return TRUE;
return FALSE;
}

BOOL CADORsX1::First()
{
if (m_recordset == NULL)
return FALSE;
HRESULT hr = m_recordset->MoveFirst();
if (SUCCEEDED(hr))
return TRUE;
return FALSE;
}

BOOL CADORsX1::Next()
{
if (m_recordset == NULL)
return FALSE;
HRESULT hr = m_recordset->MoveNext();
if (SUCCEEDED(hr))
return TRUE;
return FALSE;
}

BOOL CADORsX1::Last()
{
if (m_recordset == NULL)
return FALSE;
HRESULT hr = m_recordset->MoveLast();
if (SUCCEEDED(hr))
return TRUE;
return FALSE;
}

BOOL CADORsX1::prev()
{
if (m_recordset == NULL)
return FALSE;
HRESULT hr = m_recordset->MovePrevious();
if (SUCCEEDED(hr))
return TRUE;
return FALSE;
}

BOOL CADORsX1::IsEOF(_RecordsetPtr &rset)
{
if (rset == NULL)
return FALSE;
VARIANT_BOOL newVal;
HRESULT hr = rset->get_EOF(&newVal);
if (SUCCEEDED(hr) && newVal)
return TRUE;
return FALSE;
}

BOOL CADORsX1::IsEOF()
{
if (m_recordset == NULL)
return FALSE;
VARIANT_BOOL newVal;
HRESULT hr = m_recordset->get_EOF(&newVal);
if (SUCCEEDED(hr) && newVal)
return TRUE;
return FALSE;
}

BOOL CADORsX1::IsBOF()
{
if (m_recordset == NULL)
return FALSE;
VARIANT_BOOL newVal;
HRESULT hr = m_recordset->get_BOF(&newVal);
if (SUCCEEDED(hr) && newVal)
return TRUE;
return FALSE;
}

long CADORsX1::GetRecordCount()
{
if (m_recordset == NULL)
return FALSE;
long pl;
pl = 0;
HRESULT hr = m_recordset->get_RecordCount(&pl);
if (SUCCEEDED(hr))
return pl;
return 0L;
}

BOOL CADORsX1::Empty()
{
if (m_recordset == NULL)
return FALSE;
VARIANT_BOOL bEmpty;
HRESULT hr = m_recordset->get_EOF(&bEmpty);
if (SUCCEEDED(hr) && &bEmpty)
hr = m_recordset->get_BOF(&bEmpty);
if (SUCCEEDED(hr) && bEmpty)
return TRUE;
return FALSE;
}


/////////////// Utilities: Get DAO Field ///////////////////
/*
enum VARENUM
{ VT_EMPTY = 0,
VT_NULL = 1,
VT_I2 = 2,
VT_I4 = 3,
VT_R4 = 4,
VT_R8 = 5,
VT_CY = 6,
VT_DATE = 7,
VT_BSTR = 8,
VT_DISPATCH = 9,
VT_ERROR = 10,
VT_BOOL = 11,
VT_VARIANT = 12,
VT_UNKNOWN = 13,
VT_DECIMAL = 14,
VT_I1 = 16,
VT_UI1 = 17,
VT_UI2 = 18,
VT_UI4 = 19,
VT_I8 = 20,
VT_UI8 = 21,
VT_INT = 22,
VT_UINT = 23,
VT_VOID = 24,
VT_HRESULT = 25,
VT_PTR = 26,
VT_SAFEARRAY = 27,
VT_CARRAY = 28,
VT_USERDEFINED = 29,
VT_LPSTR = 30,
VT_LPWSTR = 31,
VT_RECORD = 36,
VT_FILETIME = 64,
VT_BLOB = 65,
VT_STREAM = 66,
VT_STORAGE = 67,
VT_STREAMED_OBJECT = 68,
VT_STORED_OBJECT = 69,
VT_BLOB_OBJECT = 70,
VT_CF = 71,
VT_CLSID = 72,
VT_BSTR_BLOB = 0xfff,
VT_VECTOR = 0x1000,
VT_ARRAY = 0x2000,
VT_BYREF = 0x4000,
VT_RESERVED = 0x8000,
VT_ILLEGAL = 0xffff,
VT_ILLEGALMASKED = 0xfff,
VT_TYPEMASK = 0xfff
};
*/

CString CADORsX1::RS_GetString(LPCTSTR sFldName)
{
if (m_recordset == NULL)
return _T("");
_variant_t newVal;
CString stmp = _T("");

if (GetField(_variant_t(sFldName), &newVal))
stmp = ConvertVarToStr(newVal);
#ifdef _VTDEBUG
else
LogItem("RS_GetString : GetField(FldName) returned error.");
#endif
return stmp;
}


CString CADORsX1::RS_GetString(int nFieldIndex)
{
if (m_recordset == NULL)
return _T("");
CString str;
_variant_t newVal;
CString stmp = _T("");

if (1)//nFieldIndex >= 0 && nFieldIndex <= m_FldCount)
{
if (GetField(_variant_t((long)nFieldIndex), &newVal))
stmp = ConvertVarToStr(newVal);
#ifdef _VTDEBUG
else
LogItem("RS_GetString : GetField(FldIndex) returned error.");
#endif
}
#ifdef _VTDEBUG
else
LogItem("RS_GetString : Field Index out of range");
#endif
return stmp;
}


CString CADORsX1::ConvertVarToStr(VARIANT &var)
{
USES_CONVERSION;
if (m_recordset == NULL)
return _T("");
// Check that newVal is of type BSTR
// MessageBox(0,(const char*)_bstr_t(tp),"Message",0);
CString str = _T("");

switch (var.vt)
{
case VT_BSTR:
str = OLE2CT(var.bstrVal);
::SysFreeString(var.bstrVal);
break;

default:
#ifdef _VTDEBUG
LogItem("RS_GetString : " + GetVariantString (var.vt) + " Not String Type");
#endif
break;
}
return str;
}


double CADORsX1::RS_GetDouble(LPCTSTR sFldName)
{
if (m_recordset == NULL)
return 0.;
_variant_t newVal;
double dVal = 0.;

if (GetField(_variant_t(sFldName), &newVal))
dVal = ConvertVarToDouble(newVal);
#ifdef _VTDEBUG
else
LogItem("RS_GetDouble : GetField(FldName) returned error.");
#endif
return dVal;
}


double CADORsX1::RS_GetDouble(int nFieldIndex)
{
if (m_recordset == NULL)
return 0.;
_variant_t newVal;
double dVal = 0.;

if (1)//nFieldIndex >= 0 && nFieldIndex <= m_FldCount)
{
if (GetField(_variant_t((long)nFieldIndex), &newVal))
dVal = ConvertVarToDouble(newVal);
#ifdef _VTDEBUG
else
LogItem("RS_GetDouble : GetField(FldIndex) returned error.");
#endif
}
#ifdef _VTDEBUG
else
LogItem("RS_GetDouble : Field Index out of range");
#endif
return dVal;
}


double CADORsX1::ConvertVarToDouble(VARIANT &var)
{
if (m_recordset == NULL)
return FALSE;
double dVal = 0.;
switch (var.vt)
{
case VT_I2:
dVal = var.iVal;
break;
case VT_I4:
dVal = var.lVal;
break;
case VT_R4:
dVal = (double) var.fltVal;
break;
case VT_R8:
dVal = var.dblVal;
break;

default:
#ifdef _VTDEBUG
LogItem("RS_GetDouble : " + GetVariantString (var.vt) + " Not Numeric Type");
#endif
break;
}
return dVal;
}


int CADORsX1::RS_GetInt(LPCTSTR sFldName)
{
if (m_recordset == NULL)
return FALSE;
_variant_t newVal;
int nVal = 0;

if (GetField(_variant_t(sFldName), &newVal))
nVal = ConvertVarToInt(newVal);
#ifdef _VTDEBUG
else
LogItem("RS_GetInt : GetField(FldName) returned error.");
#endif
return nVal;
}


int CADORsX1::RS_GetInt(int nFieldIndex)
{
if (m_recordset == NULL)
return FALSE;
CString str;

_variant_t newVal;
int nVal = 0;

if (1)//nFieldIndex >= 0 && nFieldIndex <= m_FldCount)
{
if (GetField(_variant_t((long)nFieldIndex), &newVal))
nVal = ConvertVarToInt(newVal);
#ifdef _VTDEBUG
else
LogItem("RS_GetInt : GetField(FldIndex) returned error.");
#endif
}
#ifdef _VTDEBUG
else
LogItem("RS_GetInt : Field Index out of range");
#endif
return nVal;
}


int CADORsX1::ConvertVarToInt(VARIANT &var)
{
if (m_recordset == NULL)
return FALSE;
int nVal = 0;
switch (var.vt)
{
case VT_I2:
nVal = (int) var.iVal;
break;
case VT_I4:
nVal = var.lVal;
break;

default:
#ifdef _VTDEBUG
LogItem("RS_GetInt : " + GetVariantString (var.vt) + " Not Integer Type");
#endif
break;
}
return nVal;
}


float CADORsX1::RS_GetFloat(LPCTSTR sFldName)
{
if (m_recordset == NULL)
return FALSE;
_variant_t newVal;
float dVal = 0.;

if (GetField(_variant_t(sFldName), &newVal))
dVal = ConvertVarToFloat(newVal);
#ifdef _VTDEBUG
else
LogItem("RS_GetFloat : GetField(FldName) returned error.");
#endif
return dVal;
}


float CADORsX1::RS_GetFloat(int nFieldIndex)
{
if (m_recordset == NULL)
return FALSE;
_variant_t newVal;
float dVal = 0.;

if (1)//nFieldIndex >= 0 && nFieldIndex <= m_FldCount)
{
if (GetField(_variant_t((long)nFieldIndex), &newVal))
dVal = ConvertVarToFloat(newVal);
#ifdef _VTDEBUG
else
LogItem("RS_GetFloat : GetField(FldIndex) returned error.");
#endif
}
#ifdef _VTDEBUG
else
LogItem("RS_GetFloat : Field Index out of range");
#endif
return dVal;
}


float CADORsX1::ConvertVarToFloat(VARIANT &var)
{
if (m_recordset == NULL)
return FALSE;
float dVal = 0;
switch (var.vt)
{
case VT_I2:
dVal = (float) var.iVal;
break;
case VT_I4:
dVal = (float) var.lVal;
break;
case VT_R4:
dVal = var.fltVal;
break;
case VT_R8:
dVal = (float) var.dblVal;
break;

default:
#ifdef _VTDEBUG
LogItem("RS_GetFloat : " + GetVariantString (var.vt) + " Not Numeric Type");
#endif
break;
}
return dVal;
}


long CADORsX1::RS_GetLong(LPCTSTR sFldName)
{
if (m_recordset == NULL)
return FALSE;
_variant_t newVal;
long nVal = 0;

if (GetField(_variant_t(sFldName), &newVal))
nVal = ConvertVarToLong(newVal);
#ifdef _VTDEBUG
else
LogItem("RS_GetLong : GetField(FldName) returned error.");
#endif
return nVal;
}


long CADORsX1::RS_GetLong(int nFieldIndex)
{
if (m_recordset == NULL)
return FALSE;
CString str;
_variant_t newVal;
long nVal = 0;

if (1)//nFieldIndex >= 0 && nFieldIndex <= m_FldCount)
{
if (GetField(_variant_t((long)nFieldIndex), &newVal))
nVal = ConvertVarToLong(newVal);
#ifdef _VTDEBUG
else
LogItem("RS_GetLong : GetField(FldIndex) returned error.");
#endif
}
#ifdef _VTDEBUG
else
LogItem("RS_GetLong : Field Index out of range");
#endif
return nVal;
}


long CADORsX1::ConvertVarToLong(VARIANT &var)
{
if (m_recordset == NULL)
return FALSE;
long nVal = 0;
switch (var.vt)
{
case VT_I2:
nVal = (int) var.iVal;
break;
case VT_I4:
nVal = var.lVal;
break;

default:
#ifdef _VTDEBUG
LogItem("RS_GetLong : " + GetVariantString (var.vt) + " Not Integer Type");
#endif
break;
}
return nVal;
}


bool CADORsX1::RS_GetBool(LPCTSTR sFldName)
{
if (m_recordset == NULL)
return FALSE;
_variant_t newVal;
bool bVal = false;

if (GetField(_variant_t(sFldName), &newVal))
bVal = ConvertVarToBool(newVal);
#ifdef _VTDEBUG
else
LogItem("RS_GetBool : GetField(FldName) returned error.");
#endif
return bVal;
}


bool CADORsX1::RS_GetBool(int nFieldIndex)
{
if (m_recordset == NULL)
return FALSE;
CString str;
_variant_t newVal;
bool bVal = 0;

if (1)//nFieldIndex >= 0 && nFieldIndex <= m_FldCount)
{
if (GetField(_variant_t((long)nFieldIndex), &newVal))
bVal = ConvertVarToBool(newVal);
#ifdef _VTDEBUG
else
LogItem("RS_GetBool : GetField(FldIndex) returned error.");
#endif
}
#ifdef _VTDEBUG
else
LogItem("RS_GetBool : Field Index out of range");
#endif
return bVal;
}


bool CADORsX1::ConvertVarToBool(VARIANT &var)
{
if (m_recordset == NULL)
return FALSE;
bool bVal = false;
switch (var.vt)
{
case VT_BOOL:
bVal = (var.boolVal == 0) ? false : true;
break;
default:
#ifdef _VTDEBUG
LogItem("RS_GetBool : " + GetVariantString (var.vt) + " Not Logical Type");
#endif
break;
}
return bVal;
}


void CADORsX1::LogItem (const CString &s)
{
TRACE(s + "\r\n");
}


static CString sVT[] = {

_T("VT_EMPTY") ,// 0, [V] nothing
_T("VT_NULL") ,// 1, [V] SQL style Null
_T("VT_I2") ,// 2, [V] 2 byte signed int
_T("VT_I4") ,// 3, [V] 4 byte signed int
_T("VT_R4") ,// 4, [V] 4 byte real
_T("VT_R8") ,// 5, [V] 8 byte real
_T("VT_CY") ,// 6, [V] currency
_T("VT_DATE") ,// 7, [V] date
_T("VT_BSTR") ,// 8, [V] OLE Automation string
_T("VT_DISPATCH") ,// 9, [V] IDispatch *
_T("VT_ERROR") ,// 10, [V] SCODE
_T("VT_BOOL") ,// 11, [V] True=-1, False=0
_T("VT_VARIANT") ,// 12, [V] VARIANT *
_T("VT_UNKNOWN") ,// 13, [V] IUnknown *
_T("VT_DECIMAL") ,// 14, [V] 16 byte fixed point
_T("VT_I1") ,// 16, [V] signed char
_T("VT_UI1") ,// 17, [V] unsigned char
_T("VT_UI2") ,// 18, [V] unsigned short
_T("VT_UI4") ,// 19, [V] unsigned short
_T("VT_I8") ,// 20, [T] signed 64-bit int
_T("VT_UI8") ,// 21, [T] unsigned 64-bit int
_T("VT_INT") ,// 22, [V] signed machine int
_T("VT_UINT") ,// 23, [V] unsigned machine int
_T("VT_ARRAY") ,// 0x2000, [V] SAFEARRAY*
_T("VT_BYREF") ,// 0x4000, [V] void* for local use
_T("none") };


CString CADORsX1::GetVariantString (int nId)
{
if (m_recordset == NULL)
return _T("");
if (nId == 0x2000)
nId = 24;
else
if (nId == 0x4000)
nId = 25;
else
if (!(nId >= 0 && nId <= 23))
nId = 26;
return sVT[nId];
}


BOOL CADORsX1::AppendField(CString FldName, DataTypeEnum FldType, long FldSize, FieldAttributeEnum FldAttr)
{
if (m_recordset == NULL)
return FALSE;
// Append new field ...
Fields *fields = 0;
HRESULT hr = m_recordset->get_Fields(&fields);
if (SUCCEEDED(hr))
hr = fields->Append(_bstr_t(FldName), FldType, FldSize, FldAttr);
if (fields != NULL)
fields->Release();
if (SUCCEEDED(hr))
return TRUE;
return FALSE;
}

BOOL CADORsX1::RemoveUnfilteredRecords()
{
if (m_recordset == NULL)
return FALSE;
_StreamPtr tmpStream = 0;
HRESULT hr = tmpStream.CreateInstance(__uuidof(Stream));
if (SUCCEEDED(hr))
hr = tmpStream->put_Type(adTypeBinary);
if (SUCCEEDED(hr))
hr = m_recordset->Save(_variant_t(tmpStream.GetInterfacePtr()), adPersistADTG);
m_recordset->Close();
tmpStream->put_Position(0);
if (SUCCEEDED(hr))
hr = m_recordset->Open(_variant_t(tmpStream.GetInterfacePtr()),_variant_t((IDispatch *)NULL,false),adOpenUnspecified,adLockUnspecified,adCmdFile);//adConnectUnspecified);
tmpStream->Close();
tmpStream.Release();
if (SUCCEEDED(hr))
return TRUE;
return FALSE;
}

BOOL CADORsX1::RemoveUnfilteredRecords(_RecordsetPtr &rsnew)
{
if (m_recordset == NULL || rsnew != NULL)
return FALSE;
HRESULT hr = rsnew.CreateInstance(__uuidof(Recordset));
if (SUCCEEDED(hr))
hr = rsnew->put_CursorLocation(adUseClient);
if (SUCCEEDED(hr))
hr = rsnew->put_ActiveConnection(_variant_t((IDispatch *)NULL, false));
_StreamPtr tmpStream = 0;
if (SUCCEEDED(hr))
hr = tmpStream.CreateInstance(__uuidof(Stream));
if (SUCCEEDED(hr))
hr = tmpStream->put_Type(adTypeBinary);
if (SUCCEEDED(hr))
hr = m_recordset->Save(_variant_t(tmpStream.GetInterfacePtr()), adPersistADTG);
if (SUCCEEDED(hr))
tmpStream->put_Position(0);
if (SUCCEEDED(hr))
hr = rsnew->Open(_variant_t(tmpStream.GetInterfacePtr()),_variant_t((IDispatch *)NULL,false),adOpenUnspecified,adLockUnspecified,adCmdFile);//adConnectUnspecified);
if (tmpStream)
{
tmpStream->Close();
tmpStream.Release();
}
if (SUCCEEDED(hr))
return TRUE;
if (rsnew)
{
rsnew->Release();
rsnew = 0;
}
return FALSE;
}

BOOL CADORsX1::RS_PutLong(LPCTSTR sFldName, long lval)
{
if (m_recordset == NULL)
return FALSE;
return PutField(_variant_t(sFldName), _variant_t((long)lval));
}

BOOL CADORsX1::RS_PutLong(long idx, long lval)
{
if (m_recordset == NULL)
return FALSE;
return PutField(_variant_t((long)idx), _variant_t((long)lval));
}

BOOL CADORsX1::RS_PutBool(LPCTSTR sFldName, bool bval)
{
if (m_recordset == NULL)
return FALSE;
return PutField(_variant_t(sFldName), _variant_t(bval));
}

BOOL CADORsX1::RS_PutBool(long idx, bool bval)
{
if (m_recordset == NULL)
return FALSE;
CString stf;
stf = bval ? _T("True") : _T("False");
return PutField(_variant_t((long) idx), _variant_t(bval));
}

BOOL CADORsX1::RS_PutDouble(LPCTSTR sFldName, double dval)
{
if (m_recordset == NULL)
return FALSE;
return PutField(_variant_t(sFldName), _variant_t(dval));
}

BOOL CADORsX1::RS_PutDouble(long idx, double dval)
{
if (m_recordset == NULL)
return FALSE;
return PutField(_variant_t((long) idx), _variant_t(dval));
}

BOOL CADORsX1::RS_PutFloat(LPCTSTR sFldName, double dval)
{
if (m_recordset == NULL)
return FALSE;
return PutField(_variant_t(sFldName), _variant_t(dval));
}

BOOL CADORsX1::RS_PutFloat(long idx, double dval)
{
if (m_recordset == NULL)
return FALSE;
return PutField(_variant_t((long) idx), _variant_t(dval));
}

BOOL CADORsX1::RS_PutInt(LPCTSTR sFldName, int ival)
{
if (m_recordset == NULL)
return FALSE;
return PutField(_variant_t(sFldName), _variant_t((long)ival));
}

BOOL CADORsX1::RS_PutInt(long idx, int ival)
{
if (m_recordset == NULL)
return FALSE;
return PutField(_variant_t((long) idx), _variant_t((long)ival));
}

BOOL CADORsX1::RS_PutString(LPCTSTR sFldName, LPCTSTR sval)
{
if (m_recordset == NULL)
return FALSE;
return PutField(_variant_t(sFldName), _variant_t(sval));
}

BOOL CADORsX1::RS_PutString(long idx, LPCTSTR sval)
{
if (m_recordset == NULL)
return FALSE;
return PutField(_variant_t((long) idx), _variant_t(sval));
}


BOOL CADORsX1::AddNew()
{
if (m_recordset == NULL)
return FALSE;
HRESULT hr = m_recordset->AddNew();
if (SUCCEEDED(hr))
return TRUE;
return FALSE;
}

BOOL CADORsX1::putFilter(LPCTSTR sFltr)
{
if (m_recordset == NULL)
return FALSE;
HRESULT hr = m_recordset->put_Filter(_variant_t(sFltr));
if (SUCCEEDED(hr))
return TRUE;
return FALSE;
}

BOOL CADORsX1::putFilter(VARIANT sCriteria)
{
if (m_recordset == NULL)
return FALSE;
HRESULT hr = m_recordset->put_Filter(sCriteria);
if (SUCCEEDED(hr))
return TRUE;
return FALSE;
}

BOOL CADORsX1::putSort(LPCTSTR sSort)
{
if (m_recordset == NULL)
return FALSE;
HRESULT hr = m_recordset->put_Sort(_bstr_t(sSort));
if (SUCCEEDED(hr))
return TRUE;
return FALSE;
}

BOOL CADORsX1::GetBookmark(_RecordsetPtr &rset, VARIANT *vbookMark)
{
if (rset == NULL)
return FALSE;
HRESULT hr = rset->get_Bookmark(vbookMark);
if (SUCCEEDED(hr))
return TRUE;
return FALSE;
}

BOOL CADORsX1::GetBookmark(VARIANT *vbookMark)
{
if (m_recordset == NULL)
return FALSE;
HRESULT hr = m_recordset->get_Bookmark(vbookMark);
if (SUCCEEDED(hr))
return TRUE;
return FALSE;
}

BOOL CADORsX1::putBookmark(VARIANT vbookMark)
{
if (m_recordset == NULL)
return FALSE;
HRESULT hr = m_recordset->put_Bookmark(vbookMark);
if (SUCCEEDED(hr))
return TRUE;
return FALSE;
}

BOOL CADORsX1::putBookmark(_RecordsetPtr &rset, VARIANT vbookMark)
{
if (rset == NULL)
return FALSE;
HRESULT hr = rset->put_Bookmark(vbookMark);
if (SUCCEEDED(hr))
return TRUE;
return FALSE;
}

// Create a Table from this objects recordset
BOOL CADORsX1::CreateTable(CString sTable, CString sSource, CString sUser, CString sPassword, long nOptions)
{
USES_CONVERSION;

if (m_recordset == NULL)
return FALSE;
_CommandPtr tmpCmd = NULL;
_RecordsetPtr tmpRS = NULL;
_ConnectionPtr tmpCon = NULL;

HRESULT hr = tmpCon.CreateInstance("ADODB.Connection");
if (SUCCEEDED(hr))
{
hr = tmpCon->put_CursorLocation(adUseClient);
if (SUCCEEDED(hr))
hr = tmpCon->Open(_bstr_t(sSource), _bstr_t(sUser), bstr_t(sPassword), nOptions);
}
if (SUCCEEDED(hr))
hr = tmpCmd.CreateInstance(__uuidof(Command));
if (SUCCEEDED(hr))
hr = tmpCmd->putref_ActiveConnection(tmpCon);
if (SUCCEEDED(hr))
hr = tmpRS.CreateInstance(__uuidof(Recordset));

if (FAILED(hr))
{
if (tmpCon)
tmpCon->Close();
tmpCmd = 0;
tmpRS = 0;
tmpCon = 0;
return FALSE;
}

// Gather field information ...

//////////// get recordset state, if closed, open it /////////
First();
long numflds = 0;
Fields *fields = 0;
hr = m_recordset->get_Fields(&fields);
if (SUCCEEDED(hr))
fields->get_Count(&numflds);
if (numflds > 0)
{
// Get Field pointers ...
Field **field = new (Field(*[numflds]));
for (int i = 0; i < numflds; i++)
{
field = 0;
if (SUCCEEDED(hr))
hr = fields->get_Item(_variant_t((long)i), &field);
}
//FLDINFO fld_rec;
if (SUCCEEDED(hr))
{
CString sCreateStr = _T("DROP TABLE ") + sTable + _T(";");
_Recordset* prec = 0;
hr = tmpCon->Execute(_bstr_t(sCreateStr), NULL, adCmdText, &prec);
if (SUCCEEDED(hr))
prec->Release();
sCreateStr = _T("CREATE TABLE ") + sTable + _T(";");
prec = 0;
hr = tmpCon->Execute(_bstr_t(sCreateStr), NULL, adCmdText, &prec);
if (SUCCEEDED(hr))
prec->Release();

if (SUCCEEDED(hr))
{
for (i = 0; i < numflds; i++)
{
//// Add one column at a time ////
BSTR bsfldName;
field->get_Name(&bsfldName);
DataTypeEnum efldType;
field->get_Type(&efldType);
long nfldSize = 0;
field->get_DefinedSize(&nfldSize);

CString sFldStr = _T("[") + CString(OLE2CT(bsfldName)) + _T("] ");
CString sadd = _T("");
switch (efldType)
{
case adDouble:
sadd = _T("DOUBLE");
break;
case adInteger:
sadd = _T("INTEGER");
break;
case adBoolean:
sadd = _T("LOGICAL");
break;
case adVarChar:
default:
sadd.Format(_T("VARCHAR(%d)"), nfldSize);
break;
}
sFldStr += sadd;
sCreateStr = _T("ALTER TABLE ") + sTable + _T(" ADD ") + sFldStr + _T(";");
prec = 0;
hr = tmpCon->Execute(_bstr_t(sCreateStr), NULL, adCmdText + adExecuteNoRecords, &prec);
// if (SUCCEEDED(hr))
// prec->Release();
}
}
}
// Insert rows into table ...
if (SUCCEEDED(hr))
{
Last();
if (!IsBOF())
{
First();
while (!IsEOF())
{
CString sRowData = _T("");
for (i = 0; i < numflds; i++)
{
CString sadd = _T("");
DataTypeEnum efldType;
field->get_Type(&efldType);

switch (efldType)
{
case adDouble:
sadd.Format(_T("%f"), RS_GetDouble(i));
break;
case adInteger:
sadd.Format(_T("%d"), RS_GetInt(i));
break;
case adBoolean:
sadd = (RS_GetBool(i) ? _T("-1") : _T("0"));//_T("'True'") : _T("'False'"));
break;
case adVarChar:
default:
sadd.Format(_T("'%s'"), RS_GetString(i));
break;
}
sRowData += sadd;
if (i < (numflds-1))
sRowData += _T(", ");
}
Next();
_Recordset* prec = 0;
CString sInsertStr = _T("INSERT INTO ") + sTable + _T(" VALUES (");
sInsertStr += sRowData + _T(")");
hr = tmpCon->Execute(_bstr_t(sInsertStr), NULL, adCmdText + adExecuteNoRecords, &prec);
// if (SUCCEEDED(hr))
// prec->Release();
}
}
}

// Release references ...
for (i = 0; i < numflds; i++)
{
if (field != 0)
field->Release();
}
if (fields != 0)
fields->Release();
delete [] field;
}
// finished ?
if (tmpCon)
tmpCon->Close();
tmpCmd = 0;
tmpRS = 0;
tmpCon = 0;
if (SUCCEEDED(hr))
return TRUE;
return FALSE;
}


BOOL CADORsX1::DIST_FilterRecords(CString Sortflds, CString Flagfld)
{
USES_CONVERSION;
if (m_recordset == NULL)
return FALSE;

/////////////////////////////////////////////////////////////
// START it here ......
// *********************************************
long total_flds;
GetFieldCount(&total_flds);

// Parse the Sort Field string (don't upper case it) ....
vector <CString> vaSortFldName;
if (total_flds <= 0 || !ParseStringCSV(vaSortFldName, Sortflds, FALSE))
return FALSE;

// Get the Fields ...
Fields *fields = 0;
HRESULT hr = m_recordset->get_Fields(&fields);
// Get Field pointers ...
Field **field = new (Field(*[total_flds]));
for (int i = 0; i < total_flds; i++)
{
field = 0;
if (SUCCEEDED(hr))
hr = fields->get_Item(_variant_t((long)i), &field);
}
// Match up the Field names with their indexes ...
vector <int> vaSortFldNdx;
int fld_name_size = vaSortFldName.size();
CString sSortString = _T("");
int FlagNdx = -1;
for (i = 0; i < fld_name_size; i++)
{
for (int k = 0; k < total_flds; k++)
{
BSTR bname;
field[k]->get_Name(&bname);
CString fldname = OLE2CT(bname);
if (fldname == Flagfld)
FlagNdx = k;
else
if (fldname == vaSortFldName)
{
if (sSortString.GetLength() > 0)
sSortString += _T(", ");
sSortString += vaSortFldName;
vaSortFldNdx.push_back(k);
if (FlagNdx >= 0)
break;
}
}
}
// Release references ...
for (i = 0; i < total_flds; i++)
{
if (field != 0)
field->Release();
}
if (fields != 0)
fields->Release();
delete [] field;

// Here we have sort string, sort order and flag field indexes ...
int SortNdx_size = vaSortFldNdx.size();
if (SortNdx_size <= 0 || FlagNdx < 0 || fld_name_size != SortNdx_size)
return FALSE;

// Take off Filter and put on Sort ...
PutFilter(_T(""));
PutSort(sSortString);
long total_records = GetRecordCount();

/* _variant_t *vb = new _variant_t[total_records]();
int vbcnt = 0;
for (int i = 0; i < total_records; i++)
vb.vt = VT_EMPTY;
*/
int *Distinct = new int[total_records]();
for (i = 0; i < total_records; i++)
Distinct = 0;

for (int ndx = 0; ndx < fld_name_size; ndx++)
{
First();
int currec = 0;
BOOL bfirst = TRUE;
_variant_t lastVal;
BOOL bIsLastValid = TRUE;

if (bfirst)
{
GetField(_variant_t((long)vaSortFldNdx[ndx]), &lastVal);
if (!Distinct[currec])
{
Distinct[currec] = 1;
RS_PutLong(FlagNdx, 1L);
/* _variant_t vtmpbook;
Xrs_test->GetBookmark(&vtmpbook);
vb[vbcnt] = vtmpbook;
vbcnt++;
*/ }
Next();
bfirst = FALSE;
bIsLastValid = TRUE;
currec++;
}

while (!IsEOF())
{
if (!Distinct[currec])
{
// see if lastVal is valid
if (bIsLastValid == FALSE)
{
Prev();
GetField(_variant_t((long)vaSortFldNdx[ndx]), &lastVal);
Next();
bIsLastValid = TRUE;
}
_variant_t newVal;
GetField(_variant_t((long)vaSortFldNdx[ndx]), &newVal);
int condition = (newVal != lastVal);
if (condition > 0)
{
RS_PutLong(FlagNdx, 1L);
/*
_variant_t vtmpbook;
GetBookmark(&vtmpbook);
vb[vbcnt] = vtmpbook;
vbcnt++;
*/
// debug ....
// see what current field and record;
int cf = vaSortFldNdx[ndx];
int cr = currec;
int ds = Distinct[currec];
int stophere = 0;
// end debug ....
}
else
// On first field only set Flag to 0 if not distinct...
if (ndx == 0)
RS_PutLong(FlagNdx, 0L);

Distinct[currec] += condition;
lastVal = newVal;
}
else
{
// mark lastVal as invalid...
bIsLastValid = FALSE;
}
Next();
currec++;
}
}

// See what we found ...
int dupsfound = 0;
for (i = 0; i < total_records; i++)
{
if (Distinct == 0)
dupsfound++;
}

/* // Filter via Bookmarked recs
_variant_t vBookmark;
vBookmark.vt = VT_VARIANT|VT_ARRAY;

SAFEARRAYBOUND rgsabound[1];
rgsabound[0].lLbound = 0;
rgsabound[0].cElements = vbcnt; // needed ...
// Create safearrays to store array of variant
SAFEARRAY FAR *psa = SafeArrayCreate(VT_VARIANT, 1, rgsabound);
for (i = 0; i < vbcnt; i++)
SafeArrayPutElement(psa, (long *)&i, &vb);
vBookmark.parray = psa;
// Filter the Record with the array of bookmarks.
Xrs_test->PutSort(_T("FieldA, FieldB, FieldC"));
Xrs_test->PutFilter(vBookmark);
*/
// Filter via 'FILT' field
PutFilter(Flagfld + _T(" = 1"));
// PutFilter(_T(""));
int nrecs = GetRecordCount();

// Clean up ...
/* if (vb)
delete [] vb;
*/ if (Distinct)
delete [] Distinct;

// done
return TRUE;
}

BOOL CADORsX1::DIST_CreateMap(vector <DATAMAP_REC> &vaDataMap, int *pmaxsize)
{
USES_CONVERSION;
if (m_recordset == NULL)
return FALSE;

/////////////////////////////////////////////////////////////
// START it here ......
// *********************************************
*pmaxsize = 0;
long total_flds;
GetFieldCount(&total_flds);

// Parse the Sort Field string (don't upper case it) ....
BSTR criteria;
m_recordset->get_Sort(&criteria);
vector <CString> vaSortFldName;
CString Sortflds = OLE2CT(criteria);
if (total_flds <= 0 || !ParseStringCSV(vaSortFldName, Sortflds, FALSE))
return FALSE;

// Get the Fields ...
Fields *fields = 0;
HRESULT hr = m_recordset->get_Fields(&fields);
// Get Field pointers ...
Field **field = new (Field(*[total_flds]));
for (int i = 0; i < total_flds; i++)
{
field = 0;
if (SUCCEEDED(hr))
hr = fields->get_Item(_variant_t((long)i), &field);
}
// Match up the Field names with their indexes ...
vector <int> vaSortFldNdx;

int fld_name_size = vaSortFldName.size();
for (i = 0; i < fld_name_size; i++)
{
for (int k = 0; k < total_flds; k++)
{
BSTR bname;
field[k]->get_Name(&bname);
CString fldname = OLE2CT(bname);
if (fldname == vaSortFldName)
{
int flen = fldname.GetLength();
if (flen > (*pmaxsize))
*pmaxsize = flen;
vaSortFldNdx.push_back(k);
break;
}
}
}
// Release references ...
for (i = 0; i < total_flds; i++)
{
if (field != 0)
field->Release();
}
if (fields != 0)
fields->Release();
delete [] field;

// Here we have sort string, sort order and flag field indexes ...
int SortNdx_size = vaSortFldNdx.size();
if (SortNdx_size <= 0 || fld_name_size != SortNdx_size)
return FALSE;

int nrecs = GetRecordCount();

if (vaDataMap.size() > 0)
vaDataMap.erase(vaDataMap.begin(), vaDataMap.end());

// Note - all DATAMAP_REC members initialize to -1
// vector <DATAMAP_REC> vaDataMap;
int nSecondNDX = 0;
int nCtrlNdx = 0;
BOOL blastfld = FALSE;

for (int ndx = 0; ndx < fld_name_size; ndx++)
{
if (ndx == (fld_name_size-1))
blastfld = TRUE;
First();
int currec = 0;
BOOL bfirst = TRUE;
_variant_t lastVal;
_variant_t newVal;

while (!IsEOF())
{
if (bfirst)
{
DATAMAP_REC dm_rec;
GetField(_variant_t((long)vaSortFldNdx[ndx]), &lastVal);

_variant_t vbookmark;
GetBookmark(&vbookmark);
dm_rec.nMapData_Rec = ((int)ConvertVarToDouble(vbookmark)) - 1;

dm_rec.nCurIndex = nCtrlNdx;
dm_rec.sMapData_FldName = vaSortFldName[ndx];
vaDataMap.push_back(dm_rec);
nCtrlNdx++;
bfirst = FALSE;

// Save the 'vector' index into the second field (for below)...
if (ndx == 1)
nSecondNDX = vaDataMap.size() - 1;
}
else
{
// Look for difference on all but the last field. For last, get them all !!
GetField(_variant_t((long)vaSortFldNdx[ndx]), &newVal);
if (newVal != lastVal || blastfld)
{
DATAMAP_REC dm_rec;

_variant_t vbookmark;
GetBookmark(&vbookmark);
dm_rec.nMapData_Rec = ((int)ConvertVarToDouble(vbookmark)) - 1;

dm_rec.sMapData_FldName = vaSortFldName[ndx];
dm_rec.nCurIndex = nCtrlNdx;
vaDataMap.push_back(dm_rec);
nCtrlNdx++;
lastVal = newVal;
}
}
Next();
}
// Put the ender on it ...
if (vaDataMap.size() > 0)
{
DATAMAP_REC dm_rec;
dm_rec.sMapData_FldName = vaSortFldName[ndx];
dm_rec.nMapData_Rec = -1;
dm_rec.nCurIndex = nCtrlNdx;
vaDataMap.push_back(dm_rec);
nCtrlNdx++;
// restart index
// nCtrlNdx = 0;
}
}
// Traverse the Map vector, fill in the the NextFld numbers ...
if (nSecondNDX > 0)
{
int curndx = 0;
int DataRec = vaDataMap[curndx].nMapData_Rec;
int nsize = vaDataMap.size();

while (nSecondNDX < nsize)
{
//int DREC = vaDataMap[nSecondNDX].nMapData_Rec + 75;
if (DataRec == vaDataMap[nSecondNDX].nMapData_Rec)
{
vaDataMap[curndx].nNextIndex = vaDataMap[nSecondNDX].nCurIndex;
//int CNDX = vaDataMap[curndx].nCurIndex;
//int NXT = vaDataMap[curndx].nNextIndex;
curndx++;
DataRec = vaDataMap[curndx].nMapData_Rec;
}
nSecondNDX++;
}
}
// done
return TRUE;
}


int SortByMapNdx (const MAPDATA_REC &arec, const MAPDATA_REC &brec)
{
if (arec.nMapNdx < brec.nMapNdx)
return true;
return false;
}
int SortByDRec (const MAPDATA_REC &arec, const MAPDATA_REC &brec)
{
if (arec.nDRec < brec.nDRec)
return true;
return false;
}
int SortByStoreData (const MAPDATA_REC &arec, const MAPDATA_REC &brec)
{
USES_CONVERSION;
switch (arec.vtStoreData.vt)
{
case VT_I2:
if (arec.vtStoreData.iVal < brec.vtStoreData.iVal)
return true;
break;
case VT_I4:
if (arec.vtStoreData.lVal < brec.vtStoreData.lVal)
return true;
break;
case VT_R4:
if (arec.vtStoreData.fltVal < brec.vtStoreData.fltVal)
return true;
break;
case VT_R8:
if (arec.vtStoreData.dblVal < brec.vtStoreData.dblVal)
return true;
break;
case VT_BSTR:
{
CString stra = OLE2CT(arec.vtStoreData.bstrVal);
CString strb = OLE2CT(brec.vtStoreData.bstrVal);
if (stra < strb)
return true;
break;
}
default:
break;
}
return false;
}


BOOL CADORsX1::DIST_ChangeMapUnfiltered(_RecordsetPtr &rsStore1, CString sFldStore1, _RecordsetPtr &rsStore2, CString sFldStore2)
{
USES_CONVERSION;
// Check sizes ...
long pl1, pl2;
pl1 = 0;
pl2 = 0;
HRESULT hr = rsStore1->get_RecordCount(&pl1);
hr = rsStore2->get_RecordCount(&pl2);
if (!(pl1 > 0 && pl2 > 0 && sFldStore1.GetLength() > 0 && sFldStore2.GetLength() > 0))
return FALSE;

// Find the Store1 field name index ...
// (get the Fields)
int nFldStore1_Ndx = -1;
Fields *fields = 0;
hr = rsStore1->get_Fields(&fields);
long total_flds = 0;
fields->get_Count(&total_flds);
if (total_flds <= 0)
{
if (fields != 0)
fields->Release();
return FALSE;
}
// Get Field pointers ...
Field **field = new (Field(*[total_flds]));
for (int i = 0; i < total_flds; i++)
{
field = 0;
if (SUCCEEDED(hr))
hr = fields->get_Item(_variant_t((long)i), &field);
}
for (i = 0; i < total_flds; i++)
{
BSTR bname;
field->get_Name(&bname);
CString fldname = OLE2CT(bname);
if (fldname == sFldStore1)
{
nFldStore1_Ndx = i;
break;
}
}
// Release references ...
for (i = 0; i < total_flds; i++)
{
if (field != 0)
field->Release();
}
if (fields != 0)
fields->Release();
delete [] field;

// Find the Store2 field name index ...
// (get the Fields)
int nFldStore2_Ndx = -1;
fields = 0;
hr = rsStore2->get_Fields(&fields);
total_flds = 0;
fields->get_Count(&total_flds);
if (total_flds <= 0)
{
if (fields != 0)
fields->Release();
return FALSE;
}
// Get Field pointers ...
field = new (Field(*[total_flds]));
for (i = 0; i < total_flds; i++)
{
field = 0;
if (SUCCEEDED(hr))
hr = fields->get_Item(_variant_t((long)i), &field);
}
for (i = 0; i < total_flds; i++)
{
BSTR bname;
field->get_Name(&bname);
CString fldname = OLE2CT(bname);
if (fldname == sFldStore2)
{
nFldStore2_Ndx = i;
break;
}
}
// Release references ...
for (i = 0; i < total_flds; i++)
{
if (field != 0)
field->Release();
}
if (fields != 0)
fields->Release();
delete [] field;

if (nFldStore1_Ndx < 0 || nFldStore2_Ndx < 0)
return FALSE;

// Advance to sFldStore1 Ctrl in this Map ...
First();
int currec = 0;
BOOL bfirst = TRUE;
_variant_t mapFldVal;
BOOL bfound = FALSE;
while (!IsEOF())
{
GetField(_variant_t((long)0L), &mapFldVal);
if (mapFldVal == _variant_t(sFldStore1))
{
bfound = TRUE;
break;
}
Next();
}
if (!bfound)
return FALSE;

// At this point we have the Store's field indexs where the data is
// and we are at that postion in the Map
// ------------------------------------------------------------------
// Create an array of Map Data (Ctrl, Ndx, Store1[DRec])
//
vector <MAPDATA_REC> vaMap;
CString sCurCtrl = RS_GetString(0);
CString sLastCtrl = sCurCtrl;
i = 0;
while (sCurCtrl == sLastCtrl)
{
MAPDATA_REC map_rec;
map_rec.nMapNdx = i;//RS_GetLong(1); // Ndx fld
i++;
map_rec.nDRec = RS_GetLong(2); // DRec fld
if (map_rec.nDRec == -1)
break;
vaMap.push_back(map_rec);
Next();
if (IsEOF())
break;
sCurCtrl = RS_GetString(0);
}

// Sort the Map array by the DRec field ...
// note - should already be sorted!!
// sort(vaMap.begin(), vaMap.end(), SortByDRec);

// Get info from STORE1 into Map array (vtStoreData) ...
int nsize = vaMap.size();
int movecnt = 0;
for (i = 0; i < nsize; i++)
{
int curdrec = vaMap.nDRec;



_variant_t vbook;
vbook.vt = VT_R8;
vbook.dblVal = curdrec+1;
PutBookmark(rsStore1, vbook);

// if (i == 0)
// rsStore1->MoveFirst();
// while (movecnt < curdrec)
// {
// rsStore1->MoveNext();
// movecnt++;
// }
// if (IsEOF())
// break;

_variant_t vtstore;
GetField(rsStore1, _variant_t((long)nFldStore1_Ndx), &vtstore);
vaMap.vtStoreData = vtstore;
}

// Sort the Map array by the Variant field (same as Field of Store2 now) ...
sort(vaMap.begin(), vaMap.end(), SortByStoreData);

// Save Store1's Sort string, Put Sort Store1 by sFldStore1 ...
BSTR crit_Store1;
rsStore1->get_Sort(&crit_Store1);
rsStore1->put_Sort(_bstr_t(sFldStore1));

// Save Store2's Sort string, Put Sort Store2 by sFldStore2 ...
BSTR crit_Store2;
rsStore2->get_Sort(&crit_Store2);
rsStore2->put_Sort(_bstr_t(sFldStore2));

// Get indexes from STORE2 into Map array (overwrite DRec info) ...
int move2cnt = 0;
i = 0;

rsStore2->MoveFirst();
_variant_t vtStore2a;
GetField(rsStore2, _variant_t((long)nFldStore2_Ndx), &vtStore2a);
_variant_t vtMapStore = vaMap.vtStoreData;

while (!IsEOF(rsStore2) && i < nsize)
{
if (vtStore2a == vtMapStore)
{
// Do substitution ...
_variant_t vbook;
GetBookmark(rsStore2, &vbook);
int vbookStore2 = ((int)ConvertVarToDouble(vbook)) - 1;
// Go past dups in Map array ...
while (i < nsize && vaMap.vtStoreData == vtStore2a)
{
// Do substitution ...
vaMap.nDRec = vbookStore2;
// vaMap.nDRec = move2cnt;
i++;
}
if (i < nsize)
vtMapStore = vaMap.vtStoreData;
}
if (i < nsize)
{
// Go past dups in Store2 ...
if (!IsEOF(rsStore2))
{
_variant_t vtStore2b = vtStore2a;
while (!IsEOF(rsStore2) && vtStore2b == vtStore2a)
{
rsStore2->MoveNext();
move2cnt++;
if (!IsEOF(rsStore2))
GetField(rsStore2, _variant_t((long)nFldStore2_Ndx), &vtStore2a);
}
}
}
}

// Here the substituted indexes into Store2 are in the Map array,
// get the array info back into the Map Recordset (this) ...
// -------------------------------------------------

// Sort the Map array by the ndx field ...
sort(vaMap.begin(), vaMap.end(), SortByMapNdx);

// Advance to sFldStore1 Ctrl in this Map ...
First();
currec = 0;
bfirst = TRUE;
while (!IsEOF())
{
GetField(_variant_t((long)0L), &mapFldVal);
if (mapFldVal == _variant_t(sFldStore1))
{
bfound = TRUE;
break;
}
Next();
}

// Do substitution ...
for (i = 0; i < nsize; i++)
{
RS_PutLong((long)2, (long)vaMap.nDRec); // DRec fld
Next();
if (IsEOF())
break;
}

// Put rsStore1, rsStore2 sorts back on ..
rsStore1->put_Sort(crit_Store1);
rsStore2->put_Sort(crit_Store2);

// done!
return TRUE;
}


BOOL CADORsX1::DIST_ChangeMapFiltered(_RecordsetPtr &rsStore1, CString sFldStore1, _RecordsetPtr &rsStore2, CString sFldStore2, CString sFiltFldStore2)
{
USES_CONVERSION;
return FALSE;
}


int CADORsX1::parseStringCSV(vector <CString> &vaPRS, CString sString, BOOL bMakeUpper)
{
/* example: " FieldA, FieldB, FieldC " */
USES_CONVERSION;
int ncurpos = 0;
int nlastpos = 0;
int npos = 0;
if (vaPRS.size() > 0)
vaPRS.erase(vaPRS.begin(), vaPRS.end());

do {
ncurpos = sString.Find(',',nlastpos);

if (ncurpos >= 0)
npos = ncurpos;
else
if (sString.GetLength() > 0)
npos = sString.GetLength();

CString stmp = sString.Mid(nlastpos, (npos - nlastpos));
if (stmp.GetLength() > 0)
{
// ok found one, make upper and remove all peripheral spaces ..
if (bMakeUpper)
stmp.MakeUpper();
stmp.TrimRight();
stmp.TrimLeft();
vaPRS.push_back(stmp);
}
nlastpos = ncurpos+1;
} while (ncurpos >= 0);

return vaPRS.size();
}
 
D

david.f.jenkins

Hi, Michele, and thanks for the advice.

I can't execute an external program or shove files around, because of
performance implications, mostly. I need a "sub" (but one written in
Perl) that I can call from VBA.

What did you find vague? In VBA I want to have some container that can
hold a set of strings (a Collection, an Array - I'm not picky - I'll
use what's required) that I want to populate in a Perl method. As a
template, I'm using the PerlCtrl sample program that provides a Regex
control.


Michele said:
I want to pass an empty container for a set of strings from VBA into
Perl, do some stuff in Perl, and populate the Collection with a set of
strings. I've stolen most of the PDK Perlctrl regex sample and made
some small mods to it to meet my requirements.
Click to expand...

Quite vague. Do you want some sort of IPC? I guess VBA does have a
means to run an external program. Can it gather the program's output?
If so, then just... do so! Or else, how 'bout using it to run perl,
have it write its output into a file, and then read its contents?

Or else I've completely misunderstood your question.


Michele
--
{$_=pack'B8'x25,unpack'A8'x32,$a^=sub{pop^pop}->(map substr
(($a||=join'',map--$|x$_,(unpack'w',unpack'u','G^<R<Y]*YB='
.'KYU;*EVH[.FHF2W+#"\Z*5TI/ER<Z`S(G.DZZ9OX0Z')=~/./g)x2,$_,
256),7,249);s/[^\w,]/ /g;$ \=/^J/?$/:"\r";print,redo}#JAPH,
Click to expand...
 
D

Dr.Ruud

Michele Dondi schreef:
david.f.jenkins:

(Un)fortunately I don't know enough VBA (namely, no VBA at all) to
address your question. My naive answer would be along the lines that
it's not possible, period. But indeed there may be some
framework/technology that allows this. Hope someone will know better.
Click to expand...

VBA can call members of libraries, at least .dll.
So if there would be a perllib.dll or such, it would be possible.
 
M

Mark Clements

Dr.Ruud said:
Michele Dondi schreef:

VBA can call members of libraries, at least .dll.
So if there would be a perllib.dll or such, it would be possible.
Click to expand...

Perl classes can be wrapped as COM components. See Windows Script
Components.

Mark
 
D

david.f.jenkins

I'm aware of that.

I have created the Perl ActiveX control I need, and can safely travel
back and forth from VBA to Perl. What I *need* is help on the
mechanics of getting String array information back from the called
control. I am unable to figure out how to do this either through a
passed argument, or through VBA access of the control's poperties.

Right now, I'm pretty much dead in the water. I just can't believe
that this is not a problem that myriads of others have already faced
and overcome.
 
D

Dr.Ruud

(e-mail address removed) schreef:
I'm aware of that.
Click to expand...

Of what? Don't top-post.

I have created the Perl ActiveX control I need, and can safely travel
back and forth from VBA to Perl. What I *need* is help on the
mechanics of getting String array information back from the called
control. I am unable to figure out how to do this either through a
passed argument, or through VBA access of the control's poperties.

Right now, I'm pretty much dead in the water. I just can't believe
that this is not a problem that myriads of others have already faced
and overcome.
Click to expand...


Maybe this helps:

SOAP::Lite
http://search.cpan.org/src/BYRNE/SOAP-Lite-0.69/examples/COM/
("when you return an array reference from a subroutine, it is
automatically converted into an array in the host language")

Scriptlets
http://www.foo.be/docs/tpj/issues/vol3_4/tpj0304-0009.html

PDK:
http://www.foo.be/docs/tpj/issues/vol5_3/tpj0503-0011.html

(all from the first few hits of google: vba perl string return)
 
D

david.f.jenkins

Dr.Ruud said:
(e-mail address removed) schreef:


Of what? Don't top-post.
Click to expand...

Let me request that you refrain from *telling* me what not to do. You
might ask, instead - much more polite.
Maybe this helps:

SOAP::Lite
http://search.cpan.org/src/BYRNE/SOAP-Lite-0.69/examples/COM/
("when you return an array reference from a subroutine, it is
automatically converted into an array in the host language")
Click to expand...

A few pointers (no pun intended) that may help - thanks!
Scriptlets
http://www.foo.be/docs/tpj/issues/vol3_4/tpj0304-0009.html
Click to expand...

Been there ... many times. Has some helpful tips, but doesn't solve my
PerlCtrl problems/questions. How do I define the COM interface for the
array reference I'm returning form Perl, e.g.? I must confess, though,
that upon re-reading, I've seen some stuff I didn't pick up on the
first few times I read that article. Another sleepless night looms ...
PDK:
http://www.foo.be/docs/tpj/issues/vol5_3/tpj0503-0011.html
Click to expand...

No help: single string-oriented
(all from the first few hits of google: vba perl string return)
Click to expand...

And are you insinuating that I should be more creative with my
Googling? I've spent many evenings on this problem and Google and I
are on inimate terms - both Web searches and News Group searches.
Since I have *no* problem passing strings back and forth (my problem is
arrays, remember? (See my previous posts for repeated references to
arrays.)) I have generally seen fit to include "array" in most of my
searching.
 
T

Tad McClellan

Let me request that you refrain from *telling* me what not to do. You
might ask, instead -
Click to expand...


OK, let's put it another way then.

Don't top-post, unless you don't mind being widely ignored forevermore.

much more polite.
Click to expand...

Top-posting is rude. You reap(ed) what you sow(ed).



A mother might say "look both ways before you cross the street"
instead off "look both ways before you cross the street so that
you don't get hit by a car".

Not looking both ways because the consequences were not spelled out
might make the independent-minded feel a little better, but being
underneath a car will make you feel really really bad...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Please, help me. 1
Help me with this task, please. 3
Malicious Coding Help Please 5
I need help in understanding these files on my phone, Could someone help me understand these files? Urgent help needed. Please help. 1
Copy string from 2D array to a 1D array in C 1
Trouble creating multi dimensional array. 0 to 26 in 3 dimensions. 1
Looking for someone to take alook at this code and help 2
converting vba to perl without win32::ole 6

Members online

No members online now.
Total: 26 (members: 0, guests: 26)
Robots: 323

Forum statistics

Threads
473,755
Messages
2,569,536
Members
45,013
Latest member
KatriceSwa

Latest Threads

Top