For 5 years of using My Visual Database as a development tool, I have accumulated about 500 (!) different projects created in this unique development environment. Among them are both commercial programs and examples of solving individual technical problems that were posted on the developers’ forum. Therefore, I decided to add the ability to record and analyze the content of projects to the Developer’s Handbook.

The “Projects” tab has been added to the main window, which displays a list of projects in a hierarchical view with the name, file location, status and description. Since, in addition to standard editing operations, additional functions will be needed to work with this list, I added a panel with buttons at the bottom of the tab to call them. Usually I try to place all the buttons on the same panel at the top, but in this case this solution is quite justified, as it separates general functions from private ones and does not change the appearance of the main toolbar when switching main tabs.

Four tables have been added to store the new data:

  • project – projects
  • unit – project modules
  • unitProc – procedures in project modules
  • unitProcParam – procedure parameters

At this stage, only the project table is involved, but in the near future I plan to use other tables to analyze the project architecture and automate versioning of modules for their reuse in various projects.

Unfortunately, the architectural feature of MVDB itself does not allow connecting modules outside the scripts folder to the project, so different projects may have the same copies of the same modules, which makes their maintenance (bug fixing and development) difficult.

Also in each folder with the project is an executable file, the size of which is currently about 19 MB. For 500 projects, most of which serve as illustrations of working methods, the disk memory consumption for storing identical copies is more than 9 GB, so I added the ability to strip projects from executable files, and, if necessary, quickly create it in the right folder.

Updating the list of projects

If there are a lot of projects, then it will take a long time to enter them manually. Therefore, I added a special procedure that not only adds new projects to the database, but also monitors if the old ones have disappeared, and also deletes executable files if necessary.

procedure frmUpdateProjectList_btnUpdate_OnClick(Sender: TObject; var Cancel: boolean);
// update the list of projects
var
   tmpFileList:string;
   tmpFiles: array of string;
   i: integer;
   tmpSQL:string;
   tmpDataSet:TDataSet;
   tmpCount: integer;
   tmpMaxCount: integer;
   tmpPath:string;
   tmpName:string;
   tmpIDParent:string;
   tmpFileName:string;

   function FindParent:string;
   // search for the parent folder by the maximum match of paths
   begin
     tmpSQL := 'SELECT id FROM ( SELECT id, length( path ) FROM project WHERE (isGroup = 1) and (path = substr('+StrToSQL(tmpPath)+',1,length(path) ) ) ORDER BY 2 DESC LIMIT 1 )';
     Result := SQLExecute(tmpSQL);
     if result = '' then
       Result := 'NULL';
   end;

begin
   if DirectoryExists(frmUpdateProjectList.edtPath.Text) then
   begin
     Progress(0,0,'Updating the list of projects');
     tmpSQL := 'SELECT count(*) FROM project';
     tmpMaxCount := SQLExecute(tmpSQL);
     tmpCount := 0;
     try
       // check existing records
       tmpSQL := 'SELECT * FROM project';
       SQLQuery(tmpSQL,tmpDataSet);
       try
         while not tmpDataSet.EOF do
         begin
           Progress(tmpCount,tmpMaxCount,'Checking Folders');
           if not DirectoryExists( tmpDataSet.FieldByName('path').asString ) then
           begin
             tmpSQL := 'UPDATE project SET status = "Path not found" WHERE id = '+tmpDataSet.FieldByName('id').asString;
             SQLExecute(tmpSQL);
           end;
           tmpDataSet.Next;
           inc(tmpCount);
         end;
       finally
         tmpDataSet.Free;
       end;
       Progress(0,0,'Search for new projects');
       ProjectRootDir := frmUpdateProjectList.edtPath.Text;
       RemoveExe := frmUpdateProjectList.chbRemoveExe.Checked;
       UserApp_WriteParams;
       // processing process
       tmpFileList := Trim(GetFilesList(ProjectRootDir,'*.vdb'));
       tmpFiles := SplitString(tmpFileList,chr(10));
       tmpMaxCount := Length(tmpFiles);
       for i:=0 to Length(tmpFiles)-1 do
       begin
         Progress(i,tmpMaxCount,'Search for new projects');
         tmpPath := ExtractFileDir( tmpFiles[i] );
         tmpSQL := 'SELECT count(*) FROM project WHERE path = '+StrToSQL(tmpPath);
         if SQLExecute(tmpSQL) = 0 then // project not found
         begin
           tmpName := Trim( ExtractFileName(tmpFiles[i]) );
           delete(tmpName,Length(tmpName)-3,4);
           tmpIDParent := FindParent;
           tmpSQL := 'INSERT INTO project (name,path,parentID,isGroup,status) VALUES ('+StrToSQL(tmpName)+','+StrToSQL(tmpPath)+','+tmpIDParent+',0,"New project") ';
           SQLExecute(tmpSQL);
         end;
       end;
       // delete exe
       if RemoveExe then
       begin
         tmpSQL := 'SELECT count(*) FROM project';
         tmpMaxCount := SQLExecute(tmpSQL);
         tmpSQL := 'SELECT * FROM project';
         SQLQuery(tmpSQL,tmpDataSet);
         try
           while not tmpDataSet.EOF do
           begin
             Progress(tmpCount,tmpMaxCount,'Deleting executable files');
             //
             tmpFileName := tmpDataSet.FieldByName('path').asString + '\'+ tmpDataSet.FieldByName('name').asString + '.exe';
             if FileExists(tmpFileName) then
               DeleteFile(tmpFileName);
             //
             tmpDataSet.Next;
             inc(tmpCount);
           end;
         finally
           tmpDataSet.Free;
         end;
       end;
     finally
       progress();
     end;
     Form_UpdateData( GetFormByName( 'dtfProject_Tree' ) );
   end
   else
   begin
     ShowHint(frmUpdateProjectList.edtPath,'Folder not found');
     Cancel := True;
   end;
