unit MyDB;

interface

uses
  Windows, SysUtils, Classes;

const
  INDEX_MAX_NAME_LEN = 207;

type
  PListRecord = ^TListRecord;
  TListRecord = record
    Flags: LongWord;              // Flags
    Hash: Int64;                  // Data hash (unique!)
    Offset: Int64;                // Offset to TIndexRecord in .dat file
    IdxOffset: Int64;             // Offset to TIndexRecord2 in .idx file
    UID: LongWord;                // UID
  end;

  PIndexRecord2 = ^TIndexRecord2;
  TIndexRecord2 = record
    Flags: LongWord;              // Flags
    Hash: Int64;                  // Data hash (unique!)
    Offset: Int64;                // Offset to TIndexRecord in .dat file
    UID: LongWord;                // UID
  end;

  PIndexRecord = ^TIndexRecord;
  TIndexRecord = record
    Ident: LongWord;              // Equal to DB_DENT
    Flags: LongWord;              // Flags
    Name: array[0..INDEX_MAX_NAME_LEN] of Char;  // Some readable name
    AddDate: TDateTime;           // Date of adding to DB
    RepDate: TDateTime;           // Date of generating report
    Hash: Int64;                  // Data hash (unique!)
    IP: LongWord;                 // IP
    UID: LongWord;                // UID
    DataLen: LongWord;            // Length of the data, followed by the actual data
  end;

  PHashEntry = ^THashEntry;
  THashEntry = record
    Hash: Int64;
    Offset: Int64;
    Next: PHashEntry;
  end;

  PHashEntryArray = ^THashEntryArray;
  THashEntryArray = array[0..0] of PHashEntry;

  THashTable = class(TObject)
  private
    FSize: LongWord;
    FTable: PHashEntryArray;
  public
    constructor Create(TableSize: LongWord);
    destructor Destroy; override;
    procedure Insert(Hash: Int64; Offset: Int64);
    function Get(Hash: Int64): Int64; // -1 if not found
  end;

  TDBManager = class(TObject)
  private
    FHandle: THandle;
    FIndexHandle: THandle;
    FError: Integer;
    FIndexList: TList;
    FDatFile: String;
    FHashTable: THashTable;
  protected
    procedure Write(Handle: THandle; Data: Pointer; DataLen: LongWord);
    procedure Read(Handle: THandle; Data: Pointer; DataLen: LongWord);
    procedure LoadIndexesFromDat;
    procedure LoadIndexesFromIdx;
  public
    property IndexList: TList read FIndexList;
    property Error: Integer read FError;

    constructor Create(const FileName, IndexName: String);
    destructor Destroy; override;

    function Add(const IndexRecord: TIndexRecord; Data: Pointer): Int64; // Returns offset to dupe or -1 if new
    function Get(Index: Integer): TIndexRecord;
    function GetData(Index: Integer; var Data: Pointer): TIndexRecord;
    function GetByHash(Hash: Int64; out Index: TIndexRecord): Boolean;
    procedure Delete(Index: Integer);

    function ErrorToStr(Error: Integer): String;
  end;

const
  DB_IDENT              = Ord('I') + Ord('t') shl 8 + Ord('E') shl 16 + Ord('M') shl 24;
  DB_ERR_OPEN           = 1;
  DB_ERR_SEEK           = 2;
  DB_ERR_WRITE          = 3;
  DB_ERR_READ           = 4;
  DB_ERR_GETSIZE        = 5;
  DB_ERR_GETIDX         = 6;
  DB_ERR_STRUCT         = 7;

  DBFLAG_DELETED        = 1;

implementation

function FileSeek(Handle: Integer; const Offset: Int64; Origin: Integer): Int64;
begin
  Result := Offset;
  Int64Rec(Result).Lo := SetFilePointer(THandle(Handle), Int64Rec(Result).Lo,
    @Int64Rec(Result).Hi, Origin);
end;

{ THashTable }

constructor THashTable.Create(TableSize: LongWord);
begin
  FSize := TableSize;
  GetMem(FTable, TableSize*SizeOf(THashEntry));
  FillChar(FTable^, TableSize*SizeOf(THashEntry), 0);
end;

destructor THashTable.Destroy;
var
  i: Integer;
  P, PNext: PHashEntry;
