program FilGen { for FILGEN16.EXE, FILGEN32.EXE ; command-line file data } ;

{$i version.pas - sets one of BORPAS, DELPHI}

uses {$IFDEF BORPAS} Dos {$ENDIF}
  {$IFDEF DELPHI} SysUtils, Windows {$ENDIF} ;

const MINE = ' (c) www.merlyn.demon.co.uk >= 2005-04-18 ;' ;


{ Write any/all file/directory properties given by FindFirst, 16/32-bit,
  or drive-type properties, on Standard Output, in any layout.  The 32-bit
  version is substantially a superset of the 16-bit one.

  The program compiles in the Borland Pascal 7, Turbo Pascal 7 IDEs, and
  with D3 DCC32; and is dual command-line compiled by my FILGENMK.BAT to
  FILGEN16.EXE (16-bit BP7) and FILGEN32.EXE (32-bit D3); uses version.pas.

  NEW; SUBJECT TO CHANGE, including parameter change; USE AT YOUR OWN RISK.

  Further Win32 properties might be added, if I discover how to get them.


  USAGE

  Prompt> ProgName Parameters

  A parameter not starting with / specifies a drive, directory or file for
  which information is required.

  A parameter starting / may give an Info String, which is stored for later
  use with a corresponding drive or file/directory parameter.  There are
  default Drive and File Info Strings.

  Environment FILGENCMD ( use no leading / ) is, if present, stored as a
  File Info String; then the command-line parameters are handled in order.

  Quotes "" may be handled by the OS; they are not special here.
  Since they may be eaten by the OS, use ' for " and \' for '.

  Parameters are case-dependent; their type depends on their
  leading character(s) :
    /? as first parameter, or no parameter, gives brief help citing this.
    /; terminates the parameter list;
    /+ (Win32) sets following non-/ parameters as Drive-type not File-type.
    /- (Win32) sets following non-/ parameters back to File-type.
    // leads a comment parameter;
    /@ leads a script file name;
    /: leads a case-dependent Drive Info String, <= 127 characters;
    else / starts a case-dependent File Info String, <= 127 characters.

  Then parameters of two characters, the second being colon, are Drives,
  independently of /+.

  Otherwise parameters are file or directory names, possibly wild-carded.
  But following a parameter /+ the 32-bit program will take following
  parameters as drive-type (may require to start with drive letter).
  Having only Win98, I do not get different results for a drive-type
  directory.


  Output is to Standard Output, redirectable and pipeable.

  A Script can be read, using /@filename.ext, one parameter per line.

  FILGEN16 uses short file names throughout, and gives DOS info.
  FILGEN32 uses short and long file names, and gives Windows & DOS info.

  The default date/time layout ('Y-M-D H:m:s') is after ISO 8601;
  the OS default layout can be selected, or a user-composed layout.

  To pipe : option /@ calls for further parameters on Standard Input -
  as from   dir /b   or   HUNT * o   for example


  INFO STRINGS

  The two Drive and File Info Strings are stored independently.  They are
  not at this stage checked.

  In interpreting them with a File or Drive, characters not introduced by
  the current special character are copied, with exceptions as shown below.
  With escapes, it should be possible to include any desired text.

  Let the current special character be #, which is the default.
  Here, $ is an optional +- digit string, default 0, for field length;
  0 means use field's default; 1 gives minimum.  Field text is not cut.
  Positive pads on left, for numbers; negative pads on right, for names.

   #$Q : Output Field Q, padded to width $
   (string) : new date/time field layout string
   [string] : new month names, each max 20, tot max 127, as MonthNames below

  Escapes:
   \^x : Special Character is now character x
   \n, \t, \s, \c : newline, tab, space, caret
   \* : escaped *, for * being any non-alphanumeric character bar ^


  PSEUDO-FIELDS :

   : : sets space between fields to $; default = 1.
   , : Comma-in-Number set to Odd($); if on, numeric field defaults expand.
   z : convert Win32 dates from UTC to LocalTime ???      RSVP.
   Z : not z


  FIELDS for DRIVES

   s : MsDos size
   f : MsDos free
   u : MsDos used (as s-f)
   A : Win32 Available (for NT+ ?)
   F : Win32 FreeTotal
   S : Win32 SizeTotal
   U : Win32 UsedTotal (as S-F)
   G : Win32 General - all info, just listed; includes other stuff.


  FIELDS for BOTH 16- and 32- bit files :

   F : MsDos filename.ext
   N : MsDos filename
   X : MsDos ext
   D : MsDos date
   B : MsDos Attribute as byte
   P : Path with final name      : 16-bit : In Upper Case
   p : Path without final name   : 32-bit : Case as it happens ?

   _ : spaces (default 0)
   & : Revise saved localised date order; $ = 0 1 2 for mdy dmy ymd
   @ : nothing


  FIELDS for 16-Bit files :

   S : MsDos Size
   r : MsDos Attribute ReadOnly, as letter R ...
   h s v d a : hidden system volume-id directory archive, likewise ...
   f g : MsDos Attribute Bits 6 & 7, as letters - Unset bits show comma.


  FIELDS for 32-Bit files :

   S : Win32 Size
   A : Win32 Attributes as DWORD
   a c d h n o r s t : Win32 Attributes, as letters -
     ARCHIVE, COMPRESSED, DIRECTORY, HIDDEN, NORMAL,
     OFFLINE, READONLY, SYSTEM, TEMPORARY, OFFLINE - else comma.
   C : Win32 Creation Date
   R : Win32 Access Date
   W : Win32 Write Date - these probably UTC.
   Q : Win32 Short Name - may be empty? - consider F?
   L : Win32 Long Name (no longer quoted; use ' for " and \' for ')
   E, e : as P, p but converted to SFN (Eight.Three) form
   U, u : as P, p but converted to LFN (Utmost) form
   K : Win32 ExcludeAttr, whatever that may be ??


  DATE STRING SPECIALS (string is checked only when used)

   Y : 4 digit year
   y : 2 digit year
   c : 2 digit century
   M : 2 digit month
   N : 3 letter month by default; uses MonthNames
   D : 2 digit day
   d : day
   x : Suffix - st nd rd th
   H : 2 digit hour 00..23
   h : 2 digit hour 01..12
   m : 2 digit minute
   s : 2 digit second
   S : 2.3 seconds
   a : a or p
   A : A or P
   0 : space
   1 : m
   2 : M
   3 : DateSeparator
   4 : TimeSeparator
   9 : space ?
   added 2005-04-18 (J is Jours (fr.)), base is 1980-00-00.0 = 0.0 :
   t : seconds
   T : seconds and 3 decimals (only useful in Delphi)
   j : days and 5 decimals
   J : days and 8 decimals (ditto)

   Empty : Use saved localised layout. 16-bit requires DOS 3.0+. 32-bit
   has dubious needs.
   Date field order, date separator, and time separator are initially
   read from the OS.
   WinAPI used by Delphi reduces dates after 2100.0 to 2100.0
   Beware time zone and summer time effects; FILGEN16 & FILGEN32 may give
   differing results.


  RESERVED FIELDS

   None


  NOTES

  Strings are limited to 200-250 characters.

  For ErrorLevels, scan for DAI and DIE below; error numbers may change.

  By piping output to my STOW, an environment variable can be set :

  FILGEN## /#1S file | STOW ZZ       will set the file size into ZZ

  CON, NUL, etc, should exist in every directory; I don't know why
  FILGEN32 sees them but not FILGEN16 - HUNT (16) can.

  There is little need to add selectivity to this program;
  consider   prompt>HUNT *.pas f2002:5 e    "filgen16" ">> XXX"
  and        prompt>HUNT *.pas f2002:5 u q0 "filgen32" | more


  EXAMPLES (with some output spaces removed)

  prompt> filgen16 filgen.pas
  2002-12-13 13:29:28 FILGEN.PAS       23757 .....A..  C:\PAS-PROG\FILGEN.PAS

  prompt>filgen16 /\s(d9N9y)#-16F#+12S\s#D filgen.pas
  FILGEN.PAS              24408  13 Dec 02


  prompt> filgen32 filgen.pas
  2002-12-13 13:29:28 FILGEN.PAS    23757 ....A....  "C:\pas-prog\FILGEN.PAS"

  prompt>filgen32 /:#1,#0:\tSize=#1S\s\sFree=#1F\s\sUsed=#1U c:
        Size=4,030,681,088  Free=2,028,404,736  Used=2,002,276,352

  Note that FILGEN can help with logical selection -
  prompt> HUNT *.pas n q0 e "FILGEN16 /#F#:#s#h" u | find /v ",," | COLS 1+12
  lists files with attributes S and/or H set

  It can expand  dir /o:x /b -
  prompt> dir *.txt /o:-e /b | filgen16 /#F#S(N)#D /@
  PRINTEXT.TXT          4972 Dec
  NAMES.TXT               57 Nov


  BUGS

  At present, P E & U with file '.' / '..' or ending '\.*' would be wrong,
  and so are suppressed by DotCheck.

  }



