AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Programmieren allgemein Delphi Record als Result einer Funktion
Thema durchsuchen
Ansicht
Themen-Optionen

Record als Result einer Funktion

Offene Frage von "Uwe Raabe"
Ein Thema von NoGAD · begonnen am 27. Mär 2020 · letzter Beitrag vom 30. Mär 2020
Antwort Antwort
Seite 2 von 7     12 34     Letzte »    
DieDolly

Registriert seit: 22. Jun 2018
2.175 Beiträge
 
#11

AW: Record als Result einer Funktion

  Alt 27. Mär 2020, 15:17
Zitat:
Das wäre in dem Fall aber immer noch Zufall und nichts, auf das du dich verlassen kannst/solltest!
Deswegen sollte man auch immer alles brav selber initialisieren.
  Mit Zitat antworten Zitat
Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
44.184 Beiträge
 
Delphi 12 Athens
 
#12

AW: Record als Result einer Funktion

  Alt 27. Mär 2020, 15:22
Dieser Record (über 4 Byte) wird, wie auch bei Strings, DynArrays, Interfaces und alle Typen größer als 4 Byte (NativeInt/Pointer) als VAR-Para,eter durchgereicht.

Die Initialisierung hängt also vom Aufrufer ab und dort ist es meistens eine lokale Variable in einer Prozedur.
Auch in einer Schleife (For/Repeat) ist sowas selten so initialisiert, wie du es denkst.
$2B or not $2B
  Mit Zitat antworten Zitat
Dennis07

Registriert seit: 19. Sep 2011
Ort: Deutschland
488 Beiträge
 
Delphi 11 Alexandria
 
#13

AW: Record als Result einer Funktion

  Alt 27. Mär 2020, 15:23
Deswegen sollte man auch immer alles brav selber initialisieren.
Da bin ich absolut deiner Meinung. Wollte nur sagen, dass du dich halt nicht darauf verlassen kannst, da sie halt nicht zwingend True sein müssen, sondern es nur meistens halt durch Zufall bei dir waren.
Dennis
  Mit Zitat antworten Zitat
Benutzerbild von NoGAD
NoGAD

Registriert seit: 31. Jan 2006
Ort: Weimar
345 Beiträge
 
Delphi 10.4 Sydney
 
#14

AW: Record als Result einer Funktion

  Alt 27. Mär 2020, 19:28
Ich habe mal mein Testprojekt angehängt.

Bitte nicht wundern, wenn hier und da noch etwas im Code technisch nicht ganz sauber ist.


Code:
procedure init_Result( var _Result : TDB_Result );
  begin

>> Hier mal ein Exit; rein machen und bitte testen.
Mit dieser Hilfsprocedure klappt es nun auch.

Als Fremdkomponenten benutze ich ABSDatabase, ABSQuery, ABSTable.

LG Mathias



Edit: Quellcode hinzugefügt

Code:
unit Unit1;

interface

uses
  Unit_ABS_DBFunctions,

  Winapi.Windows,
  Winapi.Messages,
  System.SysUtils,
  System.Variants,
  System.Classes,
  Vcl.Graphics,
  Vcl.Controls,
  Vcl.Forms,
  Vcl.Dialogs,
  Data.DB,
  ABSMain,
  Vcl.Grids,
  Vcl.DBGrids,
  Vcl.StdCtrls;

type
  TForm1 = class( TForm )
    DBGrid1 : TDBGrid;
    ABSDatabase1 : TABSDatabase;
    ABSTable1 : TABSTable;
    DataSource1 : TDataSource;
    Button1 : TButton;
    ABSQuery1 : TABSQuery;
    Button2 : TButton;
    Button3 : TButton;
    Memo1 : TMemo;
    Button4 : TButton;
    Button5 : TButton;
    Button6 : TButton;
    procedure Button1Click( Sender : TObject );
    procedure Button3Click( Sender : TObject );
    procedure Button4Click( Sender : TObject );
    procedure Button2Click( Sender : TObject );
    procedure FormCreate( Sender : TObject );
    procedure Button5Click( Sender : TObject );
    procedure Button6Click( Sender : TObject );
    private
      { Private-Deklarationen }
    public
      { Public-Deklarationen }
  end;

var
  Form1 : TForm1;
  a_SelfPath : string;
  { Datenbankpfad }
  a_DataBasePath : string;
  a_DatabaseFileName : string;

