Skip to content

Latest commit

 

History

History
118 lines (98 loc) · 2.47 KB

file14.pas

File metadata and controls

118 lines (98 loc) · 2.47 KB
 
Nov 18, 2000
Nov 18, 2000
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
{$A+,B+,D-,E+,F+,I+,L+,N-,O+,R-,S+,V-}
unit file14;
interface
uses
crt,dos,
{rcg11172000 no overlay under Linux.}
{overlay,}
myio,
file0, file11,
common;
procedure getgifspecs(fn:astr; var sig:astr; var x,y,c:word);
procedure dogifspecs(fn:astr; var abort,next:boolean);
procedure addgifspecs;
implementation
procedure getgifspecs(fn:astr; var sig:astr; var x,y,c:word);
var f:file;
rec:array[1..11] of byte;
c1,i,numread:word;
begin
assign(f,fn);
{$I-} reset(f,1); {$I+}
if (ioresult<>0) then begin
sig:='NOTFOUND';
exit;
end;
blockread(f,rec,11,numread);
close(f);
if (numread<>11) then begin
sig:='BADGIF';
exit;
end;
sig:='';
for i:=1 to 6 do sig:=sig+chr(rec[i]);
x:=rec[7]+rec[8]*256;
y:=rec[9]+rec[10]*256;
c1:=(rec[11] and 7)+1;
c:=1;
for i:=1 to c1 do c:=c*2;
end;
procedure dogifspecs(fn:astr; var abort,next:boolean);
var s,sig:astr;
x,y,c:word;
begin
getgifspecs(fn,sig,x,y,c);
s:=#3#3+align(stripname(fn));
if (sig='NOTFOUND') then
s:=s+' '+#3#7+'NOT FOUND'
else
s:=s+' '+#3#5+mln(cstrl(x)+'x'+cstrl(y),10)+' '+
mln(cstr(c)+' colors',10)+' '+#3#7+sig;
printacr(s,abort,next);
end;
procedure addgifspecs;
var f:ulfrec;
gifstart,gifend,tooktime:datetimerec;
s,sig:astr;
totfils:longint;
x,y,c:word;
pl,rn,savflistopt:integer;
abort,next:boolean;
begin
nl;
print('Adding GifSpecs to files -');
nl;
recno('*.*',pl,rn);
if (baddlpath) then exit;
savflistopt:=thisuser.flistopt;
totfils:=0; abort:=FALSE; next:=FALSE;
getdatetime(gifstart);
while (rn<>0) and (pl<>0) and (rn<=pl) and
(not abort) and (not hangup) do begin
seek(ulff,rn); read(ulff,f);
if ((isgifext(f.filename)) and (not isgifdesc(f.description))) then begin
getgifspecs(memuboard.dlpath+sqoutsp(f.filename),sig,x,y,c);
if (sig<>'NOTFOUND') then begin
s:='('+cstrl(x)+'x'+cstrl(y)+','+cstr(c)+'c) ';
f.description:=s+f.description;
if (length(f.description)>54) then
f.description:=copy(f.description,1,54);
seek(ulff,rn); write(ulff,f);
pfn(rn,f,abort,next);
inc(totfils);
end;
end;
nrecno('*.*',pl,rn);
wkey(abort,next);
end;
getdatetime(gifend);
timediff(tooktime,gifstart,gifend);
thisuser.flistopt:=savflistopt;
nl;
s:='Added GifSpecs to '+cstrl(totfils)+' file';
if (totfils<>1) then s:=s+'s';
s:=s+' - Took '+longtim(tooktime);
print(s);
close(ulff);
end;
end.