//-----------------------------------------------------------------------------
// AScript win32ole module
// this module has been developed with knowledge about COM provided in the
// following sites. Thanks so much!
//   http://homepage1.nifty.com/markey/ruby/win32ole/index.html
//   http://winapi.freetechsecrets.com/ole/OLEIDispatchInvoke.htm
//   http://www.sol.dti.ne.jp/~yoshinor/ni/index.html
//-----------------------------------------------------------------------------
#include <ascript.h>

AScript_BeginModule(win32ole)

AScript_DeclarePrivSymbol(import_const);

OLECHAR *StringToBSTR(const char *psz);
String BSTRToString(const OLECHAR *bstr);

bool ValueToVariant(Signal sig, VARIANT &var, const Value &value);
void VariantToValue(Environment &env, Value &value, const VARIANT &var);

//-----------------------------------------------------------------------------
// Object_Ole
//-----------------------------------------------------------------------------
AScript_DeclarePrivClass(Ole);

class Object_Ole : public Object {
public:
	class IteratorEx : public Iterator {
	private:
		Object_Ole *_pObj;
		IEnumVARIANT *_pEnum;
		bool _validFlag;
		Value _value;
	public:
		inline IteratorEx(Object_Ole *pObj, IEnumVARIANT *pEnum) :
				Iterator(false), _pObj(pObj), _pEnum(pEnum), _validFlag(false) {}
		virtual ~IteratorEx();
		virtual bool DoNext(Environment &env, Signal sig, Value &value);
		virtual String ToString(Signal sig) const;
	};
public:
	class Callable : public ICallable {
	private:
		String _name;
		Object_Ole *_pObj;
		DISPID _dispid;
	public:
		inline Callable(Object_Ole *pObj) : _pObj(pObj) {}
		HRESULT Setup(const char *name);
		virtual Value DoCall(Environment &env, Signal sig, Args &argsExpr);
	};
private:
	IDispatch *_pDispatch;
	Callable _callable;
public:
	AScript_DeclareObjectAccessor(Ole)
public:
	inline Object_Ole(Environment &env) :
				Object(AScript_PrivClass(Ole)), _pDispatch(NULL), _callable(this) {}
	inline Object_Ole(Environment &env, IDispatch *pDispatch) :
				Object(AScript_PrivClass(Ole)), _pDispatch(pDispatch), _callable(this) {}
	virtual ~Object_Ole();
	virtual Object *Clone() const;
	inline IDispatch *GetDispatch() { return _pDispatch; }
	bool Create(Signal sig, const char *progID);
	bool Connect(Signal sig, const char *progID);
	bool ImportConstant(Environment &env, Signal sig);
	HRESULT GetDispID(const char *name, DISPID &dispid);
	HRESULT GetDispIDOfNamedArg(
				const char *nameMethod, const char *name, DISPID &dispid);
	virtual Iterator *CreateIterator(Signal sig);
	virtual bool DoPropDir(Signal sig, SymbolSet &symbols);
	virtual Value DoPropGet(Signal sig, const Symbol *pSymbol, bool &evaluatedFlag);
	virtual Value DoPropSet(Signal sig, const Symbol *pSymbol,
								const Value &value, bool &evaluatedFlag);
	virtual ICallable *GetCallable(Signal sig, const Symbol *pSymbol);
	virtual String ToString(Signal sig, bool exprFlag);
	static void SetError(Signal sig, HRESULT hr);
};

Object_Ole::~Object_Ole()
{
	if (_pDispatch != NULL) {
		_pDispatch->Release();
	}
}

Object *Object_Ole::Clone() const
{
	return NULL;
}

bool Object_Ole::Create(Signal sig, const char *progID)
{
	HRESULT hr;
	CLSID clsid;
	do {
		OLECHAR *progID_W = StringToBSTR(progID);
		::CLSIDFromProgID(progID_W, &clsid);
		::SysFreeString(progID_W);
	} while (0);
	hr = ::CoCreateInstance(clsid,
					NULL, CLSCTX_INPROC_SERVER | CLSCTX_LOCAL_SERVER,
					IID_IDispatch, reinterpret_cast<LPVOID *>(&_pDispatch));
	if (FAILED(hr)) {
		SetError(sig, hr);
		return false;
	}
	return true;
}

