Хранение информации о проектах имеет далеко идущие цели: анализ исходного кода и архитектуры с выдачей рекомендаций по их оптимизации.

А начнем с простой задачи: извлечение информации о содержимом модуля, в частности – поиск и отображение процедур и функций.

Скрипты

За основу анализатора я взял алгоритм, используемый в модуле подсветки синтаксиса CodeHL.pas, что наводит на мысль о необходимости создания универсальной процедуры для парсинга. Но пока, к моему огорчению, я прибегнул к копипасту, чтобы получить рабочий код процедуры UpdateProjectList_UpdateUnitProcList().

procedure UpdateProjectList_UpdateUnitProcList(AIDUnit: integer; AShowProgress: boolean); // обновление информации по процедурам модулям // AIDUnit - ID модуля // AShowProgress - флаг отображения прогресса // в работе используются настройки модуля CodeHL var tmpFileName: string; tmpStrings: TStringList; i: integer; j: integer; tmpWord: string; tmpChar: string; s1, s2: string; tmpIndex: integer; tmpText: string; tmpBeginCount: integer; tmpProcDetected: boolean; tmpProcCount: integer; tmpDataSet: TDataSet; begin if AShowProgress then Progress(0, 0, R('UAPP_MODULE_DATA_UPDATE',UAPP_MODULE_DATA_UPDATE) ); try tmpFileName := Trim( SQLExecute('SELECT project.path || "\script\" || unit.path FROM unit LEFT JOIN project ON project.id = unit.id_project WHERE unit.id=' + IntToStr(AIDUnit)) ); // файла может не быть, это не совсем нормально, но обрабатывается не здесь if not FileExists(tmpFileName) then exit; tmpStrings := TStringList.Create; // фишка MVDB - главный файл должен быть в кодировке UTF-8, а все остальные - ANSI if UpperCase( ExtractFileName(tmpFileName) ) = 'SCRIPT.PAS' then tmpStrings.LoadFromFile(tmpFileName) else tmpStrings.LoadFromFileANSI(tmpFileName); // tmpText := tmpStrings.Text; tmpStrings.Clear; // создаём список процедур и функций tmpBeginCount := 0; tmpProcCount := 0; tmpProcDetected := False; tmpIndex := -1; tmpWord := ''; for i := 1 to Length(tmpText) do begin tmpChar := tmpText[i]; if Ord(tmpChar) = 0 then // в конце строки может оказаться символ завершения строки. break; // линейный режим - это отключение посимвольного анализа до обнаружения триггерной последовательности if tmpIndex <> -1 then begin s1 := CHL_LM_End[tmpIndex]; // обнаружена завершающая последовательность? if copy(tmpText, i, Length(s1)) = s1 then begin // если завершающая последовательность больше одного символа, то делаем корректировку if Length(s1) > 1 then delete(tmpText, i + 1, Length(s1) - 1); // tmpIndex := -1; tmpWord := ''; end else tmpWord := tmpWord + tmpChar; continue; end; // конец слова if tmpText[i] in [' ', '{', '}', '/', '\', ')', '(', ';', ':', '"', '''', '.', ',', chr(13)] then begin // проверка начала линейного режима for j := 0 to Length(CHL_LM_Begin) - 1 do begin if copy(tmpText, i, Length(CHL_LM_Begin[j])) = CHL_LM_Begin[j] then begin tmpIndex := j; continue; end; end; // проверка слов tmpWord := Trim(tmpWord); if tmpWord <> '' then begin if tmpProcDetected then begin tmpStrings.Add(tmpWord); tmpProcDetected := False; end else if (UpperCase(tmpWord) = 'BEGIN') or (UpperCase(tmpWord) = 'CASE') or (UpperCase(tmpWord) = 'TRY') then inc(tmpBeginCount) else if UpperCase(tmpWord) = 'END' then begin dec(tmpBeginCount); if tmpBeginCount = 0 then dec(tmpProcCount); end else if ( UpperCase(tmpWord) = 'PROCEDURE' ) or ( UpperCase(tmpWord) = 'FUNCTION' ) then begin if tmpProcCount = 0 then tmpProcDetected := True; inc( tmpProcCount ); end; // tmpWord := ''; end; end else tmpWord := tmpWord + tmpChar; end; // смотрим, не удалили ли чего... Application.ProcessMessages; SQLQuery('SELECT id, name FROM unitProc WHERE id_unit = '+IntToStr(AIDUnit),tmpDataSet); while not tmpDataSet.EOF do begin if tmpStrings.IndexOf( tmpDataSet.FieldByName('name').asString ) < 0 then begin SQLExecute('UPDATE unitProc SET status = "Не найдена" WHERE id = '+tmpDataSet.FieldByName('id').asString ); Application.ProcessMessages; end; tmpDataSet.Next; end; // смотрим, не надо ли добавить... for i:=0 to tmpStrings.Count - 1 do begin if AShowProgress then Progress(i, tmpStrings.Count - 1, 'Добавление процедур' ) else Application.ProcessMessages; tmpDataSet.First; tmpProcDetected := False; while not tmpDataSet.EOF do begin if tmpStrings.strings(i) = tmpDataSet.FieldByName('name').asString then begin tmpProcDetected := True; Break; end; tmpDataSet.Next; end; if not tmpProcDetected then begin // добавляем... SQLExecute('INSERT INTO unitProc (id_unit,name,status) VALUES ('+IntToStr(AIDUnit)+','+StrToSQL( tmpStrings.strings(i) )+','+StrToSQL('Новая ')+')'); Application.ProcessMessages; end; end; tmpDataSet.Free; tmpStrings.Free; finally if AShowProgress then Progress(); end; end;
Code language: Delphi (delphi)

