Is there an alternative to the GETFILE() dialog?

I was faced with the task of creating a screen interface so our Customer Service Reps could import a series of Tab Delimited files that were sent to us by customers. Several things made the use of the GETFILE() function unattractive for this procedure. First, the incoming files were without file extensions (i.e. B00D0601, B00F0601, etc.) Second, there were three separate applications, each of which had different file name prefixes, 'B00','G00' and 'CAR'. When processed, the resulting file names had to have some correlation to the original file names. B00D0601 became GULD0601, CAR03014 became GVL03014, etc.

I finally decided to create a form class that handled the filtering and selection of the files. What follows is the code for that class. If nothing else, it should give you some ideas that you can adapt to your needs.

Steve

**************************************************
*-- Class: mm_getfile
*-- ParentClass: form
*-- BaseClass: form
*-- Time Stamp: 06/14/01 08:56:13 AM
*-- A form for selecting "extensionless" tab delimited files for importing
*
DEFINE CLASS mm_getfile AS form


Height = 318
Width = 514
DoCreate = .T.
AutoCenter = .T.
Caption = "Form1"
Closable = .F.
Icon = "accept.ico"
WindowType = 1
*-- Enter the product acronym (i.e. GUL2, GVUL, etc.)
product_id = "GUL2/GFPLA"
*-- Enter the beginning letters of all incoming data files.
incoming_prefix = "B00"
*-- Enter the letters to substitute for the Incoming_Prefix values for the output file.
outgoing_prefix = "GUL2"
return_file = ""
sort_column = 1
Name = "Form1"

ADD OBJECT label1 AS label WITH ;
AutoSize = .T., ;
FontBold = .T., ;
BackStyle = 0, ;
Caption = "Highlight the file to be imported and click on 'Import'", ;
Height = 17, ;
Left = 24, ;
Top = 24, ;
Width = 294, ;
ForeColor = RGB(0,0,255), ;
Name = "Label1"

ADD OBJECT grid1 AS grid WITH ;
ColumnCount = 4, ;
AllowRowSizing = .F., ;
DeleteMark = .F., ;
Height = 204, ;
Left = 25, ;
Panel = 1, ;
ReadOnly = .T., ;
RecordMark = .F., ;
ScrollBars = 2, ;
SplitBar = .F., ;
Top = 41, ;
Width = 464, ;
Name = "Grid1", ;
Column1.Width = 173, ;
Column1.ReadOnly = .T., ;
Column1.Name = "Column1", ;
Column2.Width = 136, ;
Column2.ReadOnly = .T., ;
Column2.Name = "Column2", ;
Column3.Width = 75, ;
Column3.ReadOnly = .T., ;
Column3.Name = "Column3", ;
Column4.CurrentControl = "Check1", ;
Column4.ReadOnly = .T., ;
Column4.Sparse = .F., ;
Column4.Name = "Column4"

ADD OBJECT mm_getfile.grid1.column1.header1 AS header WITH ;
Alignment = 2, ;
Caption = "File Name", ;
Name = "Header1"

ADD OBJECT mm_getfile.grid1.column1.text1 AS textbox WITH ;
BorderStyle = 0, ;
Margin = 0, ;
ReadOnly = .T., ;
ForeColor = RGB(0,0,0), ;
BackColor = RGB(255,255,255), ;
Name = "Text1"

ADD OBJECT mm_getfile.grid1.column2.header1 AS header WITH ;
Alignment = 2, ;
Caption = "File Date", ;
Name = "Header1"

ADD OBJECT mm_getfile.grid1.column2.text1 AS textbox WITH ;
BorderStyle = 0, ;
Margin = 0, ;
ReadOnly = .T., ;
ForeColor = RGB(0,0,0), ;
BackColor = RGB(255,255,255), ;
Name = "Text1"

ADD OBJECT mm_getfile.grid1.column3.header1 AS header WITH ;
Alignment = 2, ;
Caption = "File Size", ;
Name = "Header1"