const

  DatabaseFileName = 'test_db';
  DatabaseExt = '.trm';
  DatabaseName = 'DB';

  { Fields Table Test }
  TableName_Test = 'test_table';
  Labels_DB : TArray< string > = [ 'nummer', 'spalte2', 'spalte3', 'spalte4', 'spalte5', 'ALF', 'eeeeeee' ];
  Labels_DB_Type_Query : TArray< string > = [ 'AUTOINC NOT NULL', 'VARCHAR(%d) NOT NULL', 'VARCHAR(%d)', 'VARCHAR(%d)', 'VARCHAR(%d)', 'VARCHAR(%d)', 'AUTOINC' ];
  Labels_DB_Size_Query : TArray< Integer > = [ 0, 2, 2, 4, 2, 2, 0 ];
  Indizes_DB_Query_n : TArray< TArray< string > > = [ [ 'pk_number', 'CREATE UNIQUE INDEX pk_number ON test_table (nummer);' ], [ 'i_spalte2', 'CREATE INDEX i_spalte2 ON test_table (spalte2,spalte3 );' ], [ 'i_spalte4', 'CREATE INDEX i_spalte4 ON test_table (spalte2,spalte3 );' ], [ 'i_spalte3', 'CREATE INDEX i_spalte3 ON test_table (spalte2,spalte3 );' ] ];

implementation

{$R *.dfm}

procedure TForm1.Button1Click( Sender : TObject );
  var
    i : Integer;
  begin

    if trim( ABSDatabase1.DatabaseFileName ) <> '' then
      if ( FileExists( ABSDatabase1.DatabaseFileName ) ) then
        if trim( ABSTable1.TableName ) <> '' then
          if ABSTable1.Database.Exists then
            try
              ABSTable1.FieldDefs.BeginUpdate;
              ABSTable1.DisableControls;
              for i := 1 to 7 do
              begin
                ABSTable1.Append;
                ABSTable1.FieldByName( Labels_DB[ 1 ] ).AsInteger := random( 300 ) + 1700;
                ABSTable1.FieldByName( Labels_DB[ 2 ] ).AsInteger := random( 300 ) + 1700;
                ABSTable1.FieldByName( Labels_DB[ 3 ] ).AsInteger := random( 300 ) + 1700;
                ABSTable1.FieldByName( Labels_DB[ 4 ] ).AsString := format( '%d,%2.2d', [ random( 50 ) + 5, random( 99 ) ] );
                ABSTable1.FieldByName( Labels_DB[ 5 ] ).AsString := '5';
                ABSTable1.Post;
              end;
              ABSTable1.EnableControls;
              ABSTable1.FieldDefs.EndUpdate;
            finally
              Memo1.Lines.Add( '' );
              Memo1.Lines.Add( '- Datensätze wurden hinzugefügt -' );
            end;

    if ( trim( ABSDatabase1.DatabaseFileName ) = '' ) or ( not FileExists( ABSDatabase1.DatabaseFileName ) ) then
    begin
      Memo1.Lines.Add( '' );
      Memo1.Lines.Add( '- Keine Datenbank vorhanden - ' );
      Memo1.Lines.Add( '(Kann keine Daten hinzufügen)' );
    end;

    if ( trim( ABSTable1.TableName ) = '' ) or ( not ABSTable1.Database.Exists ) then
    begin
      Memo1.Lines.Add( '' );
      Memo1.Lines.Add( '- Keine Tabelle vorhanden - ' );
      Memo1.Lines.Add( '(Kann keine Daten hinzufügen)' );
    end;

  end;

procedure TForm1.Button2Click( Sender : TObject );
  var
    DB_Result : TDB_Result;
  begin

    a_SelfPath := IncludeTrailingPathDelimiter( ExtractFilePath( ParamStr( 0 ) ) );
    a_DataBasePath := a_SelfPath;
    a_DatabaseFileName := a_DataBasePath + DatabaseFileName + DatabaseExt;

    init_Result( DB_Result );

    DB_Result := init_DatabaseABS( ABSDatabase1, ABSTable1, ABSQuery1, a_DatabaseFileName, DatabaseName );
    Memo1.Lines.Add( '' );
    if DB_Result.Create_Database then
      Memo1.Lines.Add( '- Datenbank wird neu erstellt -' );
    if DB_Result.Open_DataBase then
      Memo1.Lines.Add( '- Datenbank ist vorhanden, wird geöffnet -' );

    DB_Result := init_TableABS_Query( ABSDatabase1, ABSTable1, ABSQuery1, TableName_Test, Labels_DB, Labels_DB_Type_Query, Labels_DB_Size_Query, Indizes_DB_Query_n );
    Memo1.Lines.Add( '' );
    if DB_Result.Create_Table then
      Memo1.Lines.Add( '- Tabelle wurde neu erstellt -' );
    if DB_Result.Open_Table then
      Memo1.Lines.Add( '- Tabelle war vorhanden, wurde geöffnet -' );
    if DB_Result.Add_Table then
      Memo1.Lines.Add( '- Tabelle wurde hinzugefügt -' );
    if DB_Result.Create_Field then
      Memo1.Lines.Add( '- Feld(er) wurde(n) zur Tabelle hinzugefügt -' );
    if DB_Result.Change_Field then
      Memo1.Lines.Add( '- Feld(er) in der Tabelle wurde(n) aktualisiert -' );
    if DB_Result.Delete_Field then
      Memo1.Lines.Add( '- Felde(r) in der Tabelle wurde(n) gelöscht -' );
    if DB_Result.Create_Index then
      Memo1.Lines.Add( '- Index/Indizes wurde(n) neu erstellt -' );
    if DB_Result.Add_Index then
      Memo1.Lines.Add( '- Index/Indizes wurde(n) hinzugefügt -' );
    if DB_Result.Change_Index then
      Memo1.Lines.Add( '- Index/Indizes wurde(n) aktualisiert -' );
    if DB_Result.Rebuild_Index then
      Memo1.Lines.Add( '- Index/Indizes wurde(n) neu aufgebaut -' );

  end;