bool Object_Ole::Connect(Signal sig, const char *progID)
{
	HRESULT hr;
	CLSID clsid;
	do {
		OLECHAR *progID_W = StringToBSTR(progID);
		::CLSIDFromProgID(progID_W, &clsid);
		::SysFreeString(progID_W);
	} while (0);
	IUnknown *pUnknown = NULL;
	hr = ::GetActiveObject(clsid, 0, &pUnknown);
	if (FAILED(hr)) {
		SetError(sig, hr);
		return false;
	}
	hr = pUnknown->QueryInterface(IID_IDispatch,
								reinterpret_cast<LPVOID *>(&_pDispatch));
	if (FAILED(hr)) {
		pUnknown->Release();
		SetError(sig, hr);
		return false;
	}
	pUnknown->Release();
	return true;
}

bool Object_Ole::ImportConstant(Environment &env, Signal sig)
{
	HRESULT hr;
	//hr = _pDispatch->GetTypeInfoCount(&cnt); // 0 or 1
	ITypeLib *pTypeLib = NULL;
	do {
		ITypeInfo *pTypeInfo = NULL;
		do {
			hr = _pDispatch->GetTypeInfo(0, LOCALE_SYSTEM_DEFAULT, &pTypeInfo);
			if (FAILED(hr)) {
				SetError(sig, hr);
				return false;
			}
		} while (0);
		do {
			unsigned int index; // not necessary for the actual use?
			hr = pTypeInfo->GetContainingTypeLib(&pTypeLib, &index);
			if (FAILED(hr)) {
				SetError(sig, hr);
				pTypeInfo->Release();
				return false;
			}
		} while (0);
		pTypeInfo->Release();
	} while (0);
	long cntTypeInfo = pTypeLib->GetTypeInfoCount();
	for (long iTypeInfo = 0; iTypeInfo < cntTypeInfo; iTypeInfo++) {
		ITypeInfo *pTypeInfo = NULL;
		do {
			hr = pTypeLib->GetTypeInfo(iTypeInfo, &pTypeInfo);
			if (FAILED(hr)) {
				SetError(sig, hr);
				pTypeLib->Release();
				return false;
			}
		} while (0);
		int cVars = 0;
		do {
			TYPEATTR *pTypeAttr = NULL;
			hr = pTypeInfo->GetTypeAttr(&pTypeAttr);
			if (FAILED(hr)) {
				SetError(sig, hr);
				pTypeInfo->Release();
				pTypeLib->Release();
				return false;
			}
			cVars = pTypeAttr->cVars;
			pTypeInfo->ReleaseTypeAttr(pTypeAttr);
		} while (0);
		for (int iVar = 0; iVar < cVars; iVar++) {
			VARDESC *pVarDesc = NULL;
			hr = pTypeInfo->GetVarDesc(iVar, &pVarDesc);
			if (FAILED(hr)) continue;
			if (pVarDesc->varkind != VAR_CONST) {
				pTypeInfo->ReleaseVarDesc(pVarDesc);
				continue;
			}
			const Symbol *pSymbol = NULL;
			do {
				OLECHAR *nameOle;
				unsigned int len;
				hr = pTypeInfo->GetNames(pVarDesc->memid, &nameOle, 1, &len);
				if (FAILED(hr)) break;
				pSymbol = Symbol::Add(BSTRToString(nameOle).c_str());
				::SysFreeString(nameOle);
			} while (0);
			if (pSymbol != NULL) {
				Value value;
				VariantToValue(*this, value, *pVarDesc->lpvarValue);
				env.AssignValue(pSymbol, value, false);
			}
			pTypeInfo->ReleaseVarDesc(pVarDesc);
		}
		pTypeInfo->Release();
	}
	pTypeLib->Release();
	return true;
}