{$IFDEF DELPHI} {$H-} {$ENDIF Delphi uses short strings}
{ NOTE : Conversion to native strings is in hand; please report any problem }

type
S05 = string [5] ;
S20 = string [20] ;
S30 = string [30] ;
S40 = string [40] ;
S127 = string [127] ;
S255 = string [255] ;
Trio = 0..2 ;
TSR = {$IFDEF BORPAS} SearchRec {$ELSE} TSearchRec {$ENDIF} ;

const DateTimeForm : S40 = 'Y-M-D H:m:s' ;
const MonthNames : S127 = '_Jan_Feb_Mar_Apr_May_Jun_Jul_Aug_Sep_Oct_Nov_Dec' ;
{ _January_February_March_April_May_June_July_August_Sepember_October_November_December }
const DateOrder : Trio = 0 ;
const ThatChar : char = '#' ;
const Commas : boolean = false ;
{$IFDEF DELPHI} const LocalTime : boolean = false ; {$ENDIF}
{$IFDEF BORPAS}
const DateSeparator : char = '|' ;
const TimeSeparator : char = '~' ;
{$ENDIF}

var CannotDoPath : boolean ;



procedure DIE(const St : string ; const Errlev : byte) ;
begin Writeln({$IFDEF BORPAS} 'FILGEN16' {$ELSE} 'FILGEN32' {$ENDIF},
    ': ', St, '  EL=', ErrLev, '.') ; HALT(Errlev) end {DIE} ;

