Path: news.mitre.org!blanket.mitre.org!philabs!newsjunkie.ans.net!newsfeeds.ans.net!streamer1.cleveland.iagnet.net!iagnet.net!news.maxwell.syr.edu!uninett.no!news.net.uni-c.dk!news.uni-c.dk!not-for-mail
From: Karsten Nyblad <karsten@tdr.dk>
Newsgroups: comp.os.vms
Subject: Re: Anyone has a LIB$FILE_SCAN example ?
Date: Tue, 16 Dec 1997 20:32:13 +0100
Organization: Tele Danmark Research
Lines: 311
Message-ID: <3496D73D.41C6@tdr.dk>
References: <3496b486.100159531@news.interlink.net>
NNTP-Posting-Host: ux12.tdr.dk
Mime-Version: 1.0
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: 7bit
X-Mailer: Mozilla 3.0Gold (X11; I; OSF1 V3.2 alpha)

Stephane Paquin wrote:
>         I'm looking for a LIB$FILE_SCAN programming example. I would
> like to list the files in a directory and have access internally to
> their size and date of creation/modification.
> 
>         A file specification including a wildcard would be passed to
> LIB$FILE_SCAN

I once had to
read the dates of files and in order to do it right I looked
into the fiches of VMS version 4.4 (the last version where
they where free).  I dought the code has been changed. 
Digital normally only change code when they can make
something  secnificantly better.  DIRECTORY uses
lib$file_scan, which is described in the runtime library
manual.  If the command needs attributes of the file, then 
it adds all XAB's being used for reading or setting file
attributes.  It also add XAB's which will be filed with
information not needed, e.g., XABDAT when the dates are not
needed.  These XAB's are used only when the files are
accessed through DECNET.  Therefore DIRECTORY assert
NAM$M_SRCHXABS in the NAM block.  If the file is not remote,
then DIRECTORY uses ACP/QIO for accessing the information.
The device name and file id are taken from the NAM block.
Again Digital reads all attributes of the file, also those
not needed. Using ACP/QIO has the advantage that the
information can be read from files, that are locked by an
other user.  I have attached the code I used for reading
file dates of a file. You will have to add a loop to make it
return more than one file name.

Karsten Nyblad
Tele Danmark R&D
E-mail: karsten@tdr.dk

$! ................... Cut between dotted lines and save.
...................
$!...........................................................................
$! VAX/VMS archive file created by VMS_SHARE V06.10 7-FEB-1989.
$!
$! VMS_SHARE was written by James Gray (Gray:OSBUSouth@Xerox.COM) from
$! VMS_SHAR by Michael Bednarek (U3369429@ucsvc.dn.mu.oz.au).
$!
$! To unpack, simply save, concatinate all parts into one file and
$! execute (@) that file.
$!
$! This archive was created by user KARSTEN
$! on 20-NOV-1989 14:31:02.65.
$!
$! It contains the following 1 file:
$!        FILEDATE.PAS
$!
$!============================================================================
$ SET SYMBOL/SCOPE=( NOLOCAL, NOGLOBAL )
$ VERSION = F$GETSYI( "VERSION" )
$ IF VERSION .GES "V4.4" THEN GOTO VERSION_OK
$ WRITE SYS$OUTPUT "You are running VMS ''VERSION'; ", -
    "VMS_SHARE V06.10 7-FEB-1989 requires VMS V4.4 or higher."
$ EXIT 44 ! SS$_ABORT
$VERSION_OK:
$ GOTO START
$!
$UNPACK_FILE:
$ WRITE SYS$OUTPUT "Creating ''FILE_IS'"
$ DEFINE/USER_MODE SYS$OUTPUT NL:
$ EDIT/TPU/COMMAND=SYS$INPUT/NODISPLAY/OUTPUT='FILE_IS'/NOSECTION -
    VMS_SHARE_DUMMY.DUMMY
