PARAMETERS xacordform

IF TYPE('xacordform')<>"C" .OR. EMPTY(xacordform)
	RETURN .F.
ENDIF

PRIVATE acordalias, tempfile, m.line, fieldcount, xvalue, xfield, llacordok, lcACORDdef
acordalias=''
acordalias=ALIAS()
tempfile = hdir+xacordform+'.xfdf'
pdffile  = hdir+xacordform+'.pdf'
m.line = ''
fieldcount = 0
xvalue = ''
xfield = ''
llacordok = .T.
lcACORDdef = SYS(5)+SYS(2003)

PRIVATE cAppKey, cAppName, cExtn, nErrNum, lcpath, lcshort, lcsetsafety
PRIVATE cAppname, lcresult

lcsetsafety=SET('SAFETY')
SET SAFETY OFF

IF FILE(pdffile)		&& .pdf file
	DELETE FILE (pdffile)
ENDIF
IF FILE(tempfile)		&& .xfdf file
	DELETE FILE (tempfile)
ENDIF

PRIVATE llokay
llokay = .F.
IF UseFile("ACORDEFN",ddir,"FORMORDER")
	IF UseFile("ACORDICT",ddir,"FORMFIELDU")
		IF UseFile("ACORDFRM",ddir,"FORM")
			llokay = .T.
		ENDIF
	ENDIF
ENDIF
IF !llokay
	IF USED("ACORDFRM")	&& holds pdf forms
		USE IN ACORDFRM
	ENDIF
	IF USED("ACORDICT")	&& holds acord/policy profiler data dictionary
		USE IN ACORDICT
	ENDIF
	IF USED("ACORDEFN")	&& holds field definitions
		USE IN acordefn
	ENDIF
	IF !EMPTY(acordalias) .AND. ALIAS() <> acordalias
		SELECT (acordalias)
	ENDIF
	IF !EMPTY(lcsetsafety)
		SET SAFETY &lcsetsafety
	ENDIF
	RETURN .F.
ENDIF

SELE acordefn
GO TOP

PRIVATE m.output
m.output = FCREATE(tempfile,0)

IF m.output < 0
	=MESSAGEBOX("Could not create '+tempfile+' Acord xml file.",0+16+4096,"ERROR")
	IF USED("ACORDICT")	&& holds policy profiler->acord data dictionary
		USE IN ACORDICT
	ENDIF
	IF USED("ACORDEFN")	&& hold form fields
		USE IN acordefn
	ENDIF
	IF USED("ACORDFRM")	&& holds pdf forms
		USE IN ACORDFRM
	ENDIF
	IF !EMPTY(acordalias) .AND. ALIAS() <> acordalias
		SELECT (acordalias)
	ENDIF
	IF !EMPTY(lcsetsafety)
		SET SAFETY &lcsetsafety
	ENDIF
	RETURN .F.
ENDIF

