dbdm.pas

DBDesigner 4 is a database design system that integrates database design, modelling, creation and ma

  end;
end;


function TDMDB.GetDBTables(var tablelist: TStringList; theSQLConn: TSQLConnection = nil; theDBConn: TDBConn = nil): Boolean;
begin
  if(SchemaSQLQuery.Active)then
    SchemaSQLQuery.Close;

  tablelist.Clear;

  if(theSQLConn<>nil)then
    SchemaSQLQuery.SQLConnection:=theSQLConn;

  if(theDBConn=nil)then
    theDBConn:=CurrentDBConn;

  try
    if(CompareText(theDBConn.DriverName, 'Oracle')=0)then
    begin
      SchemaSQLQuery.SetSchemaInfo(stNoSchema, '', '');
      SchemaSQLQuery.SQL.Text:='SELECT * FROM ALL_TABLES '+
        'ORDER BY OWNER, TABLE_NAME';
      SchemaSQLQuery.Open;
      try
        while(Not(SchemaSQLQuery.EOF))do
        begin
          tablelist.Add(SchemaSQLQuery.FieldByName('OWNER').AsString+
            '.'+SchemaSQLQuery.FieldByName('TABLE_NAME').AsString);
          SchemaSQLQuery.Next;
        end;
      finally
        SchemaSQLQuery.Close;
      end;

      GetDBTables:=True;
    end
    else if(CompareText(theDBConn.DriverName, 'SQLite')=0)then
    begin
      //Meta Information is stored in the table sqlite_master
      SchemaSQLQuery.SetSchemaInfo(stNoSchema, '', '');

      SchemaSQLQuery.SQL.Text:='SELECT name FROM sqlite_master '+
        'WHERE type=''table'' '+
        'ORDER BY name';
      SchemaSQLQuery.Open;
      try
        while(Not(SchemaSQLQuery.EOF))do
        begin
          tablelist.Add(SchemaSQLQuery.FieldByName('name').AsString);
          SchemaSQLQuery.Next;
        end;
      finally
        SchemaSQLQuery.Close;
      end;

      GetDBTables:=True;
    end
    else if(CompareText(theDBConn.DriverName, 'MSSQL')=0)then
    begin
      //Meta Information is stored in the table sqlite_master
      SchemaSQLQuery.SetSchemaInfo(stNoSchema, '', '');

      SchemaSQLQuery.SQL.Text:='sp_tables @table_type="''TABLE''"';
      SchemaSQLQuery.Open;
      try
        while(Not(SchemaSQLQuery.EOF))do
        begin
          tablelist.Add(SchemaSQLQuery.FieldByName('TABLE_QUALIFIER').AsString+'.'+
            SchemaSQLQuery.FieldByName('TABLE_NAME').AsString);
          SchemaSQLQuery.Next;
        end;
      finally
        SchemaSQLQuery.Close;
      end;

      GetDBTables:=True;
    end
    else
    begin
      //GetTables
      //Col 0: RECNO
      //1: CATALOG_NAME
      //2: SCHEMA_NAME
      //3: TABLE_NAME
      //4: TABLE_TYPE
      SchemaSQLQuery.SetSchemaInfo(stTables, '', '');
      SchemaSQLQuery.Open;
      try
        while(Not(SchemaSQLQuery.EOF))do
        begin
          {if(CurrentDBConn.DriverName='openodbc')then
            tablelist.Add(Copy(SchemaSQLQuery.Fields[3].AsString, 2, Length(SchemaSQLQuery.Fields[3].AsString)-2))
          else}
          tablelist.Add(SchemaSQLQuery.Fields[3].AsString);

          SchemaSQLQuery.Next;
        end;
      finally
        SchemaSQLQuery.Close;
      end;

      GetDBTables:=True;
    end;
  finally
    SchemaSQLQuery.SQLConnection:=SQLConn;
  end;
end;

