unit ExpiredPassports;

interface

type
  TPassportMap= array of array of byte;

procedure MapInclude(var Map: TPassportMap; Serial, No: integer);
procedure MapExclude(var Map: TPassportMap; Serial, No: integer);
function MapTest(var Map: TPassportMap; Serial, No: integer): boolean;

procedure LoadPassportList(var Map: TPassportMap; const FileName: string);

procedure SavePassportMap(var Map: TPassportMap; const FileName: string);
procedure LoadPassportMap(var Map: TPassportMap; const FileName: string);

procedure SavePassportPacket(var Map: TPassportMap; const FileName: string);
procedure LoadPassportPacket(var Map: TPassportMap; const FileName: string);

implementation

type
  TBuffer= array[0..999999] of byte;

procedure MapInclude(var Map: TPassportMap; Serial, No: integer);
begin;
  if (Serial<0) or (Serial>9999) or (No<0) or (No>999999) then exit;
  if Length(Map)=0 then SetLength(Map, 10000);
  if Length(Map[Serial])=0 then begin;
    SetLength(Map[Serial], 125000);
    FillChar(Map[Serial,0], 125000, 0);
    end;
  Map[Serial, No shr 3]:=1 shl (No and 7) or Map[Serial, No shr 3];
  end;

procedure MapExclude(var Map: TPassportMap; Serial, No: integer);
begin;
  if (Serial<0) or (Serial>9999) or (No<0) or (No>999999) then exit;
  if Length(Map)=0 then exit;
  if Length(Map[Serial])=0 then exit;
  Map[Serial, No shr 3]:=(not (1 shl (No and 7))) and Map[Serial, No shr 3];
  end;

function MapTest(var Map: TPassportMap; Serial, No: integer): boolean;
begin;
  Result:=false;
  if (Serial<0) or (Serial>9999) or (No<0) or (No>999999) then exit;
  if Length(Map)=0 then exit;
  if Length(Map[Serial])=0 then exit;
  Result:=1 shl (No and 7) and Map[Serial, No shr 3]<>0;
  end;

function SubstrToInt(const s: string; i1, i2: integer): integer;
var
  i, c: integer;
begin;
  Result:=0;
  for i:=i1 to i2 do begin;
    c:=ord(s[i])-ord('0');
    if cardinal(c)>9 then begin;
      Result:=-1;
      exit;
      end;
    Result:=Result*10+c;
    end;
  end;

procedure LoadPassportList(var Map: TPassportMap; const FileName: string);
var
  Fi: Text;
  s: string;
begin;
  Map:=nil;
  Assign(Fi, Filename); Reset(Fi);
  while not EOF(Fi) do begin;
    ReadLn(Fi, s);
    if (Length(s)=11) and (s[5]=',')
    then MapInclude(Map, SubstrToInt(s,1,4), SubstrToInt(s,6,11));
    end;
  CloseFile(Fi);
  end;

procedure SavePassportMap(var Map: TPassportMap; const FileName: string);
var
  Fi: file;
  Serial: integer;
begin;
  Assign(Fi, Filename); Rewrite(Fi,1);
  for Serial:=0 to Length(Map)-1 do if Length(Map[Serial])=125000 then begin;
    BlockWrite(Fi, Serial, 4);
    BlockWrite(Fi, Map[Serial,0], 125000);
    end;
  CloseFile(Fi);
  end;

procedure LoadPassportMap(var Map: TPassportMap; const FileName: string);
var
  Fi: file;
  Serial, Count: integer;
begin;
  Map:=nil; SetLength(Map, 10000);
  Assign(Fi, Filename); Reset(Fi,1);
  while true do begin;
    BlockRead(Fi, Serial, 4, Count);
    if Count=0 then break;
    if (Count<>4) or (Serial<0) or (Serial>9999) then begin;
      Map:=nil; break;
      end;
    SetLength(Map[Serial], 125000);
    BlockRead(Fi, Map[Serial,0], 125000, Count);
    if Count<>125000 then begin;
      Map:=nil; break;
      end;
    end;
  CloseFile(Fi);
  end;

procedure EncodeDelta(var Buf: TBuffer; var BufPos: integer; Delta: integer);
begin;
  if Delta<=$7F then begin;
    Buf[BufPos]:=Delta;
    inc(BufPos);
    end
  else if Delta<=$3FFF then begin;
    Buf[BufPos]:=Delta and $3F or $80;
    Buf[BufPos+1]:=Delta shr 6;
    inc(BufPos, 2);
    end
  else begin;
    Buf[BufPos]:=Delta and $3F or $C0;
    Buf[BufPos+1]:=Delta shr 6;
    Buf[BufPos+2]:=Delta shr 14;
    inc(BufPos, 3);
    end;
  end;