SELE acordefn
GO TOP
SCAN FOR UPPER(ALLTRIM(acordefn.FORM))=UPPER(ALLTRIM(xacordform)) .AND. !DELETED()

	m.line=''

	IF EMPTY(acordefn.FIELD)	&& tag only not a field

		STORE .F. TO mfields

		DO CASE
			CASE !EMPTY(acordefn.tag1)
				m.line = ALLTRIM(acordefn.tag1)+CHR(10)
			CASE !EMPTY(acordefn.tag2)
				m.line = ALLTRIM(acordefn.tag2)+CHR(10)
			CASE !EMPTY(acordefn.href)
				IF fieldcount > 0
					m.line = "</fields>"+CHR(10)
				ENDIF
				m.line = m.line + ALLTRIM(acordefn.href)+CHR(10)
			CASE !EMPTY(acordefn.endtag)
				m.line = ALLTRIM(acordefn.endtag)+CHR(10)
		ENDCASE

	ELSE	&& field

		*--Check for the first field, if first print the <fields> tag
		IF fieldcount = 0	&& first field
			m.line = m.line + "<fields>"+CHR(10)
			fieldcount = fieldcount + 1
		ENDIF

		*--Get the profiler value for this field
		IF INDEXSEEK(UPPER(ALLTRIM(acordefn.FIELD)),.T.,'ACORDICT','FORMFIELDU')
			IF !EMPTY(ACORDICT.profiler)
				xvalue = EVALUATE(ACORDICT.profiler)
			ELSE
				xvalue = EVALUATE(ACORDICT.EXPRESSION)
			ENDIF
		ELSE
			xvalue = ''
		ENDIF

		*--Format xvalue to string
		DO CASE
			CASE TYPE('xvalue')="N"
				IF AT('.',xvalue) > 0
					xvalue = TRANSFORM(xvalue,'9,999,999.99')
				ELSE
					xvalue = ALLTRIM(STR(xvalue))
				ENDIF
			CASE TYPE('xvalue')="D"
				xvalue = DTOC(xvalue)
			CASE TYPE('xvalue')="C"
				xvalue = RTRIM(xvalue)
		ENDCASE

		*--Print the field name tags for this field
		FOR ia = 1 TO 10	&& step through all possible field tags for this item
			xfield = 'FIELD'+ALLTRIM(STR(ia))
			IF !EMPTY(EVALUATE(xfield))
				m.line = m.line+"<field name='"+ALLTRIM(EVALUATE(xfield))+"'>" + CHR(10)
			ELSE
				EXIT
			ENDIF
		ENDFOR

		*--Print the value line for this field
		m.line = m.line + "<value>"+xvalue+"</value>"+CHR(10)

		*--Print the field tag delimiters for this field
		FOR ib = 1 TO acordefn.fieldtags
			m.line = m.line + "</field>"+CHR(10)
		ENDFOR

	ENDIF

	*--Write the lines to the file [formname].xfdf in the user's home directory
	IF !EMPTY(m.line)
		=FWRITE(m.output,m.line)
	ENDIF

ENDSCAN
=FCLOSE(m.output)

