Jim,
Appreciate the improvements, I'll be working on it tonight.
I also noticed a piece of old code that I should have removed
> SET VAR vm_keepnull = (CVAL('NULL'))
This doesn't work... as an example, if null is set to -0- when this var
is set, and null is then set to ' ', vm_keepnull will also be set to a
space... the null value is stored, not it representative characters..
so you can't retrieve the original -0-. It's not used anywhere in the
routine, but might leave a person wondering.
Ben Petersen
On 12 Jun 2002, at 12:43, Jim Limburg wrote:
> G-Day all
>
> Ben Peterson was kind enough to put up some code for getting file info
> into a table.. I tweaked it some.. I was finding a couple of
> problems in going from one machine to another and small amount
> of the way it was formating and so... While I say that I have
> done some improvements that could be negated fairly quickly
> when your such a rookie as myself, so I will just say I
> worked his good code to suit myslef a bit more, and now I am
> going to post it back to the list.
>
> Again, Thank you Ben
>
> NOTE: This code seems to be only good for RBWin and so far
> works good on Win98 and Win2k systems from my testing.
>
> --------------------------------------------------------
> -- Requires vm_path... path with file spec
> -- ie.. SET VAR vm_path = ('k:\chatt\*.*')
> --AND that you be connected to a database.
>
> *(KEEP IN MIND THAT THIS ONLY WORKS WITH THE WINDOWS VERSION
> OF RBASE. I tried it in a DOS Rbase session and where it
> uses the IF (SLOC(.vm_syscmd, 'Cmd')) > 0 THEN command
> looking for the CMD in the SET VAR vm_comspec = (ENVVAL('COMSPEC'))
> variable it returned that it was a DOS system. This is documented
> in the RSYNTAX to be careful about this from what I found.)
>
> *(XXX Added the path line in here for testing purposes. Will need to
> be removed / or changed to what's needed.)
> SET VAR vm_path = ('k:\chatt\*.*')
> SET VAR vm_keepnull = (CVAL('NULL'))
>
> SET NULL -0-
> SELECT (COUNT(sys_table_name)) INTO vm_tblcnt FROM sys_tables +
> WHERE sys_table_name = 'tDir'
> IF vm_tblcnt = 0 THEN
> --was temp
> *(XXX Changed the table structure so it's needed to drop this table
> before running this test code. )
> CREATE TABLE tdir (fsname TEXT (12) , fsize TEXT (12) , fdate +
> TEXT (10), ftime TEXT (6), flname TEXT (40) , fext TEXT (40), fdirlvl +
> TEXT (8), fdot INTEGER, fdotshort INTEGER)
> ELSE
> DROP TABLE tdir
> CREATE TABLE tdir (fsname TEXT (12) , fsize TEXT (12) , fdate +
> TEXT (10), ftime TEXT (6), flname TEXT (40) , fext TEXT (40), fdirlvl +
> TEXT (8), fdot INTEGER, fdotshort INTEGER)
> ENDIF
> CLEAR VAR vm_tblcnt
> SET VAR vm_comspec = (ENVVAL('COMSPEC'))
> IF (SLOC(.vm_comspec,'Cmd.Exe')) > 0 THEN
> SET VAR vm_batcmd = ('DIR' & .vm_path & '/-C /X /O:GNE /-P > fDIR.Fil')
> ELSE
> SET VAR vm_batcmd = ('DIR' & .vm_path & '/O:GNE /-P > fDIR.Fil')
> ENDIF
>
> SET VAR vm_syscmd = (ENVVAL('comspec')&'/C Start /min fDIR.BAT')
>
> OUTPUT fdir.bat
> WRITE '@ECHO OFF'
> WRITE .vm_batcmd
> WRITE 'Exit'
> OUTPUT SCREEN
>
> ZIP &vm_syscmd
> -- Pause allows Dos process to finish before load
> PAUSE FOR 1
> IF (SLOC(.vm_syscmd, 'Cmd')) > 0 THEN
> -- NT OS
> --LOAD tdir FROM fdir.fil +
> --AS FORMATTED USING fdate 1 8,ftime 10 16,fdirlvl 25 29,fsize 30 39,+
> --fsname 40 51,flname 56 87
> LOAD tdir FROM fdir.fil +
> AS FORMATTED USING fdate 1 10,ftime 11 17,fdirlvl 25 29,fsize 30 39,+
> fsname 40 51,flname 56 87
> ELSE
> --LOAD tdir FROM fdir.fil +
> --AS FORMATTED USING fsname 1 8,fext 10 12,fdirlvl 16 20,fsize 15 27,+
> --fdate 29 36,ftime 39 42,flname 45 84
>
> LOAD tdir FROM fdir.fil +
> AS FORMATTED USING fsname 1 8,fext 10 12,fdirlvl 16 20,fsize 15 27,+
> fdate 29 36,ftime 38 42,flname 45 84
> ENDIF
>
> UPDATE tdir SET fsname = flname WHERE fsname IS NULL
> UPDATE tdir SET flname = (FINDFILE(flname)), fdirlvl = +
> ('Current'), fdate = .#DATE WHERE fsname = '.'
> UPDATE tdir SET flname = (FINDFILE(flname)), fdirlvl = +
> ('Parent'), fdate = .#DATE WHERE fsname = '..'
> UPDATE tdir SET flname = (FINDFILE(flname)), fdirlvl = +
> ('Sub-Dir'), fdate = .#DATE WHERE fdirlvl = '<DIR>'
> ALTER TABLE tdir ALTER COLUMN fsize TO fsize INTEGER
>
> SET VAR keepval = (CVAL('Date'))
> SET DATE MM/DD/YY
> ALTER TABLE tdir ALTER COLUMN fdate TO fdate DATE
> SET DATE &keepval
>
> SET VAR keepval = (CVAL('Time'))
> SET TIME FORMAT HH:MM
> ALTER TABLE tdir ALTER COLUMN ftime TO ftime TIME
> SET TIME FORMAT &keepval
>
> UPDATE tdir SET fdot = (SLOC(flname,'.'))
> UPDATE tdir SET fdotshort = (SLOC(fsname,'.'))
> UPDATE tdir SET fext = (SGET(flname,SLEN(flname)-fdot,(fdot+1))) +
> WHERE fdot > 0
>
> --UPDATE tdir SET flname = (SGET(flname,(fdot-1),1)), fsname = +
> --(SGET(flname,(fdot-1),1)) WHERE fdot BETWEEN 2 AND 9
>
> *(XXX Changed the code quite a bit here to enable it to keep
> short file name the same, plus it was giving me an error on a
> WIN98 system of insuffident buffer space, so I split the statements
> and also only run one part if it's on a win NT/XP system. )
>
> UPDATE tdir SET flname = (SGET(flname,(fdot-1),1)) WHERE fdot > 1
> UPDATE tdir SET fdirlvl = NULL WHERE fdirlvl IS NOT NULL AND fsize IS NOT NULL
> IF (SLOC(.vm_syscmd, 'Cmd')) > 0 THEN
> UPDATE tdir SET fsname = (SGET(fsname,(fdotshort-1),1)) WHERE fdot > 1
> ENDIF
> DELETE FROM tdir WHERE fdate IS NULL
> DELETE fdir.*
> CLEAR VAR vm_%
> SET NULL ' '
> RETURN
> --------------------------------------------------------
>
>
>
> __________________________________________________
> Do You Yahoo!?
> Yahoo! - Official partner of 2002 FIFA World Cup
> http://fifaworldcup.yahoo.com
> ================================================
> TO SEE MESSAGE POSTING GUIDELINES:
> Send a plain text email to [EMAIL PROTECTED]
> In the message body, put just two words: INTRO rbase-l
> ================================================
> TO UNSUBSCRIBE: send a plain text email to [EMAIL PROTECTED]
> In the message body, put just two words: UNSUBSCRIBE rbase-l
> ================================================
> TO SEARCH ARCHIVES:
> http://www.mail-archive.com/rbase-l%40sonetmail.com/
>
================================================
TO SEE MESSAGE POSTING GUIDELINES:
Send a plain text email to [EMAIL PROTECTED]
In the message body, put just two words: INTRO rbase-l
================================================
TO UNSUBSCRIBE: send a plain text email to [EMAIL PROTECTED]
In the message body, put just two words: UNSUBSCRIBE rbase-l
================================================
TO SEARCH ARCHIVES:
http://www.mail-archive.com/rbase-l%40sonetmail.com/