procedure TForm1.Button3Click( Sender : TObject );
  begin

    ABSTable1.Close;
    ABSQuery1.Close;
    ABSDatabase1.Close;
    ABSTable1.IndexDefs.Clear;
    ABSQuery1.IndexDefs.Clear;

    ABSDatabase1.DeleteDatabase;
    Memo1.Lines.Add( '' );
    Memo1.Lines.Add( '- Datenbank wurde gelöscht -' );

  end;

procedure TForm1.Button4Click( Sender : TObject );
  var
    x : Integer;
  begin

    if trim( ABSDatabase1.DatabaseFileName ) <> '' then
      if ( FileExists( ABSDatabase1.DatabaseFileName ) ) then
        if trim( ABSTable1.TableName ) <> '' then
          if ABSTable1.Database.Exists then
            try
              ABSTable1.IndexDefs.Update;
            finally
              Memo1.Lines.Add( '' );
              Memo1.Lines.Add( 'Indexfields:' );
              for x := 0 to pred( ABSTable1.IndexDefs.Count ) do
                Memo1.Lines.Add( format( '%s[%d] (%d): %s', [ 'Indexname', x, Succ( x ), ABSTable1.IndexDefs[ x ].Name ] ) );
            end;

    if ( trim( ABSDatabase1.DatabaseFileName ) = '' ) or ( not FileExists( ABSDatabase1.DatabaseFileName ) ) then
    begin
      Memo1.Lines.Add( '' );
      Memo1.Lines.Add( '- Keine Datenbank vorhanden - ' );
      Memo1.Lines.Add( '(Kann keine Idexfelder abrufen)' );
    end;

    if ( trim( ABSTable1.TableName ) = '' ) or ( not ABSTable1.Database.Exists ) then
    begin
      Memo1.Lines.Add( '' );
      Memo1.Lines.Add( '- Keine Tabelle vorhanden - ' );
      Memo1.Lines.Add( '(Kann keine Idexfelder abrufen)' );
    end;

  end;

procedure TForm1.Button5Click( Sender : TObject );
  begin

    Memo1.Lines.Clear;

  end;

procedure TForm1.Button6Click( Sender : TObject );
  var
    x : Integer;
  begin
    if trim( ABSDatabase1.DatabaseFileName ) <> '' then
      if ( FileExists( ABSDatabase1.DatabaseFileName ) ) then
        if trim( ABSTable1.TableName ) <> '' then
          if ABSTable1.Database.Exists then
            try
              ABSTable1.IndexDefs.Update;
            finally
              Memo1.Lines.Add( '' );
              Memo1.Lines.Add( 'FieldTypes:' );
              for x := 0 to pred( ABSTable1.FieldDefs.Count ) do
                Memo1.Lines.Add( format( '%s[%d]: %s | %s: %s(%d)', [ 'FieldName', x, ABSTable1.FieldDefs[ x ].Name, 'FieldType:', FieldTyp2String( ABSTable1.Fields[ x ].DataType ), ABSTable1.Fields[ x ].Size ] ) );
            end;

    if ( trim( ABSDatabase1.DatabaseFileName ) = '' ) or ( not FileExists( ABSDatabase1.DatabaseFileName ) ) then
    begin
      Memo1.Lines.Add( '' );
      Memo1.Lines.Add( '- Keine Datenbank vorhanden - ' );
      Memo1.Lines.Add( '(Kann keine FeldTypen abrufen)' );
    end;

    if ( trim( ABSTable1.TableName ) = '' ) or ( not ABSTable1.Database.Exists ) then
    begin
      Memo1.Lines.Add( '' );
      Memo1.Lines.Add( '- Keine Tabelle vorhanden - ' );
      Memo1.Lines.Add( '(Kann keine FeldTypen abrufen)' );
    end;

  end;

