|
midrange.com
> To: dwysocki@mmisolutions.com
>
> >
> > If you have an extra minute (ha!) do you think you
> > could post or email me
> > the code? I'd really like to see it. Any insight
> > would be greatly
> > appreciated.
> >
> Dawn,
>
> here's the code, a lot of which I got from this list
> when I was first learning how to use these api's.
> It
> takes an ifs directory as a parameter. It then gets
> the create time the calls subprocedure #deleteOK to
> determine whether to delete. If so, the file is
> deleted using unlink(). Hope the code doesn't get
> too
> mangled in the e-mail.
>
> The utc and number of days is hardcoded. You could
> retrieve the utc and have the number of days
> variable
> I just didn't need to. (good enough vs T.S. example?
> <g>)
>
> phil
>
> *Retrieve creation timestamp for *STMF objects in a
> given ifs directory
> *----------------------------
>
>
> Dlstat PR 10I 0
> EXTPROC('lstat')
> D * value
> D * value
> Dopendir PR *
> EXTPROC('opendir')
> D * VALUE
> Dreaddir PR *
> extproc('readdir')
> D * value
> Dclosedir PR 10I
> 0EXTPROC('closedir')
> D * VALUE
> Dunlink PR 10I 0
> EXTPROC('unlink')
> D * VALUE
> D #deleteOK pr n
> D pr_seconds 10u 0 value
>
>
> *-----------------------------
>
>
> D* stat data structure returned by procedure lstat()
> D StatDS ds 128
> D st_mode 10u 0
> D st_ino 10U 0
> D st_nlink 5U 0
> D reserved1 2A
> D st_uid 10u 0
> D st_gid 10u 0
> D st_size 10u 0
> D st_atime 10U 0
> D st_mtime 10U 0
> D st_ctime 10U 0
> D st_dev 10u 0
> D st_blksize 10i 0
> D st_allocsize 10I 0
> D st_objtype 10A
> D reserved2 2A
> D st_codepage 5u 0
> D st_reserved1 62a
> D st_ino_gen_id 10u 0
> D*-----------------------------
> D* dir entry data structure returned by procedure
> readdir()
> D DirEntry DS
> D d_reserved1 16a
> D d_fileno_genid 10u 0
> D d_fileno 10u 0
> D d_reclen 10U 0
> D d_reserved3 10I 0
> D d_reserved@4 6A
> D d_reserved5 2a
> D d_ccsid 10i 0
> D d_country_id 2A
> D d_language_id 3A
> D d_nls_reserved 3A
> D d_namelen 10u 0
> D d_name 640
> D*-----------------------------
> D Null S 1 inz(X'00')
> D ReturnInt S 10i 0
> D ReturnDir S *
> D PtrToEntry S *
> D RtnEntry s
> based(PtrToEntry)
> like(DirEntry)
> D EntryName s 120
> D EntryPath S 256
> D*-----------------------------
> D* Input Parameters
> D DirName S 100
> D FullName S 256
> D*-----------------------------
> D* Work Variables
> D delete s n
> D seconds s 11 0
> D*-----------------------------
> D ObjVar S 90
> D ObjVarLen S 10i 0
> inz(%size(ObjVar))
> D ObjVarFmt S 8
> D ObjTyp S 10
> D*-----------------------------
> D ApiErr DS
> D ErrSiz 1 4B 0 inz(256)
> D ErrLen 5 8B 0 inz(0)
> D ErrMic 9 15
> D ErrNbr 16 16
> D ErrDta 17 272
> *-----------------------------
> C eval FullName =
> %trimr(DirName) + Null
> C
> C* Open directory
> C eval returnDir =
> opendir(%addr(FullName))
> C
>
>
> C* Terminate if error occurred when opening
> directory
>
> C if ReturnDir = *Null
>
>
> C eval *inlr = *on
>
>
> C return
>
>
> C endif
>
>
> C
>
>
> C dou PtrToEntry = *null
>
>
> C
>
>
> C* Read next directory entry
>
>
> C eval PtrToEntry =
> readdir(ReturnDir)
> C
>
>
> C* Directory entry name is in field d_name
>
>
> C if PtrToEntry <> *Null
>
>
> C eval DirEntry = RtnEntry
>
>
> C
>
>
> C* Get directory entry name
>
>
> C eval EntryName =
> %str(%addr(d_name))
> C
>
>
> C* Determine object type of entry
>
>
> C eval EntryPath =
> %trim(DirName) + '/'
> C + %trimr(EntryName) +
> Null
> C eval ReturnInt =
> lstat(%addr(EntryPath)
> C :
> %addr(StatDS))
> C
>
>
> C if st_objtype = '*STMF'
>
>
> C eval delete =
> #deleteOK(st_ctime)
> C if delete = *on
>
>
> C if %subst(entryPath:1:2)
> =
> '//'
> C eval entryPath =
> %subst(entryPath:2)
> C endif
>
>
> C eval returnInt =
> unlink(%addr(entryPath))
> C endif
>
>
> C
>
>
> C endif
>
>
> C endif
>
>
> C enddo
>
>
> C
>
>
> C* Close directory
>
>
> C eval ReturnInt =
>
>
> C closedir(ReturnDir)
>
>
> C
>
>
> C eval *inlr = *on
>
>
> C*-----------------------------
>
>
> C *inzsr begsr
>
>
> C *entry plist
>
>
> C parm dirname
>
>
> C
>
>
> C endsr
>
>
>
> ***************************
> D*------------------
>
>
> D #deleteOK pr n
> D pr_seconds 10u 0 value
> D*------------------
> P #deleteOK b export
> D #deleteOK pi n
> D seconds 10u 0 value
> D
> DbaseDate s z
> inz(z'1970-01-01-00.00.00.000000'
> Dtoday s z inz(*sys)
> Dresult s z
> Ddays s 5 0
> DutcOffset s 5 0 inz(14400)
> Ddelete s n
>
>
> C subdur UtcOffset:*s BaseDate
> C basedate adddur seconds:*s result
> C Today subdur result days:*d
> C if days > 7
> C eval delete = *on
> C else
> C eval delete = *off
> C endif
> C return delete
> P #deleteOK e
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
> __________________________________________________
> Do You Yahoo!?
> Get email at your own domain with Yahoo! Mail.
> http://personal.mail.yahoo.com/
>
__________________________________________________
Do You Yahoo!?
Get email at your own domain with Yahoo! Mail.
http://personal.mail.yahoo.com/
+---
| This is the Midrange System Mailing List!
| To submit a new message, send your mail to MIDRANGE-L@midrange.com.
| To subscribe to this list send email to MIDRANGE-L-SUB@midrange.com.
| To unsubscribe from this list send email to MIDRANGE-L-UNSUB@midrange.com.
| Questions should be directed to the list owner/operator: david@midrange.com
+---
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2025 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.
