Why Gemfury? Push, build, and install  RubyGems npm packages Python packages Maven artifacts PHP packages Go Modules Debian packages RPM packages NuGet packages

Repository URL to install this package:

Details    
fpc-src / usr / share / fpcsrc / 3.0.0 / packages / fpindexer / src / fbindexdb.pp
Size: Mime:
{
    This file is part of the Free Component Library (FCL)
    Copyright (c) 2012 by the Free Pascal development team

    SQLDB Firebird based indexer
    
    See the file COPYING.FPC, included in this distribution,
    for details about the copyright.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

 **********************************************************************}
unit fbIndexdb;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, fpIndexer, sqldbIndexDB ,sqldb, ibconnection;

type
  { TFBIndexDB }

  TFBIndexDB = class(TSQLDBIndexDB)
  private
    FIB: TIBConnection;
    FGenQuery: Array[TIndexTable] of TSQLQuery;
    Function GetGenQuery(ATable : TIndexTable) : TSQLQuery;
    function GetS(AIndex: integer): string;
    procedure SetS(AIndex: integer; const AValue: string);
  protected
    procedure InsertMatch(AWordID, aFileID, aLanguageID: int64; const ASearchData: TSearchWordData); override;
    function InsertWord(const AWord: string): int64; override;
    function InsertURL(const URL: string; ATimeStamp: TDateTime; ALanguageID: int64): int64; override;
    function InsertLanguage(const ALanguage: string): int64; override;
    function GetConnection: TSQLConnection; override;
    function GetID(TableType: TIndexTable): int64;
    procedure FinishCreateTable(const TableType: TIndexTable); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property DatabasePath: string Index 0 read GetS write SetS;
    property UserName: string Index 1 read GetS write SetS;
    property Password: string Index 2 read GetS write SetS;
  end;

implementation

{ TFBIndexDB }

function TFBIndexDB.GetID(TableType: TIndexTable): int64;

var
  Q: TSQLQuery;
  S: string;

begin
  Q := GetGenQuery(TableType);
  Q.Open;
  try
    if (Q.EOF and Q.BOF) then
      raise Exception.CreateFmt('Could not get ID for table %s', [GetTableName(TableType)]);
    Result := Q.Fields[0].AsLargeInt;
  finally
    Q.Close;
  end;
end;

function TFBIndexDB.InsertLanguage(const ALanguage: string): int64;
var
  Q: TSQLQuery;
begin
  Result := getID(itLanguages);
  Q := CreateCachedQuery(cqtInsertLanguage, InsertSQL(itLanguages));
  Q.ParamByName(GetFieldName(ifLanguagesID)).AsLargeInt := Result;
  Q.ParamByName(GetFieldName(ifLanguagesName)).AsString := ALanguage;
  Q.ExecSQL;
end;

function TFBIndexDB.InsertWord(const AWord: string): int64;
var
  Q: TSQLQuery;
begin
  Result := getID(itWords);
  Q := CreateCachedQuery(cqtInsertWord, InsertSQL(itWords));
  Q.ParamByName(GetFieldName(ifWordsID)).AsLargeInt := Result;
  Q.ParamByName(GetFieldName(ifWordsWord)).AsString := AWord;
  Q.ExecSQL;
end;

function TFBIndexDB.InsertURL(const URL: string; ATimeStamp: TDateTime; ALanguageID: int64): int64;
var
  Q: TSQLQuery;
begin
  Result := getID(itFiles);
  Q := CreateCachedQuery(cqtInsertFile, InsertSQL(itFiles));
  Q.ParamByName(GetFieldName(ifFilesID)).AsLargeInt := Result;
  Q.ParamByName(GetFieldName(ifFilesURL)).AsString := URL;
  Q.ParamByName(GetFieldName(ifFilesTimeStamp)).AsDateTime := ATimeStamp;
  Q.ParamByName(GetFieldName(ifFilesLanguageID)).AsLargeInt := ALanguageID;
  Q.ParamByName(GetFieldName(ifFilesUpdated)).AsInteger := 0;
  Q.ParamByName(GetFieldName(ifFilesReindex)).AsInteger := 0;
  Q.ExecSQL;
end;

procedure TFBIndexDB.InsertMatch(AWordID, aFileID, aLanguageID: int64; const ASearchData: TSearchWordData);
var
  Q: TSQLQuery;
begin
  Q := CreateCachedQuery(cqtInsertMatch, InsertSQL(itMatches));
  Q.ParamByName(GetFieldName(ifMatchesID)).AsLargeInt := GetID(itMatches);
  Q.ParamByName(GetFieldName(ifMatchesLanguageID)).AsLargeInt := aLanguageID;
  Q.ParamByName(GetFieldName(ifMatchesWordID)).AsLargeInt := aWordID;
  Q.ParamByName(GetFieldName(ifMatchesFileID)).AsLargeInt := aFileID;
  Q.ParamByName(GetFieldName(ifMatchesPosition)).AsLargeInt := ASearchData.Position;
  Q.ParamByName(GetFieldName(ifMatchesContext)).AsString := ASearchData.Context;
  Q.ExecSQL;
end;

function TFBIndexDB.GetConnection: TSQLConnection;
begin
  Result := FiB;
end;

procedure TFBIndexDB.FinishCreateTable(const TableType: TIndexTable);
begin
  Execute('CREATE GENERATOR ' + DefaultGeneratorNames[TableType], True);
end;

constructor TFBIndexDB.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FIB := TIBConnection.Create(nil);
end;

destructor TFBIndexDB.Destroy;
begin
  // Parent destroys FIB.
  inherited Destroy;
end;

function TFBIndexDB.GetGenQuery(ATable: TIndexTable): TSQLQuery;
begin
  If (FGenQuery[ATable]=Nil) then
    begin
    FGenQuery[ATable]:=CreateQuery(Format('SELECT GEN_ID(%S,1) FROM RDB$DATABASE', [DefaultGeneratorNames[ATable]]));
    FGenQuery[ATable].Prepare;
    end;
  Result:=FGenQuery[ATable];
end;

function TFBIndexDB.GetS(AIndex: integer): string;
begin
  case Aindex of
    0: Result := FIB.DatabaseName;
    1: Result := FIB.UserName;
    2: Result := FIB.Password;
    3: Result := FIB.HostName;
  end;
end;

procedure TFBIndexDB.SetS(AIndex: integer; const AValue: string);
begin
  case Aindex of
    0: FIB.DatabaseName := AValue;
    1: FIB.UserName := AValue;
    2: FIB.Password := AValue;
    3: FIB.HostName := AValue;
  end;
end;

end.