procedure TForm1.FormCreate( Sender : TObject );
  begin

    Button5Click( nil );
    // Button2Click( nil );
    // Button4Click( nil );

  end;

end.

Code:
unit Unit_ABS_DBFunctions;

interface

uses

  ABSSecurity,
  ABSMain,
  Data.DB,
  System.Classes,
  System.StrUtils,
  System.Sysutils,
  System.TypInfo,
  System.UITypes,
  Vcl.Controls,
  Vcl.Dialogs;

{ Datenbank-Rückgabe Ergebnisse von Funktionen }
type
  TDB_Result = record
    Open_DataBase : Boolean;
    Create_Database : Boolean;

    Open_Table : Boolean;
    Create_Table : Boolean;
    Add_Table : Boolean;

    Create_Field : Boolean;
    Add_Field : Boolean;
    Change_Field : Boolean;
    Delete_Field : Boolean;

    Create_Index : Boolean;
    Add_Index : Boolean;
    Change_Index : Boolean;
    Rebuild_Index : Boolean;

    RestructureResult : Boolean;
  end;

type
  TDB_Settings = record
    Show_Errors : Boolean;
    Show_Questions : Boolean;
    Delete_Fields : Boolean;
  end;

var
  DB_Settings : TDB_Settings;

const
  BR = #10#13;
  DBR = BR + BR;

  Question_Restructure_Table1 = 'Ein Programmupdate wurde kürzlich installiert. Die Datenbank ''%s'' muss aktualisiert werden. Dieser Vorgang kann länger dauern.';
  Question_Restructure_Table2 = '!! Befolgen Sie diesen Hinweis unbedingt !!' + DBR + 'Bitte beenden Sie das Programm nicht, auch wenn es aussieht, als würde es festhängen. Bitte melden Sie keinen weiteren Benutzer im Netzwerk an.' + DBR + 'Die Datenbank kann sonst beschädigt werden.';

  Error_C_DB_Create = 'Fehler: Datenbank [%s] konnte nicht erstellt werden!';
  Error_C_Table_Open = 'Die Tabelle [%s] konnte nicht geöffnet werden.';
  Error_C_Table_Create = 'Die Tabelle [%s] konnte nicht erstellt werden!';
  Error_C_Index_Rebuild = 'Indexfehler beim Neuaufbeu in Tabelle [%s]!';
  Error_C_Table_Restructure_AddField = 'Fehler bei der Restrukturierung. Das Tabellenfeld [%s] konnte nicht zur Tabelle [%s] hinzugefügt werden.';
  Error_C_Table_DropField = 'Fehler beim Löschen von Tabellenfeld [%s] in Tabelle [%s]!';
  Error_C_Table_Change_TypeSize = 'Fehler beim Ändern eines FeldTypes oder Feldgröße im Feld [%s]. Betrifft Tabelle [%s]!';

  Question_C_Table_FieldSize = 'Ein bestehendes Feld [%s] soll verkleinert werden. Dadurch kann es zu Datenverlust kommen. Soll der Vorgang fortgesetzt werden?';

procedure init_Result( var _Result : TDB_Result );
function FieldTyp2String( _ft : TFieldType ) : string;
function init_DatabaseABS( _DataBase : TABSDatabase; _Table : TABSTable; _Query : TABSQuery; _DatabaseFileName : string; _DatabaseName : string; _MultiUser : Boolean = True; _Encrypted : Boolean = False; _CryptoAlgorithm : TABSCryptoAlgorithm = craRijndael_256; _CryptoPassword : string = ''; _PageSize : Integer = 128; _PageCountInExtent : Integer = 8; _MaxConnections : Integer = 483 ) : TDB_Result;
function init_TableABS_Query( _DataBase : TABSDatabase; _Table : TABSTable; _Query : TABSQuery; _Table_Name : string; _Labels_DB : TArray< string >; _Labels_DB_Type_Query : TArray< string >; _Labels_DB_Size_Query : TArray< Integer >; _Indizes_DB_Query : TArray< TArray< string > > ) : TDB_Result;
function Restructure_Table_Query( _DataBase : TABSDatabase; _Query : TABSQuery; _Table_Name : string; _Labels_DB : TArray< string >; _Labels_DB_Type_Query : TArray< string >; _Labels_DB_Size_Query : TArray< Integer >; _Indizes_DB_Query : TArray< TArray< string > > ) : TDB_Result;
function Create_Table_Query( _Table : TABSTable; _Query : TABSQuery; _Table_Name : string; _Labels_DB : TArray< string >; _Labels_DB_Type_Query : TArray< string >; _Labels_DB_Size_Query : TArray< Integer > ) : TDB_Result;
function Index_Exists( _Table : TABSTable; const _IndexName : string ) : Boolean;
function Rebuild_Index_Query( _Table : TABSTable; _Query : TABSQuery; _Labels_DB : TArray< string >; _Labels_DB_Type_Query : TArray< string >; _Indizes_DB_Query : TArray< TArray< string > > ) : TDB_Result;