IF FILE(tempfile)
	SELE ACORDFRM
	GO TOP
	IF INDEXSEEK(UPPER(ALLTRIM(xacordform)),.T.,'ACORDFRM','FORM')
		=STRTOFILE(ACORDFRM.DATA,hdir+xacordform+'.pdf')
		IF FILE(tempfile) .AND. FILE(pdffile)
			DO DECLexewait
			*--Look for AcroRd32.exe first
			lcresult=readregistrykey()
			IF OCCURS('"',lcresult)>0
				IF TYPE('lcresult')="C" .and. !EMPTY(lcresult)
					m.cAppName=SUBSTR(lcresult,2,AT('"',lcresult,2)-2)
				ELSE
					m.cAppName = ''
				ENDIF
			ELSE
				m.cAppName = lcresult+"AcroRd32.Exe"
			ENDIF
			IF FILE(m.cAppName)	&& AcroRd32.exe
				lcACORDdef = SYS(5)+SYS(2003)
				SET DEFAULT TO LEFT(hdir,RAT("\",hdir)-1)
				lnpos=(RAT("\",m.cAppName)+1)	&& one position to the right of
				lcshort=''
				lcpath=''
				IF lnpos > 0
					lcshort = UPPER(SUBSTR(m.cAppName,lnpos))	&& grab from lnpos to end
					lcpath  = UPPER(LEFT(m.cAppName,RAT("\",m.cAppName)-1))			&& strip off the extension
				ENDIF
				IF !EMPTY(lcshort) .AND. !EMPTY(lcpath)
					lcpath = "'"+lcpath+"'"
					SET DEFAULT TO &lcpath
					llacordok = ExeWait(lcshort,hdir+xacordform+'.xfdf',lcpath)
				ELSE
					llacordok = ExeWait( m.cAppName, xacordform+'.xfdf',hdir)
				ENDIF
				IF !llacordok
					=MESSAGEBOX("Unable to print Acord Form.",0+16+4096,"ERROR")
				ELSE
					WAIT WINDOW "Finished Printing" NOWAIT
				ENDIF
				SET DEFAULT TO &lcACORDdef
			ELSE
				#DEFINE ERROR_SUCCESS		0	&& OK
				oReg = NEWOBJECT("FileReg",'registry.vcx')
				cAppKey = ""
				cAppName = "ACRORD32.EXE"
				m.cExtn = "PDF"
				nErrNum = oReg.GetAppPath(m.cExtn,@cAppKey,@cAppName)
				IF m.nErrNum # ERROR_SUCCESS	&& No associated pdf reader installed
					=MESSAGEBOX("Cannot locate Acrobat Reader. Please install and try again.",0+16+4096,"Acrobat Reader Missing.")
				ELSE	&& Adobe installed
					IF ATC(".EXE",m.cAppName) #0
						m.cAppName= ALLTRIM(SUBSTR(m.cAppName,1,ATC(".EXE",m.cAppName)+3))
						IF ASC(LEFT(cAppName,1))=34 &&check for long file name in quotes
							m.cAppName = SUBSTR(m.cAppName,2)
						ENDIF
					ENDIF
					lcACORDdef = SYS(5)+SYS(2003)
					SET DEFAULT TO LEFT(hdir,RAT("\",hdir)-1)
					lnpos=(RAT("\",m.cAppName)+1)	&& one position to the right of
					lcshort=''
					lcpath=''
					IF lnpos > 0
						lcshort = UPPER(SUBSTR(m.cAppName,lnpos))	&& grab from lnpos to end
						lcpath  = UPPER(LEFT(m.cAppName,RAT("\",m.cAppName)-1))			&& strip off the extension
					ENDIF
					IF EMPTY(m.cAppName)
						=MESSAGEBOX("Cannot locate Acrobat Reader. Please install and try again.",0+16+4096,"Acrobat Reader Missing.")
					ELSE
						IF !EMPTY(lcshort) .AND. !EMPTY(lcpath)
							lcpath = "'"+lcpath+"'"
							SET DEFAULT TO &lcpath
							llacordok = ExeWait(lcshort,hdir+xacordform+'.xfdf',lcpath)
						ELSE
							llacordok = ExeWait( m.cAppName, xacordform+'.xfdf',hdir)
						ENDIF
						IF !llacordok
							=MESSAGEBOX("Unable to print Acord Form.",0+16+4096,"ERROR")
						ELSE
							WAIT WINDOW "Finished Printing" NOWAIT
						ENDIF
					ENDIF
					SET DEFAULT TO &lcACORDdef
				ENDIF
			ENDIF
		ELSE	&& could not create .xfdf or .pdf file
			=MESSAGEBOX("Unable to create Acord Form.",0+16+4096,"ERROR - PDF or XFDF Missing.")
		ENDIF
	ELSE
		=MESSAGEBOX("Cannot locate form:"+UPPER(ALLTRIM(xacordform))+" in forms table.",0+16+4096,"ERROR - Form Missing in Form Table.")
	ENDIF
ENDIF

*--Cleanup
IF FILE(pdffile)		&& .pdf file
	DELETE FILE (pdffile)
ENDIF
IF FILE(tempfile)		&& .xfdf file
	DELETE FILE (tempfile)
ENDIF

IF USED("ACORDICT")	&& holds policy profiler->acord data dictionary
	USE IN ACORDICT
ENDIF
IF USED("ACORDEFN")	&& hold form fields
	USE IN acordefn
ENDIF
IF USED("ACORDFRM")	&& holds pdf forms
	USE IN ACORDFRM
ENDIF

IF !EMPTY(acordalias) .AND. ALIAS() <> acordalias
	SELECT (acordalias)
ENDIF

IF !EMPTY(lcsetsafety)
	SET SAFETY &lcsetsafety
ENDIF

PRIVATE idll, lcdll
PRIVATE ARRAY dllarray(1)
=ADLLS(dllarray)
FOR idll = 1 TO ALEN(dllarray,1)
	lcdll = dllarray(idll,1)
	lccommand = "Clear DLLS "+"'"+lcdll+"'"
	&lccommand
ENDFOR
*CLEAR DLLS "RegEnumKey","RegDeleteKey","RegCloseKey","RegCreateKey","RegDeleteKey",;
"RegEnumValue","RegOpenKey","RegQueryValueEx","RegSetValueEx","Sleep",;
"RegDeleteValue","RegEnumKeyEx"
=ADLLS(dllarray)
RETURN .T.



*----------------------------------------------------------------------
*--PROCEDURE ExeWait
*----------------------------------------------------------------------
*--Uses GetExitcodeProcess instead of waitforsingleobject
*----------------------------------------------------------------------
FUNCTION  ExeWait(lcApp, lcCmdLine, lcdir)
PRIVATE llsetback, file_han, lnstart, lngone, lnElapsed, lnBegin, lcOldSetHours, exitcode, lnlast
lnlast = 0
IF _VFP.AUTOYIELD = .F.
	llsetback = .T.
ELSE
	llsetback = .F.
ENDIF
_VFP.AUTOYIELD = .T.
#DEFINE INFINITE  0xFFFFFFFF
LOCAL lcStartupInfo, lcProcInfo, hProcess, ;
	lnPrio, lnIBelieve1
lnIBelieve1 = 1   && Don't remember what that was
lnPrio = 32 && Priority of Process=Normal
lcStartupInfo = CHR(68) + REPLI(CHR(0), 67)
lcProcInfo = REPLI(CHR(0), 16)
IF CreateProcess(0, m.lcApp+" "+m.lcCmdLine+CHR(0), 0,0,;
		m.lnIBelieve1, m.lnPrio,;
		0, 0, @lcStartupInfo, @lcProcInfo) <> 0
	* process and thread handles returned in ProcInfo structure
	hProcess = buf2dword(SUBSTR(lcProcInfo, 1,4))
	hThread = buf2dword(SUBSTR(lcProcInfo, 5,4))
	* waiting until the termination of the program
	DOEVENTS
	lcOldSetHours = SET("HOURS")
	SET HOURS TO 24
	lnBegin = DATETIME()
	DO WHILE .T.
		exitcode = 0					&& initialize return value to 0
		= GetExitCodeProcess(hProcess, @exitcode)	&& try to obtain process exit code
		IF exitcode # 259				&& not still busy
			EXIT							&& fall out of loop
		ENDIF
		= Sleep (100)					&& wait .1 seconds
		lnElapsed = DATETIME() - lnBegin
		*--Just in Case - (a double-check)
		IF lnElapsed > 60 .AND. (lnElapsed > (lnlast + 10))	&& give app 60 seconds at least to startup and run
			lnlast = lnElapsed			&& 10 seconds between each attempt
			file_han = FOPEN(pdffile,12)
			IF file_han > 0		      && can open the file read and write unbuffered
				=FCLOSE(file_han)
				EXIT
			ENDIF
		ENDIF
	ENDDO
	SET HOURS TO &lcOldSetHours
	= CloseHandle(hThread)
	= CloseHandle(hProcess)
ELSE
	IF llsetback
		_VFP.AUTOYIELD = .F.
	ENDIF
	RETURN .F.
ENDIF
IF llsetback
	_VFP.AUTOYIELD = .F.
ENDIF
RETURN .T.

*----------------------------------------------------------------------
PROCEDURE DECLexewait  && load required dlls for exewait function

=ADLLS(dllarray)
IF ASCAN(dllarray,'CREATEPROCESS') = 0
	DECLARE INTEGER CreateProcess IN kernel32;
		INTEGER lpAppName, STRING lpCmdLine, INTEGER lpProcAttr,;
		INTEGER lpThrAttr, INTEGER bInhHandles, INTEGER dwCrFlags,;
		INTEGER lpEnvir, INTEGER lpCurDir, ;
		STRING @lpStInfo, STRING @lpProcInfo
ENDIF
IF ASCAN(dllarray,'GETLASTERROR') = 0
	DECLARE INTEGER GetLastError IN kernel32
ENDIF
IF ASCAN(dllarray,"CLOSEHANDLE") = 0
	DECLARE INTEGER CloseHandle IN kernel32 INTEGER hObject
ENDIF
IF ASCAN(dllarray,"GETEXITCODEPROCESS") = 0
	DECLARE INTEGER GetExitCodeProcess IN WIN32API INTEGER hProcess, INTEGER @lpExitCode
ENDIF
IF ASCAN(dllarray,"SLEEP") = 0
	DECLARE Sleep IN kernel32 INTEGER dwMilliseconds
ENDIF
RETURN

*----------------------------------------------------------------------
FUNCTION buf2dword(lcBuffer)
RETURN ASC(SUBSTR(lcBuffer, 1,1)) + ;
	ASC(SUBSTR(lcBuffer, 2,1)) * 256 +;
	ASC(SUBSTR(lcBuffer, 3,1)) * 65536 +;
	ASC(SUBSTR(lcBuffer, 4,1)) * 16777216
RETURN


*-------------------------------------------------------------------------
FUNCTION ReadRegistryKey

#Define HKEY_CLASSES_ROOT           -2147483648
#Define HKEY_CURRENT_USER           -2147483647
#Define HKEY_LOCAL_MACHINE          -2147483646
#Define HKEY_USERS                  -2147483645

#Define REG_SZ 				1	&& String
#Define REG_BINARY 			3	&& Binary data
#Define REG_DWORD 			4	&& 32bits int

#Define ERROR_SUCCESS		0	&& OK

*Start of Code
LOCAL nKey, cSubKey, cValue, cValueRead
*nkey = HKEY_CLASSES_ROOT
nkey = HKEY_LOCAL_MACHINE
*nKey = HKEY_CURRENT_USER
*cSubKey = "Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders"
*cSubKey = "Applications\AcroRd32.EXE\Shell\Open\command"
cSubKey = "Software\Microsoft\Windows\CurrentVersion\App Paths\AcroRd32.exe"
cValue = "Path"

cValueRead = ReadREG_SZ(nKey, cSubKey, cValue)
IF (EMPTY(cValueRead)) THEN
   RETURN ''
   *=MESSAGEBOX("Function Not Successful.")
ELSE
   RETURN cValueRead
   =MESSAGEBOX("Function Successful.")
ENDIF

FUNCTION ReadREG_SZ
* This function reads a REG_SZ value from the registry. If successful,
* it will return the value read. If not successful, it will return an empty string.
   PARAMETERS  nKey, cSubKey, cValue
   * nKey The root key to open. It can be any of the constants defined below.
   *  #DEFINE HKEY_CLASSES_ROOT           -2147483648
   *  #DEFINE HKEY_CURRENT_USER           -2147483647
   *  #DEFINE HKEY_LOCAL_MACHINE          -2147483646
   *  #DEFINE HKEY_USERS                  -2147483645
   * cSubKey The SubKey to open.
   * cValue The value that is going to be read.

   * Constants that are needed for Registry functions
*   #DEFINE REG_SZ   1

   * WIN 32 API functions that are used
   DECLARE Integer RegOpenKey IN Win32API ;
      Integer nHKey, String @cSubKey, Integer @nResult
   DECLARE Integer RegQueryValueEx IN Win32API ;
      Integer nHKey, String lpszValueName, Integer dwReserved,;
      Integer @lpdwType, String @lpbData, Integer @lpcbData
   DECLARE Integer RegCloseKey IN Win32API Integer nHKey

   * Local variables used
   LOCAL nErrCode      && Error Code returned from Registry functions
   LOCAL nKeyHandle    && Handle to Key that is opened in the Registry
   LOCAL lpdwValueType && Type of Value that we are looking for
   LOCAL lpbValue      && The data stored in the value
   LOCAL lpcbValueSize && Size of the variable
   LOCAL lpdwReserved  && Reserved Must be 0
    
   * Initialize the variables
   nKeyHandle = 0
   lpdwReserved = 0           
   lpdwValueType = REG_SZ
   lpbValue = ""
   
   nErrCode = RegOpenKey(nKey, cSubKey, @nKeyHandle)
   * If the error code isn't 0, then the key doesn't exist or can't be opened.
   IF (nErrCode # 0) THEN
      RETURN ""
   ENDIF

   lpcbValueSize = 1 
   * Get the size of the data in the value
   nErrCode=RegQueryValueEx(nKeyHandle, cValue, lpdwReserved, @lpdwValueType, @lpbValue, @lpcbValueSize)

   * Make the buffer big enough
   lpbValue = SPACE(lpcbValueSize)   
   nErrCode=RegQueryValueEx(nKeyHandle, cValue, lpdwReserved, @lpdwValueType, @lpbValue, @lpcbValueSize)
   
   =RegCloseKey(nKeyHandle)
   IF (nErrCode # 0) THEN
      RETURN ""
   ENDIF

   lpbValue = LEFT(lpbValue, lpcbValueSize - 1)
RETURN lpbValue