jvquibmetadata.pas

East make Tray Icon in delphi

var
  I: Integer;
begin
  Stream.WriteString(Format('CREATE TABLE %s (', [FName]));
  for I := 0 to FieldsCount - 1 do
  begin
    Stream.WriteString(BreakLine + '   ');
    Fields[I].SaveToDDL(Stream);
    if I <> FieldsCount - 1 then
      Stream.WriteString(',');
  end;
  Stream.WriteString(BreakLine + ');');
end;

class function TMetaTable.NodeClass: string;
begin
  Result := 'Table';
end;

class function TMetaTable.NodeType: TMetaNodeType;
begin
  Result := MetaTable;
end;

//=== { TMetaBaseField } =====================================================

procedure TMetaBaseField.LoadFromStream(Stream: TStream);
begin
  ReadString(Stream, FName);
  Stream.Read(FFieldType, SizeOf(FFieldType));

  if FFieldType = uftNumeric then
  begin
    Stream.Read(FScale, SizeOf(FScale));
    Stream.Read(FPrecision, SizeOf(FPrecision));
  end
  else
  begin
    FScale := 0;
    FPrecision := 0;
  end;

  if FFieldType in [uftChar..uftCstring] then
  begin
    Stream.Read(FLength, SizeOf(FLength));
    ReadString(Stream, FCharSet);
    Stream.Read(FBytesPerCharacter, SizeOf(FBytesPerCharacter));
  end
  else
  begin
    FLength := 0;
    FCharSet := '';
  end;

  if FFieldType = uftBlob then
  begin
    Stream.Read(FSegmentLength, SizeOf(FSegmentLength));
    Stream.Read(FSubType, SizeOf(FSubType));
  end
  else
  begin
    FSegmentLength := 0;
    FSubType := 0;
  end;
end;

procedure TMetaBaseField.SaveToStream(Stream: TStream);
begin
  WriteString(Stream, FName);
  Stream.Write(FFieldType, SizeOf(FFieldType));

  if FFieldType = uftNumeric then
  begin
    Stream.Write(FScale, SizeOf(FScale));
    Stream.Write(FPrecision, SizeOf(FPrecision));
  end;

  if FFieldType in [uftChar..uftCstring] then
  begin
    Stream.Write(FLength, SizeOf(FLength));
    WriteString(Stream, FCharSet);
    Stream.Write(FBytesPerCharacter, SizeOf(FBytesPerCharacter));
  end;

  if FFieldType = uftBlob then
  begin
    Stream.Write(FSegmentLength, SizeOf(FSegmentLength));
    Stream.Write(FSubType, SizeOf(FSubType));
  end;
end;

procedure TMetaBaseField.LoadFromQuery(QField, QCharset: TJvUIBStatement);

  procedure FindCharset(const Id: Single; var Charset: string; var Count: Smallint);
  var
    I: Integer;
  begin
    for I := 0 to QCharset.Fields.RecordCount - 1 do
    begin
      QCharset.Fields.GetRecord(I);
      if QCharset.Fields.AsSmallint[0] = Id then
      begin
        Charset := Trim(QCharset.Fields.AsString[1]);
        Count := QCharset.Fields.AsSmallint[2];
        Exit;
      end;
      Charset := '';
      FBytesPerCharacter := 1;
    end;
  end;

begin
  FScale := Abs(QField.Fields.AsSmallInt[1]);
  FLength := QField.Fields.AsSmallInt[2];
  FPrecision := QField.Fields.AsSmallInt[3];
  if FScale > 0 then
  begin
    FFieldType := uftNumeric;
    if FPrecision = 0 then
      case QField.Fields.AsSmallint[0] of
        blr_short:
          FPrecision := 4;
        blr_long:
          FPrecision := 7;
        blr_int64, blr_quad, blr_double:
          FPrecision := 15;
      else
        raise EUIBError.Create(EUIB_UNEXPECTEDERROR);
      end;
  end
  else
    case QField.Fields.AsSmallint[0] of
      blr_text, blr_text2:
        FFieldType := uftChar;
      blr_varying, blr_varying2:
        FFieldType := uftVarchar;
      blr_cstring, blr_cstring2:
        FFieldType := uftCstring;
      blr_short:
        FFieldType := uftSmallint;
      blr_long:
        FFieldType := uftInteger;
      blr_quad:
        FFieldType := uftQuad;
      blr_float, blr_d_float:
        FFieldType := uftFloat;
      blr_double:
        FFieldType := uftDoublePrecision;
      blr_timestamp:
        FFieldType := uftTimestamp;
      blr_blob:
        FFieldType := uftBlob;
      blr_blob_id:
        FFieldType := uftBlobId;
      blr_sql_date:
        FFieldType := uftDate;
      blr_sql_time:
        FFieldType := uftTime;
      blr_int64:
        FFieldType := uftInt64;
      {$IFDEF IB7_UP}
      blr_boolean_dtype:
        FFieldType := uftBoolean;
      {$ENDIF IB7_UP}
    end;
  if (FFieldType in [uftChar, uftVarchar, uftCstring]) and
    not QField.Fields.IsNull[4] then
    FindCharset(QField.Fields.AsSmallint[4], FCharSet, FBytesPerCharacter)
  else
    FBytesPerCharacter := 1;

  FSubType := QField.Fields.AsSmallint[5];
