
/*
 *  Copyright 1995 Microsoft Corporation. All rights reserved.
 *  Developed by Ataman Software, Inc., ftp://rmii.com/pub2/ataman,
 *       info@ataman.com
 *
 *  This library is free software; you can redistribute it and/or
 *  modify it under the terms of the GNU Library General Public
 *  License as published by the Free Software Foundation; either
 *  version 2 of the License, or (at your option) any later version.
 *
 *  This library is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 *  Library General Public License for more details.
 *
 *  You should have received a copy of the GNU Library General Public
 *  License along with this library; if not, write to the Free
 *  Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 */


#define STRICT
#include <windows.h>
#include <ole2ver.h>

extern "C" {
#include "rexx.h"

streng *w32_createobject(paramboxptr parms);
streng *w32_releaseobject(paramboxptr parms);
streng *w32_getobject(paramboxptr parms);
streng *w32_callfunc(paramboxptr parms);
streng *w32_callproc(paramboxptr parms);
streng *w32_getproperty(paramboxptr parms);
streng *w32_getsubobj(paramboxptr parms);
streng *w32_putproperty(paramboxptr parms);
char *GetOLEErr(void);
}

const unsigned long lcid = MAKELCID(MAKELANGID(LANG_ENGLISH,SUBLANG_ENGLISH_US), SORT_DEFAULT);
const int MAXARGS = 50;

#define MAXSTRING (16*1024)

static void Cleanup(void) {
	OleUninitialize();
}

static void OLEErr(const char *format, ...);
static void OLEStdErr(const char *name, HRESULT hr, const char *tag);

static BOOL DoChange(const char *name, VARIANT *, unsigned short type);

static BOOL fInited = FALSE;

static BOOL Init(void)
{
	DWORD dwVersion = OleBuildVersion();

	if (HIWORD(dwVersion) != rmm || LOWORD(dwVersion) < rup)
		return FALSE;

	if (FAILED(OleInitialize(NULL)))
		return FALSE;

	fInited = TRUE;
	(void)atexit(Cleanup);

	return TRUE;
}

enum CallType_t {ct_func, ct_proc, ct_subobj };

static streng *DoInvoke(streng *iptr, streng *name, CallType_t calltype,
	unsigned short itype, streng *typelist, paramboxptr parms);

streng *w32_createobject(paramboxptr parms) {
	/* val = w32CreateObject(ProgramID) */
	HRESULT hr;
	IUnknown *punk = NULL;
	IDispatch *pdsp = NULL;
	CLSID clsid;
	streng *ret;
	OLECHAR ocBuf[MAXSTRING];

	checkparam(parms, 1, 1) ;

	if (!fInited) {
		if (!Init()) {
	 	 	exiterror(ERR_SYSTEM_FAILURE);
		}
	}

	parms->value = Str_ify(parms->value);

	if (MultiByteToWideChar(CP_ACP, 0, parms->value->value,
		-1, ocBuf, sizeof ocBuf) == 0) {
		exiterror(ERR_SYSTEM_FAILURE);
	}

	hr = CLSIDFromProgID(ocBuf, &clsid);
	if (FAILED(hr)) {
		OLEStdErr("CreateObject", hr, "CLSIDFromProgID failed");
		goto errexit;
	}

	hr = CoCreateInstance(clsid, NULL, CLSCTX_SERVER, IID_IUnknown, (LPVOID *)&punk);
	if (FAILED(hr)) {
		OLEStdErr("CreateObject", hr, "CoCreateInstance failed");
		goto errexit;
	}

	hr = punk->QueryInterface(IID_IDispatch, (LPVOID *)&pdsp);
	if (FAILED(hr)) {
		OLEStdErr("CreateObject", hr, "QueryInterface failed");
		goto errexit;
	}

	errexit:
	if (punk) {
		punk->Release();
	}

	if (!pdsp) {
	  exiterror(ERR_OLE_ERROR);
	}

	ret = Str_make((sizeof pdsp * 2) + 1);
	sprintf(ret->value, "%lx", (unsigned long)pdsp);
	ret->len = strlen(ret->value);
	return ret;
}