В отличии от других процедур заполнения и проверок, для извлечения данных используется только один запрос к базе, а проверки осуществляются с использованием компонентов TDataSet и TStringList, в которых загружаются сведения об имеющихся записях и информация о процедурах и функциях модуля.

Ещё одна особенность My Visual Database состоит в том, что кодировка главного модуля script.pas должна быть UTF-8, а кодировки остальных модулей – ANSY, и это необходимо учитывать при парсинге файлов модулей.

Для получения текста процедуры по имени используется функция UserApp_GetProcBody(), в основе которой лежит тот же парсер, что и в процедурах UpdateProjectList_UpdateUnitProcList() и CodeHL_TextToHTML(). (Обязуюсь к следующей версии придумать, как избавиться от копипаста в этих трёх процедурах).

function UserApp_GetProcBody( AText:string; AProcName:string ):string; var i: integer; j: integer; tmpWord: string; tmpChar: string; s1, s2: string; tmpIndex: integer; tmpBeginCount: integer; tmpProcDetected: boolean; tmpProcCount: integer; tmpProcStartPos: integer; tmpProcEndPos: integer; tmpStartPos: integer; tmpBody: boolean; tmpText:string; s: string; begin tmpText := AText; tmpBeginCount := 0; tmpProcCount := 0; tmpProcDetected := False; tmpIndex := -1; tmpWord := ''; tmpBody := False; for i := 1 to Length(tmpText) do begin tmpChar := tmpText[i]; if Ord(tmpChar) = 0 then // в конце строки может оказаться символ завершения строки. break; if tmpBody then Result := Result + tmpChar; // линейный режим - это отключение посимвольного анализа до обнаружения триггерной последовательности if tmpIndex <> -1 then begin s1 := CHL_LM_End[tmpIndex]; // обнаружена завершающая последовательность? if copy(tmpText, i, Length(s1)) = s1 then begin // если завершающая последовательность больше одного символа, то делаем коректировку if Length(s1) > 1 then delete(tmpText, i + 1, Length(s1) - 1); // tmpIndex := -1; tmpWord := ''; end else tmpWord := tmpWord + tmpChar; continue; end; // конец слова if tmpText[i] in [' ', '{', '}', '/', '\', ')', '(', ';', ':', '"', '''', '.', ',', chr(13)] then begin // проверка начала линейного режима for j := 0 to Length(CHL_LM_Begin) - 1 do begin if copy(tmpText, i, Length(CHL_LM_Begin[j])) = CHL_LM_Begin[j] then begin tmpIndex := j; continue; end; end; // проверка слов tmpWord := Trim(tmpWord); if tmpWord <> '' then begin if tmpProcDetected then begin if UpperCase(tmpWord) = UpperCase(AProcName) then begin for j := i-Length(tmpWord)-9 downto 0 do begin s := copy(tmpText,j,i-j+1); if ( UpperCase(copy(s,1,9)) = 'PROCEDURE') or ( UpperCase(copy(s,1,8 )) = 'FUNCTION') then begin Result := s; break; end; end; tmpBody := True; end; tmpProcDetected := False; end else if (UpperCase(tmpWord) = 'BEGIN') or (UpperCase(tmpWord) = 'CASE') or (UpperCase(tmpWord) = 'TRY') then inc(tmpBeginCount) else if UpperCase(tmpWord) = 'END' then begin dec(tmpBeginCount); if tmpBeginCount = 0 then begin dec(tmpProcCount); if (tmpProcCount = 0) and tmpBody then tmpBody := False; end; end else if ( UpperCase(tmpWord) = 'PROCEDURE' ) or ( UpperCase(tmpWord) = 'FUNCTION' ) then begin if tmpProcCount = 0 then tmpProcDetected := True; inc( tmpProcCount ); end; // tmpWord := ''; end; end else tmpWord := tmpWord + tmpChar; end; end;
Code language: Delphi (delphi)

Другие доработки

  • UserApp_LoadExample() – добавлена обработка случая, когда источником примера является таблица отображения процедур модуля: для извлечения текста вызывается UserApp_GetProcBody().
  • Splash_Create() – добавлена строка для отображения статуса инициализации приложения.
  • Splash_ShowProgress() – добавлена процедура отображения статуса инициализации приложения. Актуально для приложений с большим временем запуска.
  • UserApp_InitForm() – добавлены вызовы Splash_ShowProgress() для пояснения этапов инициализации
  • UserApp_UpdateDD() – добавлена обработка для формы dtfUnit_Tree, у которой теперь есть дочерняя форма dtfUnitProc
  • frmMain_btnProc_Update_OnClick() – добавлена процедура обработки нажатия кнопки, по которой производится анализ выбранного модуля.
  • english.txt, русский.txt – в файлы локализации ресурсов добавлены новые данные

Результат

Заменил картинку на заставке, чтобы надписи были более читабельными.

Добавил многостраничник для отображения процедур и функций (в перспективе планирую собирать сведения о константах и глобальных переменных).

При выборе процедуры можно просмотреть её код.

В базу данных добавлены описания для встроенных в My Visual Database процедур.

Планы

  • Отображать информацию о статических формах приложения (формах, созданных в редакторе форм My Visual Database).
  • Отображать информацию о структуре базы данных
  • Отображать зависимости между модулями и формами
  • Извлекать описательные данные из исходников для создания автоматической документации проекта.
  • Добавить в поисковую систему поиск по проектам, модулям и процедурам модулей
  • Синхронизация версий модулей.
  • Создание эталонных модулей (репозиторий модулей).

Ссылки

Добавить комментарий

Ваш адрес email не будет опубликован. Обязательные поля помечены *