end;Code language: Delphi (delphi)

Of the features of this procedure, it is worth noting the FindParent function, which analyzes the project placement path and finds a suitable parent in the project tree. When debugging this function, an interesting effect was found in the behavior of the tree, namely:

If the value of the ParentID field does not contain a reference to a real record or is not equal to NULL, then the tree loading speed is reduced to an obscenely low level.

Application launch

To run a project, you need an executable file, but it makes no sense to store it in each project. Therefore, it can be obtained by copying the builder.dll file from the folder where My Visual Database is installed.

procedure frmMain_btnStart_OnClick(Sender: TObject; var Cancel: boolean);
// run for execution
var
   tmpGrid: TdbStringGridEx;
   tmpID: integer;
   tmpSQL:string;
   tmpFile:string;
   tmpDir:string;
begin
   tmpGrid := DTF_GetGrid('dtfProject_Tree');
   tmpID := tmpGrid.dbItemID;
   if tmpID = -1 then
     ShowHint(tmpGrid,'Select project')
   else
   begin
     tmpSQL := 'SELECT path || "\" || name || ".exe" FROM project WHERE id = '+IntToStr(tmpID);
     tmpFile := SQLExecute(tmpSQL);
     if not FileExists(tmpFile) then // if the executable file is not found, try to create it
     begin
       // check if the project folder exists
       tmpSQL := 'SELECT path FROM project WHERE id = '+IntToStr(tmpID);
       tmpDir := SQLExecute(tmpSQL);
       if not DirectoryExists(tmpDir) then
       begin
         tmpSQL := 'UPDATE project SET status = "Path not found" WHERE id = '+IntToStr(tmpID);
         SQLExecute(tmpSQL);
         ShowMessage('Folder not found: '+tmpDir);
       end
       else
       begin
         // to do this, copy the build.dll file and rename it!
         if not FileExists( BuilderDLL ) then
           ShowMessage('File not found '+BuilderDLL) // TODO: add a configuration form for this parameter
         else
         begin
           CopyFile(BuilderDLL,tmpFile);
         end;
       end;
     end;
     OpenFile(tmpFile);
   end;
end;Code language: Delphi (delphi)

A variable and parameters are used to store the path to the builder.dll file:

var
   BuilderDLL:string; // path where the project player is located