streng *w32_getobject(paramboxptr parms) {
	/* val = w32GetObject([FileName], [ProgramID]) */
	HRESULT hr;
	IUnknown *punk = NULL;
	IDispatch *pdsp = NULL;
	IMoniker *pmon = NULL;
	IPersistFile *ppf = NULL;
	LPBC pbc = NULL;
	CLSID clsid;
	streng *ret;
	ULONG cEaten;
	OLECHAR ocBuf[MAXSTRING];
	enum gettype_t { gt_fileonly, gt_apponly, gt_both } gettype;

	if (parms->next == NULL) {
		if (parms->value == NULL) {
			exiterror(ERR_INCORRECT_CALL);
		}
		gettype = gt_fileonly;
		parms->value = Str_ify(parms->value);
	} else if (parms->value == NULL) {
		if (parms->next->value == NULL) {
			exiterror(ERR_INCORRECT_CALL);
		}
		gettype = gt_apponly;
		parms->next->value = Str_ify(parms->next->value);
	} else {
		if (parms->next->value != NULL) {
			gettype = gt_both;
			parms->next->value = Str_ify(parms->next->value);
		} else {
			gettype = gt_fileonly;
		}
		parms->value = Str_ify(parms->value);
	}

	if (!fInited) {
		if (!Init()) {
	 	 	exiterror(ERR_SYSTEM_FAILURE);
		}
	}


	if (gettype == gt_apponly) {
		if (MultiByteToWideChar(CP_ACP, 0, parms->next->value->value,
			-1, ocBuf, sizeof ocBuf) == 0) {
			exiterror(ERR_SYSTEM_FAILURE);
		}

		hr = CLSIDFromProgID(ocBuf, &clsid);
		if (FAILED(hr)) {
			OLEStdErr("GetObject", hr, "CLSIDFromProgID failed");
			goto errexit;
		}

		hr = GetActiveObject(clsid, NULL, &punk);
		if (FAILED(hr)) {
			OLEStdErr("GetObject", hr, "GetActiveObject failed");
			goto errexit;
		}

		hr = punk->QueryInterface(IID_IDispatch, (LPVOID *)&pdsp);
		if (FAILED(hr)) {
			OLEStdErr("GetObject", hr, "QueryInterface failed");
			goto errexit;
		}
	} else if (gettype == gt_fileonly) {
		if (MultiByteToWideChar(CP_ACP, 0, parms->value->value,
			-1, ocBuf, sizeof ocBuf) == 0) {
			exiterror(ERR_SYSTEM_FAILURE);
		}

		hr = CreateBindCtx(0, &pbc);
		if (FAILED(hr)) {
			OLEStdErr("GetObject", hr, "CreateBindCtx failed");
			goto errexit;
		}

		hr = MkParseDisplayName(pbc, ocBuf, &cEaten, &pmon);
		if (FAILED(hr)) {
			OLEStdErr("GetObject", hr, "MkParseDisplayName failed");
			goto errexit;
		}

		hr = BindMoniker(pmon, 0, IID_IDispatch, (LPVOID *)&pdsp);
		if (FAILED(hr)) {
			OLEStdErr("GetObject", hr, "BindMoniker failed");
			goto errexit;
		}
	} else { // gt_both
		if (MultiByteToWideChar(CP_ACP, 0, parms->next->value->value,
			-1, ocBuf, sizeof ocBuf) == 0) {
			exiterror(ERR_SYSTEM_FAILURE);
		}

		hr = CLSIDFromProgID(ocBuf, &clsid);
		if (FAILED(hr)) {
			OLEStdErr("GetObject", hr, "CLSIDFromProgID failed");
			goto errexit;
		}

		hr = CoCreateInstance(clsid, NULL, CLSCTX_SERVER, IID_IUnknown, (LPVOID *)&punk);
		if (FAILED(hr)) {
			OLEStdErr("GetObject", hr, "CoCreateInstance failed");
			goto errexit;
		}

		hr = punk->QueryInterface(IID_IPersistFile, (LPVOID *)&ppf);
		if (FAILED(hr)) {
			OLEStdErr("GetObject", hr, "QueryInterface (IPersistFile) failed");
			goto errexit;
		}

		if (MultiByteToWideChar(CP_ACP, 0, parms->value->value,
			-1, ocBuf, sizeof ocBuf) == 0) {
			OLEErr("Error converting filename: '%s' to UNICODE", parms->value->value);
			goto errexit;
		}

		hr = ppf->Load(ocBuf, 0);
		if (FAILED(hr)) {
			OLEStdErr("GetObject", hr, parms->value->value);
			goto errexit;
		}

		hr = ppf->QueryInterface(IID_IDispatch, (LPVOID *)&pdsp);
		if (FAILED(hr)) {
			OLEStdErr("GetObject", hr, "QueryInterface (IDispatch) failed");
			goto errexit;
		}
	}

errexit:

	if (punk) {
		punk->Release();
	}

	if (pmon) {
		pmon->Release();
	}

	if (pbc) {
		pbc->Release();
	}

	if (ppf) {
		ppf->Release();
	}

	if (!pdsp) {
	  exiterror(ERR_OLE_ERROR);
	}

	ret = Str_make((sizeof pdsp * 2) + 1);
	sprintf(ret->value, "%lx", (unsigned long)pdsp);
	ret->len = strlen(ret->value);
	return ret;
}