end;

procedure TMetaBaseField.SaveToDDLNode(Stream: TStringStream);
begin
  case FFieldType of
    uftNumeric:
      Stream.WriteString(Format('%s(%d,%d)',
        [FieldTypes[FFieldType], FPrecision, FScale]));
    uftChar..uftCstring:
      begin
        Stream.WriteString(Format('%s(%d)',
          [FieldTypes[FFieldType], FLength div FBytesPerCharacter]));
        if FCharSet <> '' then
          Stream.WriteString(' CHARACTER SET ' + FCharSet);
      end;
    uftBlob:
      Stream.WriteString(Format('%s SUB_TYPE %d SEGMENT SIZE %d',
        [FieldTypes[FFieldType], FSubType, FSegmentLength]));
  else
    Stream.WriteString(Format('%s', [FieldTypes[FFieldType]]));
  end;
end;

class function TMetaBaseField.NodeClass: string;
begin
  Result := 'Field';
end;

function TMetaBaseField.GetShortFieldType: string;
begin
  case FFieldType of
    uftChar..uftCstring:
      Result := Format('%s(%d)', [FieldTypes[FFieldType],
        FLength div FBytesPerCharacter]);
    uftNumeric:
      Result := Format('%s(%d,%d)',
        [FieldTypes[FFieldType], FPrecision, FScale]);
  else
    Result := Format('%s', [FieldTypes[FFieldType]]);
  end;
end;

class function TMetaBaseField.NodeType: TMetaNodeType;
begin
  Result := MetaBaseField;
end;

//=== { TMetaDataBase } ======================================================

constructor TMetaDataBase.Create(AOwner: TMetaNode; ClassIndex: Integer);
begin
  inherited Create(nil, -1);
  AddClass(TMetaDomain);
  AddClass(TMetaTable);
  AddClass(TMetaView);
  AddClass(TMetaProcedure);
  AddClass(TMetaGenerator);
  AddClass(TMetaException);
  AddClass(TMetaUDF);
  AddClass(TMetaRole);

  FOIDDatabases := ALLOBjects;
  FOIDTables := ALLTables;
  FOIDViews := ALLViews;
  FOIDProcedures := ALLProcedures;
  FOIDUDFs := ALLUDFs;
  FSysInfos := False;
end;

procedure TMetaDataBase.LoadFromDatabase(Transaction: TJvUIBTransaction);
var
  I: Integer;
  ConStr, Str: string;
  QNames, QFields, QCharset, QPrimary: TJvUIBStatement;
  QIndex, QForeign, QCheck, QTrigger: TJvUIBStatement;

  procedure Configure(var Q: TJvUIBStatement; const Qry: string;
    CachedFetch: Boolean = False);
  begin
    Q := TJvUIBStatement.Create(nil);
    Q.Transaction := Transaction;
    Q.CachedFetch := CachedFetch;
    Q.SQL.Text := Qry;
  end;

