// Autor: Sebastian Jänicke (jaenicke @ delphipraxis.net)
// [url]http://www.delphipraxis.net/post1011159.html#1011159[/url]
function SJCheckIPv6(Value: AnsiString): Boolean;
function CheckIPv4(Start: Integer): Boolean;
var
i, CurValue, DotCount: Integer;
CurDot: Boolean;
begin
Result := False;
CurValue := 0;
DotCount := 0;
CurDot := False;
for i := Start
to Length(Value)
do
case Value[i]
of
'
0'..'
9':
begin
CurValue := CurValue * 10 + Ord(Value[i]) - 48;
CurDot := False;
end;
'
.':
if (CurValue > 255)
or CurDot
or (i = Start)
then
Exit
else
begin
CurValue := 0;
CurDot := True;
Inc(DotCount);
end;
else
Exit;
end;
Result := (DotCount = 3)
and (CurValue <= 255)
and not CurDot;
end;
type
TCheckIP6State = (cisNone, cisColon, cisColonStart, cisDoubleColon,
cisHex1, cisHex2, cisHex3, cisHex4);
var
DoubleColon: Boolean;
i, CurBlock: Integer;
CurState: TCheckIP6State;
function CheckHexChars: Boolean;
begin
Result := True;
case CurState
of
cisNone, cisColon:
begin
CurState := cisHex1;
Inc(CurBlock);
if CurBlock > 8
then
Result := False;
// mehr als 8 Blöcke geht nicht
end;
cisColonStart:
Result := False;
// ein einzelnes : am Anfang geht nicht
cisDoubleColon:
begin
CurState := cisHex1;
Inc(CurBlock, 2);
if CurBlock > 8
then
Result := False;
// :: steht für mind. 1 Block, mehr als 8 geht nicht
end;
cisHex1:
CurState := cisHex2;
cisHex2:
CurState := cisHex3;
cisHex3:
CurState := cisHex4;
cisHex4:
Result := False;
// Mehr als 4 hexadezimale Zeichen hintereinander geht nicht
end;
end;
function CheckColon: Boolean;
begin
Result := True;
case CurState
of
cisNone:
CurState := cisColonStart;
cisColon:
if DoubleColon
or (CurBlock > 7)
then
Result := False
// zweimal :: geht nicht,
// außerdem steht :: für mind. 1 Block, mehr als 8 geht nicht
else
begin
CurState := cisDoubleColon;
DoubleColon := True;
end;
cisColonStart:
begin
CurState := cisDoubleColon;
DoubleColon := True;
end;
cisDoubleColon:
Result := False;
// drittes : hintereinander ist nicht erlaubt
cisHex1, cisHex2, cisHex3, cisHex4:
CurState := cisColon;
end;
end;
// Überprüfung ob IPv4 Adresse eingebettet ist
function CheckDot: Boolean;
type
TCheckIP4State = (cis4Colon, cis4DoubleColon, cis4Zero, cis4F1, cis4F2, cis4F3, cis4F4);
var
j, Start: Integer;
IP4State: TCheckIP4State;
begin
Result := False;
Start := i - 1;
while (Start > 0)
and (Value[Start] <> '
:')
do
Dec(Start);
if Start = 0
then
Exit;
IP4State := cis4Colon;
for j := Start - 1
downto 1
do
case Value[j]
of
'
f', '
F':
case IP4State
of
cis4Colon:
IP4State := cis4F1;
cis4Zero:
Exit;
cis4F1:
IP4State := cis4F2;
cis4F2:
IP4State := cis4F3;
cis4F3:
IP4State := cis4F4;
cis4F4:
Exit;
end;
'
0':
case IP4State
of
cis4Colon, cis4DoubleColon, cis4Zero:
IP4State := cis4Zero;
else
Exit;
end;
'
1'..'
9':
Exit;
'
:':
case IP4State
of
cis4Colon:
IP4State := cis4DoubleColon;
cis4DoubleColon:
Exit;
else
IP4State := cis4Colon;
end;
else
Exit;
// ungültiges Zeichen für IPv4 Einbettung
end;
if IP4State
in [cis4DoubleColon, cis4Zero]
then
Result := CheckIPv4(Start + 1);
end;
begin
Result := False;
DoubleColon := False;
CurState := cisNone;
CurBlock := 0;
for i := 1
to Length(Value)
do
case Value[i]
of
'
a'..'
f', '
0'..'
9', '
A'..'
F':
if not CheckHexChars
then
Exit;
'
:':
if not CheckColon
then
Exit;
'
.':
// Überprüfung ob IPv4 Adresse eingebettet ist
begin
if CurBlock <= 7
then
Result := CheckDot;
Exit;
end;
else
Exit;
// ungültiges Zeichen
end;
Result := (CurState <> cisColon)
and ((CurBlock = 8)
or DoubleColon);
end;