streng *w32_releaseobject(paramboxptr parms) {
	/* call w32ReleaseObject object */
	IDispatch *pdsp;

	checkparam(parms, 1, 1) ;

	parms->value = Str_ify(parms->value);

	sscanf(parms->value->value, "%lx", (unsigned long *)&pdsp);

	if (pdsp) {
		pdsp->Release();
	}

	return nullstringptr();
}

streng *w32_callproc(paramboxptr parms) {
	/* call w32CallProc object, name, typelist, ... */
	paramboxptr tlptr;

	checkparam(parms, 2, 53) ;

	tlptr = parms->next->next;

	return DoInvoke(parms->value, parms->next->value, ct_proc,
		DISPATCH_METHOD, tlptr?tlptr->value:NULL, tlptr?tlptr->next:NULL);
}

streng *w32_callfunc(paramboxptr parms) {
	/* val = w32CallFunc(object, name, typelist, ...) */
	paramboxptr tlptr;

	checkparam(parms, 2, 53) ;

	tlptr = parms->next->next;

	return DoInvoke(parms->value, parms->next->value, ct_func,
		DISPATCH_METHOD, tlptr?tlptr->value:NULL, tlptr?tlptr->next:NULL);
}

streng *w32_getsubobj(paramboxptr parms) {
	/* val = w32GetSubObj(object, name, typelist, ...) */
	paramboxptr tlptr;

	checkparam(parms, 2, 53) ;

	tlptr = parms->next->next;

	return DoInvoke(parms->value, parms->next->value, ct_subobj,
		DISPATCH_METHOD, tlptr?tlptr->value:NULL, tlptr?tlptr->next:NULL);
}

streng *w32_getproperty(paramboxptr parms) {
	/* val = w32GetProperty(object, name) */

	checkparam(parms, 2, 2) ;

	return DoInvoke(parms->value, parms->next->value, ct_func,
		DISPATCH_PROPERTYGET, NULL, NULL);
}

streng *w32_putproperty(paramboxptr parms) {
	/* call w32PutProperty(object, name, typelist, value) */
	unsigned long cParms;
	paramboxptr ptr;

	cParms = 0;
	for (ptr=parms; ptr; ptr = ptr->next) {
		cParms++;
	}

	if (cParms != 4) {
		exiterror(ERR_INCORRECT_CALL);
	}

	return DoInvoke(parms->value, parms->next->value, ct_proc,
		DISPATCH_PROPERTYPUT, parms->next->next->value, parms->next->next->next);
}


