[Back to MISC SWAG index] [Back to Main SWAG index] [Original]
Program GifCommR;
{
ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ
ÛÛÛÝÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÞÛÛÛ±±
ÛÛÛÝÛÛ ÛÛÞÛÛÛ±±
ÛÛÛÝÛÛ GIF Comments Remover ÛÛÞÛÛÛ±±
ÛÛÛÝÛÛ ÛÛÞÛÛÛ±±
ÛÛÛÝÛÛ Aleksandar Dlabac ÛÛÞÛÛÛ±±
ÛÛÛÝÛÛ (C) 1997. Dlabac Bros. Company ÛÛÞÛÛÛ±±
ÛÛÛÝÛÛ ------------------------------ ÛÛÞÛÛÛ±±
ÛÛÛÝÛÛ adlabac@urcpg.urc.cg.ac.yu ÛÛÞÛÛÛ±±
ÛÛÛÝÛÛ adlabac@urcpg.pmf.cg.ac.yu ÛÛÞÛÛÛ±±
ÛÛÛÝÛÛ ÛÛÞÛÛÛ±±
ÛÛÛÝßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÞÛÛÛ±±
ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ±±
±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±
}
Uses Crt;
Var I, Pos : word;
B : byte;
NumCol : word;
St : string;
Terminate : Boolean;
Src, Dest : file;
Buff : array [1..10000] of byte;
Begin
ClrScr;
Writeln ('GIFCommR - Removes comments from GIF files');
Writeln ('Copyrights (C) Aleksandar Dlabac, 1997.');
Writeln;
If ParamCount<>2 then
Begin
Writeln (' USAGE: GIFKom In_file Out_file');
Halt;
End;
Assign (Src,ParamStr (1));
Assign (Dest,ParamStr (2));
{$I-}
Reset (Src,1);
{$I+}
If IOResult<>0 then
Begin
Writeln ('Error reading file ',ParamStr (1));
Halt;
End;
St [0]:=#4;
BlockRead (Src,St [1],4);
If St<>'GIF8' then
Begin
Writeln ('Invalid GIF header.'#7);
Halt
End;
Seek (Src,10);
BlockRead (Src,B,1);
If B<$80 then
Begin
Writeln ('Onlu for global palette.'#7);
Halt
End;
NumCol:=1 shl (B and 7+1); { Number of colors in palette }
{$I-}
Rewrite (Dest,1);
{$I+}
If IOResult<>0 then
Begin
Writeln ('Error opening file ',ParamStr (2));
Halt;
End;
Seek (Src,0);
BlockRead (Src,Buff [1],13+NumCol*3); { Save header and palette }
BlockWrite (Dest,Buff [1],13+NumCol*3); { in new file. }
Terminate:=False;
Repeat
BlockRead (Src,B,1);
If not (B in [$21,$2C,$3B]) then { Known block separators }
Begin
Close (Dest);
Erase (Dest);
Writeln ('Illegal separator.'#7);
Halt
End;
Case B of
$21 : Begin { Extension block }
BlockRead (Src,B,1);
If B=$FE then { Is it Comment? }
Begin
Buff [1]:=$21;
Buff [2]:=$FE;
Pos:=3;
St:='';
Repeat
BlockRead (Src,B,1);
Buff [Pos]:=B;
Inc (Pos);
If B>0 then
Begin
BlockRead (Src,Buff [Pos],B);
If Length (St)<255 then
For I:=Pos to Pos+B-1 do
St:=St+Chr (Buff [I]);
Inc (Pos,B)
End
Until B=0;
I:=1;
{ While loop below converts 0Dh or 0Ah characters into 0Dh 0Ah pair. GWS, for
example uses only 0Dh. Program works the same without this loop, but
comment text on screen could be scrambled. }
While I<=Length (St) do
Begin
While (I<=Length (St)) and not (St [I] in [#$0D,#$0A]) do
Inc (I);
If I<=Length (St) then
If I=Length (St) then
If St [I]=#$0D then
St:=St+#$0A
else
St:=St+#$0D
else
Begin
If not ((St [I]=#$0D) and (St [I+1]=#$0A)) and
not ((St [I]=#$0A) and (St [I+1]=#$0D)) then
St:=Copy (St,1,I-1)+#$0D#$0A+Copy (St,I+1,Length (St)-I);
Inc (I)
End;
Inc (I)
End;
ClrScr;
Writeln ('Comment:');
Writeln ('---------');
Writeln (St);
Writeln ('---------');
Write ('Remove (Y/N): ');
Repeat
B:=Ord (UpCase (ReadKey))
Until B in [27,Ord ('Y'),Ord ('N')];
Writeln (Chr (B));
If B=27 then
Begin
Close (Dest);
Erase (Dest);
Halt
End;
If B=Ord ('N') then
BlockWrite (Dest,Buff [1],Pos-1)
End
else
Begin { Block is not comment }
Buff [1]:=$21;
Buff [2]:=B;
BlockWrite (Dest,Buff [1],2);
Repeat
BlockRead (Src,B,1);
Buff [1]:=B;
If B>0 then
BlockRead (Src,Buff [2],B);
BlockWrite (Dest,Buff [1],B+1)
Until B=0
End
End;
$2C : Begin { Graphics }
Buff [1]:=$2C;
BlockRead (Src,Buff [2],10);
BlockWrite (Dest,Buff [1],11);
Repeat
BlockRead (Src,B,1);
BlockWrite (Dest,B,1);
If B>0 then
Begin
BlockRead (Src,Buff [1],B);
BlockWrite (Dest,Buff [1],B)
End
Until B=0
End;
$3B : Begin { GIF Terminator }
BlockWrite (Dest,B,1);
Terminate:=True
End
End
Until Eof (Src) or Terminate;
Close (Src);
Close (Dest)
End.
[Back to MISC SWAG index] [Back to Main SWAG index] [Original]