begin
  for i := 0 to FSize-1 do begin
    P := FTable^[i];
    while P <> nil do begin
      PNext := P^.Next;
      Dispose(P);
      P := PNext;
    end;
  end;
  FreeMem(FTable);
  inherited;
end;

function THashTable.Get(Hash: Int64): Int64;
var
  Index: LongWord;
  P: PHashEntry;
begin
  Result := -1;
  Index := LongWord(Hash) mod FSize;
  P := FTable^[Index];
  while P <> nil do begin
    if P^.Hash = Hash then begin
      Result := P.Offset;
      Exit;
    end;
    P := P.Next;
  end;
end;

procedure THashTable.Insert(Hash: Int64; Offset: Int64);
var
  Index: LongWord;
  P: PHashEntry;
begin
  Index := LongWord(Hash) mod FSize;
  if FTable^[Index] = nil then begin
    New(FTable^[Index]);
    FTable^[Index].Hash := Hash;
    FTable^[Index].Offset := Offset;
    FTable^[Index].Next := nil;
  end else begin
    New(P);
    P.Hash := Hash;
    P.Next := FTable^[Index];
    P.Offset := Offset;
    FTable^[Index] := P;
  end;
end;

{ TDBManager }

function TDBManager.Add(const IndexRecord: TIndexRecord; Data: Pointer): Int64;
var
  FileOffset: Int64;
  P: PIndexRecord2;
  IndexRecord2: TIndexRecord2;

  FreeAvaible, TotalSpace: Int64;
begin
  Result := -1;
  if FError <> 0 then Exit;

  Result := FHashTable.Get(IndexRecord.Hash);
  if Result <> -1 then Exit;

  // Check free space
  GetDiskFreeSpaceEx(PChar(Copy(FDatFile, 1, 3)), FreeAvaible, TotalSpace, nil);
  if Int64(SizeOf(IndexRecord) + IndexRecord.DataLen + SizeOf(IndexRecord2)) > FreeAvaible then Exit;

  FileOffset := FileSeek(FHandle, 0, 2);
  if (FileOffset = -1) and (GetLastError <> NO_ERROR) then begin
    FError := DB_ERR_SEEK;
    Exit;
  end;

  // Write record to data file
  Write(FHandle, @IndexRecord, SizeOf(IndexRecord));
  // Write the data contents
  if FError = 0 then
    Write(FHandle, Data, IndexRecord.DataLen);

  // Add index offset to internal list
  if FError = 0 then begin
    New(P); P^.Flags := IndexRecord.Flags;
    P^.Offset := FileOffset;
    P^.UID := IndexRecord.UID;
    FIndexList.Add(P);
  end;

  // Write record to index file
  IndexRecord2.Flags := IndexRecord.Flags;
  IndexRecord2.Offset := FileOffset;
  IndexRecord2.Hash := IndexRecord.Hash;
  IndexRecord2.UID := IndexRecord.UID;
  Write(FIndexHandle, @IndexRecord2, SizeOf(IndexRecord2));

  FHashTable.Insert(IndexRecord.Hash, FileOffset);
end;

constructor TDBManager.Create(const FileName, IndexName: String);
begin
  FDatFile := FileName;
  
  FHandle := CreateFile(PChar(FileName), GENERIC_WRITE or GENERIC_READ, FILE_SHARE_WRITE or FILE_SHARE_READ, nil, OPEN_ALWAYS, 0, 0);
  if FHandle = INVALID_HANDLE_VALUE then
    FError := DB_ERR_OPEN;

  FIndexHandle := CreateFile(PChar(IndexName), GENERIC_WRITE or GENERIC_READ, FILE_SHARE_WRITE or FILE_SHARE_READ, nil, OPEN_ALWAYS, 0, 0);
  if FIndexHandle = INVALID_HANDLE_VALUE then
    FError := DB_ERR_OPEN;

  FIndexList := TList.Create;
  FHashTable := THashTable.Create(50000);
  LoadIndexesFromIdx;
end;

destructor TDBManager.Destroy;
var
  i: Integer;
begin
  if FHandle <> INVALID_HANDLE_VALUE then
    CloseHandle(FHandle);
  if FIndexHandle <> INVALID_HANDLE_VALUE then
    CloseHandle(FIndexHandle);

  for i := 0 to FIndexList.Count-1 do
    Dispose(FIndexList.Items[i]);
  FIndexList.Free;
  FHashTable.Free;
  inherited;
end;