static streng *DoInvoke(streng *iptr, streng *name, CallType_t calltype,
	unsigned short itype, streng *typelist, paramboxptr parms) {
	IDispatch *pdsp = NULL;
	HRESULT hr;
	DISPID dispid;
	DISPPARAMS dspp;
	EXCEPINFO ex;
	unsigned int bt;
	VARIANTARG vRet;
	streng *ret = nullstringptr();
	VARIANTARG vArgs[MAXARGS];
	long l;
	char *tl = NULL;
	paramboxptr ptr;
	unsigned int cParms;
	OLECHAR ocBuf[MAXSTRING];
	OLECHAR *tb = ocBuf;
	DISPID did;

	cParms = 0;
	for (ptr=parms; ptr; ptr = ptr->next) {
	 	cParms++;
	}

	iptr = Str_ify(iptr);
	name = Str_ify(name);

	if (typelist) {
		 typelist = Str_ify(typelist);
		 tl = typelist->value;
	}

	sscanf(iptr->value, "%lx", (unsigned long *)&pdsp);


	if (MultiByteToWideChar(CP_ACP, 0, name->value, -1, ocBuf, sizeof ocBuf) == 0) {
	  exiterror(ERR_SYSTEM_FAILURE);
	}


	hr = pdsp->GetIDsOfNames(IID_NULL, &tb, 1, lcid, &dispid);
	if (FAILED(hr)) {
		OLEStdErr(name->value, hr, "GetIDsOfNames failed");
		goto errexit;
	}

	VariantInit(&vRet);


	for (l=0; l<(int)cParms; l++) {
		VariantInit(&vArgs[l]);
	}

	for (ptr=parms,l=cParms-1; l>=0; l--, ptr=ptr->next) {
		if (!ptr->value) {
			vArgs[l].vt = VT_ERROR;
			vArgs[l].scode = DISP_E_PARAMNOTFOUND;
		} else {
		  ptr->value = Str_ify(ptr->value);
		  if (MultiByteToWideChar(CP_ACP, 0, ptr->value->value, -1,
				 ocBuf, sizeof ocBuf) == 0) {
				 exiterror(ERR_SYSTEM_FAILURE);
		  }
			vArgs[l].vt = VT_BSTR;
			vArgs[l].bstrVal = SysAllocString(ocBuf);

			if (tl) {
				switch (*tl) {
					case 'b':
					  if (!DoChange(name->value, &vArgs[l], VT_BOOL)) {
							goto errexit;
					  }
						break;
					case 'c':
					  if (!DoChange(name->value, &vArgs[l], VT_CY)) {
							goto errexit;
					  }
						break;
					case 'd':
					  if (!DoChange(name->value, &vArgs[l], VT_DATE)) {
							goto errexit;
					  }
						break;
					case 'i':
					  if (!DoChange(name->value, &vArgs[l], VT_I2)) {
							goto errexit;
					  }
						break;
					case 'I':
						if (!DoChange(name->value, &vArgs[l], VT_I4)) {
								goto errexit;
						}
						break;
					case 'o':
						VariantClear(&vArgs[l]);
						vArgs[l].vt = VT_DISPATCH;
						sscanf(ptr->value->value, "%lx", &vArgs[l].pdispVal);
						break;
					case 'r':
					  if (!DoChange(name->value, &vArgs[l], VT_R4)) {
							goto errexit;
					  }
						break;
					case 'R':
					  if (!DoChange(name->value, &vArgs[l], VT_R8)) {
							goto errexit;
					  }
						break;
					case 's':
						break;
					default:
						OLEStdErr(name->value, hr, "Bad type in type list");
						goto errexit;
				}
			}
		}

		if (tl) {
			tl++;
		}
	}

	dspp.rgvarg = vArgs;
	dspp.cArgs = cParms;
	if (itype == DISPATCH_PROPERTYPUT) {
		did = DISPID_PROPERTYPUT;
		dspp.rgdispidNamedArgs = &did;
		dspp.cNamedArgs = 1;
	} else {
		dspp.rgdispidNamedArgs = NULL;
		dspp.cNamedArgs = 0;
	}

	hr = pdsp->Invoke(dispid, IID_NULL, lcid, itype, &dspp,
		calltype != ct_proc?&vRet:NULL, &ex, &bt);
	if (FAILED(hr)) {
		if (GetScode(hr) == DISP_E_TYPEMISMATCH) {
			OLEErr("%s: Argument %d is of an incorrect type", name->value, (int)(cParms-bt));
		} else if (GetScode(hr) == DISP_E_EXCEPTION) {
			if (ex.pfnDeferredFillIn) {
				(*ex.pfnDeferredFillIn)(&ex);
			}
			OLEErr("%s: %ls: %ls", name->value, ex.bstrSource, ex.bstrDescription);
			SysFreeString(ex.bstrSource);
			SysFreeString(ex.bstrDescription);
			SysFreeString(ex.bstrHelpFile);
		} else {
			OLEStdErr(name->value, hr, "Invoke failed");
		}
	  goto errexit;
	}

	if (calltype != ct_proc) {
		DWORD dwLen;

		if (calltype == ct_subobj) {
			if (vRet.vt != VT_DISPATCH) {
				OLEErr("Name: %s, does not return handle to a subobject", name->value);
				goto errexit;
			}
		}

		if (vRet.vt == VT_DISPATCH) {
			OLECHAR buf[24];
			wsprintfW(buf, L"%lx", (unsigned long)vRet.pdispVal);
			// NO VariantClear(&vRet)!!!! this does a Release() on the pdisp.
			vRet.vt = VT_BSTR;
			vRet.bstrVal = SysAllocString(buf);
		} else {
			hr = VariantChangeType(&vRet, &vRet, 0, VT_BSTR);
			if (FAILED(hr)) {
				OLEStdErr(name->value, hr, "Failure converting return value to string");
				goto errexit;
			}
		}

	  dwLen = WideCharToMultiByte(CP_ACP, 0, vRet.bstrVal, -1, NULL, 0, NULL, NULL);

	  ret = Str_make(dwLen+1);

	  if (WideCharToMultiByte(CP_ACP, 0, vRet.bstrVal, -1,
			  ret->value, dwLen+1, NULL, NULL) == 0) {
		  exiterror(ERR_SYSTEM_FAILURE);
	  }

	  ret->len = strlen(ret->value);
	}

	VariantClear(&vRet);

	for (l=0; l<(int)cParms; l++) {
		VariantClear(&vArgs[l]);
	}

	return ret;

errexit:
	VariantClear(&vRet);

	for (l=0; l<(int)cParms; l++) {
		VariantClear(&vArgs[l]);
	}

	exiterror(ERR_OLE_ERROR);

	return ret; /* Not Reached */
}


