Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Running external program
Message
From
22/09/2005 02:23:56
 
General information
Forum:
Visual FoxPro
Category:
Coding, syntax & commands
Environment versions
Visual FoxPro:
VFP 9
OS:
Windows XP SP2
Database:
Visual FoxPro
Miscellaneous
Thread ID:
01051001
Message ID:
01051860
Views:
6
Hi Naomi,

>Srdjan,
>
>Can you make a modification to the class, so it would remember the original directory before I run it?

You were right!
You caught me in the middle of upsizing my XDIR tool , so I hv sent you
code directly fm code window :)
Thks for spotting that bug, will amend it in download as well.

I fixed this code to be workable, but if you want final version
you hv to download XDIR later today :)


Here is fixed code I sent u earlier ;
***********Call  
local o
o=createobject('search_4_file')
o.search_file='filer.dll'
o.xScan('C:\gemf')
select dirlist
browse normal
return

define class search_4_file as xdirectory
    search_file=''


    procedure init
        dodefault()
        create cursor dirlist ( ;
            nLev      n(3) ,;
            DirName   C(100) ,;
            FileName C(50)  ,;
            rty      C(1)  ,;
            FileAttr   C(5) ,;
            FileSize  n(12) ,;
            DateMod   D  ,;
            TimeMod   C (15) )


    procedure  with_directory
        lparameters cPath
        wait wind 'Now Searching ... ' + chr(13) + cPath nowait

    procedure  with_file
        lparameters cFile,nSize,dLastMod,cTime,cAttr
        select dirlist
        scatter memvar
        m.DirName  = justpath(cFile)
        m.FileName = justfname(cFile)
        if upper(allt(m.FileName)) == upper(allt(this.search_file))
            m.rty='F'
            m.FileAttr = cAttr
            m.FileSize = nSize
            m.DateMod  = dLastMod
            m.TimeMod  = cTime
            insert into dirlist from memvar
        endif




enddefine


******************************************************
* Scans all subdirectories of
* specified directory and executes methods
* 'with_directory'
* 'with_file'
******************************************************
define class xdirectory as custom
    p_level=1
    drive_letters=''

    procedure init
        this.drive_letters=this.retrieve_drive_letters()


    procedure with_directory
        lparameters cPath


    procedure with_file
        lparameters cFile,nSize,dLastMod,cTime,cAttr




    procedure xScan
        ***********************
        * Main Drive/directory/files
        * processing 'loop'
        * with recursive call
        *******************
        lparameters cPath

        local cDirString, i ,sv_default
        if !this.Is_There_Path(cPath)
            messagebox('Path does not exist! '+ chr(13) +chr(13) + cPath )
            return
        endif
        sv_default=allt(sys(5)) + allt(sys(2003))
        set default to (cPath)

        this.with_directory(cPath)
        this.xfiles(cPath)
        local arrmd(1)
        cDirString=this.dirdir(cPath)
        if len(cDirString) > 0
            this.string_to_array(cDirString,'|',@arrmd)
            for i=1 to alen(arrmd)
                this.p_level=this.p_level + 1
                this.xScan(addbs(cPath)+arrmd(i))
                this.p_level=this.p_level - 1
            next
        endif
        set default to (sv_default)        
        return

    procedure  Is_There_Path
        lparameters cDirPath

        if len(cDirPath) = 0
          return .f.
        endif        

        if this.Is_It_Drive(cDirPath)
            return .t.
        endif

        local temparray(1)
        return adir(temparray,cDirPath,'D') > 0



    procedure  Is_It_Drive
        lparameters cPath
        if addbs(cPath) $ this.drive_letters
            return .t.
        else
            return .f.
        endif




    procedure retrieve_drive_letters
        local oFileSys,cDrives,i,j
        oFileSys = createobject("Scripting.FileSystemObject")
        cDrives=''
        i=1
        for each oDrive in oFileSys.Drives
            cDrives = cDrives + oDrive.DriveLetter + ':\' + '|'
            i=i+1
        next
        return left(cDrives,len(cDrives)-1)






    procedure xfiles
        **********************
        * Process current path
        * files and calls user
        * method 'with_file'
        * passing file parameters
        *************************
        lparameters cPath
        local nCount,i,j
        local dirfiles(1)
        nCount=adir(dirfiles,'*.*')
        j=0
        for i=1 to nCount
            if atc('.',dirfiles(i,1)) > 0 &&files only
                j=j+1
                this.with_file(addbs(cPath)+dirfiles(i,1) , dirfiles(i,2), dirfiles(i,3),dirfiles(i,4) , dirfiles(i,5)  )
            endif
        next
        return j



        **********************************
        * Return all subdirectories of
        * specified path as
        * delimited string
        **********************************
    procedure dirdir
        lparameters cPath
        local i,nCount,rVal
        local sv_default,cPath
        if !directory(cPath)
            return
        endif
        sv_default=allt(sys(5)) + allt(sys(2003))
        set default to (cPath)
        local tmparray(1)
        nCount=adir(tmparray, '*.*','D')
        rVal=''
        for i=1 to nCount
            if atc('D',tmparray(i,5))=5 and atc('.',tmparray(i,1))=0
                rVal=rVal+tmparray(i,1)+'|'
            endif
        next
        set default to (sv_default)
        rVal=left(rVal,len(rVal)-1)
        return rVal

        ****************************
        * String to array conversion
        * to array passed by reference
        ****************************
    procedure string_to_array
        lparameters cString,cDlm,myarray
        declare myarray(occurs(cDlm,cString)+1)
        for i = 1 to alen(myarray)
            if atc(cDlm,cString)>0
                myarray(i)=left(cString,atc(cDlm,cString)-1)
                cString=right(cString,len(cString)-atc(cDlm,cString))
            else
                myarray(i)=cString
            endif
        next
        return alen(myarray)



enddefine
Rgds++
*****************
Srdjan Djordjevic
Limassol, Cyprus

Free Reporting Framework for VFP9 ;
www.Report-Sculptor.Com
Previous
Next
Reply
Map
View

Click here to load this message in the networking platform