HRESULT Object_Ole::GetDispID(const char *name, DISPID &dispid)
{
	OLECHAR *wszName = StringToBSTR(name);
	HRESULT hr = _pDispatch->GetIDsOfNames(IID_NULL,
							&wszName, 1, LOCALE_USER_DEFAULT, &dispid);
	::SysFreeString(wszName);
	return hr;
}

HRESULT Object_Ole::GetDispIDOfNamedArg(
				const char *nameMethod, const char *nameArg, DISPID &dispid)
{
	// named argument have to be looked up with a method name. see MSDN KB223165.
	OLECHAR *wszNames[2];
	DISPID dispids[2];
	wszNames[0] = StringToBSTR(nameMethod);
	wszNames[1] = StringToBSTR(nameArg);
	HRESULT hr = _pDispatch->GetIDsOfNames(IID_NULL,
							wszNames, 2, LOCALE_USER_DEFAULT, dispids);
	::SysFreeString(wszNames[0]);
	::SysFreeString(wszNames[1]);
	dispid = dispids[1];
	return hr;
}

Iterator *Object_Ole::CreateIterator(Signal sig)
{
	VARIANT var;
	HRESULT hr;
	::VariantInit(&var);
	do {
		DISPPARAMS dispParams = { NULL, NULL, 0, 0 };
	    EXCEPINFO exceptInfo;
		unsigned int argErr;
		::memset(&exceptInfo, 0, sizeof(exceptInfo));
		hr = _pDispatch->Invoke(DISPID_NEWENUM, IID_NULL, LOCALE_USER_DEFAULT,
					DISPATCH_METHOD | DISPATCH_PROPERTYGET,
					&dispParams, &var, &exceptInfo, &argErr);
		if (FAILED(hr)) {
			SetError(sig, hr);
			return NULL;
		}
	} while (0);
	IEnumVARIANT *pEnum = NULL;
	VARTYPE type = var.vt & VT_TYPEMASK;
	if (type == VT_UNKNOWN) {
		IUnknown *pUnknown = (var.vt & VT_BYREF)? *var.ppunkVal : var.punkVal;
		hr = pUnknown->QueryInterface(IID_IEnumVARIANT,
										reinterpret_cast<LPVOID *>(&pEnum));
	} else if (type == VT_DISPATCH) {
		IDispatch *pDispatch = (var.vt & VT_BYREF)? *var.ppdispVal : var.pdispVal;
		hr = pDispatch->QueryInterface(IID_IEnumVARIANT,
										reinterpret_cast<LPVOID *>(&pEnum));
	} else {
		sig.SetError(ERR_RuntimeError, "unexpected return value");
		return NULL;
	}
	::VariantClear(&var);
	if (FAILED(hr)) {
		SetError(sig, hr);
		return NULL;
	}
	Iterator *pIterator = new IteratorEx(Object_Ole::Reference(this), pEnum);
	return pIterator;
}

