humdb.pas

来自「FIR引擎最新源码+注册」· PAS 代码 · 共 794 行 · 第 1/2 页

var
  ChrRecordHeader: TIPRecordHeader;
begin
  Result := False;
  if FileSeek(m_nFileHandle, nIndex * SizeOf(TRecordDataInfo) + SizeOf(TDBHeader), 0) = -1 then Exit;
  m_nLastIndex := nIndex;
  m_dUpdateTime := Now();
  ChrRecordHeader.boDeleted := True;
  FileWrite(m_nFileHandle, ChrRecordHeader, SizeOf(TIPRecordHeader));
  m_DeletedList.Add(Pointer(nIndex));
  m_Header.nLastIndex := m_nLastIndex;
  m_Header.dLastDate := m_dUpdateTime;
  m_Header.dUpdateDate := Now();
  FileSeek(m_nFileHandle, 0, 0);
  FileWrite(m_nFileHandle, m_Header, SizeOf(TDBHeader));
  m_boChanged := True;
  Result := True;
end;

procedure TFileHumDB.Rebuild;
var
  sTempFileName: string;
  nHandle, n10: Integer;
  DBHeader: TDBHeader;
  ChrRecord: TRecordDataInfo;
begin
  sTempFileName := 'Mir#$00.DB';
  if FileExists(sTempFileName) then
    DeleteFile(sTempFileName);
  nHandle := FileCreate(sTempFileName);
  n10 := 0;
  if nHandle < 0 then Exit;
  try
    if Open then begin
      FileSeek(m_nFileHandle, 0, 0);
      if FileRead(m_nFileHandle, DBHeader, SizeOf(TDBHeader)) = SizeOf(TDBHeader) then begin
        FileWrite(nHandle, DBHeader, SizeOf(TDBHeader));
        while (True) do begin
          if FileRead(m_nFileHandle, ChrRecord, SizeOf(TRecordDataInfo)) = SizeOf(TRecordDataInfo) then begin
            if ChrRecord.boDeleted then Continue;
            FileWrite(nHandle, ChrRecord, SizeOf(TRecordDataInfo));
            Inc(n10);
          end else Break;
        end;
        DBHeader.nHumCount := n10;
        DBHeader.dUpdateDate := Now();
        FileSeek(nHandle, 0, 0);
        FileWrite(nHandle, DBHeader, SizeOf(TDBHeader));
      end;
    end;
  finally
    Close;
  end;
  FileClose(nHandle);
  FileCopy(sTempFileName, m_sDBFileName);
  DeleteFile(sTempFileName);
end;

function TFileHumDB.Count: Integer;
begin
  Result := m_QuickIPList.Count;
end;

{ TFileGMHumDB }

constructor TFileGMHumDB.Create(sFileName: string);
begin
  n4 := 0;
  n4ADAE4 := 0;
  n4ADAE8 := 0;
  n4ADAF0 := 0;
  m_sDBFileName := sFileName;
  m_QuickIDList := TQuickList.Create;
  m_DeletedList := TList.Create;
  m_nLastIndex := -1;
  LoadQuickList();
end;

destructor TFileGMHumDB.Destroy;
begin
  m_QuickIDList.Free;
  m_DeletedList.Free;
  inherited;
end;

procedure TFileGMHumDB.LoadQuickList;
var
  nIndex: Integer;
  DBHeader: TDBHeader;
  RecordHeader: TIPRecordHeader;
begin
  n4 := 0;
  m_QuickIDList.Clear;
  m_DeletedList.Clear;
  n4ADAE4 := 0;
  n4ADAE8 := 0;
  n4ADAF0 := 0;
  try
    if Open then begin
      FileSeek(m_nFileHandle, 0, 0);
      if FileRead(m_nFileHandle, DBHeader, SizeOf(TDBHeader)) = SizeOf(TDBHeader) then begin
        n4ADAF0 := DBHeader.nHumCount;
        for nIndex := 0 to DBHeader.nHumCount - 1 do begin
          Inc(n4ADAE4);
          if FileSeek(m_nFileHandle, nIndex * SizeOf(TRecordDataInfo) + SizeOf(TDBHeader), 0) = -1 then Break;
          if FileRead(m_nFileHandle, RecordHeader, SizeOf(TIPRecordHeader)) <> SizeOf(TIPRecordHeader) then Break;
          if not RecordHeader.boDeleted then begin
            if RecordHeader.sAccount <> '' then begin
              m_QuickIDList.AddObject(RecordHeader.sAccount, TObject(nIndex));
              Inc(n4ADAE8);
            end else m_DeletedList.Add(TObject(nIndex));
          end else begin
            m_DeletedList.Add(TObject(nIndex));
            Inc(n4ADAEC);
          end;
          Application.ProcessMessages;
          if Application.Terminated then begin
            Close;
            Exit;
          end;
        end;
      end;
    end;
  finally
    Close();
  end;
  m_QuickIDList.SortString(0, m_QuickIDList.Count - 1);
  m_nLastIndex := m_Header.nLastIndex;
  m_dUpdateTime := m_Header.dLastDate;