static BOOL DoChange(const char *name, VARIANT *bstr, unsigned short type)
{
	 HRESULT hr;

	 hr = VariantChangeType(bstr, bstr, 0, type);
	 if (FAILED(hr)) {
		  OLEStdErr(name, hr, "Bad data conversion");
		  return FALSE;
	 }

	 return TRUE;
}
/*
{
	int x, y ;

	checkparam( parms, 2, 2 ) ;
	y = atozpos( parms->value ) ;
	x = atozpos( parms->next->value ) ;

	move( y, x ) ;
	return nullstringptr() ;
}
*/

/*
{
	double largest, current ;
	paramboxptr ptr ;
	streng *result ;

	if (!(ptr=parms)->value)
		exiterror( ERR_INCORRECT_CALL ) ;

	largest = myatof( ptr->value ) ;

	for(;ptr;ptr=ptr->next)
		if ((ptr->value)&&((current=myatof(ptr->value))>largest))
			largest = current ;

	result = Str_make( sizeof(double)*3+7 ) ;
	sprintf(result->value, "%G", largest) ;
	result->len = strlen(result->value) ;
	return result ;
}
*/

#include <stdarg.h>

static char OLEErrBuf[8192];

static void OLEErr(const char *format, ...) {
	va_list ap;

	va_start(ap, format);
	vsprintf(OLEErrBuf, format, ap);
	va_end(ap);
}


static void OLEStdErr(const char *name, HRESULT hr, const char *tag) {
	sprintf(OLEErrBuf, "OLE Error in %s: %s: SCODE=%x", name, tag, hr);
}



char *GetOLEErr(void) {
	return OLEErrBuf;
}