bool Object_Ole::DoPropDir(Signal sig, SymbolSet &symbols)
{
	Environment &env = *this;
	if (!Object::DoPropDir(sig, symbols)) return false;
	HRESULT hr;
	//hr = _pDispatch->GetTypeInfoCount(&cnt); // 0 or 1
	ITypeLib *pTypeLib = NULL;
	do {
		ITypeInfo *pTypeInfo = NULL;
		do {
			hr = _pDispatch->GetTypeInfo(0, LOCALE_SYSTEM_DEFAULT, &pTypeInfo);
			if (FAILED(hr)) {
				SetError(sig, hr);
				return false;
			}
		} while (0);
		do {
			unsigned int index; // not necessary for the actual use?
			hr = pTypeInfo->GetContainingTypeLib(&pTypeLib, &index);
			if (FAILED(hr)) {
				SetError(sig, hr);
				pTypeInfo->Release();
				return false;
			}
		} while (0);
		pTypeInfo->Release();
	} while (0);
	long cntTypeInfo = pTypeLib->GetTypeInfoCount();
	for (long iTypeInfo = 0; iTypeInfo < cntTypeInfo; iTypeInfo++) {
		ITypeInfo *pTypeInfo = NULL;
		do {
			hr = pTypeLib->GetTypeInfo(iTypeInfo, &pTypeInfo);
			if (FAILED(hr)) {
				SetError(sig, hr);
				pTypeLib->Release();
				return false;
			}
		} while (0);
		int cFuncs = 0;
		int cVars = 0;
		do {
			TYPEATTR *pTypeAttr = NULL;
			hr = pTypeInfo->GetTypeAttr(&pTypeAttr);
			if (FAILED(hr)) {
				SetError(sig, hr);
				pTypeInfo->Release();
				pTypeLib->Release();
				return false;
			}
			cFuncs = pTypeAttr->cFuncs;
			cVars = pTypeAttr->cVars;
			pTypeInfo->ReleaseTypeAttr(pTypeAttr);
		} while (0);
		for (int iFunc = 0; iFunc < cFuncs; iFunc++) {
			FUNCDESC *pFuncDesc = NULL;
			hr = pTypeInfo->GetFuncDesc(iFunc, &pFuncDesc);
			if (FAILED(hr)) continue;
			const Symbol *pSymbol = NULL;
			do {
				OLECHAR *nameOle;
				unsigned int len;
				hr = pTypeInfo->GetNames(pFuncDesc->memid, &nameOle, 1, &len);
				if (FAILED(hr)) break;
				pSymbol = Symbol::Add(BSTRToString(nameOle).c_str());
				::SysFreeString(nameOle);
			} while (0);
			if (pSymbol != NULL) symbols.insert(pSymbol);
			pTypeInfo->ReleaseFuncDesc(pFuncDesc);
		}
#if 0
		for (int iVar = 0; iVar < cVars; iVar++) {
			VARDESC *pVarDesc = NULL;
			hr = pTypeInfo->GetVarDesc(iVar, &pVarDesc);
			if (FAILED(hr)) continue;
			const Symbol *pSymbol = NULL;
			do {
				OLECHAR *nameOle;
				unsigned int len;
				hr = pTypeInfo->GetNames(pVarDesc->memid, &nameOle, 1, &len);
				if (FAILED(hr)) break;
				pSymbol = Symbol::Add(BSTRToString(nameOle).c_str());
				::SysFreeString(nameOle);
			} while (0);
			if (pSymbol != NULL) symbols.insert(pSymbol);
			pTypeInfo->ReleaseVarDesc(pVarDesc);
		}
#endif
		pTypeInfo->Release();
	}
	pTypeLib->Release();
	return true;
}

Value Object_Ole::DoPropGet(Signal sig, const Symbol *pSymbol, bool &evaluatedFlag)
{
	DISPID dispid;
	do {
		HRESULT hr = GetDispID(pSymbol->GetName(), dispid);
		if (FAILED(hr)) {
			SetError(sig, hr);
			return Value::Null;
		}
	} while (0);
	evaluatedFlag = true;
	VARIANT var;
	do {
		DISPPARAMS dispParams = { NULL, NULL, 0, 0 };
		HRESULT hr = _pDispatch->Invoke(dispid, IID_NULL, LOCALE_USER_DEFAULT,
						DISPATCH_PROPERTYGET, &dispParams, &var, NULL, NULL);
		if (FAILED(hr)) {
			SetError(sig, hr);
			return Value::Null;
		}
	} while (0);
	Value result;
	VariantToValue(*this, result, var);
	::VariantClear(&var);
	return result;
}

Value Object_Ole::DoPropSet(Signal sig, const Symbol *pSymbol,
									const Value &value, bool &evaluatedFlag)
{
	evaluatedFlag = true;
	DISPID dispid;
	do {
		HRESULT hr = GetDispID(pSymbol->GetName(), dispid);
		if (FAILED(hr)) {
			SetError(sig, hr);
			return Value::Null;
		}
	} while (0);
	do {
		VARIANTARG varArgs[1];
		DISPID dispidNamedArgs[1] = { DISPID_PROPERTYPUT };
		if (!ValueToVariant(sig, varArgs[0], value)) return Value::Null;
		DISPPARAMS dispParams;
		dispParams.rgvarg = varArgs;
		dispParams.rgdispidNamedArgs = dispidNamedArgs;
		dispParams.cArgs = 1;
		dispParams.cNamedArgs = 1;
		HRESULT hr = _pDispatch->Invoke(dispid, IID_NULL, LOCALE_USER_DEFAULT,
							DISPATCH_PROPERTYPUT, &dispParams, NULL, NULL, NULL);
		::VariantClear(&varArgs[0]);
		if (FAILED(hr)) {
			SetError(sig, hr);
			return Value::Null;
		}
	} while (0);
	return value;
}