procedure UserApp_ReadParams;
// read parameters
begin
   ProjectRootDir := IniFile_Read('PARAMS','ProjectRootDir','c:\');
   RemoveExe := IniFile_Read_Bool('PARAMS','RemoveExe',False);
   BuilderDLL := IniFile_Read('PARAMS','BuilderDLL','c:\Program Files (x86)\My Visual Database\builder.dll');
end;Code language: Delphi (delphi)

Opening a project

This is the simplest action, which is implemented as follows:

procedure frmMain_btnOpenProject_OnClick(Sender: TObject; var Cancel: boolean);
// open project in MVDN editor
var
   tmpGrid: TdbStringGridEx;
   tmpID: integer;
   tmpSQL:string;
   tmpFile:string;
begin
   tmpGrid := DTF_GetGrid('dtfProject_Tree');
   tmpID := tmpGrid.dbItemID;
   if tmpID = -1 then
     ShowHint(tmpGrid,'Select project')
   else
   begin
     tmpSQL := 'SELECT path || "\" || name || ".vdb" FROM project WHERE id = '+IntToStr(tmpID);
     tmpFile := SQLExecute(tmpSQL);
     if FileExists(tmpFile) then
       OpenFile(tmpFile)
     else
     begin
       tmpSQL := 'UPDATE project SET status = "Project not found" WHERE id = '+IntToStr(tmpID);
       SQLExecute(tmpSQL);
       ShowMessage('Project not found: '+tmpFile);
     end;
   end;
end;Code language: Delphi (delphi)

Opening a folder

This operation is similar to opening a project

procedure frmMain_btnFolder_OnClick(Sender: TObject; var Cancel: boolean);
// open project folder
var
   tmpGrid: TdbStringGridEx;
   tmpID: integer;
   tmpSQL:string;
   tmpFile:string;
begin
   tmpGrid := DTF_GetGrid('dtfProject_Tree');
   tmpID := tmpGrid.dbItemID;
   if tmpID = -1 then
     ShowHint(tmpGrid,'Select project')
   else
   begin
     tmpSQL := 'SELECT path FROM project WHERE id = '+IntToStr(tmpID);
     tmpFile := SQLExecute(tmpSQL);
     if DirectoryExists(tmpFile) then
       OpenFile(tmpFile)
     else
     begin
       tmpSQL := 'UPDATE project SET status = "Path not found" WHERE id = '+IntToStr(tmpID);
       SQLExecute(tmpSQL);
       ShowMessage('Folder not found: '+tmpFile);
     end;
   end;
end;Code language: Delphi (delphi)

Deleting a project folder

But to implement this function, I had to create an alternative function for deleting a folder, since the standard RemoveDir(), which was inherited from Delphi since the days of DOS, deletes only empty folders. But RemoveDirEx() is able to remove a folder along with all its contents.

function RemoveDirEx(ADir: string):boolean;
// deleting a directory with preliminary cleaning of files and subdirectories
var
   i: integer;
   tmpList: TStringList;
   tmpDir:string;
begin
   Result := False;
   // remove trailing slash
   if copy(ADir, Length(ADir), 1) = '\' then
     delete(ADir, Length(ADir), 1);
   if DirectoryExists(ADir) then
   begin
     tmpList := TStringList.Create;
     try
       // delete files
       tmpList.Text := GetFilesList(ADir);
       for i := 0 to tmpList.Count - 1 do
         DeleteFile(tmpList.Strings[i]);
       tmpList.Sorted := True;
       tmpList.Text := GetDirectories(ADir);
       // delete folders
       for i := tmpList.Count - 1 downto 0 do
         RemoveDir( tmpList.strings(i) );
     finally
       tmpList.Free;
     end;
     Result := RemoveDir(ADir);
   end;
end;

procedure frmMain_btnDelete_Dir_OnClick(Sender: TObject; var Cancel: boolean);
// deleting the project from the disk and from the database
var
   tmpGrid: TdbStringGridEx;
   tmpID: integer;
   tmpSQL:string;
   tmpDir:string;
begin
   tmpGrid := DTF_GetGrid('dtfProject_Tree');
   tmpID := tmpGrid.dbItemID;
   if tmpID = -1 then
     ShowHint(tmpGrid,'Select project')
   else
   begin
     if MessageBox( 'Delete the project and all its files?', 'Delete the project', MB_YESNO + MB_ICONWARNING ) = mrYes then
     begin
       tmpSQL := 'SELECT path FROM project WHERE id = '+IntToStr(tmpID);
       tmpDir := SQLExecute(tmpSQL);
       if not RemoveDirEx(tmpDir) then
         ShowMessage('Unable to delete folder '+tmpDir)
       else
       begin
         tmpSQL := 'DELETE FROM project WHERE id = '+IntToStr(tmpID);
         tmpDir := SQLExecute(tmpSQL);
         tmpGrid.dbUpdate;
       end;
     end;
   end;
end;Code language: Delphi (delphi)

Epilogue

In the process of debugging the program, it turned out that the procedure for deleting a record contains an error: when deleting a tree node, child elements are not deleted, as a result of which records are lost and braking occurs when displaying the tree.

A sign that the table has tree-like data is the presence of the ParentID field. This is a convention that is accepted in this application (and in many examples of development environments). Therefore, it would be nice to know if there is such a field in the table. To do this, add the DB_FieldExists() function. However, when implementing it, it turned out that a query using the pragma_table_info () built-in function does not work in MVDB, although it works fine in SQLiteStudio. So I had to add more code than I planned:

function DB_FieldExists( ATableName: string; AFieldName:string ):boolean;
// checks if the table exists
var
   tmpDataSet:TDataSet;
begin
   case dbType of
   DBT_UNKNOW: RaiseException('DB_TableExists - not supported for database type DBT_UNKNOW');
   DBT_SQLITE:begin
     // Result := SQLExecute('SELECT COUNT(*) AS CNTREC FROM ( pragma_table_info('+ATableName+') WHERE name="'+AFieldName+'" )' ) = 1; // SQLite - doesn't work in MVDB, but works in SQLiteStudio
     Result := False;
     SQLQuery('PRAGMA table_info('+ATableName+') ',tmpDataSet);
     while not tmpDataSet.EOF do
     begin
       if UpperCase( tmpDataSet.FieldByName('name').asString ) = UpperCase( AFieldName ) then
       begin
         Result := True;
         break;
       end;
       tmpDataSet.Next;
     end;
     tmpDataSet.Free;
   end;
   DBT_MYSQL: RaiseException('DB_TableExists - not supported for database type DBT_MYSQL');
   end;
end;Code language: Delphi (delphi)

I created the DB_DeleteTree() tree node deletion routine as a FIFO stack, because recursion in MVDB doesn’t always work as expected. Each time an entry is removed, the IDs of the child entries are pushed onto the stack. The idea of deleting records with several requests without creating a transaction is not very correct, you need to think about how to secure the data in case of an abnormal termination of the process.

procedure DB_DeleteTree( ATableName: string; AParentID: string );
var
  tmpSQL: string;
  tmpIDList: TStringList;
  tmpID: string;
  tmpIDs: array of string;
  i: integer;
begin
  tmpIDList := TStringList.Create;
  try
    tmpIDList.Add(AParentID);
    repeat
      tmpID := tmpIDList.Strings[0];
      SQLExecute('DELETE from '+ATableName+' WHERE id = '+tmpID );
      tmpIDList.Delete(0);
      tmpSQL := 'SELECT GROUP_CONCAT(id) FROM '+ATableName+' WHERE ParentID = '+tmpID;
      tmpIDs := SplitString( SQLExecute(tmpSQL),',' );
      for i:=0 to length(tmpIDs) - 1 do
      begin
        if tmpIDs[i] <> '' then
          tmpIDList.Add(tmpIDs[i]);
      end;
    until tmpIDList.Count = 0;
  finally
    tmpIDList.Free;
  end;
end;Code language: Delphi (delphi)

Now the removal procedure looks like this:

procedure frmMain_btnDelete_OnClick(Sender: TObject; var Cancel: boolean);
// delete
var
   tmpID:string
   tmpTableName:string;
begin
   if frmMain.pgcMain.ActivePage = frmMain.tshExample then
   begin
     if IDExample <> -1 then
       if MessageBox( 'Delete example?', 'Delete', MB_YESNO + MB_ICONWARNING ) = mrYes then
       begin
         SQLExecute('delete from example where id = '+IntToStr(IDExample) );
         UpdateDatabase('example');
       end;
   end
   else
   if (frmMain.pgcMain.ActivePage = frmMain.tshNavigation) and (ActiveGrid<>nil) then
   begin
     tmpID := IntToStr(ActiveGrid.dbItemID);
     tmpTableName := Grid_GetTableName(ActiveGrid);
     if tmpID = '-1' then
       ShowHint(ActiveGrid,'Select entry')
     else
     if MessageBox( 'Delete entry?', 'Delete', MB_YESNO + MB_ICONWARNING ) = mrYes then
     begin
       if DB_FieldExists( tmpTableName, 'parentID') then // if table with tree
         DB_DeleteTree(tmpTableName,tmpID) // delete the branch
       else // otherwise - delete the record
         SQLExecute('delete from '+tmpTableName+' where id = '+tmpID );
       UpdateDatabase(tmpTableName);
     end;
   end;
end;Code language: Delphi (delphi)

Links

Leave a Reply

Your email address will not be published. Required fields are marked *