2021-01-23

PUTFILE function as originally typed (not in uppercase)

As already discussed in Fox.Wikis - "VFP has always been a bit funny about filename cases. More specifically, how it works with filename case is not documented. It will translate filenames to lower case in some cases, and to upper in others, and leave it alone in yet others." PUTFILE is in that list of strange functions, always returning UPPERCASE file names. So here's a short function that I've been using that returns the chosen filename the way the user typed.

The parameters and usage is exactly the same as the VFP original PUTFILE function:

FUNCTION XPUTFILE(tcCustomText, tcFileName, tcFileExt)

	* Usage:
	* ? PUTFILE("Save file as...", "MyFile.PDF", "PDF;TXT;*")

	#DEFINE COMMDLOG_DEFAULT_FLAG 	0x00080000
	#DEFINE COMMDLOG_RO 			4
	#DEFINE COMMDLOG_MULTFILES 		512

	LOCAL lcSetDefa
	m.lcSetDefa = SET("Default") + CURDIR()

	LOCAL loDlgForm AS "Form"
	m.loDlgForm = CREATEOBJECT("Form")
	m.loDlgForm.ADDOBJECT("oleObject1", "oleComDialObject")

	LOCAL loDlg
	m.loDlg = m.loDlgForm.OleObject1

	LOCAL lcFilter, lcFileExt, lnExtCount, n
	IF NOT EMPTY(tcFileExt)
		lnExtCount = GETWORDCOUNT(m.tcFileExt, ";")
		lcFilter = ""
		FOR n = 1 TO lnExtCount
			lcFileExt = GETWORDNUM(m.tcFileExt, n, ";")
			IF lcFileExt = "*"
				lcFilter = lcFilter + "All files|*.*"
			ELSE 
				lcFilter = lcFilter + lcFileExt + " files|*." + lcFileExt && EVL(tcFileExt, "All files|*.*")
			ENDIF			
			IF n < lnExtCount
				lcFilter = lcFilter + "|"
			ENDIF 
		ENDFOR
	ELSE
		lcFilter = "*.*|*.*" && EVL(tcFileExt, "All files|*.*")
	ENDIF 

	m.loDlg.FILTER		= lcFilter
	m.loDlg.FileName	= EVL(m.tcFileName, "")
	m.loDlg.DialogTitle	= EVL(m.tcCustomText, "Save file as...")
	m.loDlg.FLAGS		= COMMDLOG_RO + COMMDLOG_DEFAULT_FLAG
	m.loDlg.MaxFileSize	= 256

	LOCAL lnResult AS INTEGER, lcFileName
	* lnResult = loDlg.ShowOpen()
	m.lnResult = m.loDlg.ShowSave()

	* Restore the original directory
	SET DEFAULT TO (m.lcSetDefa)

	IF EMPTY(m.loDlg.FileTitle) && Clicked 'Cancel'
		m.lcFileName = ""
	ELSE
		m.lcFileName = m.loDlg.FileName
	ENDIF
	m.loDlgForm = NULL
	RETURN m.lcFileName


DEFINE CLASS oleComDialObject AS OLECONTROL
	OLECLASS ="MSComDlg.CommonDialog.1"
ENDDEFINE

1 comment:

  1. Hi, friends.
    I am receiving the error message

    OLE error code: 0x800401f3: Cadena clase no válida.

    (String class invalid) in the line

    m.loDlgForm.ADDOBJECT("oleObject1", "oleComDialObject")

    I am receiving this error repetitively in Win10 with every one of the Common Controls.
    I think to remember that this is resolved not using PRG-text-based forms, but do using SCX-binary-based forms, but you use PRG-based forms here.

    I would like to know how to resolve this, and I am asking to you.

    Thanks for sharing.

    HERNAN CANO

    ReplyDelete