function TDBManager.Get(Index: Integer): TIndexRecord;
var
  P: PListRecord;
  FileOffset: Int64;
begin
  if FError <> 0 then Exit;

  if Index >= FIndexList.Count then begin
    FError := DB_ERR_GETIDX;
    Exit;
  end;

  P := FIndexList.Items[Index];

  // Seek record offset
  FileOffset := FileSeek(FHandle, P^.Offset, 0);
  if FileOffset <> P^.Offset then begin
    FError := DB_ERR_SEEK;
    Exit;
  end;

  // Read the record
  Read(FHandle, @Result, SizeOf(Result));

  if (FError = 0) and (Result.Ident <> DB_IDENT) then
    FError := DB_ERR_STRUCT;
end;

function TDBManager.GetData(Index: Integer;
  var Data: Pointer): TIndexRecord;
var
  P: PListRecord;
  FileOffset: Int64;
begin
  Data := nil;

  if FError <> 0 then Exit;

  if Index >= FIndexList.Count then begin
    FError := DB_ERR_GETIDX;
    Exit;
  end;

  P := FIndexList.Items[Index];

  // Seek record offset
  FileOffset := FileSeek(FHandle, P^.Offset, 0);
  if FileOffset <> P^.Offset then begin
    FError := DB_ERR_SEEK;
    Exit;
  end;

  // Read the record
  Read(FHandle, @Result, SizeOf(Result));
  if FError <> 0 then Exit;

  if Result.Ident <> DB_IDENT then
    FError := DB_ERR_STRUCT;

  GetMem(Data, Result.DataLen);
  Read(FHandle, Data, Result.DataLen);
end;

function TDBManager.GetByHash(Hash: Int64; out Index: TIndexRecord): Boolean;
var
  FileOffset, NewOffset: Int64;
begin
  Result := False;
  if FError <> 0 then Exit;

  // Get index record offset
  FileOffset := FHashTable.Get(Hash);
  if FileOffset = -1 then Exit;

  // Seek record
  NewOffset := FileSeek(FHandle, FileOffset, 0);
  if FileOffset <> NewOffset then begin
    FError := DB_ERR_SEEK;
    Exit;
  end;

  // Read the record
  Read(FHandle, @Index, SizeOf(Index));

  Result := FError = 0;
  if (Result) and (Index.Ident <> DB_IDENT) then
    FError := DB_ERR_STRUCT;
end;

procedure TDBManager.Delete(Index: Integer);
var
  FileOffset: Int64;
  P: PListRecord;
begin
  if FError <> 0 then Exit;

  if Index >= FIndexList.Count then begin
    FError := DB_ERR_GETIDX;
    Exit;
  end;

  P := FIndexList.Items[Index];
  if P^.Flags and DBFLAG_DELETED <> 0 then Exit; // Already deleted
  P^.Flags := P^.Flags or DBFLAG_DELETED;

  // Fix flags in .idx file
  if P^.IdxOffset <> -1 then begin
    // Seek EOF
    FileOffset := FileSeek(FIndexHandle, P^.IdxOffset, 0);
    if FileOffset <> P^.IdxOffset then begin
      FError := DB_ERR_SEEK;
      Exit;
    end;
    Write(FIndexHandle, @P^.Flags, 4);
  end;

  // Fix flags in .dat file
  FileOffset := FileSeek(FHandle, P^.Offset+4, 0);
  if FileOffset <> P^.Offset+4 then begin
    FError := DB_ERR_SEEK;
    Exit;
  end;  
  Write(FHandle, @P^.Flags, 4);  
end;

procedure TDBManager.LoadIndexesFromDat;
var
  FileOffset, SeekOffset: Int64;
  FileSize: Int64;
  IdxOffset: Int64;
  FileSizeLow, FileSizeHigh: LongWord;

  Index: TIndexRecord;
  P: PListRecord;
