INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Jobs

Usefull Functions & Procedures

Is there an alternative to the GETFILE() dialog? by SGLong
Posted: 14 Jun 01

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
**************************************************

Back to Microsoft: Visual FoxPro FAQ Index
Back to Microsoft: Visual FoxPro Forum

My Archive

Resources

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close