end;

procedure TFileGMHumDB.Lock;
begin
  EnterCriticalSection(HumDB_CS);
end;
procedure TFileGMHumDB.UnLock;
begin
  LeaveCriticalSection(HumDB_CS);
end;

function TFileGMHumDB.Open: Boolean;
begin
  Lock();
  n4 := 0;
  m_boChanged := False;
  if FileExists(m_sDBFileName) then begin
    m_nFileHandle := FileOpen(m_sDBFileName, fmOpenReadWrite or fmShareDenyNone);
    if m_nFileHandle > 0 then
      FileRead(m_nFileHandle, m_Header, SizeOf(TDBHeader));
  end else begin
    m_nFileHandle := FileCreate(m_sDBFileName);
    if m_nFileHandle > 0 then begin
      m_Header.nHumCount := 0;
      m_Header.n6C := 0;
      FileWrite(m_nFileHandle, m_Header, SizeOf(TDBHeader));
    end;
  end;
  if m_nFileHandle > 0 then Result := True
  else Result := False;
end;

procedure TFileGMHumDB.Close;
begin
  FileClose(m_nFileHandle);
  if m_boChanged and Assigned(m_OnChange) then begin
    m_OnChange(Self);
  end;
  UnLock();
end;

function TFileGMHumDB.OpenEx: Boolean;
var
  DBHeader: TDBHeader;
begin
  Lock();
  m_boChanged := False;
  m_nFileHandle := FileOpen(m_sDBFileName, fmOpenReadWrite or fmShareDenyNone);
  if m_nFileHandle > 0 then begin
    Result := True;
    if FileRead(m_nFileHandle, DBHeader, SizeOf(TDBHeader)) = SizeOf(TDBHeader) then
      m_Header := DBHeader;
    n4 := 0;
  end else Result := False;
end;

function TFileGMHumDB.Index(sName: string): Integer;
begin
  Result := m_QuickIDList.GetIndex(sName);
end;

function TFileGMHumDB.Get(nIndex: Integer; var IPRecord: TRecordDataInfo): Integer;
var
  nIdx: Integer;
begin
  nIdx := Integer(m_QuickIDList.Objects[nIndex]);
  if GetRecord(nIdx, IPRecord) then Result := nIdx
  else Result := -1;
end;

function TFileGMHumDB.Update(nIndex: Integer;
  var IPRecord: TRecordDataInfo): Boolean;
begin
  Result := False;
  if (nIndex >= 0) and (m_QuickIDList.Count > nIndex) then
    if UpdateRecord(Integer(m_QuickIDList.Objects[nIndex]), IPRecord, False) then Result := True;
end;

function TFileGMHumDB.Add(var IPRecord: TRecordDataInfo): Boolean;
var
  sName: string;
  DBHeader: TDBHeader;
  nIdx: Integer;
begin
  sName := IPRecord.sAccount;
  if m_QuickIDList.GetIndex(sName) >= 0 then begin
    Result := False;
  end else begin
    DBHeader := m_Header;
    if m_DeletedList.Count > 0 then begin
      nIdx := Integer(m_DeletedList.Items[0]);
      m_DeletedList.Delete(0);
    end else begin
      nIdx := m_Header.nHumCount;
      Inc(m_Header.nHumCount);
    end;
    if UpdateRecord(nIdx, IPRecord, True) then begin
      m_QuickIDList.AddRecord(sName, nIdx);
      Result := True;
    end else begin
      m_Header := DBHeader;
      Result := False;
    end;
  end;
end;

function TFileGMHumDB.GetRecord(nIndex: Integer;
  var IPRecord: TRecordDataInfo): Boolean;
begin
  if FileSeek(m_nFileHandle, nIndex * SizeOf(TRecordDataInfo) + SizeOf(TDBHeader), 0) <> -1 then begin
    FileRead(m_nFileHandle, IPRecord, SizeOf(TRecordDataInfo));
    FileSeek(m_nFileHandle, -SizeOf(TRecordDataInfo), 1);
    n4 := nIndex;
    Result := True;
  end else Result := False;
end;

function TFileGMHumDB.UpdateRecord(nIndex: Integer;
  var IPRecord: TRecordDataInfo; boNew: Boolean): Boolean;
var
  nPosion, n10: Integer;
  dt20: TDateTime;
  ReadRCD: TRecordDataInfo;