procedure SavePassportPacket(var Map: TPassportMap; const FileName: string);
var
  Fi: file;
  Serial, No, OldNo, Val, Bit, BufPos, i, j: integer;
  Buf: TBuffer;
begin;
  Assign(Fi, Filename); Rewrite(Fi,1);
  for Serial:=0 to Length(Map)-1 do if Length(Map[Serial])=125000 then begin;
    BlockWrite(Fi, Serial, 4);
    Bit:=Map[Serial,0] and 1;
    BlockWrite(Fi, Bit, 1);
    No:=0; OldNo:=0; BufPos:=0;
    for i:=0 to 125000-1 do begin;
      Val:=Map[Serial,i];
      if (Val=0) and (Bit=0) or (Val=255) and (Bit<>0) then begin;
        inc(No, 8);
        continue;
        end
      else for j:=0 to 7 do begin;
        if Val and 1<>Bit then begin;
          EncodeDelta(Buf, BufPos, No-OldNo-1);
          OldNo:=No;
          Bit:=Bit xor 1;
          end;
        inc(No);
        Val:=Val shr 1;
        end
      end;
    EncodeDelta(Buf, BufPos, No-OldNo-1);
    BlockWrite(Fi, BufPos, 4);
    BlockWrite(Fi, Buf[0], BufPos);
    end;
  CloseFile(Fi);
  end;

function DecodeDelta(var Buf: TBuffer; var BufPos: integer): integer;
begin;
  Result:=Buf[BufPos];
  if Result<=$7F then begin;
    inc(BufPos);
    end
  else if Result<=$BF then begin;
    Result:=integer(Buf[BufPos+1]) shl 6
         or Result and $3F;
    inc(BufPos, 2);
    end
  else begin;
    Result:=integer(Buf[BufPos+2]) shl 14
         or integer(Buf[BufPos+1]) shl 6
         or Result and $3F;
    inc(BufPos, 3);
    end;
  end;

procedure LoadPassportPacket(var Map: TPassportMap; const FileName: string);
var
  Fi: file;
  Serial, No, OldNo, Bit, BufLen, BufPos: integer;
  Buf: TBuffer;
var
  Count: integer;
begin;
  Map:=nil; SetLength(Map, 10000);
  Assign(Fi, Filename); Reset(Fi,1);
  while true do begin;
    BlockRead(Fi, Serial, 4, Count);
    if Count=0 then break;
    if (Count<>4) or (Serial<0) or (Serial>9999) then begin;
      Map:=nil; break;
      end;
    Bit:=0; BlockRead(Fi, Bit, 1, Count); Bit:=Bit xor 1;
    if (Count<>1) or (Bit and -2<>0) then begin;
      Map:=nil; break;
      end;
    BlockRead(Fi, BufLen, 4, Count);
    if (Count<>4) or (BufLen<=0) or (BufLen>SizeOf(Buf)) then begin;
      Map:=nil; break;
      end;
    BlockRead(Fi, Buf[0], BufLen, Count);
    if Count<>BufLen then begin;
      Map:=nil; break;
      end;
    SetLength(Map[Serial], 125000);
    No:=0; OldNo:=0; BufPos:=0;
    while BufPos<BufLen do begin;
      No:=DecodeDelta(Buf, BufPos)+1+No;
      Bit:=Bit xor 1;
      if (BufPos>BufLen) or (No>999999+1) then break;
      if Bit=0 then while OldNo<No do begin;
        if (OldNo and 7=0) and (OldNo+7<No) then begin;
          Map[Serial, OldNo shr 3]:=0;
          inc(OldNo, 8);
          end
        else begin;
          Map[Serial, OldNo shr 3]:=(not (1 shl (OldNo and 7))) and Map[Serial, OldNo shr 3];
          inc(OldNo);
          end;
        end
      else while OldNo<No do begin;
        if (OldNo and 7=0) and (OldNo+7<No) then begin;
          Map[Serial,OldNo shr 3]:=$FF;
          inc(OldNo, 8);
          end
        else begin;
          Map[Serial, OldNo shr 3]:=1 shl (oldNo and 7) or Map[Serial, OldNo shr 3];
          inc(OldNo);
          end;
        end;
      end;
    if (BufPos<>BufLen) or (No<>999999+1) then begin;
      Map:=nil; break;
      end;
    end;
  CloseFile(Fi);
  end;

end.