На предыдущую страницу…

---

В некоторых случаях возникает необходимость создания (формирования) пустой БД SQLite заданной структуры. Например, если при запуске программа не находит файл БД в указанном месте (см. пример).

Для этого можно использовать следующий код:

function DB_Empty_Create(dbName:string; ListSQL:TStrings; dirName:string; YesIfExist:boolean=true):boolean;
//Создать пустую БД SQLite заданной структуры
// dbName - имя БД без расширения
// ListSQL - текст SQL-запроса, содержащий описание соответствующей структуры БД
//dirName - имя каталога (папки), где должна быть создана БД
//YesIfExist - флаг. Если =TRUE, то БД пересоздается даже в том случае, если файл уже существует (старый - уничтожается)
Var
  fConn: TFDConnection;
begin
  fConn:=TFDConnection.Create(nil);
  TRY
    fConn.LoginPrompt:=false;
    fConn.Params.DriverID:='SQLite';
    Result:=DB_Empty_Create(fConn, dbName, ListSQL, dirName, YesIfExist);
  FINALLY
    FreeAndNil(fConn);
  END;
end;

function DB_Empty_Create(fConn: TFDConnection; dbName:string; ListSQL:TStrings; dirName:string; YesIfExist:boolean=true):boolean;
//Создать пустую БД SQLite заданной структуры
//fConn - компонент TFDConnection
//dbName - имя БД без расширения
//ListSQL - текст SQL-запроса, содержащий описание соответствующей структуры БД
//dirName - имя каталога (папки), где должна быть создана БД
//YesIfExist - флаг. Если =TRUE, то БД пересоздается даже в том случае, если файл уже существует (старый - уничтожается)
Var
  YesNext:boolean;
  Q:TFDQuery;
  fn:string;
begin
  Result:=false;
  YesNext:= true;
  fn:=dirName+dbName_to_dbFileName(dbName);
  if YesIfExist then begin
     if FileExists(fn) then YesNext:=false;
  end;
  if YesNext then begin
     YesNext:= false;
     if Assigned(fConn) then begin
        fConn.Connected := false;
        if Assigned(ListSQL) then begin
           dbName:=trim(dbName);
           if dbName<>'' then begin
              dirName:=trim(dirName);
              if dirName<>'' then begin
                 dirName:=trim(DirName_Normal_1(dirName));
                 if DirExist(dirName) then begin
                    YesNext:= true;
                 end;
              end;
           end;
        end;
     end;
  end;
  if YesNext then begin
     fConn.Params.Values['Database'] := fn;
     Q:=TFDQuery.Create(nil);
     TRY
       Q.SQL.Text := ListSQL.Text;

       if FileExists(fn) then begin
          DeleteFile(fn);
       end;

       fConn.Connected := true;
       Q.Connection:=fConn;
       Q.ExecSQL;
       Q.Close;
       Q.SQL.Clear;

       Result:=true;
     FINALLY
       fConn.Connected := false;
       FreeAndNil(Q);
     END;
  end;
end;

---

Вспомогательные функции:

---

function dbName_to_dbFileName(dbName:string):string;
begin
  Result:='';
  dbName:=trim(dbName);
  if dbName<>'' then begin
     Result:=AnsiLowerCase(dbName)+'.db';
  end;
end;

function DirName_Normal_1(DirName : String; sSep:string='\') : string;
begin
  Result:=Trim(DirName);
  if Length(Result)>0 then begin
     sSep:=trim(sSep);
     if length(sSep)<=0 then sSep:='\';
     if Result[length(Result)]<>sSep[1] then Result:=Result+sSep[1];
  end;
end;

---

Пример:

Const
  db_Name = 'daybook';
Var
  fn_db_name:string;
  DirDB:string;
  
...
     DirDB:=ExtractFilePath(ParamStr(0));
     fn_db_name := dbName_to_dbFileName(db_Name);
     if not FileExists(DirDB+fn_db_name) then begin
        DB_Create;
     end;
...

function TfMain.DB_Create:boolean;
Var
  ListSQL:TStrings;
begin
  Result:=false;
  FDConn1.Connected:=false;
  FDConn_New.Connected:=false;
  FDConn_New.Params.Values['Database'] := DirDB+fn_db_name;
  ListSQL:=TStringList.Create;
  TRY
    ListSQL.Add('CREATE TABLE daybook_list');
    ListSQL.Add('(');
    ListSQL.Add('id INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT,');
    ListSQL.Add('npp integer,');
    ListSQL.Add('code integer,');
    ListSQL.Add('code_state INTEGER,');
    ListSQL.Add('dbl_name VARCHAR(512),');
    ListSQL.Add('note VARCHAR(512),');
    ListSQL.Add('psw VARCHAR(200),');
    ListSQL.Add('info TEXT');
    ListSQL.Add(');');
    ListSQL.Add('CREATE INDEX npp_daybooklist ON daybook_list(npp ASC);');
    ListSQL.Add('CREATE INDEX codestate_daybooklist ON daybook_list(code_state ASC);');

    ListSQL.Add('CREATE TABLE dates_list');
    ListSQL.Add('(');
    ListSQL.Add('id INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT,');
    ListSQL.Add('id_dbl INTEGER NOT NULL,');
    ListSQL.Add('ymd INTEGER,');
    ListSQL.Add('date_s VARCHAR(10),');
    ListSQL.Add('day_num integer,');
    ListSQL.Add('day_name VARCHAR(5),');
    ListSQL.Add('ch VARCHAR(5),');
    ListSQL.Add('note VARCHAR(512),');
    ListSQL.Add('psw VARCHAR(200),');
    ListSQL.Add('info TEXT,');
    ListSQL.Add('FOREIGN KEY (id_dbl) REFERENCES daybook_list (id) ON DELETE CASCADE');
    ListSQL.Add(');');
    ListSQL.Add('CREATE INDEX iddbl_dateslist ON dates_list(id_dbl ASC);');
    ListSQL.Add('CREATE INDEX ymd_dateslist ON dates_list(ymd ASC);');
    ListSQL.Add('CREATE INDEX ch_dateslist ON dates_list(ch ASC);');

    Result:=DB_Empty_Create(FDConn_New, db_Name, ListSQL, DirDB);
    if Result then begin
       FDConn1.Connected:=true;
    end;

  FINALLY
    FDConn_New.Connected:=false;
    FDConn_New.Params.Values['Database'] := '';
    FreeAndNil(ListSQL);
  END;

---

На предыдущую страницу…

---

Дата: 02.10.2022