implementation

procedure init_Result( var _Result : TDB_Result );
  begin

>> Hier mal ein Exit; rein machen und bitte testen.

    _Result.Open_DataBase := False;
    _Result.Create_Database := False;

    _Result.Open_Table := False;
    _Result.Create_Table := False;
    _Result.Add_Table := False;

    _Result.Create_Field := False;
    _Result.Add_Field := False;
    _Result.Change_Field := False;
    _Result.Delete_Field := False;

    _Result.Create_Index := False;
    _Result.Add_Index := False;
    _Result.Change_Index := False;
    _Result.Rebuild_Index := False;

    _Result.RestructureResult := False;

  end;

function FieldTyp2String( _ft : TFieldType ) : string;
  begin

    case _ft of
      ftAutoinc : Result := 'AUTOINC';
      ftBlob : Result := 'BLOB';
      ftBytes : Result := 'BYTES';
      ftCurrency : Result := 'CURRENCY';
      ftDate : Result := 'DATE';
      ftDateTime : Result := 'DATETIME';
      ftFloat : Result := 'FLOAT';
      ftFmtMemo : Result := 'FORMATTEDMEMO';
      ftGraphic : Result := 'GRAPHIC';
      ftGUID : Result := 'GUID';
      ftInteger : Result := 'INTEGER';
      ftLargeInt : Result := 'LARGEINT';
      ftBoolean : Result := 'BOOLEAN';
      ftMemo : Result := 'MEMO';
      ftSmallint : Result := 'SMALLINT';
      ftString : Result := 'VARCHAR';
      ftFixedChar : Result := 'FIXEDCHAR';
      ftTime : Result := 'TIME';
      ftTimeStamp : Result := 'TIMESTAMP';
      ftVarBytes : Result := 'VARBYTES';
      ftWideString : Result := 'WIDESTRING';
      ftWord : Result := 'WORD'
      else Result := 'unbekannt';
    end;

  end;

function init_DatabaseABS( _DataBase : TABSDatabase; _Table : TABSTable; _Query : TABSQuery; _DatabaseFileName : string; _DatabaseName : string; _MultiUser : Boolean = True; _Encrypted : Boolean = False; _CryptoAlgorithm : TABSCryptoAlgorithm = craRijndael_256; _CryptoPassword : string = ''; _PageSize : Integer = 128; _PageCountInExtent : Integer = 8; _MaxConnections : Integer = 483 ) : TDB_Result;

  begin

    _DataBase.DatabaseName := _DatabaseName;
    _Table.DatabaseName := _DatabaseName;
    _Query.DatabaseName := _DatabaseName;

    _Table.Close;
    _Query.Close;
    _DataBase.Close;

    _DataBase.DatabaseFileName := _DatabaseFileName;
    try
      if ( not _DataBase.Exists ) or ( not Fileexists( _DataBase.DatabaseFileName ) ) then
      begin
        if _Encrypted and ( Length( Trim( _CryptoPassword ) ) > 0 ) then
        begin
          _DataBase.CryptoAlgorithm := _CryptoAlgorithm;
          _DataBase.Password := _CryptoPassword;
        end;
        _DataBase.CreateDatabase;
        Result.Create_Database := True;
      end;

      if _MultiUser then
        _DataBase.MultiUser := True;
      _DataBase.Open;
      Result.Open_DataBase := True;
    except
      if DB_Settings.Show_Errors then
        ShowMessage( Format( Error_C_DB_Create, [ _DatabaseName ] ) );
    end;

  end;