ADD OBJECT mm_getfile.grid1.column3.text1 AS textbox WITH ;
BorderStyle = 0, ;
Margin = 0, ;
ReadOnly = .T., ;
ForeColor = RGB(0,0,0), ;
BackColor = RGB(255,255,255), ;
Name = "Text1"

ADD OBJECT mm_getfile.grid1.column4.header1 AS header WITH ;
FontSize = 8, ;
Alignment = 2, ;
Caption = "Imported", ;
Name = "Header1"


ADD OBJECT mm_getfile.grid1.column4.text1 AS textbox WITH ;
BorderStyle = 0, ;
Margin = 0, ;
ForeColor = RGB(0,0,0), ;
BackColor = RGB(255,255,255), ;
Name = "Text1"


ADD OBJECT mm_getfile.grid1.column4.check1 AS checkbox WITH ;
Top = 42, ;
Left = 4, ;
Height = 17, ;
Width = 60, ;
Caption = " Yes", ;
ReadOnly = .T., ;
Name = "Check1"


ADD OBJECT command1 AS commandbutton WITH ;
Top = 276, ;
Left = 63, ;
Height = 27, ;
Width = 84, ;
Caption = "Import", ;
Default = .T., ;
Name = "Command1"


ADD OBJECT command2 AS commandbutton WITH ;
Top = 276, ;
Left = 367, ;
Height = 27, ;
Width = 84, ;
Cancel = .T., ;
Caption = "Cancel", ;
Name = "Command2"


ADD OBJECT label2 AS label WITH ;
AutoSize = .T., ;
FontBold = .T., ;
FontItalic = .T., ;
BackStyle = 0, ;
Caption = "^ - Ascending Order, v - Descending Order", ;
Height = 17, ;
Left = 134, ;
Top = 252, ;
Width = 246, ;
Name = "Label2"


ADD OBJECT command3 AS commandbutton WITH ;
Top = 276, ;
Left = 215, ;
Height = 27, ;
Width = 84, ;
Caption = "Delete File", ;
Name = "Command3"


PROCEDURE Init
this.caption='Import '+this.product_id+' Files For Processing'
go top
ENDPROC


PROCEDURE Load
close data all
close all
set safety off
set deleted on
local lnFileCount, lnProcCount, lnPrefLen, x, ltFileDateTime, lcLookFor
dime laIncoming(1,5), laOutgoing(1,5)
=ADIR(laIncoming, trim(thisform.incoming_prefix)+'*.')
=ADIR(laOutgoing, trim(thisform.outgoing_prefix)+'*.')

lnFileCount=alen(laIncoming,1)

lnProcCount=alen(laOutgoing,1)
lnPrefLen=len(trim(thisform.outgoing_prefix))
select 0
create table tblIncoming (filename c(40), filedate t, filesize n(10), processed l)
index on filename tag filename
index on filename descending tag filename2
index on dtos(filedate) tag filedate1
index on dtos(filedate) descending tag filedate2
index on filesize tag filesize
index on filesize descending tag filesize2
index on iif(processed,'A','Z')+filename tag procd
index on iif(processed,'Z','A')+filename tag notprocd

set order to filename
for x=1 to lnFileCount
if vartype(laIncoming[x,1])#'L'
ltFileDateTime=ctot(dtoc(laIncoming[x,3])+" "+laIncoming[x,4])
insert into tblIncoming (filename, filedate, filesize) values ;
(laIncoming[x,1], ltFileDateTime, laIncoming[x,2])
endif
endfor
for x=1 to lnProcCount
if vartype(laOutgoing[x,1])#'L'
lcLookFor=trim(thisform.incoming_prefix)+substr(laOutgoing[x,1],lnPrefLen+1)
locate for filename=lcLookFor
if found()
replace processed with .t.
endif
endif
endfor
release lnFileCount, lnProcCount, lnPrefLen, x, ltFileDateTime, lcLookFor, laIncoming, laOutgoing
select tblIncoming
set order to filename
thisform.sort_column=1
go top
ENDPROC