procedure DAI(const St : string ; const Errlev : byte) ;
begin Writeln ; DIE(St, ErrLev) end {DAI} ;


procedure HELP ;
begin DAI(MINE +
    ^M^J' Usage: See top of FILGEN.PAS; wild-cards OK.', 9) end {HELP} ;


function LZ(JJ : word) : S05 { LZ:=00..09,10..99999 } ; var St : S05 ;
begin
  Str(JJ:2, St) ; if St[1]=#32 then St[1] := '0' ; LZ := St end {LZ} ;


function IntStr(const Value : longint) : S20 ;
var S : S20 ;
begin Str(Value, S) ; IntStr := S end {IntStr} ;


{$IFDEF DELPHI}
function CompStr(const Value : comp) : S20 ;
var St : S20 ;
begin Str(Value:1:0, St) ; CompStr := St end {CompStr} ;
{$ENDIF}


function Comma(St : S30) : S30 ;
var JK : byte ;
begin JK := Length(St) ;
  if Commas then while JK>3 do begin Dec(JK, 3) ; Insert(',', St, JK+1) end ;
  Comma := St end {Comma} ;


procedure WriteJust(St : S255 ; FW : integer ; const Default : integer ) ;
begin { FW>0 pad on left, FW<0 pad on right }
  if FW=0 then FW := Default ;
  Write( '':+FW-Length(St), St, '':-FW-Length(St) ) ;
  end {WriteJust} ;


procedure WriteJustComma
  (const St : S255 ; const FW : integer ; Default : integer ) ;
begin if Default>0 Then Inc(Default, (Default-1) div 3) ;
  WriteJust(Comma(St), FW, Default) end {WriteJustComma} ;


procedure FindLocaleDefaults ; { Require >= DOS3.0 }
{$IFDEF BORPAS}
var Regs : Registers ; Buf : array [0..$2F] of char ;
{$ELSE}
var Pt : byte ;
{$ENDIF}
begin
  {$IFDEF BORPAS}
  with Regs do begin
    AX := $3800 { Get local info } ;
    DS := Seg(Buf) ; DX := Ofs(Buf) ;
    MsDos(Regs) { Int21/38 } ;
    (* Writeln(DS:7, DX:7, Flags and FCarry <> 0:7, AX:7, BX:7) ; *)
    (* Writeln(byte(Buf[$0]):4, Buf[$9]:2, Buf[$B]:2, Buf[$D]:2, byte(Buf[$11]):2) ; *)
    {          mdy dmy ymd      decimal    datesep    timesep         12/24 }
    DateOrder := byte(Buf[$0]) ;
    DateSeparator := Buf[$B] ; TimeSeparator := Buf[$D] ;
    end ;
  {$ENDIF}
  {$IFDEF DELPHI}
  { FDT := FormatDateTime('ddddd tt', 36525.00002) ;
    Pt := Pos('31', FDT) ;
    if Pt>6 then DateOrder := 2
    else if Pt=1 then DateOrder := 1 else DateOrder := 0 ; }
  Pt := Pos('dd', ShortDateFormat) ;
  if Pt>6 then DateOrder := 2
    else if Pt=1 then DateOrder := 1 else DateOrder := 0 ;
  {$ENDIF}
  {$IFDEF DEBUG} Writeln(' *** DEBUG *** DateOrder ', DateOrder,
    '   DateSeparator ', DateSeparator, '   TimeSeparator ', TimeSeparator) ; {$ENDIF}
  end {FindLocaleDefaults} ;



procedure SetSavedLocaleDateTimeForm ;
const
DFO : array [Trio] of S05 = ('M_D_Y', 'D_M_Y', 'Y_M_D') ;
T5 : S05 = 'H_m_s' ;
var S5 : S05 ;
begin
  S5 := DFO[DateOrder] ;
  S5[2] := DateSeparator ; S5[4] := DateSeparator ;
  T5[2] := TimeSeparator ; T5[4] := TimeSeparator ;
  DateTimeForm := S5+'9'+T5 ;
  end {SetSavedLocaleDateTimeForm} ;



procedure ReadDateTimeForm(const Cmnd : S127 ; var Pt : byte) ;
begin DateTimeForm := '' ;
  while (Pt<=Length(Cmnd)) and (Cmnd[Pt]<>')') do begin
    DateTimeForm := DateTimeForm+Cmnd[Pt] ; Inc(Pt) end ;
  if Cmnd[Pt]<>')' then DAI('Missing parenthesis in ' + Cmnd, 1) ;
  if DateTimeForm='' then SetSavedLocaleDateTimeForm ;
  Inc(Pt) end {ReadDateTimeForm} ;


procedure ReadMonthNames(const Cmnd : S127 ; var Pt : byte) ;
begin MonthNames := '' ;
  while (Pt<=Length(Cmnd)) and (Cmnd[Pt]<>']') do begin
    MonthNames := MonthNames+Cmnd[Pt] ; Inc(Pt) end ;
  if Cmnd[Pt]<>']' then DAI('Missing bracket in ' + Cmnd, 1) ;
  Inc(Pt) end {ReadMonthNames} ;


