unit uAidData;

interface

uses sysutils, classes;

type

  TAidIndexRec = packed record
    KeyWord: array[0..15] of char;
    Param: array[0..15] of char;
    StartPos: Integer;
    RecSize: Integer;
    RelateIndex: Integer;
    Reserve: Integer;
  end;

  TAidRelateRec = packed record
    RecType: LongBool;
    RecLevel: Integer;
    Key: array[0..15] of char;
    Note: array[0..39] of char;
  end;

  TAidDataRec = packed record
    KeyWord: string;
    Param: string;
    RelateIndex: Integer;
    RecLevel: Integer;
    Note: string;
    Data: string;
  end;

  TAidData = class
  private
    FDataFile: file of Byte;
    FIndexFile: file of TAidIndexRec;
    FRelateFile: file of TAidRelateRec;
    FIndexBuf: array of TAidIndexRec;
    FRelateBuf: array of TAidRelateRec;
    FRecCount: Integer;
  protected
    procedure GrowUP(Size: Integer);

  public
    constructor Create;
    destructor Destroy;

    function FindIndex(Rec: TAidDataRec; var IDX: Integer): Boolean;
    function GetData(KeyWord: string; Param: string = ''): string;
    function GetRelatRec(Idx: Integer): TAidRelateRec;
    procedure InsertNewRec(Rec: TAidDataRec);
    procedure ModifyRec(OldRec, NewRec: TAidDataRec);
    procedure DeleteRec(Rec: TAidDataRec);
    procedure GetChildRecs(KeyWord: string; Childs: TStringList);
    Procedure PackData;
    property RecCount: Integer read FRecCount;
  published

  end;

var
  AidData: TAidData;
function GetParamStr(P: PChar; var Param: string): PChar;

implementation

uses forms, math;
{ TAidData }

function CharNext(lpsz: PChar): PChar; stdcall;
  external 'user32.dll' name 'CharNextA';

function GetParamStr(P: PChar; var Param: string): PChar;
var
  i, Len: Integer;
  Start, S, Q: PChar;