ICallable *Object_Ole::GetCallable(Signal sig, const Symbol *pSymbol)
{
	//::printf("GetCallable(%s)\n", pSymbol->GetName());
	HRESULT hr = _callable.Setup(pSymbol->GetName());
	if (FAILED(hr)) {
		SetError(sig, hr);
		return NULL;
	}
	return &_callable;
}

String Object_Ole::ToString(Signal sig, bool exprFlag)
{
	String rtn;
	rtn += "<ole:";
	do {
		HRESULT hr;
		ITypeInfo *pTypeInfo = NULL;
		do {
			hr = _pDispatch->GetTypeInfo(0, LOCALE_SYSTEM_DEFAULT, &pTypeInfo);
			if (FAILED(hr)) {
				SetError(sig, hr);
				return rtn;
			}
		} while (0);
		TYPEKIND typekind;
		do {
			TYPEATTR *pTypeAttr = NULL;
			hr = pTypeInfo->GetTypeAttr(&pTypeAttr);
			if (FAILED(hr)) {
				SetError(sig, hr);
				pTypeInfo->Release();
				return rtn;
			}
			typekind = pTypeAttr->typekind;
			pTypeInfo->ReleaseTypeAttr(pTypeAttr);
		} while (0);
		if (typekind == TKIND_ALIAS) {
			rtn += "alias";
		} else if (typekind == TKIND_COCLASS) {
			rtn += "coclass";
		} else if (typekind == TKIND_DISPATCH) {
			rtn += "dispatch";
		} else if (typekind == TKIND_ENUM) {
			rtn += "enum";
		} else if (typekind == TKIND_INTERFACE) {
			rtn += "interface";
		} else if (typekind == TKIND_MAX) {
			rtn += "max";
		} else if (typekind == TKIND_MODULE) {
			rtn += "module";
		} else if (typekind == TKIND_RECORD) {
			rtn += "record";
		} else if (typekind == TKIND_UNION) {
			rtn += "union";
		} else {
			rtn += "(unknown)";
		}
		pTypeInfo->Release();
	} while (0);
	rtn += ">";
	return rtn;
}

void Object_Ole::SetError(Signal sig, HRESULT hr)
{
	LPWSTR errMsg = NULL;
	::FormatMessageW(
		FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS,
		NULL, hr, LOCALE_SYSTEM_DEFAULT, reinterpret_cast<LPWSTR>(&errMsg), 0, NULL);
	if (errMsg == NULL) {
		sig.SetError(ERR_RuntimeError, "COM error [%08x]", hr);
	} else {
		int len = static_cast<int>(::wcslen(errMsg));
		if (len > 0 && errMsg[len - 1] == '\n') len--;
		int bytes = ::WideCharToMultiByte(CP_UTF8, 0, errMsg, len, NULL, 0, NULL, NULL);
		char *pszErrMsg = new char [bytes];
		::WideCharToMultiByte(CP_UTF8, 0, errMsg, len, pszErrMsg, bytes, NULL, NULL);
		sig.SetError(ERR_RuntimeError, "COM error [%08x] %s", hr, pszErrMsg);
		::LocalFree(errMsg);
	}
}

//-----------------------------------------------------------------------------
// Object_Ole::Callable
//-----------------------------------------------------------------------------
HRESULT Object_Ole::Callable::Setup(const char *name)
{
	_name = name;
	return _pObj->GetDispID(name, _dispid);
}