begin
  CheckTransaction(Transaction);

  FName := Transaction.DataBase.DatabaseName;

  Configure(QNames, '');
  if FSysInfos then
    Configure(QTrigger, QRYSysTrigger)
  else
    Configure(QTrigger, QRYTrigger);
  Configure(QCharset, QRYCharset, True);
  Configure(QFields, QRYTableFields);
  Configure(QPrimary, QRYUnique, True);
  Configure(QIndex, QRYIndex);
  Configure(QForeign, QRYForeign);
  Configure(QCheck, QRYCheck);
  try
    // preload Charsets
    QCharset.Open;
    QCharset.FetchAll;

    // DOMAINS
    if OIDDomain in FOIDDatabases then
    begin
      FNodeItems[Ord(OIDDomain)].Childs.Clear;
      if FSysInfos then
        QNames.SQL.Text := QRYSysDomains
      else
        QNames.SQL.Text := QRYDomains;
      QNames.Open;
      while not QNames.Eof do
      begin
        with TMetaDomain.Create(Self, Ord(OIDDomain)) do
          LoadFromQuery(QNames, QCharset);
        QNames.Next;
      end;
    end;

    // GENERATORS
    if OIDGenerator in FOIDDatabases then
    begin
      FNodeItems[Ord(OIDGenerator)].Childs.Clear;
      QNames.SQL.Text := QRYGenerators;
      QNames.Open;
      while not QNames.Eof do
      begin
        with TMetaGenerator.Create(Self, Ord(OIDGenerator)) do
          LoadFromDataBase(Transaction, Trim(QNames.Fields.AsString[0]));
        QNames.Next;
      end;
    end;

    // TABLES
    if OIDTable in FOIDDatabases then
    begin
      FNodeItems[Ord(OIDTable)].Childs.Clear;
      if FSysInfos then
        QNames.SQL.Text := QRYSysTables
      else
        QNames.SQL.Text := QRYTables;
      QNames.Open;
      while not QNames.Eof do
      begin
        with TMetaTable.Create(Self, Ord(OIDTable)) do
          LoadFromDataBase(QNames, QFields, QCharset, QPrimary,
            QIndex, QForeign, QCheck, QTrigger, FOIDTables);
        QNames.Next;
      end;

      // FOREIGN
      if [OIDForeign, OIDTableField] <= FOIDTables then
      begin
        for I := 0 to TablesCount - 1 do
        begin
          QForeign.Params.AsString[0] := Tables[I].Name;
          QForeign.Open;
          ConStr := '';
          while not QForeign.Eof do
          begin
            if ConStr <> Trim(QForeign.Fields.AsString[0]) then // new
            begin
              with TMetaForeign.Create(Tables[I], Ord(OIDForeign)) do
              begin
                FName := Trim(QForeign.Fields.AsString[0]);
                ConStr := FName;
                FForTable := FindTableIndex(Trim(QForeign.Fields.AsString[3]));
                if 'TABLE1' = Trim(QForeign.Fields.AsString[3]) then
                  beep;
                SetLength(FFields, 1);
                FFields[0] := Tables[I].FindFieldIndex(Trim(QForeign.Fields.AsString[5]));
                Include(Tables[I].Fields[FFields[0]].FInfos, fForeign);
                SetLength(FForFields, 1);
                FForFields[0] := ForTable.FindFieldIndex(Trim(QForeign.Fields.AsString[4]));

                Str := Trim(QForeign.Fields.AsString[1]);
                if Str = 'RESTRICT' then
                  FOnUpdate := Restrict
                else
                if Str = 'CASCADE' then
                  FOnUpdate := Cascade
                else
                if Str = 'SET NULL' then
                  FOnUpdate := SetNull
                else
                  FOnUpdate := SetDefault;

                Str := Trim(QForeign.Fields.AsString[2]);
                if Str = 'RESTRICT' then
                  FOnDelete := Restrict
                else
                if Str = 'CASCADE' then
                  FOnDelete := Cascade
                else
                  if Str = 'SET NULL' then
                  FOnDelete := SetNull
                else
                  FOnDelete := SetDefault;
              end;
            end
            else
              with Tables[I].Foreign[Tables[I].ForeignCount - 1] do
              begin
                SetLength(FFields, Length(FFields) + 1);
                FFields[FieldsCount - 1] := Tables[I].FindFieldIndex(Trim(QForeign.Fields.AsString[5]));
                Include(Tables[I].Fields[FFields[FieldsCount - 1]].FInfos, fForeign);
                SetLength(FForFields, Length(FForFields) + 1);
                FForFields[ForFieldsCount - 1] := ForTable.FindFieldIndex(Trim(QForeign.Fields.AsString[4]));
              end;
            QForeign.Next;
          end;
        end;
      end;
    end;

    // VIEWS
    if OIDView in FOIDDatabases then
    begin
      FNodeItems[Ord(OIDView)].Childs.Clear;
      QNames.SQL.Text := QRYView;
      QNames.Open;
      while not QNames.Eof do
      begin
        with TMetaView.Create(Self, Ord(OIDView)) do
          LoadFromDataBase(QNames, QFields, QTrigger, QCharset, FOIDViews);