begin
  if FError <> 0 then Exit;

  // Seek begin
  SeekOffset := FileSeek(FHandle, 0, 0);
  if (SeekOffset = -1) then begin
    FError := DB_ERR_SEEK;
    Exit;
  end;

  // Get filesize
  FileSizeLow := GetFileSize(FHandle, @FileSizeHigh);
  if FileSizeLow = INVALID_FILE_SIZE then begin
    FError := DB_ERR_GETSIZE;
    Exit;
  end;

  FileSize := Int64(FileSizeLow) + Int64(FileSizeHigh) shl 32;
  if FileSize = 0 then Exit; // Empty file
  FileOffset := 0; IdxOffset := 0;

  // Read indexes
  while FileOffset < FileSize do begin
    Read(FHandle, @Index, SizeOf(Index));
    if FError <> 0 then Exit;

    SeekOffset := FileSeek(FHandle, Index.DataLen, 1);
    if (SeekOffset = -1) then begin
      FError := DB_ERR_SEEK;
      Exit;
    end;

    if Index.Flags and DBFLAG_DELETED = 0 then begin
      New(P);
      P^.Offset := FileOffset;
      P^.Flags := Index.Flags;
      P^.IdxOffset := IdxOffset;
      P^.Hash := Index.Hash;
      P^.UID := Index.UID;
      
      FIndexList.Add(P);
      FHashTable.Insert(Index.Hash, FileOffset);
    end;

    FileOffset := FileOffset + Index.DataLen + SizeOf(Index);
    IdxOffset := IdxOffset + SizeOf(TIndexRecord2);
  end;
end;

procedure TDBManager.LoadIndexesFromIdx;
var
  FileOffset, SeekOffset: LongWord;
  FileSizeLow: LongWord;
  P: PListRecord;

  M: Pointer;
  Index2: PIndexRecord2;
begin
  if FError <> 0 then Exit;

  // Seek begin
  SeekOffset := FileSeek(FIndexHandle, 0, 0);
  if (Integer(SeekOffset) = -1) then begin
    FError := DB_ERR_SEEK;
    Exit;
  end;

  // Get filesize
  FileSizeLow := GetFileSize(FIndexHandle, nil);
  if LongWord(FileSizeLow) = INVALID_FILE_SIZE then begin
    FError := DB_ERR_GETSIZE;
    Exit;
  end;

  if FileSizeLow = 0 then Exit;
  if FileSizeLow mod SizeOf(TIndexRecord2) <> 0 then Exit;

  // Read entire .idx file into memory
  GetMem(M, FileSizeLow); Index2 := M;
  Read(FIndexHandle, M, FileSizeLow);

  // Process loaded data
  if FError = 0 then begin
    FileOffset := 0;  
    while FileOffset < FileSizeLow do begin
      if Index2.Flags and DBFLAG_DELETED = 0 then begin
        New(P);
        P^.Flags := Index2^.Flags;
        P^.Hash := Index2^.Hash;
        P^.Offset := Index2^.Offset;
        P^.IdxOffset := FileOffset;
        P^.UID := Index2^.UID;
        FIndexList.Add(P);

        FHashTable.Insert(Index2^.Hash, Index2^.Offset);
      end;

      Index2 := Pointer(LongWord(Index2) + SizeOf(TIndexRecord2));
      FileOffset := FileOffset + SizeOf(TIndexRecord2);
    end;
  end;
  
  FreeMem(M);
end;

procedure TDBManager.Read(Handle: THandle; Data: Pointer; DataLen: LongWord);
var
  lpRead: LongWord;
begin
  while DataLen <> 0 do begin
    if (not ReadFile(Handle, Data^, DataLen, lpRead, nil)) or (lpRead = 0) then begin
      FError := DB_ERR_READ;
      Exit;
    end;
    Data := Pointer(LongWord(Data) + lpRead);
    DataLen := DataLen - lpRead;
  end;
end;

procedure TDBManager.Write(Handle: THandle; Data: Pointer; DataLen: LongWord);
var
  lpWritten: LongWord;
begin
  while DataLen <> 0 do begin
    if not WriteFile(Handle, Data^, DataLen, lpWritten, nil) or (lpWritten = 0) then begin
      FError := DB_ERR_WRITE;
      Exit;
    end;
    Data := Pointer(LongWord(Data) + lpWritten);
    DataLen := DataLen - lpWritten;
  end;
end;

function TDBManager.ErrorToStr(Error: Integer): String;
begin
  case Error of
    DB_ERR_OPEN: Result := 'Open';
    DB_ERR_SEEK: Result := 'Seek';
    DB_ERR_WRITE: Result := 'Write';
    DB_ERR_READ: Result := 'Read';
    DB_ERR_GETSIZE: Result := 'GetSize()';
    DB_ERR_GETIDX: Result := 'GetIndex()';
    DB_ERR_STRUCT: Result := 'Invalid DB structure';
  else
    Result := 'Unknown';
  end;
end;

end.
