ibtable.pas

这是不可多得的源代码

  bWhereClausePresent: Boolean;
begin
  bWhereClausePresent := False;
  Database.CheckActive;
  Transaction.CheckInTransaction;
  if IndexDefs.Updated = False then
    IndexDefs.Update;
  if IndexFieldNames <> '' then
    OrderByStr := FormatFieldsList(IndexFieldNames)
  else
    if IndexName <> '' then
    begin
      OrderByStr := FormatFieldsList(IndexDefs[IndexDefs.Indexof (IndexName)].Fields);
      if ixDescending in IndexDefs[IndexDefs.Indexof (IndexName)].Options then
      begin
        StringReplace (OrderByStr, ',', ' DESC,', [rfReplaceAll]);  {do not localize}
        OrderByStr := OrderByStr + ' DESC';   {do not localize}
      end;
    end
    else
      if FDefaultIndex and (FPrimaryIndexFields <> '') then    {do not localize}
        OrderByStr := FormatFieldsList(FPrimaryIndexFields);
  SQL := TStringList.Create;
  SQL.Text := 'select ' + {do not localize}
    QuoteIdentifier(DataBase.SQLDialect, FTableName) + '.*, ' {do not localize}
    + 'RDB$DB_KEY as IBX_INTERNAL_DBKEY from ' {do not localize}
    + QuoteIdentifier(DataBase.SQLDialect, FTableName);
  if Filtered and (Filter <> '') then  {do not localize}
  begin
    SQL.Text := SQL.Text + ' where ' + Filter; {do not localize}
    bWhereClausePresent := True;
  end;
  if (MasterSource <> nil) and (MasterSource.DataSet <> nil) and (MasterFields <> '') then {do not localize}
  begin
    if bWhereClausePresent then
      SQL.Text := SQL.Text + ' AND ' {do not localize}
    else
      SQL.Text := SQL.Text + ' WHERE '; {do not localize}
    ExtractLinkfields;
    if FDetailFieldsList.Count < FMasterFieldsList.Count then
      IBError(ibxeUnknownError, [nil]);
    for i := 0 to FMasterFieldsList.Count - 1 do
    begin
      if i > 0 then
        SQL.Text := SQL.Text + 'AND ';   {do not localize}
      SQL.Text := SQL.Text +
        QuoteIdentifier(DataBase.SQLDialect, FDetailFieldsList.Strings[i]) +
        ' = :' +
        QuoteIdentifier(DataBase.SQLDialect, FMasterFieldsList.Strings[i]);
    end;
  end;
  if OrderByStr <> '' then
    SQL.Text := SQL.Text + ' order by ' + OrderByStr; {do not localize}
  SelectSQL.Assign(SQL);
  RefreshSQL.Text := 'select ' + {do not localize}
    QuoteIdentifier(DataBase.SQLDialect, FTableName) + '.*, ' {do not localize}
    + 'RDB$DB_KEY as IBX_INTERNAL_DBKEY from ' {do not localize}
    + QuoteIdentifier(DataBase.SQLDialect, FTableName) +
    ' where RDB$DB_KEY = :IBX_INTERNAL_DBKEY'; {do not localize}
  WhereDBKeyRefreshSQL.Assign(RefreshSQL);
  InternalPrepare;
  if not FReadOnly then
    GenerateUpdateSQL;
  SQL.Free;
end;