Value Object_Ole::Callable::DoCall(Environment &env, Signal sig, Args &argsExpr)
{
	Value result;
	HRESULT hr;
	const ExprList &exprListArg = argsExpr.GetExprListArg();
	VARIANTARG *varArgs = NULL;
	DISPID *dispidNamedArgs = NULL;
	size_t cArgs = exprListArg.size();
	size_t cNamedArgs = 0;
	if (cArgs > 0) {
		varArgs = new VARIANTARG[cArgs];
		for (size_t iArg = 0; iArg < cArgs; iArg++) {
			::VariantInit(&varArgs[iArg]);// to avoid failure in ::VariantClear() after error
		}
		foreach_const (ExprList, ppExpr, exprListArg) {
			const Expr *pExpr = *ppExpr;
			if (pExpr->IsDictAssign()) cNamedArgs++;
		}
		dispidNamedArgs = new DISPID[cNamedArgs];
		// store named arguments
		int iArg = 0;
		foreach_const (ExprList, ppExpr, exprListArg) {
			const Expr *pExpr = *ppExpr;
			if (!pExpr->IsDictAssign()) continue;
			const Expr_DictAssign *pExprDictAssign =
						dynamic_cast<const Expr_DictAssign *>(pExpr);
			Value valueKey = pExprDictAssign->GetKey(env, sig);
			if (sig.IsSignalled()) goto error_done;
			Value value = pExprDictAssign->GetRight()->Exec(env, sig);
			if (sig.IsSignalled()) goto error_done;
			if (valueKey.IsSymbol()) {
				hr = _pObj->GetDispIDOfNamedArg(_name.c_str(),
						valueKey.GetSymbol()->GetName(), dispidNamedArgs[iArg]);
			} else if (valueKey.IsString()) {
				hr = _pObj->GetDispIDOfNamedArg(_name.c_str(),
						valueKey.GetString(), dispidNamedArgs[iArg]);
			} else {
				sig.SetError(ERR_ValueError,
						"a key for named argument of OLE must be a string or symbol");
				goto error_done;
			}
			if (FAILED(hr)) {
				Object_Ole::SetError(sig, hr);
				goto error_done;
			}
			ValueToVariant(sig, varArgs[iArg], value);
			if (sig.IsSignalled()) goto error_done;
			iArg++;
		}
		// store ordered arguments
		iArg = static_cast<int>(cArgs);
		foreach_const (ExprList, ppExpr, exprListArg) {
			const Expr *pExpr = *ppExpr;
			if (pExpr->IsDictAssign()) continue;
			iArg--;
			Value value = pExpr->Exec(env, sig);
			if (sig.IsSignalled()) goto error_done;
			ValueToVariant(sig, varArgs[iArg], value);
			if (sig.IsSignalled()) goto error_done;
		}
	}
	DISPPARAMS dispParams;
	dispParams.rgvarg = varArgs;
	dispParams.cArgs = static_cast<UINT>(cArgs);
	dispParams.rgdispidNamedArgs = dispidNamedArgs;
	dispParams.cNamedArgs = static_cast<UINT>(cNamedArgs);
	VARIANT varResult;
	hr = _pObj->GetDispatch()->Invoke(_dispid, IID_NULL, LOCALE_USER_DEFAULT,
			DISPATCH_METHOD | DISPATCH_PROPERTYGET, &dispParams, &varResult, NULL, NULL);
	if (varArgs != NULL) {
		for (size_t iArg = 0; iArg < cArgs; iArg++) {
			::VariantClear(&varArgs[iArg]);
		}
	}
	delete[] varArgs;
	delete[] dispidNamedArgs;
	if (FAILED(hr)) {
		::VariantClear(&varResult);
		Object_Ole::SetError(sig, hr);
		return Value::Null;
	}
	VariantToValue(env, result, varResult);
	::VariantClear(&varResult);
	return result;
error_done:
	if (varArgs != NULL) {
		for (size_t iArg = 0; iArg < cArgs; iArg++) {
			::VariantClear(&varArgs[iArg]);
		}
	}
	delete[] varArgs;
	delete[] dispidNamedArgs;
	return Value::Null;
}

