Automating Word to pdf

[AlanArons]

I would like to programmatically open a Word Document in VFP and create a .pdf file with a different file path and file name. When you open the Adobe Distiller "printer" it prompts you for a file name (in the word document folder), which I would like to avoid.

What I have is:
oWord = createobject("Word.Application&quot
oDocument=oWord.Documents.open("c:\devtest.doc&quot
oword.ActivePrinter = "Acrobat Distiller"
oWord.ActiveDocument.printout
oWord.ActiveDocument.close()
oWord.Quit

Anyone have any thoughts.

Alan Arons

 

[mkrausnick]

Use this code to define the filename in the registry before printing the document (requires registry.vcx)

InitPDFName(cPDFDir+cPDFName+".PDF&quot && Parameter is desired path & filename of PDF file

I have the following code in a procedure library called PDFLIB.PRG:


**********************************************************************
* PDFLIB.PRG - PDF Printer functions
*
*
#define REGFILE "K:\VFP\Lib\registry.prg" && Registry functions

*====================================================================
FUNCTION InitPDFName(cRegKeyVal, aPrts) && Initialize Adobe PDF filename
* Alameda County MICRS System Function Library
* Syntax: nResult = InitAdobe(cRegFolder, cRegKeyName,cRegKeyVal)
* Parameters: (required) cRegKeyVal - Filename to post
* (optional) aPrts - Array of installed printers
* Note: Uses REGISTRY.PRG
* Returns: nResult - Numeric error# from SetRegKey() - 0=Success
*====================================================================
local n

* See if PDFWRiter is a defined printer; exit if not
if vartype(aPrts) == "C"
if ascan(aPrts,PDFWRITER) = 0
return 0
endif
endif

IF !FILE(REGFILE)
MESSAGEBOX("INITPDFNAME: The required file "+REGFILE+" could not be found.&quot
RETURN
ENDIF
if type(&quot;cRegKeyVal&quot <>&quot;C&quot;
MESSAGEBOX(&quot;INITPDFNAME: The required filename parameter is missing&quot
RETURN
ENDIF

return SetRegValue(cRegKeyVal, ;
&quot;Software\Adobe\Acrobat PDFWriter&quot; , ;
&quot;PDFFileName&quot


*====================================================================
FUNCTION SetRegValue(cRegKeyVal, cRegFolder, cRegKeyName) && Assign a registry key value
* Syntax: nResult = SetRegValue(cRegKeyVal, cRegFolder, cRegKeyName)
* Parameters: (required) cRegKeyVal - Key value to post
* (optional) cRegFolder - Folder containing key
* (optional) cRegKeyName - Key name
* Notes: 1. Uses REGISTRY.PRG
* 2. Customized for setting PDF filename, but will set any key
* Returns: nResult - Numeric error# from SetRegKey() - 0=Success
*====================================================================

#DEFINE HKEY_CURRENT_USER -2147483647 && BITSET(0,31)+1
LOCAL oReg,nErrNum
IF !FILE(REGFILE)
MESSAGEBOX(&quot;SETREGVALUE: The required file &quot;+REGFILE+&quot; could not be found.&quot
RETURN
ENDIF
if type(&quot;cRegKeyVal&quot <>&quot;C&quot;
MESSAGEBOX(&quot;SETREGVALUE: The required key value parameter is missing&quot
RETURN
ENDIF
* Parameters
cRegFolder = iif(type(&quot;cRegFolder&quot ==&quot;C&quot;,cRegFolder ,&quot;Software\Adobe\Acrobat PDFWriter&quot
cRegKeyName = iif(type(&quot;cRegKeyName&quot==&quot;C&quot;,cRegKeyName,&quot;PDFFileName&quot
oReg = NewObject(&quot;FoxReg&quot;,REGFILE) && Create registry object
return oReg.SetRegKey( cRegKeyName , ;
cRegKeyVal , ;
cRegFolder , ;
HKEY_CURRENT_USER)




Mike Krausnick

 

[mkrausnick]

I forgot to mention that Adobe automatically deletes the registry entry after printing, so:
1) You don't have to worry about cleaning up after printing,
2) If you initialize but don't print, the next time you print to PDF it will use the filename you set the last time unless you re-initialize it.


Mike Krausnick

 

[AlanArons]

Mike,

Code looks good. (Sorry it took so long for me to sit down with it.)

Please explain the line:
#define REGFILE &quot;K:\VFP\Lib\registry.prg&quot; && Registry functions

Is this path for development or runtime and if I include Registry.vcx in my project what will I need to make it work. (because right now it doesnt)

Alan Arons

 

[mkrausnick]

Is this path for development or runtime
I don't understand the question. The variable defines the location of REGISTRY.VCX, which the routines need. I don't have REGISTRY.VCX file in my project. I would imagine that it's like WINAPI32.DLL - if you put it in the WINDOWS, WINNT, or SYSTEM32 directories, it should be found.

...because right now it doesnt

Can you be more specific? Is it that the routines are not finding REGISTRY.VCX?

If so, try removing the explicit path and leaving just the filename, and place the file in a directory in the library path. If you do this, you might have to alter or remove the if file() statements. They are there to protect against running on a machine that doesn't have REGISTRY.VCX installed.



Mike Krausnick

 

[darrellblackhawk]

The file registry.prg is normally under a folder named
classes, which is in the samples path that MSDN installs.

If you've installed the samples correctly, you'll find it
with - home(2)+&quot;classes\registry.prg&quot;.

Try this to see if it exists.
? file(home(2)+&quot;classes\registry.prg&quot

This assumes as I said, the samples have been installed and
you've told VFP under:
'Tools->Options->File Locations->Samples Directory'
the correct location of the samples directory.

Darrell

P.S.
I'd post it, but I think that would violate the EULA.
If someone knows different, I'll post it.


'We all must do the hard bits so when we get bit we know where to bite'

 

[Mike Gagnon]

Darrell
P.S.
I'd post it, but I think that would violate the EULA.
If someone knows different, I'll post it.


Though call,Although you may not distribute unmodified Visual FoxPro, you may refer to portions of sample application code as examples for building your own application. Which registry.prg falls under.


Mike Gagnon

If you want to get the best response to a question, please check out FAQ184-2483 first.

 

[darrellblackhawk]

Well then... Here's Registry.prg...
CAVEAT: This is from VFP6.0 - I'll be finally moving to V8
in the next couple of weeks.

* Copyright (c) 1995,1996 Sierra Systems, Microsoft Corporation
*
* Written by Randy Brown
* Contributions from Matt Oshry, Calvin Hsia
*
* The Registry class provides a complete library of API
* calls to access the Windows Registry. Support is provided
* for Windows 32S, Windows NT amd Windows 95. Included for
* backward compatibility with older applications which still
* use INI files are several routines which access INI sections
* and details. Finally, several valuable routines are included
* for accessing ODBC drivers and data sources.
*


* Operating System codes
#DEFINE OS_W32S 1
#DEFINE OS_NT 2
#DEFINE OS_WIN95 3
#DEFINE OS_MAC 4
#DEFINE OS_DOS 5
#DEFINE OS_UNIX 6

* DLL Paths for various operating systems
#DEFINE DLLPATH_32S &quot;\SYSTEM\&quot; &&used for ODBC only
#DEFINE DLLPATH_NT &quot;\SYSTEM32\&quot;
#DEFINE DLLPATH_WIN95 &quot;\SYSTEM\&quot;

* DLL files used to read INI files
#DEFINE DLL_KERNEL_W32S &quot;W32SCOMB.DLL&quot;
#DEFINE DLL_KERNEL_NT &quot;KERNEL32.DLL&quot;
#DEFINE DLL_KERNEL_WIN95 &quot;KERNEL32.DLL&quot;

* DLL files used to read registry
#DEFINE DLL_ADVAPI_W32S &quot;W32SCOMB.DLL&quot;
#DEFINE DLL_ADVAPI_NT &quot;ADVAPI32.DLL&quot;
#DEFINE DLL_ADVAPI_WIN95 &quot;ADVAPI32.DLL&quot;

* DLL files used to read ODBC info
#DEFINE DLL_ODBC_W32S &quot;ODBC32.DLL&quot;
#DEFINE DLL_ODBC_NT &quot;ODBC32.DLL&quot;
#DEFINE DLL_ODBC_WIN95 &quot;ODBC32.DLL&quot;

* Registry roots
#DEFINE HKEY_CLASSES_ROOT -2147483648 && BITSET(0,31)
#DEFINE HKEY_CURRENT_USER -2147483647 && BITSET(0,31)+1
#DEFINE HKEY_LOCAL_MACHINE -2147483646 && BITSET(0,31)+2
#DEFINE HKEY_USERS -2147483645 && BITSET(0,31)+3

* Misc
#DEFINE APP_PATH_KEY &quot;\Shell\Open\Command&quot;
#DEFINE OLE_PATH_KEY &quot;\Protocol\StdFileEditing\Server&quot;
#DEFINE VFP_OPTIONS_KEY &quot;Software\Microsoft\VisualFoxPro\6.0\Options&quot;
#DEFINE VFP_OPT32S_KEY &quot;VisualFoxPro\6.0\Options&quot;
#DEFINE CURVER_KEY &quot;\CurVer&quot;
#DEFINE ODBC_DATA_KEY &quot;Software\ODBC\ODBC.INI\&quot;
#DEFINE ODBC_DRVRS_KEY &quot;Software\ODBC\ODBCINST.INI\&quot;
#DEFINE SQL_FETCH_NEXT 1
#DEFINE SQL_NO_DATA 100

* Error Codes
#DEFINE ERROR_SUCCESS 0 && OK
#DEFINE ERROR_EOF 259 && no more entries in key

* Note these next error codes are specific to this Class, not DLL
#DEFINE ERROR_NOAPIFILE -101 && DLL file to check registry not found
#DEFINE ERROR_KEYNOREG -102 && key not registered
#DEFINE ERROR_BADPARM -103 && bad parameter passed
#DEFINE ERROR_NOENTRY -104 && entry not found
#DEFINE ERROR_BADKEY -105 && bad key passed
#DEFINE ERROR_NONSTR_DATA -106 && data type for value is not a data string
#DEFINE ERROR_BADPLAT -107 && platform not supported
#DEFINE ERROR_NOINIFILE -108 && DLL file to check INI not found
#DEFINE ERROR_NOINIENTRY -109 && No entry in INI file
#DEFINE ERROR_FAILINI -110 && failed to get INI entry
#DEFINE ERROR_NOPLAT -111 && call not supported on this platform
#DEFINE ERROR_NOODBCFILE -112 && DLL file to check ODBC not found
#DEFINE ERROR_ODBCFAIL -113 && failed to get ODBC environment

* Data types for keys
#DEFINE REG_SZ 1 && Data string
#DEFINE REG_BINARY 3 && Binary data in any form.
#DEFINE REG_DWORD 4 && A 32-bit number.

* Data types labels
#DEFINE REG_BINARY_LOC &quot;*Binary*&quot; && Binary data in any form.
#DEFINE REG_DWORD_LOC &quot;*Dword*&quot; && A 32-bit number.
#DEFINE REG_UNKNOWN_LOC &quot;*Unknown type*&quot; && unknown type

* FoxPro ODBC drivers
#DEFINE FOXODBC_25 &quot;FoxPro Files (*.dbf)&quot;
#DEFINE FOXODBC_26 &quot;Microsoft FoxPro Driver (*.dbf)&quot;
#DEFINE FOXODBC_30 &quot;Microsoft Visual FoxPro Driver&quot;


DEFINE CLASS registry AS CUSTOM

nUserKey = HKEY_CURRENT_USER
cVFPOptPath = VFP_OPTIONS_KEY
cRegDLLFile = &quot;&quot;
cINIDLLFile = &quot;&quot;
cODBCDLLFile = &quot;&quot;
nCurrentOS = 0
nCurrentKey = 0
lLoadedDLLs = .F.
lLoadedINIs = .F.
lLoadedODBCs = .F.
cAppPathKey = &quot;&quot;
lCreateKey = .F.
lhaderror = .F.

PROCEDURE INIT
DO CASE
CASE _DOS OR _UNIX OR _MAC
RETURN .F.
CASE ATC(&quot;Windows 3&quot;,OS(1)) # 0
THIS.nCurrentOS = OS_W32S
THIS.cRegDLLFile = DLL_ADVAPI_W32S
THIS.cINIDLLFile = DLL_KERNEL_W32S
THIS.cODBCDLLFile = DLL_ODBC_W32S
THIS.cVFPOptPath = VFP_OPT32S_KEY
THIS.nUserKey = HKEY_CLASSES_ROOT
CASE ATC(&quot;Windows NT&quot;,OS(1)) # 0
THIS.nCurrentOS = OS_NT
THIS.cRegDLLFile = DLL_ADVAPI_NT
THIS.cINIDLLFile = DLL_KERNEL_NT
THIS.cODBCDLLFile = DLL_ODBC_NT
OTHERWISE
* Windows 95
THIS.nCurrentOS = OS_WIN95
THIS.cRegDLLFile = DLL_ADVAPI_WIN95
THIS.cINIDLLFile = DLL_KERNEL_WIN95
THIS.cODBCDLLFile = DLL_ODBC_WIN95
ENDCASE
ENDPROC

PROCEDURE ERROR
LPARAMETERS nError, cMethod, nLine
THIS.lhaderror = .T.
=MESSAGEBOX(MESSAGE())
ENDPROC

PROCEDURE LoadRegFuncs
* Loads funtions needed for Registry
LOCAL nHKey,cSubKey,nResult
LOCAL hKey,iValue,lpszValue,lpcchValue,lpdwType,lpbData,lpcbData
LOCAL lpcStr,lpszVal,nLen,lpdwReserved
LOCAL lpszValueName,dwReserved,fdwType
LOCAL iSubKey,lpszName,cchName

IF THIS.lLoadedDLLs
RETURN ERROR_SUCCESS
ENDIF

DECLARE INTEGER RegOpenKey IN Win32API ;
INTEGER nHKey, STRING @cSubKey, INTEGER @nResult

IF THIS.lhaderror && error loading library
RETURN -1
ENDIF

DECLARE INTEGER RegCreateKey IN Win32API ;
INTEGER nHKey, STRING @cSubKey, INTEGER @nResult

DECLARE INTEGER RegDeleteKey IN Win32API ;
INTEGER nHKey, STRING @cSubKey

DECLARE INTEGER RegDeleteValue IN Win32API ;
INTEGER nHKey, STRING cSubKey

DECLARE INTEGER RegCloseKey IN Win32API ;
INTEGER nHKey

DECLARE INTEGER RegSetValueEx IN Win32API ;
INTEGER hKey, STRING lpszValueName, INTEGER dwReserved,;
INTEGER fdwType, STRING lpbData, INTEGER cbData

DECLARE INTEGER RegQueryValueEx IN Win32API ;
INTEGER nHKey, STRING lpszValueName, INTEGER dwReserved,;
INTEGER @lpdwType, STRING @lpbData, INTEGER @lpcbData

DECLARE INTEGER RegEnumKey IN Win32API ;
INTEGER nHKey,INTEGER iSubKey, STRING @lpszName, INTEGER @cchName

DECLARE INTEGER RegEnumKeyEx IN Win32API ;
INTEGER nHKey,INTEGER iSubKey, STRING @lpszName, INTEGER @cchName,;
INTEGER dwReserved,STRING @lpszName, INTEGER @cchName,STRING @cchName

DECLARE INTEGER RegEnumValue IN Win32API ;
INTEGER hKey, INTEGER iValue, STRING @lpszValue, ;
INTEGER @lpcchValue, INTEGER lpdwReserved, INTEGER @lpdwType, ;
STRING @lpbData, INTEGER @lpcbData

THIS.lLoadedDLLs = .T.

* Need error check here
RETURN ERROR_SUCCESS
ENDPROC

PROCEDURE OpenKey
* Opens a registry key
LPARAMETER cLookUpKey,nRegKey,lCreateKey

LOCAL nSubKey,nErrCode,nPCount,lSaveCreateKey
nSubKey = 0
nPCount = PARAMETERS()

IF TYPE(&quot;m.nRegKey&quot # &quot;N&quot; OR EMPTY(m.nRegKey)
m.nRegKey = HKEY_CLASSES_ROOT
ENDIF

* Load API functions
nErrCode = THIS.LoadRegFuncs()
IF m.nErrCode # ERROR_SUCCESS
RETURN m.nErrCode
ENDIF

lSaveCreateKey = THIS.lCreateKey
IF m.nPCount>2 AND TYPE(&quot;m.lCreateKey&quot = &quot;L&quot;
THIS.lCreateKey = m.lCreateKey
ENDIF

IF THIS.lCreateKey
* Try to open or create registry key
nErrCode = RegCreateKey(m.nRegKey,m.cLookUpKey,@nSubKey)
ELSE
* Try to open registry key
nErrCode = RegOpenKey(m.nRegKey,m.cLookUpKey,@nSubKey)
ENDIF

THIS.lCreateKey = m.lSaveCreateKey

IF nErrCode # ERROR_SUCCESS
RETURN m.nErrCode
ENDIF

THIS.nCurrentKey = m.nSubKey
RETURN ERROR_SUCCESS
ENDPROC

PROCEDURE CloseKey
* Closes a registry key
=RegCloseKey(THIS.nCurrentKey)
THIS.nCurrentKey =0
ENDPROC

PROCEDURE SetRegKey
* This routine sets a registry key setting
* ex. THIS.SetRegKey(&quot;ResWidth&quot;,&quot;640&quot;,;
* &quot;Software\Microsoft\VisualFoxPro\4.0\Options&quot;,;
* HKEY_CURRENT_USER)
LPARAMETER cOptName,cOptVal,cKeyPath,nUserKey
LOCAL iPos,cOptKey,cOption,nErrNum
iPos = 0
cOption = &quot;&quot;
nErrNum = ERROR_SUCCESS

* Open registry key
m.nErrNum = THIS.OpenKey(m.cKeyPath,m.nUserKey)
IF m.nErrNum # ERROR_SUCCESS
RETURN m.nErrNum
ENDIF

* Set Key value
nErrNum = THIS.SetKeyValue(m.cOptName,m.cOptVal)

* Close registry key
THIS.CloseKey() &&close key
RETURN m.nErrNum
ENDPROC

PROCEDURE GetRegKey
* This routine gets a registry key setting
* ex. THIS.GetRegKey(&quot;ResWidth&quot;,@cValue,;
* &quot;Software\Microsoft\VisualFoxPro\4.0\Options&quot;,;
* HKEY_CURRENT_USER)
LPARAMETER cOptName,cOptVal,cKeyPath,nUserKey
LOCAL iPos,cOptKey,cOption,nErrNum
iPos = 0
cOption = &quot;&quot;
nErrNum = ERROR_SUCCESS

* Open registry key
m.nErrNum = THIS.OpenKey(m.cKeyPath,m.nUserKey)
IF m.nErrNum # ERROR_SUCCESS
RETURN m.nErrNum
ENDIF

* Get the key value
nErrNum = THIS.GetKeyValue(cOptName,@cOptVal)

* Close registry key
THIS.CloseKey() &&close key
RETURN m.nErrNum
ENDPROC

PROCEDURE GetKeyValue
* Obtains a value from a registry key
* Note: this routine only handles Data strings (REG_SZ)
LPARAMETER cValueName,cKeyValue

LOCAL lpdwReserved,lpdwType,lpbData,lpcbData,nErrCode
STORE 0 TO lpdwReserved,lpdwType
STORE SPACE(256) TO lpbData
STORE LEN(m.lpbData) TO m.lpcbData

DO CASE
CASE TYPE(&quot;THIS.nCurrentKey&quot#'N' OR THIS.nCurrentKey = 0
RETURN ERROR_BADKEY
CASE TYPE(&quot;m.cValueName&quot #&quot;C&quot;
RETURN ERROR_BADPARM
ENDCASE

m.nErrCode=RegQueryValueEx(THIS.nCurrentKey,m.cValueName,;
m.lpdwReserved,@lpdwType,@lpbData,@lpcbData)

* Check for error
IF m.nErrCode # ERROR_SUCCESS
RETURN m.nErrCode
ENDIF

* Make sure we have a data string data type
IF lpdwType # REG_SZ
RETURN ERROR_NONSTR_DATA
ENDIF

m.cKeyValue = LEFT(m.lpbData,m.lpcbData-1)
RETURN ERROR_SUCCESS
ENDPROC

PROCEDURE SetKeyValue
* This routine sets a key value
* Note: this routine only handles data strings (REG_SZ)
LPARAMETER cValueName,cValue
LOCAL nValueSize,nErrCode

DO CASE
CASE TYPE(&quot;THIS.nCurrentKey&quot#'N' OR THIS.nCurrentKey = 0
RETURN ERROR_BADKEY
CASE TYPE(&quot;m.cValueName&quot #&quot;C&quot; OR TYPE(&quot;m.cValue&quot#&quot;C&quot;
RETURN ERROR_BADPARM
CASE EMPTY(m.cValueName) OR EMPTY(m.cValue)
RETURN ERROR_BADPARM
ENDCASE

* Make sure we null terminate this guy
cValue = m.cValue+CHR(0)
nValueSize = LEN(m.cValue)

* Set the key value here
m.nErrCode = RegSetValueEx(THIS.nCurrentKey,m.cValueName,0,;
REG_SZ,m.cValue,m.nValueSize)

* Check for error
IF m.nErrCode # ERROR_SUCCESS
RETURN m.nErrCode
ENDIF

RETURN ERROR_SUCCESS
ENDPROC

PROCEDURE DeleteKey
* This routine deletes a Registry Key
LPARAMETER nUserKey,cKeyPath
LOCAL nErrNum
nErrNum = ERROR_SUCCESS

* Delete key
m.nErrNum = RegDeleteKey(m.nUserKey,m.cKeyPath)
RETURN m.nErrNum
ENDPROC

PROCEDURE EnumOptions
* Enumerates through all entries for a key and populates array
LPARAMETER aRegOpts,cOptPath,nUserKey,lEnumKeys
LOCAL iPos,cOptKey,cOption,nErrNum
iPos = 0
cOption = &quot;&quot;
nErrNum = ERROR_SUCCESS

IF PARAMETERS()<4 OR TYPE(&quot;m.lEnumKeys&quot # &quot;L&quot;
lEnumKeys = .F.
ENDIF

* Open key
m.nErrNum = THIS.OpenKey(m.cOptPath,m.nUserKey)
IF m.nErrNum # ERROR_SUCCESS
RETURN m.nErrNum
ENDIF

* Enumerate through keys
IF m.lEnumKeys
* Enumerate and get key names
nErrNum = THIS.EnumKeys(@aRegOpts)
ELSE
* Enumerate and get all key values
nErrNum = THIS.EnumKeyValues(@aRegOpts)
ENDIF

* Close key
THIS.CloseKey() &&close key
RETURN m.nErrNum
ENDPROC

FUNCTION IsKey
* Checks to see if a key exists
LPARAMETER cKeyName,nRegKey

* Open extension key
nErrNum = THIS.OpenKey(m.cKeyName,m.nRegKey)
IF m.nErrNum = ERROR_SUCCESS
* Close extension key
THIS.CloseKey()
ENDIF

RETURN m.nErrNum = ERROR_SUCCESS
ENDFUNC

PROCEDURE EnumKeys
PARAMETER aKeyNames
LOCAL nKeyEntry,cNewKey,cNewSize,cbuf,nbuflen,cRetTime
nKeyEntry = 0
DIMENSION aKeyNames[1]
DO WHILE .T.
nKeySize = 0
cNewKey = SPACE(100)
nKeySize = LEN(m.cNewKey)
cbuf=SPACE(100)
nbuflen=LEN(m.cbuf)
cRetTime=SPACE(100)

m.nErrCode = RegEnumKeyEx(THIS.nCurrentKey,m.nKeyEntry,@cNewKey,@nKeySize,0,@cbuf,@nbuflen,@cRetTime)

DO CASE
CASE m.nErrCode = ERROR_EOF
EXIT
CASE m.nErrCode # ERROR_SUCCESS
EXIT
ENDCASE

cNewKey = ALLTRIM(m.cNewKey)
cNewKey = LEFT(m.cNewKey,LEN(m.cNewKey)-1)
IF !EMPTY(aKeyNames[1])
DIMENSION aKeyNames[ALEN(aKeyNames)+1]
ENDIF
aKeyNames[ALEN(aKeyNames)] = m.cNewKey
nKeyEntry = m.nKeyEntry + 1
ENDDO

IF m.nErrCode = ERROR_EOF AND m.nKeyEntry # 0
m.nErrCode = ERROR_SUCCESS
ENDIF
RETURN m.nErrCode
ENDPROC

PROCEDURE EnumKeyValues
* Enumerates through values of a registry key
LPARAMETER aKeyValues

LOCAL lpszValue,lpcchValue,lpdwReserved
LOCAL lpdwType,lpbData,lpcbData
LOCAL nErrCode,nKeyEntry,lArrayPassed

STORE 0 TO nKeyEntry

IF TYPE(&quot;THIS.nCurrentKey&quot#'N' OR THIS.nCurrentKey = 0
RETURN ERROR_BADKEY
ENDIF

* Sorry, Win32s does not support this one!
IF THIS.nCurrentOS = OS_W32S
RETURN ERROR_BADPLAT
ENDIF

DO WHILE .T.

STORE 0 TO lpdwReserved,lpdwType,nErrCode
STORE SPACE(256) TO lpbData, lpszValue
STORE LEN(lpbData) TO m.lpcchValue
STORE LEN(lpszValue) TO m.lpcbData

nErrCode=RegEnumValue(THIS.nCurrentKey,m.nKeyEntry,@lpszValue,;
@lpcchValue,m.lpdwReserved,@lpdwType,@lpbData,@lpcbData)

DO CASE
CASE m.nErrCode = ERROR_EOF
EXIT
CASE m.nErrCode # ERROR_SUCCESS
EXIT
ENDCASE

nKeyEntry = m.nKeyEntry + 1

* Set array values
DIMENSION aKeyValues[m.nKeyEntry,2]
aKeyValues[m.nKeyEntry,1] = LEFT(m.lpszValue,m.lpcchValue)
DO CASE
CASE lpdwType = REG_SZ
aKeyValues[m.nKeyEntry,2] = LEFT(m.lpbData,m.lpcbData-1)
CASE lpdwType = REG_BINARY
* Don't support binary
aKeyValues[m.nKeyEntry,2] = REG_BINARY_LOC
CASE lpdwType = REG_DWORD
* You will need to use ASC() to check values here.
aKeyValues[m.nKeyEntry,2] = LEFT(m.lpbData,m.lpcbData-1)
OTHERWISE
aKeyValues[m.nKeyEntry,2] = REG_UNKNOWN_LOC
ENDCASE
ENDDO

IF m.nErrCode = ERROR_EOF AND m.nKeyEntry # 0
m.nErrCode = ERROR_SUCCESS
ENDIF
RETURN m.nErrCode
ENDPROC

ENDDEFINE


DEFINE CLASS oldinireg AS registry

PROCEDURE GetINISection
PARAMETERS aSections,cSection,cINIFile
LOCAL cINIValue, nTotEntries, i, nLastPos
cINIValue = &quot;&quot;
IF TYPE(&quot;m.cINIFile&quot # &quot;C&quot;
cINIFile = &quot;&quot;
ENDIF

IF THIS.GetINIEntry(@cINIValue,cSection,0,m.cINIFile) # ERROR_SUCCESS
RETURN ERROR_FAILINI
ENDIF

nTotEntries=OCCURS(CHR(0),m.cINIValue)
DIMENSION aSections[m.nTotEntries]
nLastPos = 1
FOR i = 1 TO m.nTotEntries
nTmpPos = AT(CHR(0),m.cINIValue,m.i)
aSections[m.i] = SUBSTR(m.cINIValue,m.nLastPos,m.nTmpPos-m.nLastPos)
nLastPos = m.nTmpPos+1
ENDFOR

RETURN ERROR_SUCCESS
ENDPROC

PROCEDURE GetINIEntry
LPARAMETER cValue,cSection,cEntry,cINIFile

* Get entry from INI file
LOCAL cBuffer,nBufSize,nErrNum,nTotParms
nTotParms = PARAMETERS()

* Load API functions
nErrNum= THIS.LoadINIFuncs()
IF m.nErrNum # ERROR_SUCCESS
RETURN m.nErrNum
ENDIF

* Parameter checks here
IF m.nTotParms < 3
m.cEntry = 0
ENDIF

m.cBuffer=SPACE(2000)

IF EMPTY(m.cINIFile)
* WIN.INI file
m.nBufSize = GetWinINI(m.cSection,m.cEntry,&quot;&quot;,@cBuffer,LEN(m.cBuffer))
ELSE
* Private INI file
m.nBufSize = GetPrivateINI(m.cSection,m.cEntry,&quot;&quot;,@cBuffer,LEN(m.cBuffer),m.cINIFile)
ENDIF

IF m.nBufSize = 0 &&could not find entry in INI file
RETURN ERROR_NOINIENTRY
ENDIF

m.cValue=LEFT(m.cBuffer,m.nBufSize)

** All is well
RETURN ERROR_SUCCESS
ENDPROC

PROCEDURE WriteINIEntry
LPARAMETER cValue,cSection,cEntry,cINIFile

* Get entry from INI file
LOCAL nErrNum

* Load API functions
nErrNum = THIS.LoadINIFuncs()
IF m.nErrNum # ERROR_SUCCESS
RETURN m.nErrNum
ENDIF

IF EMPTY(m.cINIFile)
* WIN.INI file
nErrNum = WriteWinINI(m.cSection,m.cEntry,m.cValue)
ELSE
* Private INI file
nErrNum = WritePrivateINI(m.cSection,m.cEntry,m.cValue,m.cINIFile)
ENDIF

** All is well
RETURN IIF(m.nErrNum=1,ERROR_SUCCESS,m.nErrNum)
ENDPROC

PROCEDURE LoadINIFuncs
* Loads funtions needed for reading INI files
IF THIS.lLoadedINIs
RETURN ERROR_SUCCESS
ENDIF

DECLARE INTEGER GetPrivateProfileString IN Win32API ;
AS GetPrivateINI STRING,STRING,STRING,STRING,INTEGER,STRING

IF THIS.lhaderror && error loading library
RETURN -1
ENDIF

DECLARE INTEGER GetProfileString IN Win32API ;
AS GetWinINI STRING,STRING,STRING,STRING,INTEGER

DECLARE INTEGER WriteProfileString IN Win32API ;
AS WriteWinINI STRING,STRING,STRING

DECLARE INTEGER WritePrivateProfileString IN Win32API ;
AS WritePrivateINI STRING,STRING,STRING,STRING

THIS.lLoadedINIs = .T.

* Need error check here
RETURN ERROR_SUCCESS
ENDPROC

ENDDEFINE

DEFINE CLASS foxreg AS registry

PROCEDURE SetFoxOption
LPARAMETER cOptName,cOptVal
RETURN THIS.SetRegKey(cOptName,cOptVal,THIS.cVFPOptPath,THIS.nUserKey)
ENDPROC

PROCEDURE GetFoxOption
LPARAMETER cOptName,cOptVal
RETURN THIS.GetRegKey(cOptName,@cOptVal,THIS.cVFPOptPath,THIS.nUserKey)
ENDPROC

PROCEDURE EnumFoxOptions
LPARAMETER aFoxOpts
RETURN THIS.EnumOptions(@aFoxOpts,THIS.cVFPOptPath,THIS.nUserKey,.F.)
ENDPROC

ENDDEFINE

DEFINE CLASS odbcreg AS registry

PROCEDURE LoadODBCFuncs
IF THIS.lLoadedODBCs
RETURN ERROR_SUCCESS
ENDIF

* Check API file containing functions

IF EMPTY(THIS.cODBCDLLFile)
RETURN ERROR_NOODBCFILE
ENDIF

LOCAL henv,fDirection,szDriverDesc,cbDriverDescMax
LOCAL pcbDriverDesc,szDriverAttributes,cbDrvrAttrMax,pcbDrvrAttr
LOCAL szDSN,cbDSNMax,pcbDSN,szDescription,cbDescriptionMax,pcbDescription

DECLARE Short SQLDrivers IN (THIS.cODBCDLLFile) ;
INTEGER henv, INTEGER fDirection, ;
STRING @ szDriverDesc, INTEGER cbDriverDescMax, INTEGER pcbDriverDesc, ;
STRING @ szDriverAttributes, INTEGER cbDrvrAttrMax, INTEGER pcbDrvrAttr

IF THIS.lhaderror && error loading library
RETURN -1
ENDIF

DECLARE Short SQLDataSources IN (THIS.cODBCDLLFile) ;
INTEGER henv, INTEGER fDirection, ;
STRING @ szDSN, INTEGER cbDSNMax, INTEGER @ pcbDSN, ;
STRING @ szDescription, INTEGER cbDescriptionMax,INTEGER pcbDescription

THIS.lLoadedODBCs = .T.

RETURN ERROR_SUCCESS
ENDPROC

PROCEDURE GetODBCDrvrs
PARAMETER aDrvrs,lDataSources
LOCAL nODBCEnv,nRetVal,dsn,dsndesc,mdsn,mdesc

lDataSources = IIF(TYPE(&quot;m.lDataSources&quot=&quot;L&quot;,m.lDataSources,.F.)

* Load API functions
nRetVal = THIS.LoadODBCFuncs()
IF m.nRetVal # ERROR_SUCCESS
RETURN m.nRetVal
ENDIF

* Get ODBC environment handle
nODBCEnv=VAL(SYS(3053))

* -- Possible error messages
* 527 &quot;cannot load odbc library&quot;
* 528 &quot;odbc entry point missing&quot;
* 182 &quot;not enough memory&quot;

IF INLIST(nODBCEnv,527,528,182)
* Failed
RETURN ERROR_ODBCFAIL
ENDIF

DIMENSION aDrvrs[1,IIF(m.lDataSources,2,1)]
aDrvrs[1] = &quot;&quot;

DO WHILE .T.
dsn=SPACE(100)
dsndesc=SPACE(100)
mdsn=0
mdesc=0

* Return drivers or data sources
IF m.lDataSources
nRetVal = SQLDataSources(m.nODBCEnv,SQL_FETCH_NEXT,@dsn,100,@mdsn,@dsndesc,255,@mdesc)
ELSE
nRetVal = SQLDrivers(m.nODBCEnv,SQL_FETCH_NEXT,@dsn,100,@mdsn,@dsndesc,100,@mdesc)
ENDIF

DO CASE
CASE m.nRetVal = SQL_NO_DATA
nRetVal = ERROR_SUCCESS
EXIT
CASE m.nRetVal # ERROR_SUCCESS AND m.nRetVal # 1
EXIT
OTHERWISE
IF !EMPTY(aDrvrs[1])
IF m.lDataSources
DIMENSION aDrvrs[ALEN(aDrvrs,1)+1,2]
ELSE
DIMENSION aDrvrs[ALEN(aDrvrs,1)+1,1]
ENDIF
ENDIF
dsn = ALLTRIM(m.dsn)
aDrvrs[ALEN(aDrvrs,1),1] = LEFT(m.dsn,LEN(m.dsn)-1)
IF m.lDataSources
dsndesc = ALLTRIM(m.dsndesc)
aDrvrs[ALEN(aDrvrs,1),2] = LEFT(m.dsndesc,LEN(m.dsndesc)-1)
ENDIF
ENDCASE
ENDDO
RETURN nRetVal
ENDPROC

PROCEDURE EnumODBCDrvrs
LPARAMETER aDrvrOpts,cODBCDriver
LOCAL cSourceKey
cSourceKey = ODBC_DRVRS_KEY+m.cODBCDriver
RETURN THIS.EnumOptions(@aDrvrOpts,m.cSourceKey,HKEY_LOCAL_MACHINE,.F.)
ENDPROC

PROCEDURE EnumODBCData
LPARAMETER aDrvrOpts,cDataSource
LOCAL cSourceKey
cSourceKey = ODBC_DATA_KEY+cDataSource
RETURN THIS.EnumOptions(@aDrvrOpts,m.cSourceKey,HKEY_CURRENT_USER,.F.)
ENDPROC

ENDDEFINE

DEFINE CLASS filereg AS registry

PROCEDURE GetAppPath
* Checks and returns path of application
* associated with a particular extension (e.g., XLS, DOC).
LPARAMETER cExtension,cExtnKey,cAppKey,lServer
LOCAL nErrNum,cOptName
cOptName = &quot;&quot;

* Check Extension parameter
IF TYPE(&quot;m.cExtension&quot # &quot;C&quot; OR LEN(m.cExtension) > 3
RETURN ERROR_BADPARM
ENDIF
m.cExtension = &quot;.&quot;+m.cExtension

* Open extension key
nErrNum = THIS.OpenKey(m.cExtension)
IF m.nErrNum # ERROR_SUCCESS
RETURN m.nErrNum
ENDIF

* Get key value for file extension
nErrNum = THIS.GetKeyValue(cOptName,@cExtnKey)

* Close extension key
THIS.CloseKey()

IF m.nErrNum # ERROR_SUCCESS
RETURN m.nErrNum
ENDIF
RETURN THIS.GetApplication(cExtnKey,@cAppKey,lServer)
ENDPROC

PROCEDURE GETLATESTVERSION
* Checks and returns path of application
* associated with a particular extension (e.g., XLS, DOC).
LPARAMETER cClass,cExtnKey,cAppKey,lServer

LOCAL nErrNum,cOptName
cOptName = &quot;&quot;

* Open class key (e.g., Excel.Sheet)
nErrNum = THIS.OpenKey(m.cClass+CURVER_KEY)
IF m.nErrNum # ERROR_SUCCESS
RETURN m.nErrNum
ENDIF

* Get key value for file extension
nErrNum = THIS.GetKeyValue(cOptName,@cExtnKey)

* Close extension key
THIS.CloseKey()

IF m.nErrNum # ERROR_SUCCESS
RETURN m.nErrNum
ENDIF
RETURN THIS.GetApplication(cExtnKey,@cAppKey,lServer)
ENDPROC

PROCEDURE GetApplication
PARAMETER cExtnKey,cAppKey,lServer

LOCAL nErrNum,cOptName
cOptName = &quot;&quot;

* lServer - checking for OLE server.
IF TYPE(&quot;m.lServer&quot = &quot;L&quot; AND m.lServer
THIS.cAppPathKey = OLE_PATH_KEY
ELSE
THIS.cAppPathKey = APP_PATH_KEY
ENDIF

* Open extension app key
m.nErrNum = THIS.OpenKey(m.cExtnKey+THIS.cAppPathKey)
IF m.nErrNum # ERROR_SUCCESS
RETURN m.nErrNum
ENDIF

* Get application path
nErrNum = THIS.GetKeyValue(cOptName,@cAppKey)

* Close application path key
THIS.CloseKey()

RETURN m.nErrNum
ENDPROC

ENDDEFINE


'We all must do the hard bits so when we get bit we know where to bite'