procedure TIBTable.GenerateUpdateSQL;
var
  InsertFieldList, InsertParamList, UpdateFieldList: string;
  WherePrimaryFieldList, WhereAllFieldList: string;

  procedure GenerateFieldLists;
  var
    I: Integer;
  begin
    for I := 0 to FieldDefs.Count - 1 do begin
      with FieldDefs[I] do begin
        if not (InternalCalcField or (faReadOnly in Attributes) or
          (DataType = ftUnknown)) then
        begin
          if ( InsertFieldList <> '' ) then begin
            InsertFieldList := InsertFieldList + ', ';     {do not localize}
            InsertParamList := InsertParamList + ', ';    {do not localize}
            UpdateFieldList := UpdateFieldList + ', ';     {do not localize}
            if (DataType <> ftBlob) and (DataType <>ftMemo) then
              WhereAllFieldList := WhereAllFieldList + ' AND ';  {do not localize}
          end;
          InsertFieldList := InsertFieldList +
            QuoteIdentifier(DataBase.SQLDialect, Name);
          InsertParamList := InsertParamList + ':' +  {do not localize}
            QuoteIdentifier(DataBase.SQLDialect, Name);
          UpdateFieldList := UpdateFieldList +
            QuoteIdentifier(DataBase.SQLDialect, Name) +
            ' = :' +   {do not localize}
            QuoteIdentifier(DataBase.SQLDialect, Name);
          if (DataType <> ftBlob) and (DataType <>ftMemo) then
            WhereAllFieldList := WhereAllFieldList +
              QuoteIdentifier(DataBase.SQLDialect, Name) + ' = :' +  {do not localize}
              QuoteIdentifier(DataBase.SQLDialect, Name);
        end;
      end;
    end;
  end;

  procedure GenerateWherePrimaryFieldList;
  var
    i: Integer;
    tmp: String;
  begin
    i := 1;
    while i <= Length(FPrimaryIndexFields) do
    begin
      tmp := ExtractFieldName(FPrimaryIndexFields, i);
      tmp :=
        QuoteIdentifier(DataBase.SQLDialect, tmp) +  ' = :' +   {do not localize}
        QuoteIdentifier(DataBase.SQLDialect, tmp);
      if WherePrimaryFieldList <> '' then
        WherePrimaryFieldList :=
          WherePrimaryFieldList + ' AND ' + tmp     {do not localize}
      else
        WherePrimaryFieldList := tmp;
    end;
  end;

begin
  if InternalGetUpdatable = False  then
    FReadOnly := True
  else
  begin
    DeleteSQL.Text := 'delete from ' + {do not localize}
      QuoteIdentifier(DataBase.SQLDialect, FTableName) +
      ' where RDB$DB_KEY = ' + ':IBX_INTERNAL_DBKEY'; {do not localize}
    GenerateFieldLists;
    InsertSQL.Text := 'insert into ' + {do not localize}
      QuoteIdentifier(DataBase.SQLDialect, FTableName) +
    ' (' + InsertFieldList + {do not localize}
      ') values (' + InsertParamList + ')'; {do not localize}
    ModifySQL.Text := 'update ' +  {do not localize}
      QuoteIdentifier(DataBase.SQLDialect, FTableName) +
      ' set ' + UpdateFieldList + {do not localize}
      ' where RDB$DB_KEY = :IBX_INTERNAL_DBKEY'; {do not localize}
    WhereAllRefreshSQL.Text := 'select ' +  {do not localize}
      QuoteIdentifier(DataBase.SQLDialect, FTableName) + '.*, ' {do not localize}
      + 'RDB$DB_KEY as IBX_INTERNAL_DBKEY from ' {do not localize}
      + QuoteIdentifier(DataBase.SQLDialect, FTableName) +
      ' where ' + WhereAllFieldList; {do not localize}
    if FPrimaryIndexFields <> '' then
    begin
      GenerateWherePrimaryFieldList;
      WherePrimaryRefreshSQL.Text := 'select ' + {do not localize}
        QuoteIdentifier(DataBase.SQLDialect, FTableName) + '.*, ' {do not localize}
        + 'RDB$DB_KEY as IBX_INTERNAL_DBKEY from ' {do not localize}
        + QuoteIdentifier(DataBase.SQLDialect, FTableName) +
        ' where ' + WherePrimaryFieldList; {do not localize}
    end;
    try
      InternalUnprepare;
      InternalPrepare;
    except
      FReadonly := True;
    end;
  end;