//-----------------------------------------------------------------------------
// Object_Ole::IteratorEx
//-----------------------------------------------------------------------------
Object_Ole::IteratorEx::~IteratorEx()
{
	Object::Delete(_pObj);
	_pEnum->Release();
}

bool Object_Ole::IteratorEx::DoNext(Environment &env, Signal sig, Value &value)
{
	VARIANT var;
	::VariantInit(&var);
	if (_pEnum->Next(1, &var, NULL) != S_OK) return false;
	VariantToValue(*_pObj, value, var);
	::VariantClear(&var);
	return true;
}

String Object_Ole::IteratorEx::ToString(Signal sig) const
{
	return String("<iterator:win32ole>");
}

//-----------------------------------------------------------------------------
// AScript Interface for Object_Ole
//-----------------------------------------------------------------------------
AScript_ImplementPrivClass(Ole)
{
	//AScript_AssignMethod(Ole, hoge);
}

//-----------------------------------------------------------------------------
// AScript module functions: win32ole
//-----------------------------------------------------------------------------
// obj = win32ole.new(progid:string):map[:import_const]
AScript_DeclareFunctionAlias(new_, "new")
{
	SetMode(RSLTMODE_Normal, FLAG_Map);
	DeclareArg(env, "progid", VTYPE_String);
	DeclareAttr(AScript_PrivSymbol(import_const));
}

AScript_ImplementFunction(new_)
{
	Object_Ole *pObj = new Object_Ole(env);
	if (!pObj->Create(sig, args.GetString(0))) {
		delete pObj;
		return Value::Null;
	}
	if (args.IsSet(AScript_PrivSymbol(import_const))) {
		pObj->ImportConstant(*pObj, sig);
		if (sig.IsSignalled()) return Value::Null;
	}
	return Value(pObj);
}

// obj = win32ole.connect(progid:string):map[:import_const]
AScript_DeclareFunction(connect)
{
	SetMode(RSLTMODE_Normal, FLAG_Map);
	DeclareArg(env, "progid", VTYPE_String);
	DeclareAttr(AScript_PrivSymbol(import_const));
}

AScript_ImplementFunction(connect)
{
	Object_Ole *pObj = new Object_Ole(env);
	if (!pObj->Connect(sig, args.GetString(0))) {
		delete pObj;
		return Value::Null;
	}
	if (args.IsSet(AScript_PrivSymbol(import_const))) {
		pObj->ImportConstant(*pObj, sig);
		if (sig.IsSignalled()) return Value::Null;
	}
	return Value(pObj);
}

AScript_ModuleEntry()
{
	::CoInitialize(0);
	// symbol realization
	AScript_RealizePrivSymbol(import_const);
	// class realization
	AScript_RealizePrivClass(Ole, "ole", env.LookupClass(VTYPE_Object));
	// function assignment
	AScript_AssignFunctionEx(new_, "new");
	AScript_AssignFunction(connect);
}

AScript_ModuleTerminate()
{
	::CoUninitialize();
}

//-----------------------------------------------------------------------------
// Utilities
//-----------------------------------------------------------------------------
OLECHAR *StringToBSTR(const char *psz)
{
	// cnt includes null-terminater
	int cnt = ::MultiByteToWideChar(CP_UTF8, 0, psz, -1, NULL, 0);
	OLECHAR *bstr = ::SysAllocStringByteLen(NULL, cnt * sizeof(OLECHAR));
	::MultiByteToWideChar(CP_UTF8, 0, psz, -1, bstr, cnt);
	return bstr;
}

String BSTRToString(const OLECHAR *bstr)
{
	// cnt includes null-terminater
	int cnt = ::WideCharToMultiByte(CP_UTF8, 0, bstr, -1, NULL, 0, NULL, NULL);
	char *psz = new char [cnt];
	::WideCharToMultiByte(CP_UTF8, 0, bstr, -1, psz, cnt, NULL, NULL);
	return String(psz);
}