function init_TableABS_Query( _DataBase : TABSDatabase; _Table : TABSTable; _Query : TABSQuery; _Table_Name : string; _Labels_DB : TArray< string >; _Labels_DB_Type_Query : TArray< string >; _Labels_DB_Size_Query : TArray< Integer >; _Indizes_DB_Query : TArray< TArray< string > > ) : TDB_Result;
  begin

    _Table.Close;
    _Query.Close;

    _Table.TableName := _Table_Name;

    _Table.DatabaseName := _DataBase.DatabaseName;
    _Query.DatabaseName := _DataBase.DatabaseName;

    { Wenn schon vorhanden - öffnen und Feldprüfung }
    if _Table.Exists then
      try
        _Table.Close;
        Result := Restructure_Table_Query( _DataBase, _Query, _Table_Name, _Labels_DB, _Labels_DB_Type_Query, _Labels_DB_Size_Query, _Indizes_DB_Query );
        _Table.Open;
        _Table.Refresh;
        Result.Open_Table := True;
        if not Result.RestructureResult then
          Exit;
      except
        if DB_Settings.Show_Errors then
          ShowMessage( Format( Error_C_Table_Open, [ _Table_Name ] ) );
      end;

    { Wenn noch nicht vorhanden - erstellen }
    if not _Table.Exists then
      try
        Create_Table_Query( _Table, _Query, _Table_Name, _Labels_DB, _Labels_DB_Type_Query, _Labels_DB_Size_Query );
        _Table.Refresh;
        Result.Create_Table := True;
      except
        if DB_Settings.Show_Errors then
          ShowMessage( Format( Error_C_Table_Create, [ _Table_Name ] ) );
      end;

    { Alle Indizes (Index) - Suchfelder initialisieren }
    try
      Rebuild_Index_Query( _Table, _Query, _Labels_DB, _Labels_DB_Type_Query, _Indizes_DB_Query );
      Result.Rebuild_Index := True;
    except
      if DB_Settings.Show_Errors then
        ShowMessage( Format( Error_C_Index_Rebuild, [ _Table_Name ] ) );
    end;

  end;