function GetMonthName(const Mo : word) : S20 ;
var KK, MM : byte ; St : S20 ;
begin St := '' ; MM := 0 ;
  for KK := 1 to Length(MonthNames) do if MonthNames[KK]='_' then Inc(MM)
    else if MM=Mo then St := St + MonthNames[KK] ;
  GetMonthName := St end {GetMonthName} ;


function Suffix(const DD : word) : S05 ;
const Ar : array [0..2] of string [2] = ('st', 'nd', 'rd') ;
var JJ : word ;
begin Suffix := 'th' ; JJ := Pred(DD) mod 10 ;
  if (DD div 10 <> 1) and (JJ<3) then Suffix := Ar[JJ] ;
  end {Suffix} ;


function ZelCMJD(Y, M, D : word) : longint ;
begin
  if M<3 then begin Inc(M, 12) ; Dec(Y) end ;
  ZelCMJD := longint(Y)*365 - 678973 + (D + (M*153-2) div 5 +
    Y div 4 - Y div 100 + Y div 400) end {ZelCMJD} ;


function FormedTime(const Yr, Mo, Dy, Hr, Mi, Sc, ms : word) : S40 ;
var Days, DSec, Secs : extended ;
  St : S20 ; TS : S40 ; KK : byte ; Tail : string [6] ;
const AMPM : array [boolean] of char = 'ap' ;
begin
  Days := ZelCMJD(Yr, Mo, Dy) - 44207 { 1980-00-00 = 0 } ;
  DSec := (Hr*60+Mi)*60+Sc ;
  Secs := Days*86400 + DSec ;
  Str(Sc+ms*0.001:6:3, Tail) ; if Tail[1]=#32 then Tail[1] := '0' ;
  TS := '' ;
  for KK := 1 to Length(DateTimeForm) do begin
    case DateTimeForm[KK] of
      'Y' : St := IntStr(Yr) ;
      'y' : St := LZ(Yr mod 100) ;
      'c' : St := LZ(Yr div 100) ;
      'M' : St := LZ(Mo) ;
      'N' : St := GetMonthName(Mo) ;
      'D' : St := LZ(Dy) ;
      'd' : St := IntStr(Dy) ;
      'x' : St := Suffix(Dy) ;
      'H' : St := LZ(Hr) ;
      'h' : St := LZ(((Hr-1) mod 12)+1) ;
      'm' : St := LZ(Mi) ;
      's' : St := LZ(Sc) ;
      'S' : St := Tail ;
      '0' : St := #32 ;
      '1' : St := 'm' ;
      '2' : St := 'M' ;
      '3' : St := DateSeparator ;
      '4' : St := TimeSeparator ;
      '5'..'8' : DAI('Bad date/time digit', 6) ;
      '9' : St := #32 ;
      'a' : St := AMPM[Hr>11] ;
      'A' : St := UpCase(AMPM[Hr>11]) ;
      't' : Str(Secs:1:0, St) ;
      'T' : Str(Secs+ms*0.001:1:3, St) ;
      'j' : Str(Days+DSec/86400:1:5, St) ;
      'J' : Str(Days+DSec/864e2+ms/864e5:1:8, St) ;
      else  St := DateTimeForm[KK] ;
      end ;
    TS := TS+St end {KK} ;
  FormedTime := TS end {FormedTime} ;



function DOSDateStamp(const AA : longint) : S40 ;
begin DOSDateStamp := FormedTime(
    1980 + (AA shr 25), (AA shr 21) and $0F, (AA shr 16) and $1F,
    (AA shr 11) and $1F, (AA shr 5) and $3F, (AA shl 1) and $3F, 0) ;
  end {DOSDateStamp} ;


{$IFDEF DELPHI after Guido Gybels, bpdlo, 2002-12-11; Web MSDN; manual}
function GetDiskFreeSpaceExA(lpDirectoryName : PAnsiChar ;
  var lpFreeBytesAvailableToCaller, lpTotalNumberOfBytes,
  lpTotalNumberOfFreeBytes : Comp) : BOOL ; stdcall ;
external 'kernel32.dll' name 'GetDiskFreeSpaceExA' ;
{ See also EFG's D3DiskSpaceKludge.ZIP via
  http://homepages.borland.com/efg2lab/Library/Delphi/IO/DisksDrives.htm }
{$ENDIF 1st para need not be drive root}



var
GivenPath : S255 ;
SR : TSR ;
DR : record DosSize, DosFree, DosUsed : longint ;
{$IFDEF DELPHI}
 Available, SizeTotal, FreeTotal : Comp ;
 SPC, BPS, NFC, TNC : integer ;
{$ENDIF}
end ;


procedure GetDriveData16(const St : S255) ;
var BB : byte ; DL : char ;
begin with DR do begin
    DL := UpCase(St[1]) ;
    BB := Ord(DL) - Ord('@') ;
    DosSize := DiskSize(BB) ;
    DosFree := DiskFree(BB) ;
    DosUsed := DosSize - DosFree ;
    end end {GetDriveData16} ;



{$IFDEF DELPHI}
procedure GetDriveData32(St : S255) ;
var This : PAnsiChar ;
const Disc : array [0..3] of char = 'C:\' {compatible with PChar } ;
begin with DR do begin
    Disc[0] := St[1] ;
    St := St+#0 ; This := @St[1] ;
    if not
      GetDiskFreeSpaceExA(This, Available, SizeTotal, FreeTotal)
      then DAI('GetDiskFreeSpaceExA failed on '+St, 1) ;
    if not GetDiskFreeSpace(Disc, SPC, BPS, NFC, TNC)  {Win32 Help}
      then DAI('GetDiskFreeSpace failed on '+St, 1) ;
    end end {GetDriveData32} ;
{$ENDIF}



procedure WJDosFileDate(const FW : integer) ;
begin WriteJust(DOSDateStamp(SR.Time), FW, 0) end {WJDosFileDate} ;


procedure WJDosFileNameExt(const FW : integer ; const QQ : char) ;
var St : S40 ; Pt : byte ;
begin
  {$IFDEF DELPHi}
  St := SR.FindData.cAlternateFileName ; if St='' then {$ENDIF}
  St := SR.Name ;
  Pt := Pos('.', St) ;
  if Pt=0 then begin St := St + '.' ; Pt := Length(St) end ;
  case QQ of
    'F' : WriteJust(St,                  FW, -12) ;
    'N' : writeJust(Copy(St,   1, Pt-1), FW,  -8) ;
    'X' : WriteJust(Copy(St, Pt+1, 255), FW,  -4) ;
    end ;
  end {WJDosFileNameExt} ;


procedure WJDosAttrNumber(const FW : integer) ;
begin
  WriteJust(IntStr(SR.Attr), FW, +3) ;
  end {WJDosAttrNumber} ;


{$IFDEF BORPAS}

procedure WJDosAttribute(const FW : integer ; const QQ : char) ;
type B8 = set of 0..7 ;
const St : string [8] = 'RHSVDAFG' ;
var Pt : byte ; Ch : char ;
begin
  Pt := Pos(UpCase(QQ), St) ;
  if Pred(Pt) in B8(SR.Attr) then Ch := St[Pt] else Ch := ',' ;
  WriteJust(Ch, FW, 0) ;
  end {WJDosAttribute} ;


procedure WJDosFileSize(const FW : integer) ;
begin
  WriteJustComma(IntStr(SR.Size), FW, +10{+3*Ord(Commas)}) ;
  end {WJDosFileSize} ;


function Upper(St : S255) : S255 ;
var JJ : byte ;
begin for JJ := 1 to Length(St) do St[JJ] := UpCase(St[JJ]) ;
  Upper := St end {Upper} ;



procedure WJDosFilePath
  (const FW : integer ; const QQ : char ; const That : S255) ;
var St : S255 ; DS : DirStr ; NS : NameStr ; ES : ExtStr ;
begin
  if QQ='p' then begin FSplit(FExpand(That), DS, NS, ES) ; St := DS end ;
  if QQ='P' then St :=        FExpand(That) ;
  WriteJust(Upper(St), FW, 0) ;
  end {WJDosFilePath} ;

{$ENDIF BORPAS}


{$IFDEF DELPHI}

function GetLongPathName(const St : S255) : S255 ;
var TSR : TSearchRec ; Temp : string [255] ; PP : byte ;
begin
  Result := Copy(St, 1, 2) ; Temp := Copy(St, 4, 255) + '\' ;
  repeat
    PP := Pos('\', Temp) ;
    Result := Result + '\' ;
    FindFirst(Result + Copy(Temp, 1, PP-1), $3F, TSR) ;
    Result := Result + TSR.Name ;
    SysUtils.FindClose(TSR) ;
    Delete(Temp, 1, PP) ;
    until Temp='' ;
  end {GetLongPathName} ;


procedure WJWinFilePath
  (const FW : integer ; const QQ : char ; const That : S255) ;
const BS = 260 ;
var St : S255 ; Bf : array [0..BS] of byte ; KK : byte ;
begin
  St := ExpandFileName(That)  ;
  if QQ in ['a'..'z'] then St := ExtractFilePath(St) ;

  case UpCase(QQ) of
    'E' : begin
      St := St+#0 ;
      KK := GetShortPathName(@St[1], @Bf[1], BS) ;
      St[0] := char(KK) ;
      Move(Bf[1], St[1], KK) ;
      end ;
    'U' : St := GetLongPathName(St) ;
    end {case} ;

  WriteJust(St, FW, 0) ;
  end {WJWinFilePath} ;




(*
FILETIME = record dwLowDateTime, dwHighDateTime : DWORD end ;
{ 100ns from 1601-01-01 }

TWin32_Find_Data = record
  dwFileAttributes : DWORD ;
  ftCreationTime, ftLastAccessTime, ftLastWriteTime : FILETIME ;
  nFileSizeHigh, nFileSizeLow, dwReserved0, dwReserved1 : DWORD ;
  cFileName : array [ 0 .. MAX_PATH ] of char ;
  cAlternateFileName : array [ 0 .. 14 ] of char
  end ;
  *)


function WinFileDate(var TT : TFileTime) : S40 ;
var TDT : TDateTime ; Yr, Mo, Dy, Hr, Mn, Sc, ms : word ;
var TFT : TFileTime {scratch} ;
begin
  if not LocalTime then TFT := TT else
    if not FileTimeToLocalFileTime(TT, TFT) then DAI('LocalTimeFail', 7) ;
  TDT := comp(TFT)/8.64E11 - 109205 ;
  DecodeDate(TDT, Yr, Mo, Dy) ; DecodeTime(TDT, Hr, Mn, Sc, ms) ;
  Result := FormedTime(Yr, Mo, Dy, Hr, Mn, Sc, ms) ;
  end {WinFileDate} ;


function MakeComp(const HH, LL : DWORD) : comp ;
type XX = record LD, HD : DWORD end ;
begin XX(Result).HD := HH ; XX(Result).LD := LL end {MakeComp} ;


procedure WJWinFileSize(const FW : integer) ;
begin with SR.FindData do
  WriteJustComma(CompStr(MakeComp(nFileSizeHigh, nFileSizeLow)),
   FW, +14{+4*Ord(Commas)}) ;
  end {WJWinFileSize} ;


procedure WJWinAttrNumber(const FW : integer) ;
begin
  WriteJust(IntStr(SR.FindData.dwFileAttributes), FW, +8) ;
  end {WJWinAttrNumber} ;


procedure WJWinAttribute(const FW : integer ; const QQ : char) ;
var XX : DWORD ; Ch : char ;
begin XX := 0 ; Ch := ',' ;
  case QQ of
    'r' : XX := { FILE_ATTRIBUTE_READONLY   } $0001 ;
    'h' : XX := { FILE_ATTRIBUTE_HIDDEN     } $0002 ;
    's' : XX := { FILE_ATTRIBUTE_SYSTEM     } $0004 ;
    'd' : XX := { FILE_ATTRIBUTE_DIRECTORY  } $0010 ;
    'a' : XX := { FILE_ATTRIBUTE_ARCHIVE    } $0020 ;
    'n' : XX := { FILE_ATTRIBUTE_NORMAL     } $0080 ;
    't' : XX := { FILE_ATTRIBUTE_TEMPORARY  } $0100 ;
    'c' : XX := { FILE_ATTRIBUTE_COMPRESSED } $0800 ;
    'o' : XX := { FILE_ATTRIBUTE_OFFLINE    } $1000 ;
    end {QQ} ;
  if (XX and SR.FindData.dwFileAttributes) <> 0 then Ch := UpCase(QQ) ;
  WriteJust(Ch, FW, 0) ;
  end {WJWinAttribute} ;


procedure WJWinFileDate(const FW : integer ; const QQ : char) ;
var St : S40 ;
begin with SR.FindData do case QQ of
    'C' : St := WinFileDate(ftCreationTime) ;
    'R' : St := WinFileDate(ftLastAccessTime) ;
    'W' : St := WinFileDate(ftLastWriteTime) ;
    end ;
  WriteJust(St, FW, 0) ;
  end {WJWinFileDate} ;


procedure WJWinExcludeAttr(const FW : integer) ;
begin with SR do
  WriteJust(IntStr(ExcludeAttr), FW, +12) ;
  end {WJWinExcludeAttr} ;


procedure WJWinShortName(const FW : integer) ;
begin with SR.FindData do
  WriteJust(cAlternateFileName, FW, -12) ;
  end {WJWinShortName} ;


procedure WJWinLongName(const FW : integer ; const QQ : char) ;
begin
  WriteJust(StrPas(SR.FindData.cFileName), FW, 0) ;
  end {WJWinLongName} ;

{$ENDIF DELPHI}



procedure WriteFileField(const FW : integer ; const Ch : char) ;
const NoPMsg = 'No P with such a "."' ;
begin case Ch of

    'B' : WJDosAttrNumber(FW) ;
    'F', 'N', 'X' : WJDosFileNameExt(FW, Ch) ;
    'D' : WJDosFileDate(FW) ;

    {$IFDEF BORPAS}
    'S' : WJDosFileSize(FW) ;
    'r', 'h', 's', 'v', 'd', 'a', 'f', 'g' : WJDosAttribute(FW, Ch) ;
    'P', 'p' : if CannotDoPath then DAI(NoPMsg, 7) else
       WJDosFilePath(FW, Ch, GivenPath + SR.Name) ;
    {$ENDIF BORPAS}

    {$IFDEF DELPHI}
    'S' : WJWinFileSize(FW) ;
    'A' : WJWinAttrNumber(FW) ;
    'a', 'c', 'd', 'h', 'n', 'o', 'r', 's', 't' : WJWinAttribute(FW, Ch) ;
    'C', 'R', 'W' : WJWinFileDate(FW, Ch) ;
    'K' : WJWinExcludeAttr(FW) ;
    'Q' : WJWinShortName(FW) ;
    'L' : WJWinLongName(FW, Ch) ;
    'P', 'p' , 'E', 'e', 'U', 'u' : if CannotDoPath then DAI(NoPMsg, 7) else
       WJWinFilePath(FW, Ch, GivenPath + SR.Name) ;
    'z' : LocalTime := true ;
    'Z' : LocalTime := false ;
    {$ENDIF DELPHI}

     else DAI('Unknown field ''' + Ch + '''', 1) ;
    end {case Ch} ;
  end {WriteFileField} ;




procedure WriteDriveField(const FW : integer ; const Ch : char ;
  const Diry : string) ;
var QQQ : longint ; {$IFDEF DELPHI} Ans : Comp ; {$ENDIF}
begin with DR do begin
  QQQ := -1 ; {$IFDEF DELPHI} Ans := -1 ; {$ENDIF}
  case Ch of
    's' : QQQ := DosSize ;
    'f' : QQQ := DosFree ;
    'u' : QQQ := DosUsed ;
    {$IFDEF DELPHI}
    'A' : Ans := Available ;
    'F' : Ans := FreeTotal ;
    'S' : Ans := SizeTotal ;
    'U' : Ans := SizeTotal-FreeTotal ;

    'G' : begin Ans := BPS*SPC ;
      Writeln(' GetDiskFreeSpace ', Diry, ^M^J,
        '  BPS=', BPS, ' SPC=', SPC, ' TNC=', TNC, ' NFC=', NFC,
        '  Total=', Comma(CompStr(Ans*TNC)),
        ' Free=', Comma(CompStr(Ans*NFC)), #32) ;
      Writeln(' GetDiskFreeSpaceExA ', Diry, ^M^J,
        '  SizeTotal=', Comma(CompStr(SizeTotal)),
        ' FreeTotal=', Comma(CompStr(FreeTotal)),
        ' Available=', Comma(CompStr(Available)), #32) ;
      EXIT end ;

    {$ENDIF}
    else DAI('Unknown field ''' + Ch + '''', 1) ;
    end {case Ch} ;

  if Ch>='a'
    then WriteJustComma( IntStr(QQQ), FW, +10{+3*Ord(Commas)})
    {$IFDEF DELPHI}
    else WriteJustComma(CompStr(Ans), FW, +14{+4*Ord(Commas)}) {$ENDIF}
    ;

  end end {WriteDriveField} ;


var DiryName : string ;
var Gap : integer ; NotFirst : boolean ;


procedure WriteTheField(const FW : integer ; const Ch : char) ;
begin
  if NotFirst then Write('':Gap) else NotFirst := true ;
  case UpCase(DiryName[1]) of
    #0       : WriteFileField(FW, Ch) ;
    'A'..'Z' : WriteDriveField(FW, Ch, DiryName) ;
    else DAI('Not a drive : '+DiryName, 6) ;
    end {case DN1} ;
  end {WriteTheField} ;


procedure GotThatChar(var Pt : byte ; const Cmnd : S127) ;
var FW, Sg : integer ; Ch : char ;
begin
  { if Cmnd[Pt]=ThatChar then begin Write(ThatChar) ; Inc(Pt) ; EXIT end ; }
  FW := 0 ; Sg := +1 ;
  if Cmnd[Pt] in ['-', '+'] then begin
    if Cmnd[Pt] = '-' then Sg := -1 ;
    Inc(Pt) end ;
  while Cmnd[Pt] in ['0'..'9'] do begin
    FW := FW*10 + (Ord(Cmnd[Pt])-48) ; Inc(Pt) end ;
  FW := FW*Sg ; Ch := Cmnd[Pt] ; Inc(Pt) ;
  { if Ch='^' then begin ThatChar := Cmnd[Pt] ; Inc(Pt) ; EXIT end ; }
  case Ch of
    'A'..'Z', 'a'..'z' : WriteTheField(FW, Ch) ;
    ':' : Gap := FW ;
    ',' : Commas := Odd(FW) ;
    { '(', ')', '[', ']', '\' : Write(Ch) ;        }
    '_' : Write('':FW) ;
    '&' : DateOrder := FW ;
    '@' : ;
    else DAI('Unknown ''' + Ch + ''' after special in ' + Cmnd, 1) ;
    end {case} ;
  end {GotThatChar} ;


procedure WriteResultLine(const Cmnd : S127) ;
var Pt : byte ; Ch : char ;
begin
  NotFirst := false ; Gap := 1 ;
  Pt := 1 ;
  while Pt<=Length(Cmnd) do begin Ch := Cmnd[Pt] ; Inc(Pt) ;
    if Ch=ThatChar then GotThatChar(Pt, Cmnd) else
      case Ch of
        '(' : ReadDateTimeForm(Cmnd, Pt) ;
        '[' : ReadMonthNames(Cmnd, Pt) ;
        '''' : Write('"') ;
        '\' : begin Ch := Cmnd[Pt] ; Inc(Pt) ;
          case Ch of
            '^' : begin ThatChar := Cmnd[Pt] ; Inc(Pt) end ;
            'n' : Writeln ;
            't' : Write(^I) ;
            's' : Write(#32) ;
            'c' : write('^') ;
            else if not (UpCase(Ch) in ['0'..'9', 'A'..'Z'])
              then Write(Ch) else DAI('Unknown \'+Ch, 8) ;
            end ;
          end ;
        else Write(Ch) ;
      end ;
    end {<=} ;
  Writeln end {WriteResultLine} ;


procedure DoParameter(const St : string) ; forward ;


procedure RunScript(const FN : string) ;
var Fi : text ; IOR : integer ; St : string ;
begin
  Assign(Fi, FN) ; {$I-} Reset(Fi) ; IOR := IOResult {$I+} ;
  if IOR<>0 then DAI('Script "' + FN + '" not found', 2) ;
  while not EoF(Fi) do begin
    Readln(Fi, St) ; if St>'' then DoParameter(St) end ;
  Close(Fi) end {RunScript} ;


procedure DotCheck(const St : string) ;
var JJ : byte ; BB : boolean ; Ch : char ;
begin BB := false ; CannotDoPath := false ;
  for JJ := Length(St) downto 1 do begin Ch := St[JJ] ;
    if Ch='\' then begin if BB then CannotDoPath := true ; EXIT end ;
    BB := Ch='.' ;
    end ;
  CannotDoPath := BB ;
  end {DotCheck} ;


procedure SaveGivenPath(const St : string) ;
var KK : byte ;
begin
  { if St='.' then begin GivenPath := '' ; EXIT end ;  {??}
  KK := 0 ;
  GivenPath := Copy(St, 1, KK) ;
  { Writeln(' ### GP "', GivenPath, '" ###') ; }
  end {SaveGivenPath} ;



{ Mere Defaults : }

const
InfoLen = 255 ;
DriveInfoString : string [InfoLen] =
  {$IFDEF BORPAS} '#s#f#u' {$ENDIF}
  {$IFDEF DELPHI} '#1,#G#A#F#S#U' {$ENDIF}
  ;
FileInfoString : string [InfoLen] =
  {$IFDEF BORPAS} '#D#F#S#0: #r#h#s#v#d#a#f#g #1:#P' {$ENDIF}
  {$IFDEF DELPHI} '#D#F#8S#0: #r#h#s#@#d#a#n#t#c#o ''#U''' {$ENDIF}
  ;


{$IFDEF DELPHI} const WantGetDisk32 : boolean = false ; {$ENDIF}

procedure DoParameter(const St : string) ;
{$IFDEF DELPHI} var DosError  : integer ; {$ENDIF}
begin

  if St[1]='/' then begin
    if (Length(St)>1) then case St[2] of
      '@' : RunScript(Copy(St, 3, 255)) ;
      ':' : DriveInfoString := Copy(St, 3, 255) ;
      '/' : ;
      else FileInfoString := Copy(St, 2, 255) ;
      end ;
    EXIT end ;

  if (Length(St)=2) and (St[2]=':') then begin
    DiryName := St ;
    GetDriveData16(St) ;
    {$IFDEF DELPHI} GetDriveData32(St+'\') ; {$ENDIF}
    WriteResultLine(DriveInfoString) ;
    EXIT end ;

  {$IFDEF DELPHI}
  if WantGetDisk32 then begin
    DiryName := St ;
    GetDriveData32(St) ;
    WriteResultLine(DriveInfoString) ;
    EXIT end ;
  {$ENDIF}

  DiryName := #0 ;

  SaveGivenPath(St) ;

  DotCheck(St) ;

  FillChar(SR, SizeOf(SR), 0) ;

  {$IFDEF DELPHI} DosError := {$ENDIF} FindFirst(St, $3F, SR) ;

  if DosError<>0 then
    DIE('Name "' + St + '" not found, DosError=' + IntStr(DosError), 2) ;
  { Why does Pascal not find CON when Delphi & HUNT do ? }

  while DosError=0 do begin
    WriteResultLine(FileInfoString) ;
    {$IFDEF DELPHI} DosError := {$ENDIF} FindNext(SR) ;
    end ;
  {$IFDEF DELPHI} SysUtils.FindClose(SR) ; {$ENDIF}

  end {DoParameter} ;



procedure MainProcess ;
var St : S255 ; KK : integer ;
begin
  for KK := 1 to ParamCount do begin St := ParamStr(KK) ;
    if St='/;' then BREAK ;
    {$IFDEF DELPHI}
    if St='/+' then begin WantGetDisk32 :=  true ; CONTINUE end ;
    if St='/-' then begin WantGetDisk32 := false ; CONTINUE end ;
    {$ENDIF}
    DoParameter(St) end ;
  end {MainProcess} ;


procedure ReadEnvironment ;
const FGC : string [10] = 'FILGENCMD'#0 ;
var St : string [InfoLen] ; KK : integer ;
begin
  {$IFDEF BORPAS} Dec(FGC[0]) ; St := GetEnv(FGC) ; {$ENDIF}
  {$IFDEF DELPHI}
  KK := GetEnvironmentVariable(@FGC[1], @St[1], InfoLen) ;
  SetLength(St, KK) ;
  {$ENDIF}
  if St>'' then FileInfoString := St ;
  end {ReadEnvironment} ;


BEGIN ;
if (ParamCount=0) or (ParamStr(1)='/?') then HELP ;
FileMode := 0 ;
FindLocaleDefaults ;
ReadEnvironment ;
MainProcess ;
END.