end;

procedure TIBTable.ResetSQLStatements;
begin
  SelectSQL.Text := ''; {do not localize}
  DeleteSQL.Text := '';  {do not localize}
  InsertSQL.Text := '';  {do not localize}
  ModifySQL.Text := '';  {do not localize}
  RefreshSQL.Text := '';  {do not localize}
end;

procedure TIBTable.SetTableTypes(
  const Value: TIBTableTypes);
begin
  FTableTypes := Value;
end;

function TIBTable.InternalGotoDBKey(DBKey: TIBDBKey): Boolean;

  function DBKeyCompare (DBKey1, DBKey2: TIBDBKey): Boolean;
  var
  I: Integer;
  begin
    for I := 0 to 7 do
      if (DBKey1.DBKey[i] <> DBKey2.DBKey[i]) then begin
        result := False;
        exit;
      end;
    result := True;
  end;
begin
  CheckActive;
  DisableControls;
 try
    result := False;
    First;
    while ((not result) and (not EOF)) do begin
      if (DBKeyCompare (DBKey, PRecordData(GetActiveBuf)^.rdDBKey)) then
        result := True
      else
        Next;
    end;
    if not result then
      First
    else
      CursorPosChanged;
  finally
    EnableControls;
  end;
end;

function TIBTable.GetCurrentDBKey: TIBDBKey;
var
  Buf: pChar;
begin
  CheckActive;
  buf := GetActiveBuf;
  if Buf <> nil then
    Result := PRecordData(Buf)^.rdDBKey
  else
    Result.DBKey[0] := 0;
end;

procedure TIBTable.Reopen;
begin
  DisableControls;
  try
    if Active then
    begin
      SetState(dsInactive);
      CloseCursor;
      OpenCursor;
      SetState(dsBrowse);
    end;
  finally
    EnableControls;
  end;
end;

{ TIBTable IProviderSupport }

function TIBTable.PSGetDefaultOrder: TIndexDef;

  function GetIdx(IdxType: TIndexOption): TIndexDef;
  var
    i: Integer;
  begin
    Result := nil;
    for i := 0 to IndexDefs.Count - 1 do
      if IdxType in IndexDefs[i].Options then
      try
        Result := IndexDefs[i];
        GetFieldList(nil, Result.Fields);
        break;
      except
        Result := nil;
      end;
  end;

var
  DefIdx: TIndexDef;
begin
  DefIdx := nil;
  IndexDefs.Update;
  try
    if IndexName <> '' then
      DefIdx := IndexDefs.Find(IndexName)
    else if IndexFieldNames <> '' then
      DefIdx := IndexDefs.FindIndexForFields(IndexFieldNames);
    if Assigned(DefIdx) then
      GetFieldList(nil, DefIdx.Fields);
  except
    DefIdx := nil;
  end;
  if not Assigned(DefIdx) then
    DefIdx := GetIdx(ixPrimary);
  if not Assigned(DefIdx) then
    DefIdx := GetIdx(ixUnique);
  if Assigned(DefIdx) then
  begin
    Result := TIndexDef.Create(nil);
    Result.Assign(DefIdx);
  end else
    Result := nil;
end;

function TIBTable.PSGetIndexDefs(IndexTypes: TIndexOptions): TIndexDefs;
begin
  Result := GetIndexDefs(IndexDefs, IndexTypes);
end;

function TIBTable.PSGeTTableName: string;
begin
  Result := FTableName;
end;

procedure TIBTable.PSSetParams(AParams: TParams);
begin
  if AParams.Count > 0 then
    Open;
  PSReset;
end;

procedure TIBTable.PSSetCommandText(const CommandText: string);
begin
  if CommandText <> '' then   {do not localize}
    TableName := CommandText;
end;

function TIBTable.PSGetKeyFields: string;
var
  i, Idx: Integer;
  IndexFound: Boolean;