PROCEDURE Unload
if used('tblincoming')
use in tblincoming
endif
if file('tblincoming.dbf')
erase tblincoming.dbf
erase tblincoming.cdx
endif
return thisform.return_file
ENDPROC


PROCEDURE grid1.Init
this.value=tblIncoming.filename
ENDPROC


PROCEDURE grid1.Refresh
whichcol=thisform.sort_column
lcOrder=order()
do case
case whichcol=1 and lcOrder='FILENAME2'
set order to filename
captdir=' v'
case whichcol=1
set order to filename2
captdir=' ^'
case whichcol=2 and lcOrder='FILEDATE1'
set order to filedate2
captdir=' v'
case whichcol=2
set order to filedate1
captdir=' ^'
case whichcol=3 and lcOrder='FILESIZE2'
set order to filesize
captdir=' ^'
case whichcol=3
set order to filesize2
captdir=' v'
case whichcol=4 and lcOrder='NOTPROCD'
set order to procd
captdir='Yes/No'
otherwise
set order to notprocd
captdir='No/Yes'
endcase
with this
capt1mac='File Name'
capt2mac='File Date'
capt3mac='File Size'
capt4mac='Imported'
if whichcol=1
capt1mac=capt1mac+captdir
endif
if whichcol=2
capt2mac=capt2mac+captdir
endif
if whichcol=3
capt3mac=capt3mac+captdir
endif
if whichcol=4
capt4mac=captdir
endif
.column1.Header1.Caption=capt1mac
.column2.Header1.Caption=capt2mac
.column3.Header1.Caption=capt3mac
.column4.Header1.Caption=capt4mac
for x=1 to .columnCount
colmac='.column'+str(x,1)+'.Header1.FontBold='+iif(x=whichcol,'.T.','.F.')
&colmac.
endfor
endwith
go top
ENDPROC


PROCEDURE header1.Click
thisform.sort_column=1
this.parent.parent.refresh
ENDPROC


PROCEDURE header1.Click
thisform.sort_column=2
this.parent.parent.refresh
ENDPROC


PROCEDURE header1.Click
thisform.sort_column=3
this.parent.parent.refresh
ENDPROC


PROCEDURE header1.Click
thisform.sort_column=4
this.parent.parent.refresh
ENDPROC


PROCEDURE command1.Init
this.enabled=reccount('tblincoming')#0
ENDPROC


PROCEDURE command1.Click
if tblincoming.processed
if messagebox("This file has already been imported. Do you wish to 're-import' it?",36+256,"Are You Sure?")=6
thisform.return_file=sys(5)+addbs(sys(2003))+alltrim(tblincoming.filename)
thisform.release
else
thisform.grid1.setfocus
endif
else
thisform.return_file=sys(5)+addbs(sys(2003))+alltrim(tblincoming.filename)
thisform.release
endif
ENDPROC


PROCEDURE command2.Click
thisform.return_file='
thisform.release
ENDPROC


PROCEDURE command3.Init
this.enabled=reccount('tblincoming')#0
ENDPROC


PROCEDURE command3.Click
lcMsg="You are about to PERMANENTLY delete the "+alltrim(tblIncoming.filename)
if tblIncoming.processed
lcMsg=lcMsg+" and the corresponding Tab Delimted file"
endif
lcMsg=lcMsg+" from the "+thisform.product_id+" system."
if messagebox(lcMsg,20+256,"Are You Sure?")=6
lcMainFile=alltrim(tblIncoming.filename)
erase (lcMainFile)
if tblIncoming.processed
lcWork=strtran(lcMainFile,trim(thisform.incoming_prefix),trim(thisform.outgoing_prefix))
erase (lcWork)
endif
delete
go top
else
wait window 'Deletion Cancelled' nowait
endif
thisform.grid1.setfocus
ENDPROC


ENDDEFINE
*
*-- EndDefine: mm_getfile
**************************************************