begin
  nPosion := nIndex * SizeOf(TRecordDataInfo) + SizeOf(TDBHeader);
  if FileSeek(m_nFileHandle, nPosion, 0) = nPosion then begin
    dt20 := Now();
    m_nLastIndex := nIndex;
    m_dUpdateTime := dt20;
    n10 := FileSeek(m_nFileHandle, 0, 1);
    if boNew
      and (FileRead(m_nFileHandle, ReadRCD, SizeOf(TRecordDataInfo)) = SizeOf(TRecordDataInfo))
      and not ReadRCD.boDeleted and (ReadRCD.sAccount <> '') then begin
      Result := False;
    end else begin
      IPRecord.boDeleted := False;
      IPRecord.dCreateDate := Now();
      m_Header.nLastIndex := m_nLastIndex;
      m_Header.dLastDate := m_dUpdateTime;
      m_Header.dUpdateDate := Now();
      FileSeek(m_nFileHandle, 0, 0);
      FileWrite(m_nFileHandle, m_Header, SizeOf(TDBHeader));
      FileSeek(m_nFileHandle, n10, 0);
      FileWrite(m_nFileHandle, IPRecord, SizeOf(TRecordDataInfo));
      FileSeek(m_nFileHandle, -SizeOf(TRecordDataInfo), 1);
      n4 := nIndex;
      m_boChanged := True;
      Result := True;
    end;
  end else Result := False;
end;

function TFileGMHumDB.Find(sChrName: string;
  List: TStrings): Integer;
var
  I: Integer;
begin
  {for I := 0 to m_QuickIDList.Count - 1 do begin
    if CompareLStr(m_QuickIDList.Strings[I], sChrName, Length(sChrName)) then begin
      List.AddObject(m_QuickIDList.Strings[I], m_QuickIDList.Objects[I]);
    end;
  end;
  Result := List.Count;}
end;

function TFileGMHumDB.Delete(nIndex: Integer): Boolean;
var
  I: Integer;
begin
  Result := False;
  for I := 0 to m_QuickIDList.Count - 1 do begin
    if Integer(m_QuickIDList.Objects[I]) = nIndex then begin
      if DeleteRecord(nIndex) then begin
        m_QuickIDList.Delete(I);
        Result := True;
        Break;
      end;
    end;
  end;
end;

function TFileGMHumDB.Delete(sName: string): Boolean;
var
  I: Integer;
  nIndex: Integer;
begin
  Result := False;
  //nIndex := m_QuickIDList.GetIndex(sName);
  //Delete(nIndex);
  for I := 0 to m_QuickIDList.Count - 1 do begin
    if m_QuickIDList.Strings[I] = sName then begin
      nIndex := Integer(m_QuickIDList.Objects[I]);
      if DeleteRecord(nIndex) then begin
        m_QuickIDList.Delete(I);
        Result := True;
        Break;
      end;
    end;
  end;
end;

function TFileGMHumDB.DeleteRecord(nIndex: Integer): Boolean;
var
  ChrRecordHeader: TIPRecordHeader;
begin
  Result := False;
  if FileSeek(m_nFileHandle, nIndex * SizeOf(TRecordDataInfo) + SizeOf(TDBHeader), 0) = -1 then Exit;
  m_nLastIndex := nIndex;
  m_dUpdateTime := Now();
  ChrRecordHeader.boDeleted := True;
  FileWrite(m_nFileHandle, ChrRecordHeader, SizeOf(TIPRecordHeader));
  m_DeletedList.Add(Pointer(nIndex));
  m_Header.nLastIndex := m_nLastIndex;
  m_Header.dLastDate := m_dUpdateTime;
  m_Header.dUpdateDate := Now();
  FileSeek(m_nFileHandle, 0, 0);
  FileWrite(m_nFileHandle, m_Header, SizeOf(TDBHeader));
  m_boChanged := True;
  Result := True;
end;

procedure TFileGMHumDB.Rebuild;
var
  sTempFileName: string;
  nHandle, n10: Integer;
  DBHeader: TDBHeader;
  ChrRecord: TRecordDataInfo;
begin
  sTempFileName := 'Mir#$00.DB';
  if FileExists(sTempFileName) then
    DeleteFile(sTempFileName);
  nHandle := FileCreate(sTempFileName);
  n10 := 0;
  if nHandle < 0 then Exit;
  try
    if Open then begin
      FileSeek(m_nFileHandle, 0, 0);
      if FileRead(m_nFileHandle, DBHeader, SizeOf(TDBHeader)) = SizeOf(TDBHeader) then begin
        FileWrite(nHandle, DBHeader, SizeOf(TDBHeader));
        while (True) do begin
          if FileRead(m_nFileHandle, ChrRecord, SizeOf(TRecordDataInfo)) = SizeOf(TRecordDataInfo) then begin
            if ChrRecord.boDeleted then Continue;
            FileWrite(nHandle, ChrRecord, SizeOf(TRecordDataInfo));
            Inc(n10);
          end else Break;
        end;
        DBHeader.nHumCount := n10;
        DBHeader.dUpdateDate := Now();
        FileSeek(nHandle, 0, 0);
        FileWrite(nHandle, DBHeader, SizeOf(TDBHeader));
      end;
    end;
  finally
    Close;
  end;
  FileClose(nHandle);
  FileCopy(sTempFileName, m_sDBFileName);
  DeleteFile(sTempFileName);
end;

function TFileGMHumDB.Count: Integer;
begin
  Result := m_QuickIDList.Count;
end;

end.