begin
  Result := inherited PSGetKeyFields;
  if Result = '' then
  begin
    if not Exists then Exit;
    IndexFound := False;
    IndexDefs.Update;
    FieldDefs.Update;
    for i := 0 to IndexDefs.Count - 1 do
      if ixUnique in IndexDefs[I].Options then
      begin
        Idx := 1;
        Result := IndexDefs[I].Fields;
        IndexFound := False;
        while Idx <= Length(Result) do
        begin
          IndexFound := FindField(ExtractFieldName(Result, Idx)) <> nil;
          if not IndexFound then Break;
        end;
        if IndexFound then Break;
      end;
    if not IndexFound then
      Result := '';
  end;
end;

function TIBTable.InternalLocate(const KeyFields: string;
  const KeyValues: Variant; Options: TLocateOptions): Boolean;
var
  IsGood : TIBSQL;
  fl: TList;
  i, fld_cnt : Integer;
  fString, pString, eString : String;
  val : Array of Variant;
begin
  IsGood := TIBSQL.Create(Database);
  IsGood.Transaction := Transaction;
  IsGood.SQL.Text := 'select '  {do not localize}
    + 'RDB$DB_KEY as IBX_INTERNAL_DBKEY from ' {do not localize}
    + QuoteIdentifier(DataBase.SQLDialect, FTableName);
  fl := TList.Create;
  try
    GetFieldList(fl, KeyFields);
    fld_cnt := fl.Count;
    SetLength(val, fld_cnt);
    for i := 0 to fld_cnt - 1 do
      if VarIsArray(KeyValues) then
        val[i] := KeyValues[i]
      else
        val[i] := KeyValues;
    if loCaseInsensitive in Options then
    begin
      fString := 'UPPER(%:0s)';    {do not localize}
      pString := 'UPPER(:%:0s) ';   {do not localize}
    end
    else
    begin
      fString := '%:0s';     {do not localize}
      pString := ':%:0s ';   {do not localize}
    end;
    if loPartialKey in Options then
      eString := ' starting with '   {do not localize}
    else
      eString := ' = ';   {do not localize}
    for i := 0 to fld_cnt - 1 do
    begin
      if i > 0 then
      begin
        if VarIsNull(val[i]) then
          isGood.SQL.Add(Format(' and %s is null ',  {do not localize}
            [QuoteIdentifier(DataBase.SQLDialect, TField(fl[i]).FieldName)]))
        else
          isGood.SQL.Add(Format(' and ' + fString + eString + pString,   {do not localize}
            [ QuoteIdentifier(DataBase.SQLDialect, TField(fl[i]).FieldName)]));
      end
      else
      begin
        if VarIsNull(val[i]) then
          isGood.SQL.Add(Format(' Where %s is null ',    {do not localize}
            [QuoteIdentifier(DataBase.SQLDialect, TField(fl[i]).FieldName)]))
        else
          isGood.SQL.Add(Format(' Where ' + fString + eString + pString,  {do not localize }
            [ QuoteIdentifier(DataBase.SQLDialect, TField(fl[i]).FieldName)]));
      end;
    end;
    for i := 0 to fld_cnt - 1 do
      if not VarIsNull(val[i]) then
        isGood.Params.ByName(TField(fl[i]).FieldName).Value := val[i];
    IsGood.ExecQuery;
    if IsGood.Eof then
      Result := false
    else
      Result := inherited Locate(KeyFields, KeyValues, Options);
  finally
    IsGood.Free;
    fl.Free;
    val := nil;
  end;
end;

function TIBTable.Locate(const KeyFields: string; const KeyValues: Variant;
                                 Options: TLocateOptions): Boolean;
var
  CurBookmark: string;
begin
  DisableControls;
  try
    CurBookmark := Bookmark;
    First;
    result := InternalLocate(KeyFields, KeyValues, Options);
    if not result then
      Bookmark := CurBookmark;
  finally
    EnableControls;
  end;
end;

end.