bool ValueToVariant(Signal sig, VARIANT &var, const Value &value)
{
	//::printf("ValueToVariant(%s %s)\n", value.GetTypeName(), value.ToString(sig).c_str());
	::VariantInit(&var);
	if (value.IsNumber()) {
		Number num = value.GetNumber();
		if (static_cast<Number>(static_cast<long>(num)) == num) {
			var.vt = VT_I4;
			var.lVal = static_cast<long>(value.GetNumber());
		} else {
			var.vt = VT_R8;
			var.dblVal = value.GetNumber();
		}
	} else if (value.IsString()) {
		var.vt = VT_BSTR;
		var.bstrVal = StringToBSTR(value.GetString());
	} else if (value.IsBoolean()) {
		var.vt = VT_BOOL;
		var.boolVal = value.GetBoolean()? VARIANT_TRUE : VARIANT_FALSE;
	} else if (value.IsList()) {
		const ValueList &valList = value.GetList();
		SAFEARRAYBOUND safeArrayBound;
		safeArrayBound.lLbound = 0;
		safeArrayBound.cElements = static_cast<ULONG>(valList.size());
		SAFEARRAY *pSafeArray = ::SafeArrayCreate(VT_VARIANT, 1, &safeArrayBound);
		//::printf("%p\n", pSafeArray);
		var.vt = VT_VARIANT | VT_ARRAY;
		var.parray = pSafeArray;
		//::SafeArrayLock(pSafeArray);
		foreach_const (ValueList, pValue, valList) {
			VARIANT varElem;
			if (!ValueToVariant(sig, varElem, *pValue)) return false;
			long index = static_cast<long>(pValue - valList.begin());
			::SafeArrayPutElement(pSafeArray, &index, &varElem);
		}
		//::SafeArrayUnlock(pSafeArray);
	} else {
		sig.SetError(ERR_ValueError, "cannot convert to win32ole variant");
		return false;
	}
	return true;
}

void VariantToValue(Environment &env, Value &value, const VARIANT &var)
{
	VARTYPE type = var.vt & VT_TYPEMASK;
	if (var.vt & VT_ARRAY) {
		var.byref;
	} else if (type == VT_I4) {
		value = Value(static_cast<Number>((var.vt & VT_BYREF)? *var.plVal : var.lVal));
	} else if (type == VT_UI1) {
		value = Value(static_cast<Number>((var.vt & VT_BYREF)? *var.pbVal : var.bVal));
	} else if (type == VT_I2) {
		value = Value(static_cast<Number>((var.vt & VT_BYREF)? *var.piVal : var.iVal));
	} else if (type == VT_R4) {
		value = Value(static_cast<Number>((var.vt & VT_BYREF)? *var.pfltVal : var.fltVal));
	} else if (type == VT_R8) {
		value = Value(static_cast<Number>((var.vt & VT_BYREF)? *var.pdblVal :var.dblVal));
	} else if (type == VT_BOOL) {
		value = Value(static_cast<Number>((var.vt & VT_BYREF)? *var.pboolVal : var.boolVal));
	} else if (type == VT_ERROR) {
		//value = Value(static_cast<Number>((var.vt & VT_BYREF)? *var.pscode : var.code));
	} else if (type == VT_CY) {
		//value = Value(static_cast<Number>((var.vt & VT_BYREF)? *var.pcyVal : var.cyVal));
	} else if (type == VT_DATE) {
		value = Value(static_cast<Number>((var.vt & VT_BYREF)? *var.pdate : var.date));
	} else if (type == VT_BSTR) {
		value = Value(env, BSTRToString(var.bstrVal).c_str());
	} else if (type == VT_UNKNOWN) {
		//value = Value(static_cast<Number>((var.vt & VT_BYREF)? *var.ppunkVal : var.punkVal));
	} else if (type == VT_DISPATCH) {
		IDispatch *pDispatch = (var.vt & VT_BYREF)? *var.ppdispVal : var.pdispVal;
		pDispatch->AddRef(); // prevent deletion by VariantClear()
		Object_Ole *pObj = new Object_Ole(env, pDispatch);
		value = Value(pObj);
	} else if (type == VT_VARIANT) {
		//value = Value(static_cast<Number>(*var.pvarVal));
	}
}

AScript_EndModule(win32ole, win32ole)

AScript_RegisterModule(win32ole)