begin
  while True do
  begin
    while (P[0] <> #0) and (P[0] <= ' ') do
      P := CharNext(P);
    if (P[0] = '"') and (P[1] = '"') then Inc(P, 2) else Break;
  end;
  Len := 0;
  Start := P;
  while P[0] > ' ' do
  begin
    if P[0] = '"' then
    begin
      P := CharNext(P);
      while (P[0] <> #0) and (P[0] <> '"') do
      begin
        Q := CharNext(P);
        Inc(Len, Q - P);
        P := Q;
      end;
      if P[0] <> #0 then
        P := CharNext(P);
    end
    else
    begin
      Q := CharNext(P);
      Inc(Len, Q - P);
      P := Q;
    end;
  end;

  SetLength(Param, Len);

  P := Start;
  S := Pointer(Param);
  i := 0;
  while P[0] > ' ' do
  begin
    if P[0] = '"' then
    begin
      P := CharNext(P);
      while (P[0] <> #0) and (P[0] <> '"') do
      begin
        Q := CharNext(P);
        while P < Q do
        begin
          S[i] := P^;
          Inc(P);
          Inc(i);
        end;
      end;
      if P[0] <> #0 then P := CharNext(P);
    end
    else
    begin
      Q := CharNext(P);
      while P < Q do
      begin
        S[i] := P^;
        Inc(P);
        Inc(i);
      end;
    end;
  end;

  Result := P;
end;


constructor TAidData.Create;
var
  sdir: string;
  NewRec: TAidDataRec;
begin
  sdir := ExtractFilePath(Application.ExeName) + 'AidData';
  ForceDirectories(sDir);

  FileMode := fmShareExclusive or fmOpenReadWrite;
  AssignFile(FDataFile, sDir + '\AIDDATA.DAT');
  if FileExists(sDir + '\AIDDATA.DAT') then
    Reset(FDataFile)
  else
    Rewrite(FDataFile);

  FileMode := fmShareExclusive or fmOpenReadWrite;
  AssignFile(FIndexFile, sDir + '\AIDINDEX.DAT');
  if FileExists(sDir + '\AIDINDEX.DAT') then
    Reset(FIndexFile)
  else
    Rewrite(FIndexFile);

  FileMode := fmShareExclusive or fmOpenReadWrite;
  AssignFile(FRelateFile, sDir + '\AIDRELAT.DAT');
  if FileExists(sDir + '\AIDRELAT.DAT') then
    Reset(FRelateFile)
  else
    Rewrite(FRelateFile);

  FRecCount := FileSize(FIndexFile);
  GrowUP((FRecCount or $FF) + 1);
  if FRecCount = 0 then
  begin
    NewRec.KeyWord := 'help';
    NewRec.Param := '';
    NewRec.RelateIndex := 0;
    NewRec.RecLevel := 0;
    NewRec.Note := '';
    NewRec.Data := '欢迎您使用机器人！';
    InsertNewRec(NewRec);
  end;

  Seek(FIndexFile, 0);
  BlockRead(FIndexFile, FIndexBuf[0], FRecCount);

  Seek(FRelateFile, 0);
  BlockRead(FRelateFile, FRelateBuf[0], FRecCount);
end;

procedure TAidData.DeleteRec(Rec: TAidDataRec);
var
  i, idx: Integer;
begin
  if not FindIndex(rec, idx) then
    raise Exception.Create('记录不存在！');

  if Rec.RelateIndex < FRecCount - 1 then
    Move(FRelateBuf[Rec.RelateIndex + 1], FRelateBuf[Rec.RelateIndex],
      (FRecCount - (Rec.RelateIndex + 1)) * sizeof(TAidRelateRec));

  for i := 0 to FRecCount - 1 do
    if FIndexBuf[i].RelateIndex > Rec.RelateIndex then
      FIndexBuf[i].RelateIndex := FIndexBuf[i].RelateIndex - 1;

  if idx < FRecCount - 1 then
    Move(FIndexBuf[idx + 1], FIndexBuf[idx], (FRecCount - (idx + 1)) * sizeof(TAidIndexRec));

  Seek(FRelateFile, 0);
  BlockWrite(FRelateFile, FRelateBuf[0], FRecCount - 1);
  Truncate(FRelateFile);

  Seek(FIndexFile, 0);
  BlockWrite(FIndexFile, FIndexBuf[0], FRecCount - 1);
  Truncate(FIndexFile);

  FRecCount := FRecCount - 1;
end;

destructor TAidData.Destroy;
begin
  CloseFile(FDataFile);
  CloseFile(FIndexFile);
  CloseFile(FRelateFile);
end;

function TAidData.FindIndex(Rec: TAidDataRec; var IDX: Integer): Boolean;
var
  L, H, I, C: Integer;
  function CompareRec(A: TAidIndexRec; B: TAidDataRec): Integer;
  begin
    Result := CompareText(A.KeyWord, B.KeyWord);
    if Result = 0 then
      Result := CompareText(A.Param, B.Param);
  end;
begin
  Result := False;
  L := 0;
  H := FRecCount - 1;
  while L <= H do
  begin
    I := (L + H) shr 1;
    C := CompareRec(FIndexBuf[I], Rec);
    if C < 0 then L := I + 1 else
    begin
      H := I - 1;
      if C = 0 then
        Result := True;
    end;
  end;
  IDX := L;
end;

procedure TAidData.GetChildRecs(KeyWord: string; Childs: TStringList);
var
  rec: TAidDataRec;
  idx: Integer;
  i: integer;
  level: Integer;
  Key: string;
begin
  Childs.Clear;
  Childs.NameValueSeparator := #9;
  rec.KeyWord := KeyWord;
  rec.Param := '';
  if not FindIndex(rec, idx) then exit;

  level := FRelateBuf[FIndexBuf[idx].RelateIndex].RecLevel;
  for i := FIndexBuf[idx].RelateIndex + 1 to FRecCount - 1 do
  begin
    if FRelateBuf[i].RecLevel <= level then
      break;
    if FRelateBuf[i].RecLevel > level + 1 then
      continue;

    Key := FRelateBuf[i].Key;
    if FRelateBuf[i].RecType then
      Key := ' ' + Key;
    Childs.Values[Key] := FRelateBuf[i].Note;
  end;
  Childs.Sort;
end;

function TAidData.GetData(KeyWord, Param: string): string;
var
  rec: TAidDataRec;
  idx: Integer;
begin
  rec.KeyWord := KeyWord;
  rec.Param := Param;
  Result := '';
  if not FindIndex(rec, idx) then exit;
  SetLength(Result, FIndexBuf[idx].RecSize - 1);
  seek(FDataFile, FIndexBuf[idx].StartPos);
  BlockRead(FDataFile, Result[1], FIndexBuf[idx].RecSize - 1);
end;

function TAidData.GetRelatRec(Idx: Integer): TAidRelateRec;
begin
  if (idx < 0) or (idx >= FRecCount) then
    raise Exception.Create('记录不存在！');
  Result := FRelateBuf[idx];
end;

procedure TAidData.GrowUP(Size: Integer);
begin
  setlength(FIndexBuf, Size);
  setlength(FRelateBuf, Size);
end;

procedure TAidData.InsertNewRec(Rec: TAidDataRec);
var
  i, idx: Integer;
begin
  if FindIndex(rec, idx) then
    raise Exception.Create('记录已经存在！');

  for i := 0 to FRecCount - 1 do
  begin
    if FIndexBuf[i].RelateIndex >= Rec.RelateIndex then
      FIndexBuf[i].RelateIndex := FIndexBuf[i].RelateIndex + 1;
  end;

  if Rec.RelateIndex >= FRecCount then

  if FRecCount >= length(FIndexBuf) then
    GrowUP(((FRecCount + 256) or $FF) + 1);

  Move(FRelateBuf[Rec.RelateIndex], FRelateBuf[Rec.RelateIndex + 1],
    (FRecCount - Rec.RelateIndex) * sizeof(TAidRelateRec));

  FRelateBuf[Rec.RelateIndex].RecLevel := rec.RecLevel;
  FillChar(FRelateBuf[Rec.RelateIndex].Key[0], 16, #0);
  if rec.Param <> '' then
    Move(rec.Param[1], FRelateBuf[Rec.RelateIndex].Key[0], Min(Length(rec.Param), 16))
  else
    Move(rec.KeyWord[1], FRelateBuf[Rec.RelateIndex].Key[0], Min(Length(rec.KeyWord), 16));

  FRelateBuf[Rec.RelateIndex].RecType := rec.Param <> '';

  FillChar(FRelateBuf[Rec.RelateIndex].Note[0], 40, #0);
  Move(rec.Note[1], FRelateBuf[Rec.RelateIndex].Note[0], Min(Length(rec.Note), 40));

  Move(FIndexBuf[idx], FIndexBuf[idx + 1], (FRecCount - idx) * sizeof(TAidIndexRec));
  FillChar(FIndexBuf[idx].KeyWord[0], 16, #0);
  Move(rec.KeyWord[1], FIndexBuf[idx].KeyWord[0], Min(Length(rec.KeyWord), 16));
  FillChar(FIndexBuf[idx].Param[0], 16, #0);
  Move(rec.Param[1], FIndexBuf[idx].Param[0], Min(Length(rec.Param), 16));

  FIndexBuf[idx].RelateIndex := Rec.RelateIndex;
  FIndexBuf[idx].StartPos := FileSize(FDataFile);
  FIndexBuf[idx].RecSize := length(Rec.Data) + 1;
  Rec.Data := Rec.Data + #0;
  Seek(FDataFile, FIndexBuf[idx].StartPos);
  BlockWrite(FDataFile, Rec.Data[1], FIndexBuf[idx].RecSize);
  Seek(FRelateFile, 0);
  BlockWrite(FRelateFile, FRelateBuf[0], FRecCount + 1);
  Seek(FIndexFile, 0);
  BlockWrite(FIndexFile, FIndexBuf[0], FRecCount + 1);

  FRecCount := FRecCount + 1;

  if FRecCount >= length(FIndexBuf) then
    GrowUP(((FRecCount + 256) or $FF) + 1);
end;

procedure TAidData.ModifyRec(OldRec, NewRec: TAidDataRec);
var
  i, idx: Integer;
  startPos, RecSize: Integer;
  NeedDelRelat, NeedDelIDX, NeedDelData: Boolean;
begin
//  DeleteRec(OldRec);
//  InsertNewRec(NewRec);

  if (NewRec.KeyWord <> OldRec.KeyWord) or (NewRec.Param <> OldRec.Param) then
    if FindIndex(NewRec, idx) then
      raise Exception.Create('记录已经存在！');

  if not FindIndex(OldRec, idx) then
    raise Exception.Create('记录不存在！');

  NeedDelData := (NewRec.Data <> OldRec.Data) and (length(NewRec.Data) > length(OldRec.Data));
  NeedDelIDX := (NewRec.KeyWord <> OldRec.KeyWord) or (NewRec.Param <> OldRec.Param);
  NeedDelRelat := NewRec.RelateIndex <> OldRec.RelateIndex;

  if NeedDelRelat then
  begin
    if NewRec.RelateIndex < OldRec.RelateIndex then
    begin
      Move(FRelateBuf[NewRec.RelateIndex], FRelateBuf[NewRec.RelateIndex + 1],
        (OldRec.RelateIndex - NewRec.RelateIndex) * sizeof(TAidRelateRec));

      for i := 0 to FRecCount - 1 do
        if (FIndexBuf[i].RelateIndex > NewRec.RelateIndex) and
            (FIndexBuf[i].RelateIndex < OldRec.RelateIndex) then
          FIndexBuf[i].RelateIndex := FIndexBuf[i].RelateIndex + 1;
    end
    else
    begin
      Move(FRelateBuf[OldRec.RelateIndex + 1], FRelateBuf[OldRec.RelateIndex],
        (NewRec.RelateIndex - OldRec.RelateIndex) * sizeof(TAidRelateRec));
      for i := 0 to FRecCount - 1 do
        if (FIndexBuf[i].RelateIndex < NewRec.RelateIndex) and
            (FIndexBuf[i].RelateIndex > OldRec.RelateIndex) then
          FIndexBuf[i].RelateIndex := FIndexBuf[i].RelateIndex - 1;
    end;
    FIndexBuf[idx].RelateIndex := NewRec.RelateIndex;
  end;
  FRelateBuf[NewRec.RelateIndex].RecLevel := NewRec.RecLevel;
  FillChar(FRelateBuf[NewRec.RelateIndex].Key[0], 16, #0);
  if NewRec.Param <> '' then
    Move(NewRec.Param[1], FRelateBuf[NewRec.RelateIndex].Key[0], Min(Length(NewRec.Param), 16))
  else
    Move(NewRec.KeyWord[1], FRelateBuf[NewRec.RelateIndex].Key[0], Min(Length(NewRec.KeyWord), 16));
  FRelateBuf[NewRec.RelateIndex].RecType := NewRec.Param <> '';
  FillChar(FRelateBuf[NewRec.RelateIndex].Note[0], 40, #0);
  Move(NewRec.Note[1], FRelateBuf[NewRec.RelateIndex].Note[0], Min(Length(NewRec.Note), 40));

  startPos := FIndexBuf[idx].StartPos;
  RecSize :=  FIndexBuf[idx].RecSize;
  if NeedDelIDX then
  begin
    if idx < FRecCount - 1 then
      Move(FIndexBuf[idx + 1], FIndexBuf[idx], (FRecCount - (idx + 1)) * sizeof(TAidIndexRec));
    FRecCount := FRecCount-1;
    FindIndex(NewRec,idx);
    Move(FIndexBuf[idx], FIndexBuf[idx + 1], (FRecCount - idx) * sizeof(TAidIndexRec));
    FRecCount := FRecCount+1;
  end;
  FIndexBuf[idx].RelateIndex := NewRec.RelateIndex;
  FIndexBuf[idx].StartPos := startPos;
  FIndexBuf[idx].RecSize := length(NewRec.Data) + 1;
  FillChar(FIndexBuf[idx].KeyWord[0], 16, #0);
  Move(NewRec.KeyWord[1], FIndexBuf[idx].KeyWord[0], Min(Length(NewRec.KeyWord), 16));
  FillChar(FIndexBuf[idx].Param[0], 16, #0);
  Move(NewRec.Param[1], FIndexBuf[idx].Param[0], Min(Length(NewRec.Param), 16));

  if NeedDelData then
  begin
    StartPos := FileSize(FDataFile);
    RecSize := length(NewRec.Data) + 1;
  end;
  NewRec.Data := NewRec.Data + #0;
  Seek(FDataFile, StartPos);
  BlockWrite(FDataFile, NewRec.Data[1], RecSize);
  FIndexBuf[idx].StartPos := startPos;
  FIndexBuf[idx].RecSize := RecSize;

  Seek(FRelateFile, 0);
  BlockWrite(FRelateFile, FRelateBuf[0], FRecCount);
  Seek(FIndexFile, 0);
  BlockWrite(FIndexFile, FIndexBuf[0], FRecCount);
end;

procedure TAidData.PackData;
var
  n, Idx: Integer;
  PackIdxs: array of Integer;
  CurPos: Integer;
  Buf: array of Byte;

  procedure QuickSort(A: array of Integer; L, R: Integer);
  var
    I, J, P, T: Integer;
  begin
    repeat
      I := L;
      J := R;
      P := (L + R) shr 1;
      repeat
        while FIndexBuf[A[I]].StartPos < FIndexBuf[A[P]].StartPos do Inc(I);
        while FIndexBuf[A[J]].StartPos > FIndexBuf[A[P]].StartPos do Dec(J);
        if I <= J then
        begin
          T := A[I];
          A[I] := A[J];
          A[J] := T;

          if P = I then
            P := J
          else if P = J then
            P := I;
          Inc(I);
          Dec(J);
        end;
      until I > J;
      if L < J then QuickSort(A, L, J);
      L := I;
    until I >= R;
  end;

begin
  setlength(PackIdxs, FRecCount);
  setlength(Buf, 65536);
  for n:= 0 to FRecCount-1 do
  begin
    PackIdxs[n] := n;
  end;
  QuickSort(PackIdxs, 0, FRecCount-1);

  Seek(FIndexFile,0);
  Seek(FDataFile,0);
  CurPos := 0;
  for n:= 0 to FRecCount-1 do
  begin
    IDX := PackIdxs[n];
    if Length(Buf) < FIndexBuf[IDX].RecSize then
      setlength(Buf, FIndexBuf[IDX].RecSize);
    Seek(FDataFile, FIndexBuf[IDX].StartPos);
    BlockRead(FDataFile, Buf[0], FIndexBuf[IDX].RecSize);
    Seek(FDataFile, CurPos);
    BlockWrite(FDataFile, Buf[0], FIndexBuf[IDX].RecSize);
    FIndexBuf[IDX].StartPos := CurPos;
    seek(FIndexFile, IDX);
    BlockWrite(FIndexFile, FIndexBuf[IDX], 1);
    CurPos := CurPos + FIndexBuf[IDX].RecSize;
  end;
  Truncate(FDataFile);
end;

end.