b_part := CREATE_BUFFER( "{Part}", GET_INFO( COMMAND_LINE, "file_name" )
)
; s_file_spec := GET_INFO( COMMAND_LINE, "output_file" ); SET(

OUTPUT_FILE
, b_part, s_file_spec ); b_errors := CREATE_BUFFER( "{Errors}" );
i_errors 
:= 0; pat_beg_1 := ANCHOR & "-+-+-+ Beginning"; pat_beg_2 := LINE_BEGIN 
& "+-+-+-+ Beginning"; pat_end := ANCHOR & "+-+-+-+-+ End"; POSITION
( BEGINNING_OF( b_part ) ); LOOP EXITIF SEARCH( SPAN( ' ' )@r_trail 
& LINE_END, FORWARD) = 0; POSITION( r_trail ); ERASE( r_trail ); ENDLOOP
; POSITION( BEGINNING_OF( b_part ) ); i_append_line := 0; LOOP EXITIF
MARK
( NONE ) = END_OF( b_part ); s_x := ERASE_CHARACTER( 1 )
; IF s_x = '+' THEN r_skip := SEARCH( pat_beg_1, FORWARD, EXACT ); IF
r_skip 
<> 0 THEN s_x := ''; MOVE_HORIZONTAL( -CURRENT_OFFSET ); ERASE_LINE;
ENDIF
; ENDIF; IF s_x = '-' THEN r_skip := SEARCH( pat_end, FORWARD, EXACT )
; IF r_skip <> 0 THEN s_x := ''; MOVE_HORIZONTAL( -CURRENT_OFFSET );
m_skip 
:= MARK( NONE ); r_skip := SEARCH( pat_beg_2, FORWARD, EXACT ); IF
r_skip 
<> 0 THEN POSITION( END_OF( r_skip ) ); MOVE_HORIZONTAL( -CURRENT_OFFSET
)
; MOVE_VERTICAL( 1 ); MOVE_HORIZONTAL( -1 ); ELSE POSITION( END_OF(
b_part ) 
); ENDIF; ERASE( CREATE_RANGE( m_skip, MARK( NONE ), NONE ) ); ENDIF;
ENDIF
; IF s_x = 'V' THEN s_x := ''; IF i_append_line <> 0 THEN APPEND_LINE
; MOVE_HORIZONTAL( -CURRENT_OFFSET ); ENDIF; i_append_line := 1
; MOVE_VERTICAL( 1 ); ENDIF; IF s_x = 'X' THEN s_x := ''; IF
i_append_line 
<> 0 THEN APPEND_LINE; MOVE_HORIZONTAL( -CURRENT_OFFSET ); ENDIF
; i_append_line := 0; MOVE_VERTICAL( 1 ); ENDIF; IF s_x <> '' THEN
i_errors 
:= i_errors + 1; s_text := CURRENT_LINE; POSITION( b_errors ); COPY_TEXT
( "The following line could not be unpacked properly:" ); SPLIT_LINE
; COPY_TEXT( s_x ); COPY_TEXT( s_text ); POSITION( b_part );
MOVE_VERTICAL
( 1 ); ENDIF; ENDLOOP; POSITION( BEGINNING_OF( b_part ) ); LOOP r_x :=
SEARCH
( "`", FORWARD, EXACT ); EXITIF r_x = 0; POSITION( r_x );
ERASE_CHARACTER( 1 
); COPY_TEXT( ASCII( INT( ERASE_CHARACTER( 3 ) ) ) ); ENDLOOP
; IF i_errors = 0 THEN SET( NO_WRITE, b_errors, ON ); ELSE POSITION
( BEGINNING_OF( b_errors ) ); COPY_TEXT( FAO
( "The following !UL errors were detected while unpacking !AS", i_errors
, s_file_spec ) ); SPLIT_LINE; SET( OUTPUT_FILE, b_errors, "SYS$COMMAND"
)
; ENDIF; EXIT; 
$ DELETE VMS_SHARE_DUMMY.DUMMY;*
$ CHECKSUM 'FILE_IS
$ WRITE SYS$OUTPUT " CHECKSUM ", -
  F$ELEMENT( CHECKSUM_IS .EQ. CHECKSUM$CHECKSUM, ",", "failed!!,passed."
)
$ RETURN
$!
$START: 
$ FILE_IS = "FILEDATE.PAS"
$ CHECKSUM_IS = 73808826
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X`091inherit('sys$library:starlet'),environment`093 module
test(input,output);
X
Xtype word = `091volatile,word`093 -32768..32767;
X     quad = `091volatile,quad`093 record l0 : unsigned; l1 : integer
end;
X     nametype = `091volatile`093 varying `091255`093 of char;
X     esa$type = `091volatile`093 packed array `0911..255`093 of char;
X
Xvar name : nametype;
X    cdt,rdt : quad;
X    returnstatus : integer;
X
X`091asynchronous,external(sys$fao)`093 function fao (
V`009ctrstr : `091class`095s`093 packed array `091$l1..$u1:integer`093
of char

X;
X`009var outlen : word := `037immed 0;
V`009var outbuf : `091class`095s`093 packed array
`091$l3..$u3:integer`093 of
X char;
X`009p1 : `091list`093 quad) : integer; external;`032
X
Xfunction lib$file`095scan(fab : fab$type;
V                       `037immed `091unbound`093 function success(fab :
fab$t
Xype) : integer;
V                       `037immed `091unbound`093 function error(fab :
fab$typ
Xe) : integer;
X                       context : integer) : integer; external;
X
Vfunction lib$file`095scan`095end(fab : fab$type; context : integer) :
integer
X; external;
X
Xfunction success(fab : fab$type) : integer;
X
Xlabel 1;
X
Xtype xab`095ref = `094xab$type;
X     nam`095ref = `094nam$type;
X     devicenametype = packed array `0911..16`093 of char;
X
Xvar status1,status2 : integer;
X    fib : `091volatile`093 fib$type;
X    devicename : devicenametype;
X    attrl : array `0911..5`093 of atr$type;
X    channel : `091volatile,word`093 0..65535;
X    iosb : record status : word;
X                  len    : word;
X                  dummy  : integer;
X           end;
X    descr : record
X       length : word;
X       dummy  : word;
X       addr   : `094fib$type;
X    end;
X    i : 1..4;
X   `032
X   `032
X
Xprocedure checkstatus(status,retstatus : integer);
X
Xvar msg : record length : word;
X                 flags  : word;
X                 msg    : unsigned;
X          end;
Xbegin
Xif not odd(status) then begin
X   returnstatus:= retstatus;
X   goto 1;
Xend;
Xend;
X `032
Xbegin
Xfib:= (0)::fib$type;
X
Xif not fab.fab$l`095dev::dev$type.dev$v`095dir and
X   not fab.fab$l`095nam::nam`095ref`094.nam$v`095node then
X   checkstatus(ss$`095notfiledev,4);
X
Xif fab.fab$l`095dev::dev$type.dev$v`095for then
X   checkstatus(ss$`095devforeign,4);
X
Xif not fab.fab$l`095nam::nam`095ref`094.nam$v`095node then
X   with fib, fab.fab$l`095nam::nam`095ref`094,descr do begin
X      descr.length:= size(fib);
X      descr.addr:= address(fib);
X      devicename:= nam$t`095dvi;
V      status1:=
$assign(substr(devicename,2,ord(devicename`0911`093)),channel
X);
X      checkstatus(status1,4);
X      fib$w`095fid:= nam$w`095fid;
X      for i:= 1 to 2 do attrl`091i`093.atr$w`095size:= 8;
X      attrl`0911`093.atr$w`095type:= atr$c`095credate;
X      attrl`0911`093.atr$l`095addr:= (address(cdt))::unsigned;
X      attrl`0912`093.atr$w`095type:= atr$c`095revdate;
X      attrl`0912`093.atr$l`095addr:= (address(rdt))::unsigned;
X      attrl`0913`093:= (0)::atr$type;
V      status1:= $qiow(,channel,io$`095access,iosb,,,`037ref
descr,,,,`037ref
X attrl,);
X      status2:= $dassgn(channel);
X      checkstatus(status2,5);
X      checkstatus(status1,3);
X      checkstatus(iosb.status,3);
X   end
Xelse with fab, fab$l`095xab::xab`095ref`094 do begin
X      checkstatus(fab$l`095sts::integer,2);
X      if fab$l`095stv <> 0 then
X         checkstatus(fab$l`095stv::integer,2);
X      cdt:= xab$q`095cdt;
X      rdt:= xab$q`095rdt;
X   end;
Xreturnstatus:= 1;
X1: success:= ss$`095normal;
Xend;
X
X
X
Xfunction error(fab : fab$type) : integer;
X
Xvar msg : record length : word;
X                 flags  : word;
X                 mess1,mess2 : unsigned;
X          end;
X    status : integer;
Xbegin
Xreturnstatus:= 2;
Xerror:= ss$`095normal;
Xend;
X
V`091global`093 function getfiledate(name : `091volatile,class`095s`093
packed
X array `091$1..$2 : integer`093 of char;
X                  version : integer; var date : quad) : integer;
X
Xvar fab : fab$type;
X    nam : `091volatile`093 nam$type;
X    xabdat : `091volatile`093 xab$type;
X    context : integer;
X    status : integer;
X    esa : esa$type;
X
Xbegin
X   fab:= (0)::fab$type;
X   nam:= (0)::nam$type;
X   xabdat:= (0)::xab$type;
X   context:= 0;
X   esa:= (0)::esa$type;
X   with fab,nam,xabdat do begin
X      fab$b`095bid:= fab$c`095bid;
X      fab$b`095bln:= fab$c`095bln;
X      fab$l`095fna:= (address(name))::unsigned;
X      fab$l`095nam:= (address(nam))::unsigned;
X      fab$b`095fns:= $2;
X      fab$l`095xab:= (address(xabdat))::unsigned;
X      nam$b`095bid:= nam$c`095bid;
X      nam$b`095bln:= nam$c`095bln;
X      nam$l`095esa:= (address(esa))::unsigned;
X      nam$b`095ess:= 255;
X      nam$b`095nop:= nam$m`095srchxabs;
X      xab$b`095cod:= xab$c`095dat;
X      xab$b`095bln:= xab$c`095datlen;
X   end;
X   status:= lib$file`095scan(fab,success,error,context);
X   if status = rms$`095fnf
X      then returnstatus:= 2
X   else if not odd(status)
X      then returnstatus:= 4;
X   status:= lib$file`095scan`095end(fab,context);
X   if odd(status)
X      then getfiledate:= returnstatus
X      else getfiledate:= 5;
X   if odd(version)
X      then date:= cdt
X      else date:= rdt;
Xend;
Xend.
$ GOSUB UNPACK_FILE
$ EXIT