function Restructure_Table_Query( _DataBase : TABSDatabase; _Query : TABSQuery; _Table_Name : string; _Labels_DB : TArray< string >; _Labels_DB_Type_Query : TArray< string >; _Labels_DB_Size_Query : TArray< Integer >; _Indizes_DB_Query : TArray< TArray< string > > ) : TDB_Result;
  var
    x : Integer;
    Dummy_Bool : Boolean;
    field_old_type, field_new_type : string;
    field_old_size, field_new_size : Integer;
  begin

    { Tabellenfelder prüfen, gegebenenfalls anlegen }
    for x := low( _Labels_DB ) to high( _Labels_DB ) do
    begin
      { Tabellenfeld hinzufügen, wenn es nicht existiert }
      try
        _Query.SQL.Text := 'ALTER TABLE ' + _Table_Name + ' ADD (IF NOT EXISTS ' + _Labels_DB[ x ] + ' ' + Format( _Labels_DB_Type_Query[ x ], [ _Labels_DB_Size_Query[ x ] ] ) + ');';
        _Query.ExecSQL;
        Result.Add_Field := True;
      except
        if DB_Settings.Show_Errors then
          ShowMessage( Format( Error_C_Table_Restructure_AddField, [ _Labels_DB[ x ], _Table_Name ] ) );
        Exit;
      end;
      { Tabellenfeld hinzufügen, wenn es nicht existiert }

      { Wenn Tabellenfeld falsches Format oder Größe hat }
      _Query.RequestLive := True;
      _Query.SQL.Text := 'SELECT * From ' + _Table_Name + ' WHERE 1 = 0';
      _Query.Open;
      field_old_type := FieldTyp2String( _Query.Fields[ x ].DataType );
      field_old_size := _Query.Fields[ x ].Size;

      if pos( #32, _Labels_DB_Type_Query[ x ] ) = 0 then
        field_new_type := _Labels_DB_Type_Query[ x ];
      if pos( #32, _Labels_DB_Type_Query[ x ] ) <> 0 then
        field_new_type := LeftStr( _Labels_DB_Type_Query[ x ], pos( #32, _Labels_DB_Type_Query[ x ] ) );

      field_new_size := _Labels_DB_Size_Query[ x ];
      Dummy_Bool := not ( ( field_new_size = field_old_size ) or ( field_new_size > field_old_size ) );
      if field_new_size < field_old_size then
        if DB_Settings.Show_Questions then
          Dummy_Bool := MessageDLG( Question_C_Table_FieldSize, mtConfirmation, mbYesNo, 0 ) = mrYes;
      if field_new_size < field_old_size then
        if not DB_Settings.Show_Questions then
          Dummy_Bool := True;

      if ( ( field_old_type <> field_new_type ) or ( field_old_size <> field_new_size ) ) and Dummy_Bool then
        try
          _Query.SQL.Text := 'ALTER TABLE ' + _Table_Name + ' MODIFY (' + _Labels_DB[ x ] + ' ' + Format( _Labels_DB_Type_Query[ x ], [ _Labels_DB_Size_Query[ x ] ] ) + ');';
          _Query.ExecSQL;
          Result.Change_Field := True;
        except
          if DB_Settings.Show_Errors then
            ShowMessage( Format( Error_C_Table_Change_TypeSize, [ _Labels_DB[ x ], _Table_Name ] ) );
          Exit;
        end;
      { Wenn Tabellenfeld falsches Format hat }
    end;

    { Felder löschen, die in der Deklaration nicht mehr existieren }
    if DB_Settings.Delete_Fields then
      for x := _Query.FieldDefs.Count - 1 downto 0 do
        if not MatchStr( _Query.FieldDefs.Items[ x ].Name, _Labels_DB ) then
          try
            _Query.SQL.Text := 'ALTER TABLE ' + _Table_Name + ' DROP COLUMN ' + _Query.FieldDefs.Items[ x ].Name + ';';
            _Query.ExecSQL;
            Result.Delete_Field := True;
          except
            if DB_Settings.Show_Errors then
              ShowMessage( Format( Error_C_Table_DropField, [ _Query.FieldDefs.Items[ x ].Name, _Table_Name ] ) );
          end;

  end;

function Create_Table_Query( _Table : TABSTable; _Query : TABSQuery; _Table_Name : string; _Labels_DB : TArray< string >; _Labels_DB_Type_Query : TArray< string >; _Labels_DB_Size_Query : TArray< Integer > ) : TDB_Result;
  var
    x : Integer;
    Dummy_SQL : string;
  begin

    if _Table.Exists then
    begin
      _Table.Open;
      _Table.Active := True;
      Result.Open_Table := True;
    end;

    if not _Table.Exists then
      try
        _Query.SQL.Clear;
        Dummy_SQL := '';

        for x := low( _Labels_DB ) to high( _Labels_DB ) do
        begin
          if x <> low( _Labels_DB ) then
            Dummy_SQL := Dummy_SQL + ',' + DBR;
          Dummy_SQL := Dummy_SQL + Format( '%s %s', [ _Labels_DB[ x ], Format( _Labels_DB_Type_Query[ x ], [ _Labels_DB_Size_Query[ x ] ] ) ] );
        end;

        _Query.SQL.Text := 'DROP TABLE IF EXISTS ' + _Table_Name + '; ' + DBR + 'CREATE TABLE ' + _Table_Name + ' (' + Dummy_SQL + ');';
        _Query.ExecSQL;
        _Table.Open;
        _Table.Active := True;
        Result.Create_Table := True;
      except
        if DB_Settings.Show_Errors then
          ShowMessage( Format( Error_C_Table_Create, [ _Table_Name ] ) );
      end;

  end;

function Index_Exists( _Table : TABSTable; const _IndexName : string ) : Boolean;
  var
    IndexDef : TIndexDef;
    i : Integer;
  begin

    Result := False;
    for i := 0 to pred( _Table.IndexDefs.Count ) do
    begin
      IndexDef := _Table.IndexDefs[ i ];
      if CompareText( IndexDef.Name, _IndexName ) = 0 then
      begin
        Result := True;
        break;
      end;
    end;

  end;

function Rebuild_Index_Query( _Table : TABSTable; _Query : TABSQuery; _Labels_DB : TArray< string >; _Labels_DB_Type_Query : TArray< string >; _Indizes_DB_Query : TArray< TArray< string > > ) : TDB_Result;
  var
    Dummy_Int : Integer;
    Dummy_SQL : string;
  begin

    _Table.Open;
    _Table.IndexDefs.Update;

    { Alle Indexfelder durchgehen, SQL erzeugen }
    for Dummy_Int := low( _Indizes_DB_Query ) to high( _Indizes_DB_Query ) do
      if not Index_Exists( _Table, _Indizes_DB_Query[ Dummy_Int ][ 0 ] ) then
        Dummy_SQL := Dummy_SQL + _Indizes_DB_Query[ Dummy_Int ][ 1 ];

    if Dummy_SQL <> '' then
      try
        _Query.SQL.Text := Dummy_SQL;
        _Query.ExecSQL;
        _Query.SQL.Clear;
        Result.Rebuild_Index := True;
      except
        if DB_Settings.Show_Errors then
          ShowMessage( Format( Error_C_Index_Rebuild, [ _Table.TableName ] ) );
      end;

    _Query.IndexDefs.Update;
    _Table.IndexDefs.Update;
    _Table.Close;
    _Table.Open;

  end;

end.
Angehängte Dateien
Dateityp: zip abstest_20200327.zip (10,4 KB, 4x aufgerufen)
Mathias

Geändert von NoGAD (27. Mär 2020 um 20:10 Uhr) Grund: Neues Testprojekt, einige Fehler behoben
  Mit Zitat antworten Zitat
Benutzerbild von bernau
bernau

Registriert seit: 1. Dez 2004
Ort: Köln
1.295 Beiträge
 
Delphi 12 Athens
 
#15

AW: Record als Result einer Funktion

  Alt 27. Mär 2020, 20:27
In deinem Code benutzt du die Werte von DB_Settings nur zum lesen. Die drei Werte werden zu keinem Zeitpunkt initialisiert. Ist das so gewollt?
Gerd
Kölner Delphi Usergroup: http://wiki.delphitreff.de
  Mit Zitat antworten Zitat
Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
44.184 Beiträge
 
Delphi 12 Athens
 
#16

AW: Record als Result einer Funktion

  Alt 27. Mär 2020, 23:18
Die drei Werte werden zu keinem Zeitpunkt initialisiert. Ist das so gewollt?
Da es eine böse globale Variable ist, ist es auch initialisiert. (alles False)

Zitat:
BR = #10#13;
Falsch, denn es ist #13#10.

Der Witz:
BR sind sind so 2 Zeilenumbrüche,
aber wer denkt, dass 2 * 2 nun 4 ist, der wird enttäuscht, denn DBR sind so 3 Zeilenumbrüche.

Wer es nicht kann, der sollte Delphi-Referenz durchsuchensLineBreak verwenden.
$2B or not $2B

Geändert von himitsu (27. Mär 2020 um 23:23 Uhr)
  Mit Zitat antworten Zitat
Benutzerbild von NoGAD
NoGAD

Registriert seit: 31. Jan 2006
Ort: Weimar
345 Beiträge
 
Delphi 10.4 Sydney
 
#17

AW: Record als Result einer Funktion

  Alt 28. Mär 2020, 11:21
In deinem Code benutzt du die Werte von DB_Settings nur zum lesen. Die drei Werte werden zu keinem Zeitpunkt initialisiert. Ist das so gewollt?
Danke. Habe ich übersehen.

[QUOTE=himitsu;1460666]

Zitat:
BR = #10#13;
Falsch, denn es ist #13#10.

Der Witz:
BR sind sind so 2 Zeilenumbrüche,
aber wer denkt, dass 2 * 2 nun 4 ist, der wird enttäuscht, denn DBR sind so 3 Zeilenumbrüche.

Wer es nicht kann, der sollte Delphi-Referenz durchsuchensLineBreak verwenden.
Oje. Danke für den Hinweis. Das habe ich seit Jahren so gemacht. Irgenwie bin ich von Linux aus das inzwischen anders gewohnt und verwechsle das dann immer gerne.



Die von euch angesprochenen Probleme betreffen aber leider nicht das Hauptthema, um welches es mir geht.

LG Mathias
Mathias
  Mit Zitat antworten Zitat
Benutzerbild von Uwe Raabe
Uwe Raabe
Online

Registriert seit: 20. Jan 2006
Ort: Lübbecke
11.475 Beiträge
 
Delphi 12 Athens
 
#18

AW: Record als Result einer Funktion

  Alt 28. Mär 2020, 11:42
Die von euch angesprochenen Probleme betreffen aber leider nicht das Hauptthema, um welches es mir geht.
Und was ist das jetzt genau, was nicht schon durch den Hinweis auf nicht-initialisierte Variablen abgedeckt ist?
Uwe Raabe
Certified Delphi Master Developer
Embarcadero MVP
Blog: The Art of Delphi Programming
  Mit Zitat antworten Zitat
Benutzerbild von NoGAD
NoGAD

Registriert seit: 31. Jan 2006
Ort: Weimar
345 Beiträge
 
Delphi 10.4 Sydney
 
#19

AW: Record als Result einer Funktion

  Alt 28. Mär 2020, 12:33
Und was ist das jetzt genau, was nicht schon durch den Hinweis auf nicht-initialisierte Variablen abgedeckt ist?


Warum sind Boolean von Haus aus True?
Mathias
  Mit Zitat antworten Zitat
Benutzerbild von Uwe Raabe
Uwe Raabe
Online

Registriert seit: 20. Jan 2006
Ort: Lübbecke
11.475 Beiträge
 
Delphi 12 Athens
 
#20

AW: Record als Result einer Funktion

  Alt 28. Mär 2020, 13:35
Warum sind Boolean von Haus aus True?
Sind sie nicht. Ein Boolean hat die Speichergröße eines Bytes und es ist halt so, daß alles was in dem Byte steht außer 0 als True interpretiert wird. Daher ist die Wahrscheinlichkeit recht hoch, daß ein nicht-initialisierter Boolean eben als True gemeldet wird.

In der Realität ist der Speicher ja nicht wirklich zufällig belegt, sondern enthält das was vorher über eine andere Variable dort abgelegt wurde. Daher hat der vorherige Programmablauf entscheidenden Einfluss auf den Inhalt des Records.
Uwe Raabe
Certified Delphi Master Developer
Embarcadero MVP
Blog: The Art of Delphi Programming
  Mit Zitat antworten Zitat
Antwort Antwort
Seite 2 von 7     12 34     Letzte »    


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 12:03 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz