[Back to DIRS SWAG index] [Back to Main SWAG index] [Original]
Program GIFDIR(Input, Output);
Uses Dos, Crt;
Const
ProSoft = ' Gif DIRectory - Version 2.0 (C) ProSoft '+Chr(254)+' Phil R. Overman 02-02-92';
gifliteheader = chr($21)+chr($FF)+chr(11)+'GIFLITE';
giflitesearch = 100;
ScreenLines = 23;
Maxlinelength = 80;
test0 = false;
test1 = true;
(*
{$I-}
*)
Type
String12 = String[12];
LineType = Packed Array[1..Maxlinelength] of char;
LengthType = 0..Maxlinelength;
String2 = String[2];
String3 = String[3];
String8 = Packed Array[1..8] of char;
{ String12 = Packed Array[1..12] of char; }
String15 = String[15];
Var
dodate, dotime, domegs, doextension : boolean;
doversion, dopalette, doGCT : boolean;
dofiledot, doall, dogiflite : boolean;
CmtFound, Pause, ShowZips, isgif : Boolean;
CmtSize, FileCount, LinesWritten : Word;
attr, height, width, colors : Word;
fileattr : word;
TotalSize, position : Longint;
filesize, filedate : longint;
icount, jcount : integer;
count, clen : Byte;
megs : real;
DirInfo, gifdirinfo : Searchrec;
Path, Gifpath, filein : PathStr;
Dir : DirStr;
Name, infdatestring, gifname : NameStr;
Ext : ExtStr;
A, B, C, cc, ch, eoname : Char;
Abyte : Byte;
cs : String[1];
meg : String2;
gversion, gheader : String3;
filename : String[12];
infile, outfile : text;
giffile : file;
infdt, filedt : datetime;
giffilein : String15;
Drive : String2;
GCTF {1 Bit} : boolean;
ColorResolution {3 Bits} : byte;
SortFlag {1 Bit} : boolean;
SizeOfGCT {3 Bits} : byte;
giflite : boolean;
BackgroundColorIndex : Byte;
PixelAspectRatio : Byte;
SizeofPalette : Longint;
{ Cmt : CmtType; }
(***************************************************************)
Procedure BadParms;
begin
writeln(' Program syntax: GDIR [d:\Path][Filename[.GIF]] [/p/a/d/t/m/f/v/g/r/?|h]');
{ writeln; }
writeln(' Displays standard DOS DIR of GIF files, but with height, width, and colors');
{ writeln; }
writeln(' Output looks like this (with no parameters):');
{ writeln; }
writeln(' GIFNAME GIF 178152 5-11-91 640h 400w 256c');
writeln;
{ writeln('Enter *.* to display all files (normal Dir).'); }
writeln(' Parameters:');
writeln(' /P Pauses the display, just as in the DOS Dir command.');
writeln(' /A Displays complete information, except time.');
writeln(' /D turns display of the file Date off.');
writeln(' /T turns display of the file Time on.');
writeln(' /M shows size in Megabytes instead of bytes.');
writeln(' /F displays GIFNAME.GIF instead of GIFNAME GIF');
writeln(' /E suppress display of the extension.');
writeln(' /G Check if file optimized by GIFLITE and display it if so.');
writeln(' /V displays the Version of the GIF file - GIF87a, GIF89a, etc.');
writeln(' /C displays "GCM" if the file has a Global Color Map');
writeln(' /R Resolution - displays the total number of colors in the pallette');
writeln(' /H or /? displays this Help screen.');
if Doserror > 0 then writeln;
If Doserror = 18 then Writeln(' File not found');
If Doserror = 3 then writeln(' Path not found');
if Doserror > 0 then writeln;
halt(98);
end;
(************************************************)
Procedure FlipB(Var f : boolean);
Begin
If f then f := false else f := true;
End;
(************************************************)
Procedure ProcessParms(s : string);
var sr : searchrec;
Begin
If (pos('/',s) = 1) Then
Begin
If (Copy(s,2,1) = 'P') or (Copy(s,2,1) = 'p') then Pause := true;
If (Copy(s,2,1) = 'D') or (Copy(s,2,1) = 'd') then Flipb(dodate);
If (Copy(s,2,1) = 'T') or (Copy(s,2,1) = 't') then Flipb(dotime);
If (Copy(s,2,1) = 'M') or (Copy(s,2,1) = 'm') then Flipb(domegs);
If (Copy(s,2,1) = 'F') or (Copy(s,2,1) = 'f') then Flipb(dofiledot);
If (Copy(s,2,1) = 'V') or (Copy(s,2,1) = 'v') then Flipb(doversion);
If (Copy(s,2,1) = 'R') or (Copy(s,2,1) = 'r') then Flipb(dopalette);
If (Copy(s,2,1) = 'G') or (Copy(s,2,1) = 'g') then Flipb(dogiflite);
If (Copy(s,2,1) = 'C') or (Copy(s,2,1) = 'c') then Flipb(doGCT);
If (Copy(s,2,1) = 'E') or (Copy(s,2,1) = 'e') then Flipb(doextension);
If (Copy(s,2,1) = 'A') or (Copy(s,2,1) = 'a') then
Begin
Flipb(doall);
dodate := true; dotime := false; dofiledot := false;
domegs := false; doversion := true; dopalette := false;
doGCT := true; doextension := true; dogiflite := true;
End;
If (Copy(s,2,1) = 'H') or (Copy(s,2,1) = 'h') or (Copy(s,2,1) = '?') then Badparms;
End
Else
Begin
Path := FExpand(s);
{ If Copy(Path,Length(Path),1) = '\' then Path := Path + '*.GIF'; }
{ If Pos('.',path) = 0 then path := path + '.GIF'; }
{ If Pos('*',Path) + Pos('?',path) + Pos('.GIF',path) = 0
then
begin
FindFirst(Path,$10,sr);
If Doserror = 0 then Path := Path + '\*.gif';
end; }
End;
End;
(*******************)
Function Exponential(A:integer; B:byte):longint;
Var yyy : longint;
(* Returns A to the Bth *)
Begin
yyy := A;
For count := 2 to B Do yyy := yyy * A;
If b=0 then Exponential := 1 else Exponential := yyy;
End;
(**********************************)
Function BV(A:byte; b:byte):byte; {BitValue}
var aa : byte;
(* A is the byte value - b is the bit # for which the value is desired 1-8 *)
Begin
aa := a;
While aa >= Exponential(2,b) do dec(aa,Exponential(2,b));
If aa < Exponential(2,b-1) then BV := 0 else BV := 1;
End;
(***********************)
Procedure ClearName;
Begin
For count := 1 to 12 do DirInfo.name[count] := ' ';
End;
(**************************)
Procedure ClearABC;
Begin
A := ' '; B := ' '; C := ' ';
End;
(*******************)
{
Procedure ClearCmt;
Begin
CmtFound := False;
for count := 1 to MaxCmtSize do Cmt[count] := ' ';
End;
}
(*******************)
Procedure WriteName(n : String12);
Var p, q, qq, r : byte;
Begin
p := 0; q := 0; r := 0;
If doextension then qq :=12 else qq := 8;
While r < length(n) DO
Begin
inc(p);
inc(r);
if (n[p] = '.') and not dofiledot
then
Begin
If p < 9 then write(' ':9-p);
inc(q, 9-p);
If doextension then
Begin
write(' ');
inc(q);
End;
End
else
begin
If (p<9) or doextension then
begin
write(n[p]);
inc(q);
end;
end;
End;
If q < qq then write(' ':qq-q);
End;
(********************************)
Procedure WriteDate(i : longint);
Var d : datetime;
Begin
Unpacktime(i,d);
If d.month > 9 then Write(d.month,'-') else Write('0',d.month,'-');
If d.day > 9 then Write(d.day) else Write('0',d.day);
Write('-',d.year mod 100);
Write(' ');
End;
(********************************)
Procedure WriteTime(i : longint);
Var d : datetime;
Begin
Unpacktime(i,d);
Write(' ');
if d.hour = 0 then Write('12') else if d.hour mod 12 > 9 then Write(d.hour mod 12) else write(' ',d.hour mod 12);
if d.min = 0 then Write(':00') else if d.min > 9 then write(':',d.min) else Write(':0',d.min);
If d.hour > 11 then Write('p ') else Write('a ');
End;
(*****************************************************)
Procedure Writeline(s : Searchrec);
Var xx : byte; ss: string[1];
Begin
Writename(s.name);
If domegs or doextension then
Begin
xx := (s.size+5120) div 10240;
If xx < 10
then
begin
Str(xx:1, ss);
meg := '0' + ss
end
else
Str(xx:2, meg)
End;
If domegs then Write(' .',meg,' ') else Write(s.size:10);
Write(' ');
If dodate then Writedate(s.time);
If dotime then WriteTime(s.time);
If isgif then
Begin
Write(height:4,'h',width:4,'w',colors:4,'c ');
If dopalette then Write(sizeofpalette,'R ');
If doversion then Write (' ',gversion,' ');
If doGCT then begin if GCTF then Write(' GCM ') else write(' ') end;
If doGIFLITE then begin if GIFLITE then Write(' GL ') else write(' ng ') end;
End;
Writeln;
End;
(****************************************************)
Procedure ProcessGifFile;
Var result : word;
BEGIN
Assign(GifFile, Concat(Dir,DirInfo.name));
Reset(GifFile, 1);
isgif := false;
inc(filecount);
inc(totalsize,dirinfo.size);
ClearABC;
(* See if it's a GIF file. *)
Result := Pos('.',Dirinfo.name);
If (result > 0) and
(Copy(DirInfo.name,result,Length(DirInfo.name)-result+1) = '.GIF')
then isgif := true;
{ Result := Filesize; }
If isgif { and (result>12) }
then
Begin
blockread(GifFile, A, 1, result);
blockread(GifFile, B, 1, result);
blockread(GifFile, C, 1, result);
gheader := A + B + C;
End;
If gheader = 'GIF'
Then
Begin {GifFileFound!}
blockread(GifFile, A, 1, result);
blockread(GifFile, B, 1, result);
blockread(GifFile, C, 1, result);
gversion := A + B + C;
blockread(GifFile, height, 2, result);
blockread(GifFile, width, 2, result);
blockread(GifFile, Abyte, 1, result);
SizeOfGCT := BV(Abyte,1) + BV(Abyte,2)*2 + BV(Abyte,3)*4 +1;
colors := Exponential(2,SizeOfGCT);
If BV(Abyte,4) = 1 then SortFlag := true else SortFlag := false;
ColorResolution := BV(Abyte,5) + BV(Abyte,6)*2 + BV(Abyte,7)*4 +1;
SizeOfPalette := Exponential(2,ColorResolution);
SizeOfPalette := Exponential(SizeofPalette,3);
If BV(Abyte,8) = 1 then GCTF := true else GCTF := false;
Blockread(GifFile, BackgroundColorIndex, 1);
Blockread(GifFile, PixelAspectRatio, 1);
If dogiflite
then
Begin
giflite := false;
icount := 0;
count := 1;
jcount := giflitesearch;
If GCTF then inc(jcount,3*colors);
While (icount < jcount) and not giflite do
Begin
Blockread(Giffile, A, 1, result);
If A = Copy(gifliteheader, count, 1) then
Begin
If count = length(gifliteheader)
then
giflite := true
else
inc(count)
End;
Inc(icount);
End;
End;
End;
Writeline(DirInfo);
Close(GifFile);
Inc(LinesWritten);
END;
(**********************)
Procedure WriteVolLabel;
Var v : searchrec; c : byte;
Begin
FindFirst(Copy(Path,1,3)+'*.*',VolumeID,v);
Write(' Volume in drive ',Copy(Path,1,1),' is ');
For c := 1 to length(v.name) do if v.name[c] <> '.' then write(v.name[c]);
Writeln;
Write(' Directory of ',Copy(Dir,1,Length(Dir)-1));
If Copy(Dir,2,1) = ':' then Write('\');
Writeln;
Writeln;
End;
(***************************************)
Procedure ParseParms(pps : string);
Begin { This only gets parms with a slash / in them. }
If Pos('/',pps) <> 1 Then { This is the filename with a slash appended }
Begin
{ ProcessParms(Copy(pps,1,Pos('/',pps)-1)); }
Path := Fexpand(Copy(pps,1,Pos('/',pps)-1));
pps := Copy(pps,Pos('/',pps),Length(pps)-Pos('/',pps)+1)
End;
While (Pos('/',pps) > 0) and (Length(pps) > 1) Do
Begin
ProcessParms(Copy(pps,1,2));
pps := Copy(pps,2,Length(pps)-1);
If Pos('/',pps) > 0 then
pps := Copy(pps,Pos('/',pps),Length(pps)-Pos('/',pps)+1);
End;
End;
(***************************************)
Procedure Initialize;
Var sr : searchrec;
Begin
Assign(Input,''); Reset(Input);
Assign(Output,''); Rewrite(Output);
Writeln;
Writeln(ProSoft);
Writeln;
dodate := true; dotime := false; domegs := false; doextension := true;
dopalette := false; doGCT := false; doversion := false; pause := false;
dofiledot := false; dogiflite := true; doall := false;
gheader := ' '; gversion := ' ';
ClearABC; Clearname;
FileCount := 0; TotalSize := 0; LinesWritten := 0;
For count := 1 to Sizeof(path) do Path[count] := ' ';
For count := 1 to Sizeof(Dir) do Dir[count] := ' ';
For Count := 1 to Sizeof(Name) do Name[count] := ' ';
For count := 1 to Sizeof(Ext) do Ext[count] := ' ';
If paramcount = 0
then
Path := FExpand('*.GIF')
else
If Pos('/',paramstr(1)) = 1 then path := FExpand('*.GIF');
For Count := 1 to paramcount do If Pos('/',paramstr(count)) > 0
then
ParseParms(paramstr(count))
else
Path := Fexpand(paramstr(count));
{
FindFirst(Path,$10,sr);
If (Doserror = 0) and (sr.attr = $10) then
begin
Path := Path + '\*.gif';
Path := FExpand(Path)
end;
}
Fsplit(Path,Dir,Name,Ext);
If (name = '') or (name = ' ') then name := '*';
If (Ext = '') or (Ext = ' ') then Ext := '.GIF';
Path := Dir + Name + Ext;
End;
(******************> Main <*********************)
Begin { Main }
Initialize;
FindFirst(Path,$21,DirInfo);
If Doserror = 0
then
Begin
WriteVolLabel;
While DosError < 1 do
Begin
If (dirinfo.name = '.') or (dirinfo.name = '..')
then
For count := 1 to 12 do DirInfo.name[count] := ' '
else
ProcessGifFile;
FindNext(DirInfo);
If pause and (LinesWritten = ScreenLines) and (DosError < 1)
then
Begin
Writeln('Press any key to continue . . .');
AssignCrt(Input); Reset(Input);
AssignCrt(Output); Rewrite(Output);
ch := Readkey;
Assign(Input,''); Reset(Input);
Assign(Output,''); Rewrite(Output);
Writeln;
LinesWritten := 1;
End;
End;
Write(FileCount:9,' file');
If Filecount = 1 then Write(' ') else Write('s ');
cs := Copy(Path,1,1);
cc := cs[1];
count := ord(cc)-64;
Writeln(totalsize:12,' bytes');
Writeln(' ':16,diskfree(count):12,' bytes free ');
Writeln;
End
Else
Badparms;
End.
[Back to DIRS SWAG index] [Back to Main SWAG index] [Original]