procedure TDMDB.ExecSQL(s: string);
begin
  //Because of Delphi BUG!
  if(SQLConn.ActiveStatements<>0)then
  begin
    SQLConn.Close;
    SQLConn.Open;
  end;

  try
    SQLConn.ExecuteDirect(s);
  except
    SQLConn.Close;
    SQLConn.Open;

    try
      SQLConn.ExecuteDirect(s);
    except
      on x: Exception do
      begin
        EDatabaseError.Create(DMMain.GetTranslatedMessage('SQL statement cannot be executed.'+#13#10+'%s', 144,
          x.Message+#13#10+#13#10+s));
      end;
    end;
  end;
end;

procedure TDMDB.LoadSettingsFromIniFile;
var theIni: TMemIniFile;
  i: integer;
begin
  //Read IniFile
  theIni:=TMemIniFile.Create(DMMain.SettingsPath+DMMain.ProgName+'_Settings.ini');
  try
    //Check if the Program is opened the very first time
    if(theIni.ReadString('GeneralSettings', 'RunFirstTime', '0')='1')then
      RunFirstTime:=True;

    DefaultDatabaseType:=theIni.ReadString('GeneralSettings', 'DefaultDB',
      'MySQL');

    //Read all Database Types
    theIni.ReadSectionValues('DatabaseTypes', DatabaseTypes);
    for i:=0 to DatabaseTypes.Count-1 do
      DatabaseTypes[i]:=Copy(DatabaseTypes[i], Pos('=', DatabaseTypes[i])+1, Length(DatabaseTypes[i]));
  finally
    theIni.Free;
  end;
end;

procedure TDMDB.SaveSettingsToIniFile;
var theIni: TMemIniFile;
begin
  //Open IniFile
  theIni:=TMemIniFile.Create(DMMain.SettingsPath+DMMain.ProgName+'_Settings.ini');
  try
    theIni.WriteString('GeneralSettings', 'DefaultDB',
      DefaultDatabaseType);

    theIni.UpdateFile;
  finally
    theIni.Free;
  end;
end;

function TDMDB.GetRecordsAsInserts(SQLCmd: string; theQry: TClientDataSet; limit: integer = 0): string;
var insertHeader, inserts, tablename, s: string;
  i, reccount: integer;
begin
  //Get Table name after FROM
  //SQLCmd:=theQry.SQL.Text;
  s:=Copy(SQLCmd, Pos('FROM ', UpperCase(SQLCmd))+5, Length(SQLCmd));
  if(Pos(#13#10, s)>0)then
    tablename:=Copy(s, 1, Pos(#13#10, s)-1);

  if(Pos(' ', s)>0)then
    tablename:=Copy(s, 1, Pos(' ', s)-1);


  //Build Fieldnames
  s:='INSERT INTO '+tablename+'(';
  for i:=0 to theQry.Fields.Count-1 do
    s:=s+theQry.Fields[i].DisplayName+', ';

  //Remove last ,+Space
  s:=Copy(s, 1, Length(s)-2);

  insertHeader:=s+')'+#13#10+'VALUES(';


  inserts:='';

  theQry.DisableControls;
  try
    theQry.First;
    reccount:=0;
    while(not(theQry.Eof))and((limit=0)or(reccount<limit))do
    begin
      s:='';
      for i:=0 to theQry.Fields.Count-1 do
      begin
        if(theQry.Fields[i].DataType=ftSmallint)or
          (theQry.Fields[i].DataType=ftInteger)or
          (theQry.Fields[i].DataType=ftWord)or
          (theQry.Fields[i].DataType=ftLargeint)or
          (theQry.Fields[i].DataType=ftAutoInc)then
        begin
          if(theQry.Fields[i].AsString<>'')then
            s:=s+theQry.Fields[i].AsString
          else
            s:=s+'0';
        end
        else if(theQry.Fields[i].DataType=ftString)or
          (theQry.Fields[i].DataType=ftFixedChar)or
          (theQry.Fields[i].DataType=ftWideString)then
          s:=s+''''+DMMain.ReplaceText(theQry.Fields[i].AsString, '''', '''''')+''''
        else if(theQry.Fields[i].DataType=ftDateTime)or
          (theQry.Fields[i].DataType=ftTimeStamp)then
          s:=s+''''+FormatDateTime('yyyy-mm-dd hh:nn:ss', theQry.Fields[i].AsDateTime)+''''
        else if(theQry.Fields[i].DataType=ftDate)then
          s:=s+''''+FormatDateTime('yyyy-mm-dd', theQry.Fields[i].AsDateTime)+''''
        else if(theQry.Fields[i].DataType=ftTime)then
          s:=s+''''+FormatDateTime('hh:nn:ss', theQry.Fields[i].AsDateTime)+''''
        else
          s:=s+''''+DMMain.ReplaceText(theQry.Fields[i].AsString, '''', '''''')+'''';

        if(i<theQry.Fields.Count-1)then
          s:=s+', ';
      end;

      inserts:=inserts+insertHeader+s+');'+#13#10;

      inc(reccount);

      theQry.Next;
    end;

    //theQry.First;
  finally
    theQry.EnableControls;
  end;

  GetRecordsAsInserts:=inserts;
end;

function TDMDB.GetRecordsAsInsertsTSQLQuery(SQLCmd: string; theQry: TSQLQuery; limit: integer = 0): string;
var insertHeader, inserts, tablename, s: string;
  i, reccount: integer;
begin
  //Get Table name after FROM
  //SQLCmd:=theQry.SQL.Text;
  s:=Copy(SQLCmd, Pos('FROM ', UpperCase(SQLCmd))+5, Length(SQLCmd));
  if(Pos(#13#10, s)=0)then
  begin
    if(Pos(' ', s)=0)then
      tablename:=s
    else
      tablename:=Copy(s, 1, Pos(' ', s)-1)
  end
  else
    tablename:=Copy(s, 1, Pos(#13#10, s)-1);

  //Build Fieldnames
  s:='INSERT INTO '+tablename+'(';
  for i:=0 to theQry.Fields.Count-1 do
    s:=s+theQry.Fields[i].DisplayName+', ';

  //Remove last ,+Space
  s:=Copy(s, 1, Length(s)-2);

  insertHeader:=s+')'+#13#10+'VALUES(';


  inserts:='';

  theQry.DisableControls;
  try
    //theQry.First;
    reccount:=0;
    while(not(theQry.Eof))and((limit=0)or(reccount<limit))do
    begin
      s:='';
      for i:=0 to theQry.Fields.Count-1 do
      begin
        if(theQry.Fields[i].DataType=ftSmallint)or
          (theQry.Fields[i].DataType=ftInteger)or
          (theQry.Fields[i].DataType=ftWord)or
          (theQry.Fields[i].DataType=ftLargeint)or
          (theQry.Fields[i].DataType=ftAutoInc)then
        begin
          if(theQry.Fields[i].AsString<>'')then
            s:=s+theQry.Fields[i].AsString
          else
            s:=s+'0';
        end
        else if(theQry.Fields[i].DataType=ftString)or
          (theQry.Fields[i].DataType=ftFixedChar)or
          (theQry.Fields[i].DataType=ftWideString)then
          s:=s+''''+DMMain.ReplaceText(theQry.Fields[i].AsString, '''', '''''')+''''
        else if(theQry.Fields[i].DataType=ftDateTime)or
          (theQry.Fields[i].DataType=ftTimeStamp)then
          s:=s+''''+FormatDateTime('yyyy-mm-dd hh:nn:ss', theQry.Fields[i].AsDateTime)+''''
        else if(theQry.Fields[i].DataType=ftDate)then
          s:=s+''''+FormatDateTime('yyyy-mm-dd', theQry.Fields[i].AsDateTime)+''''
        else if(theQry.Fields[i].DataType=ftTime)then
          s:=s+''''+FormatDateTime('hh:nn:ss', theQry.Fields[i].AsDateTime)+''''
        else
          s:=s+''''+DMMain.ReplaceText(theQry.Fields[i].AsString, '''', '''''')+'''';

        if(i<theQry.Fields.Count-1)then
          s:=s+', ';
      end;

      inserts:=inserts+insertHeader+s+');'+#13#10;

      inc(reccount);

      theQry.Next;
    end;

    //theQry.First;
  finally
    theQry.EnableControls;
  end;

  GetRecordsAsInsertsTSQLQuery:=inserts;
end;

function TDMDB.GetFirstSQLCmdFromScript(var cmds: String): String;
var theCmdList: TStringList;
  cmd: string;
  delimCount: integer;
  cmdComplete, delimOpen, commentLine: Boolean;
begin
  theCmdList:=TStringList.Create;
  try
    theCmdList.Text:=cmds;
    cmd:='';
    cmdComplete:=False;
    delimOpen:=False;

    while(theCmdList.Count>0)and(Not(cmdComplete))do
    begin
      commentLine:=False;

      if(Not(delimOpen))then
        if(Copy(Trim(theCmdList[0]), 1, 2)='//')then
          commentLine:=True;

      if(Not(commentLine))then
      begin
        //Add line to command
        if(cmd<>'')then
          cmd:=cmd+#13#10;
        cmd:=cmd+theCmdList[0];

        delimCount:=DMMain.GetSubStringCountInString(theCmdList[0], '''');
        if(delimCount mod 2=1)then
          delimOpen:=Not(delimOpen);

        //Check if this is the last cmd
        if(theCmdList.Count>1)then
          if((Copy(Trim(theCmdList[1]), 1, 1)='')and(Not(delimOpen)))then
            cmdComplete:=True;

        if(Copy(Trim(theCmdList[0]), Length(Trim(theCmdList[0])), 1)=';')then
          cmdComplete:=True;
      end;

      theCmdList.Delete(0);

      //Delete all empty lines till next cmd or Clear List
      if(theCmdList.Count>0)then
      begin
        while(trim(theCmdList[0])='')and(theCmdList.Count>1)do
          theCmdList.Delete(0);

        //if last list
        if(trim(theCmdList.Text)='')and(theCmdList.Count>0)then
          theCmdList.Clear;
      end;
    end;

    //Remove trailing ;
    if(Copy(trim(cmd), Length(trim(cmd)), 1)=';')then
      cmd:=Copy(trim(cmd), 1, Length(trim(cmd))-1);

    GetFirstSQLCmdFromScript:=cmd;
    cmds:=theCmdList.Text;
  finally
    theCmdList.Free;
  end;
end;

function TDMDB.ExecuteSQLCmdScript(cmds: String): integer;
var ignoreScriptErrors: Boolean;
  mRes, totalRowsAffected, RowsAffected: integer;
begin
  ignoreScriptErrors:=False;
  totalRowsAffected:=0;

  while(cmds<>'')do
  begin
    //Get first script and remove it from the cmds
    OutputQry.SQL.Text:=GetFirstSQLCmdFromScript(cmds);
    try
      RowsAffected:=OutputQry.ExecSQL(True);

      if(RowsAffected>0)then
        totalRowsAffected:=totalRowsAffected+RowsAffected;
    except
      on x: Exception do
      begin
        if(Not(ignoreScriptErrors))then
        begin
          if(cmds='')then
            MessageDlg(DMMain.GetTranslatedMessage('ERROR while executing Query: '+#13#10#13#10+'%s', 145,
              Trim(OutputQry.SQL.Text)+#13#10#13#10+
              x.Message), mtError, [mbOk], 0)
          else
          begin
            mRes:=MessageDlg(DMMain.GetTranslatedMessage('ERROR while executing Query: '+#13#10#13#10+'%s', 145,
              Trim(OutputQry.SQL.Text)+#13#10#13#10+
              x.Message+#13#10#13#10)+
              DMMain.GetTranslatedMessage('Do you want to continue executing the script? '+
              'Press [Ignore] to ignore all Errors.', 146), mtError,
              [mbYes, mbNo, mbIgnore], 0);

            if(mRes=mrNo)then
            begin
              ExecuteSQLCmdScript:=totalRowsAffected;
              Exit;
            end;

            if(mRes=mrIgnore)then
              ignoreScriptErrors:=True;
          end;
        end;
      end;
    end;
  end;

  ExecuteSQLCmdScript:=totalRowsAffected;
end;

constructor TDBConn.Create;
begin
  inherited;

  Params:=TStringList.Create;
end;

destructor TDBConn.Destroy;
begin
  Params.Free;

  inherited;
end;

procedure TDBConn.Assign(Source: TPersistent);
begin
  if(Source is TDBConn)then
  begin
    Name:=TDBConn(Source).Name;
    Description:=TDBConn(Source).Description;
    DriverName:=TDBConn(Source).DriverName;
    GetDriverFunc:=TDBConn(Source).GetDriverFunc;
    LibraryName:=TDBConn(Source).LibraryName;
    VendorLib:=TDBConn(Source).VendorLib;
    TableScope:=TDBConn(Source).TableScope;
    Params.Text:=TDBConn(Source).Params.Text;
  end;
end;

constructor TDBHost.Create;
begin
  inherited;
end;

destructor TDBHost.Destroy;
begin
  inherited;
end;

end.