Subversion Repositories oidplus

unit OIDFILE;

(************************************************)

(* OIDFILE.PAS                                  *)

(* Author:   Daniel Marschall                   *)

(* Revision: 2022-10-10                         *)

(* License:  Apache 2.0                         *)

(* This file contains:                          *)

(* - Functions to handle an OID ASCII format    *)

(************************************************)

interface

uses

  StrList;

type

  POID = ^TOID;

  TOID = record

    FileId: string;

    DotNotation: string;

    ASNIds: PStringList;

    UnicodeLabels: PStringList;

    Description: string;

    SubIds: PStringList; (* first 8 chars are FileId, followed by DotNotation *)

    ParentFileId: string;

    ParentDotNotation: string;

  end;

procedure CreateOidDef(var oid: POid);

procedure FreeOidDef(oid: POid);

procedure ClearOidDef(oid: POid);

function WriteOidFile(filename: string; oid: POid): boolean;

function ReadOidFile(filename: string; oid: POid): boolean;

(* For the strings in the list "SubIds": *)

function FileIdPart(s: string): string;

function DotNotationPart(s: string): string;

implementation

uses

  VtsFuncs, OidUtils, Crt;

const

  WANT_VERS = '2022';

procedure CreateOidDef(var oid: POid);

begin

  oid := nil;

  GetMem(oid, SizeOf(TOID));

  if oid <> nil then

  begin

    oid^.FileId := '';

    oid^.DotNotation := '';

    oid^.Description := '';

    oid^.ParentFileId := '';

    oid^.ParentDotNotation := '';

    CreateList(oid^.ASNIds);

    CreateList(oid^.UnicodeLabels);

    CreateList(oid^.SubIds);

  end

  else

  begin

    Beep;

    WriteLn('CreateOidDef failed! (GetMem returned nil)');

    ReadKey;

  end;

end;

procedure FreeOidDef(oid: POid);

begin

  if oid <> nil then

  begin

    FreeList(oid^.ASNIds);

    FreeList(oid^.UnicodeLabels);

    FreeList(oid^.SubIds);

    FreeMem(oid, SizeOf(TOID));

    oid := nil;

  end

  else

  begin

    Beep;

    WriteLn('FreeOidDef failed! (Argument is nil)');

    ReadKey;

  end;

end;

procedure ClearOidDef(oid: POid);

begin

  oid^.FileId := '';

  oid^.DotNotation := '';

  oid^.Description := '';

  oid^.ParentFileId := '';

  oid^.ParentDotNotation := '';

  ListClear(oid^.ASNIds);

  ListClear(oid^.UnicodeLabels);

  ListClear(oid^.SubIds);

end;

procedure ListBubbleSortSubIds(oid: POid);

var

  n, i: integer;

  a, b: string;

  swapped: boolean;

begin

  n := ListCount(oid^.SubIds);

  while n>1 do

  begin

    i := 0;

    swapped := false;

    while i<n-1 do

    begin

      a := DotNotationPart(ListGetElement(oid^.SubIds, i));

      b := DotNotationPart(ListGetElement(oid^.SubIds, i+1));

      if CompareOID(a, b) > 0 then

      begin

        ListSwapElement(oid^.SubIds, i, i+1);

        swapped := true;

      end;

      Inc(i);

    end;

    if not swapped then break;

    Dec(n);

  end;

end;

function WriteOidFile(filename: string; oid: POid): boolean;

var

  f: Text;

  i: integer;

  lines: PStringList;

  sTmp: string;

  desc: string;

begin

  Assign(f, filename);

  {$I-}

  Rewrite(f);

  {$I+}

  if IoResult <> 0 then

  begin

    WriteOidFile := false;

    (* Must not call Close(f) if file was never opened *)

    Exit;

  end;

  WriteLn(f, 'VERS' + WANT_VERS);

  WriteLn(f, 'SELF' + oid^.FileId + oid^.DotNotation);

  WriteLn(f, 'SUPR' + oid^.ParentFileId + oid^.ParentDotNotation);

  (* Sort sub IDs *)

  ListBubbleSortSubIds(oid);

  for i := 0 to ListCount(oid^.SubIds)-1 do

  begin

    sTmp := ListGetElement(oid^.SubIds, i);

    WriteLn(f, 'CHLD' + sTmp);

  end;

  for i := 0 to ListCount(oid^.AsnIds)-1 do

  begin

    sTmp := ListGetElement(oid^.AsnIds, i);

    WriteLn(f, 'ASN1' + sTmp);

  end;

  for i := 0 to ListCount(oid^.UnicodeLabels)-1 do

  begin

    sTmp := ListGetElement(oid^.UnicodeLabels, i);

    WriteLn(f, 'UNIL' + sTmp);

  end;

  desc := Trim(oid^.Description);

  if desc <> '' then

  begin

    CreateList(lines);

    SplitStrToList(desc, lines, #13#10);

    for i := 0 to ListCount(lines)-1 do

    begin

      sTmp := ListGetElement(lines, i);

      WriteLn(f, 'DESC' + sTmp);

    end;

    FreeList(lines);

  end;

  Close(f);

  WriteOidFile := true;

end;

function ReadOidFile(filename: string; oid: POid): boolean;

var

  f: Text;

  line, cmd: string;

  version: string;

begin

  ClearOidDef(oid);

  version := '';

  Assign(f, filename);

  {$I-}

  Reset(f);

  {$I+}

  if IoResult <> 0 then

  begin

    ReadOidFile := false;

    (* Must not call Close(f) if file was never opened *)

    Exit;

  end;

  while not EOF(f) do

  begin

    ReadLn(f, line);

    cmd := Copy(line,1,4);

    Delete(line,1,4);

    if cmd = 'VERS' then

    begin

      version := line;

    end;

    if cmd = 'SELF' then

    begin

      oid^.FileId := Copy(line,1,8);

      Delete(line,1,8);

      oid^.DotNotation := line;

    end;

    if cmd = 'SUPR' then

    begin

      oid^.ParentFileId := FileIdPart(line);

      oid^.ParentDotNotation := DotNotationPart(line);

    end;

    if cmd = 'CHLD' then

    begin

      ListAppend(oid^.SubIds, line);

    end;

    if cmd = 'ASN1' then

    begin

      ListAppend(oid^.ASNIds, line);

    end;

    if cmd = 'UNIL' then

    begin

      ListAppend(oid^.UnicodeLabels, line);

    end;

    if cmd = 'DESC' then

    begin

      if Length(oid^.Description) + Length(line) + 2 <= 255 then

      begin

        oid^.Description := oid^.Description + line + #13#10;

      end;

    end;

  end;

  (* Sort sub IDs *)

  ListBubbleSortSubIds(oid);

  (* Remove last CRLF *)

  oid^.Description := Copy(oid^.Description, 1, Length(oid^.Description)-Length(#13#10));

  (* Check if everything is correct *)

  ReadOidFile := (version = WANT_VERS) and (oid^.FileId <> '');

  Close(f);

end;

function FileIdPart(s: string): string;

begin

  FileIdPart := Copy(s,1,8);

end;

function DotNotationPart(s: string): string;

begin

  Delete(s,1,8);

  DotNotationPart := s;

end;

end.