Rational Rose via COM (OLE Automation)

@roamer · Регистрация: 08.05.2009

Author24 — интернет-сервис помощи студентам

У кого-нибудь есть опыт использования ?

Добавлено через 12 часов 41 минуту 22 секунды
Уточним.

Открыть модель :

Delphi

//Запустить Rational Rose Enterprise
oleRose:= CreateOleObject('Rose.Application');
//открыть модель (файл: fn_Model)
oleModel:=oleRose.OpenModel(fn_Model);
//только для чтения
oleModel.Modifiable(false);
//Визуализировать
oleRose.Visible:=true;

"Закрыть" соединение с Ratioanal Rose

Delphi

1
2
3

oleRose.Visible:=false;
oleRose.Exit;
oleRose:=UnAssigned;

Прочитать список классов :

Delphi

  oleRoseItemCollection:=oleModel.GetAllClasses;
  c:=oleRoseItemCollection.Count;
  if c>0 then begin
     i:=0;
     while i<c do
      begin
       i:=i+1;
       oleRoseItem:=oleRoseItemCollection.GetAt(i);
       if not VarIsEmpty(oleRoseItem) then begin
          Memo1.Lines.Add(IntToStr(i)+'.   '+oleRoseItem.Name);
       end;
     end;
  end;

А как прочитать список пакетов ???

Добавлено через 15 часов 56 минут 31 секунду
Где-то как-то удалось решить.
Кривовато, но вроде работает.
Может кому-то пригодится ...

Delphi

procedure TForm1.SpeedButton1Click(Sender: TObject);
Var
  List_Category : TStrings;
  List_Class    : TStrings;
  sName,sIDclass,
  sIDcategory   : string;
  vRoseItemCollection, 
  vRoseItem     : variant;
  c,i           : integer;
 
begin
  Memo1.Lines.Clear;
 
  List_Category   := TStringList.Create;
  List_Class      := TStringList.Create;
  TRY
 
     //---------------------------------------------------
     //Создаем список всех категорий (куда входят и пакеты)
     vRoseItemCollection:=oleModel.GetAllCategories; //"читаем" коллекцию всех категорий
     c:=vRoseItemCollection.Count;
     if c>0 then begin
        i:=0;
        while i<c do
         begin
          i:=i+1;
          vRoseItem:=vRoseItemCollection.GetAt(i);   //читаем очередную категорию
          if not VarIsEmpty(vRoseItem) then begin
             sName:=trim(vRoseItem.Name);            //имя категории
             if length(sName)<=0 then sName:=' ';
             List_Category.VALUES[vRoseItem.GetUniqueID]:=sName;
          end;
        end;
     end;
     //---------------------------------------------------
 
 
     //---------------------------------------------------
     //Создаем список всех классов
     vRoseItemCollection:=oleModel.GetAllClasses;   //"читаем" коллекцию всех классов
     c:=vRoseItemCollection.Count;
     if c>0 then begin
        i:=0;
        while i<c do
         begin
          i:=i+1;
          vRoseItem:=vRoseItemCollection.GetAt(i);  //читаем очередной класс
          if not VarIsEmpty(vRoseItem) then begin
             sName:=trim(vRoseItem.Name);           //имя класса
             if length(sName)<=0 then sName:=' ';
             List_Class.VALUES[vRoseItem.GetUniqueID]:=sName;
          end;
        end;
     end;
     //---------------------------------------------------
 
     
     //---------------------------------------------------
     //Выводим список классов с принадлежностью к "чему-то"
     for i:=0 to (List_Class.Count-1) do
      begin
       sIDclass := List_Class.NAMES[i];              //ID класса
       sName    := List_Class.VALUES[sIDclass];      //имя класса
       vRoseItem:=oleModel.FindItemWithID(sIDclass); //получаем ссылку на класс (по ID)
 
       if not VarIsEmpty(vRoseItem) then begin
          sIDcategory:=vRoseItem.ParentCategory.GetUniqueID; //читаем ID родителя
          sName:=sName+ '  <=  '+ List_Category.VALUES[sIDcategory]; //добавояем имя категории
 
          //..............................................
          //теперь пробуем оценить, пакет ли это
          vRoseItem:=oleModel.FindItemWithID(sIDcategory);   //получаем ссылку на родителя
          if not VarIsEmpty(vRoseItem) then begin
             if (not vRoseItem.TopLevel) then sName:=sName+'.  Это пакет';
          end;
          //..............................................
 
       end;
       Memo1.Lines.Add(sName);
     end;
     //---------------------------------------------------
 
  FINALLY
     List_Category.Free;
     List_Category  := nil;
     List_Class.Free;
     List_Class     := nil;
  END;
 
end;

@roamer · 19.05.2009, 16:52 **[ТС]**

Раз народ смотрит и есть интерес, то рискну кинуть сюда некоторые исходники.
Может кому-то пригодится (мало ли).
Пришлось использовать метод проб и ошибок, а когда решение находилось, то писать быстро и не особо заботясь о "красоте" кода, так что ...

Delphi

function RRose_Open(YesVisible : boolean = true; fn_Model : string = ''; YesReadOnly : boolean = true) : variant;
//Открыть Rational Rose и загрузить модель fn_Model (если существует) и вернуть ссылку на него
//(как OLE Automation Server)
//YesReadOnly - если TRUE, то открыть модель только для чтения
Var
  oleModel : variant;
begin
  Result:= CreateOleObject('Rose.Application');
  fn_Model:=trim(fn_Model);
  if length(fn_Model)>0 then begin
     if FileExists(fn_Model) then begin
        oleModel:=Result.OpenRoseModel(fn_Model,false);
        if YesLinkToRRose_Any(oleModel) then begin
           oleModel.Modifiable(not YesReadOnly);
        end;
     end;
  end;
  Result.Visible:=YesVisible;
end;
 
 
procedure RRose_Close(RRose : variant);
//Закрыть Rational Rose
//RRose - ссылка на Rational Rose (OLE Automation server)
Var
  oleModel : variant;
begin
  if YesLinkToRRose_Any(RRose) then begin
     oleModel:=RRose_Model_Get(RRose);
     if YesLinkToRRose_Any(oleModel) then begin
        oleModel.UnLoad;
        oleModel:=UnAssigned;
     end;
     RRose.Visible:=false;
     RRose.Exit;
     RRose:=UnAssigned;
  end;
end;
 
 
function RRose_Model_Get(RRose : variant) : variant;
//Получить ссылку на текущую модель  Rational Rose
//RRose - ссылка на Rational Rose (OLE Automation server)
begin
  Result:=UnAssigned;
  if YesLinkToRRose_Any(RRose) then begin
     Result:=RRose.CurrentModel;
  end;
end;
 
 
function RRose_Model_Load(RRose : variant; fn_Model : string = ''; YesReadOnly : boolean = true) : variant;
//Загрузить модель из файла fn_Model и получить на нее ссылку
//RRose - ссылка на Rational Rose (OLE Automation server)
//YesReadOnly - если TRUE, то открыть модель только для чтения
begin
  Result:=UnAssigned;
  if YesLinkToRRose_Any(RRose) then begin
     fn_Model:=trim(fn_Model);
     if length(fn_Model)>0 then begin
        if FileExists(fn_Model) then begin
           Result:=RRose.OpenModel(fn_Model);
           Result.Modifiable(not YesReadOnly);
        end;
     end;
  end;
end;
 
 
function RRose_Model_Set_ReadOnly(RRose : variant) : boolean;
//Установить флаг текущей модели ReadOnly = true
//RRose - ссылка на Rational Rose (OLE Automation server)
Var
  oleModel : variant;
begin
  Result:=false;
  if YesLinkToRRose_Any(RRose) then begin
     oleModel:=RRose_Model_Get(RRose);
     if YesLinkToRRose_Any(oleModel) then begin
        oleModel.Modifiable(false);
        Result:=true;
     end;
  end;
end;
 
 
function RRose_Model_Reset_ReadOnly(RRose : variant) : boolean;
//Сбросить флаг текущей модели ReadOnly = false
//RRose - ссылка на Rational Rose (OLE Automation server)
Var
  oleModel : variant;
begin
  Result:=false;
  if YesLinkToRRose_Any(RRose) then begin
     oleModel:=RRose_Model_Get(RRose);
     if YesLinkToRRose_Any(oleModel) then begin
        oleModel.Modifiable(true);
        Result:=true;
     end;
  end;
end;
 
 
function RRose_Classes_List_Get(RRose : variant; RRoseCategory : variant) : variant;
//Получить ссылку на коллекцию классов текущей модели Rational Rose
//RRose - ссылка на Rational Rose (OLE Automation server)
//RRoseCategory - ссылка на родитель (если unassigned, то все)
Var
  oleModel   : variant;
begin
  Result:=UnAssigned;
  if YesLinkToRRose_Any(RRose) then begin
     oleModel:=RRose_Model_Get(RRose);
     if YesLinkToRRose_Any(oleModel) then begin
        if YesLinkToRRose_Any(RRoseCategory) then begin
           Result:=RRoseCategory.GetAllClasses;
        end
        else begin
           Result:=oleModel.GetAllClasses;
        end;
     end;
  end;
end;
 
 
function RRose_Classes_List_Get_1(RRose : variant; sIDRRoseCategory : string = '') : variant;
//Получить ссылку на коллекцию классов текущей модели Rational Rose
//RRose - ссылка на Rational Rose (OLE Automation server)
//sIDRRoseCategory - ссылка на родитель, по его уникальному ID (если пустая строка, то все)
Var
  oleModel : variant;
  oleCat   : variant;
begin
  Result:=UnAssigned;
  if YesLinkToRRose_Any(RRose) then begin
     oleModel:=RRose_Model_Get(RRose);
     if YesLinkToRRose_Any(oleModel) then begin
        sIDRRoseCategory:=trim(sIDRRoseCategory);
        if length(sIDRRoseCategory)>0 then begin
           oleCat:=oleModel.FindItemWithID(sIDRRoseCategory);
           if YesLinkToRRose_Any(oleCat) then begin
              Result:=oleCat.GetAllClasses;
           end;
        end
        else begin
           Result:=oleModel.GetAllClasses;
        end;
     end;
  end;
end;
 
 
function RRose_Categories_List_Get(RRose : variant; RRoseCategory : variant) : variant;
//Получить ссылку на коллекцию категорий текущей модели Rational Rose
//RRose - ссылка на Rational Rose (OLE Automation server)
//RRoseCategory - ссылка на родитель (если unassigned, то все)
Var
  oleModel   : variant;
begin
  Result:=UnAssigned;
  if YesLinkToRRose_Any(RRose) then begin
     oleModel:=RRose_Model_Get(RRose);
     if YesLinkToRRose_Any(oleModel) then begin
        if YesLinkToRRose_Any(RRoseCategory) then begin
           Result:=RRoseCategory.GetAllCategories;
        end
        else begin
           Result:=oleModel.GetAllCategories;
        end;
     end;
  end;
end;
 
 
function RRose_Categories_List_Get_1(RRose : variant; sIDRRoseCategory : string = '') : variant;
//Получить ссылку на коллекцию категорий текущей модели Rational Rose
//RRose - ссылка на Rational Rose (OLE Automation server)
//sIDRRoseCategory - ссылка на родитель, по его уникальному ID (если пустая строка, то все)
Var
  oleModel : variant;
  oleCat   : variant;
begin
  Result:=UnAssigned;
  if YesLinkToRRose_Any(RRose) then begin
     oleModel:=RRose_Model_Get(RRose);
     if YesLinkToRRose_Any(oleModel) then begin
        sIDRRoseCategory:=trim(sIDRRoseCategory);
        if length(sIDRRoseCategory)>0 then begin
           oleCat:=oleModel.FindItemWithID(sIDRRoseCategory);
           if YesLinkToRRose_Any(oleCat) then begin
              Result:=oleCat.GetAllCategories;
           end;
        end
        else begin
           Result:=oleModel.GetAllCategories;
        end;
     end;
  end;
end;
 
 
function RRose_Packages_List_Get(RRose : variant; RRoseCategory : variant) : variant;
//Получить ссылку на коллекцию пакетов текущей модели Rational Rose
//RRose - ссылка на Rational Rose (OLE Automation server)
//RRoseCategory - ссылка на родитель (если unassigned, то все)
Var
  vRoseItem   : variant;
  i : integer;
begin
  Result:=RRose_Categories_List_Get(RRose,RRoseCategory);
  if YesLinkToRRose_Any(Result) then begin
     i:=0;
     while i<Result.Count do
      begin
        i:=i+1;
        vRoseItem:=Result.GetAt(i);   //читаем очередную категорию
        if YesLinkToRRose_Any(vRoseItem) then begin
           if (vRoseItem.TopLevel) then begin //это НЕ пакет (???)
               Result.Remove(vRoseItem);  //удаляем из коллекции
               i:=i-1;
           end;
        end;
    end;
  end;
end;
 
 
function RRose_Packages_List_Get_1(RRose : variant; sIDRRoseCategory : string = '') : variant;
//Получить ссылку на коллекцию пакетов текущей модели Rational Rose
//RRose - ссылка на Rational Rose (OLE Automation server)
//sIDRRoseCategory - ссылка на родитель, по его уникальному ID (если пустая строка, то все)
Var
  vRoseItem   : variant;
  i : integer;
begin
  Result:=RRose_Categories_List_Get_1(RRose,sIDRRoseCategory);
  if YesLinkToRRose_Any(Result) then begin
     i:=0;
     while i<Result.Count do
      begin
        i:=i+1;
        vRoseItem:=Result.GetAt(i);   //читаем очередной пакет
        if YesLinkToRRose_Any(vRoseItem) then begin
           if (vRoseItem.TopLevel) then begin //это НЕ пакет (???)
               Result.Remove(vRoseItem); //удаляем из коллекции
               i:=i-1;
           end;
        end;
    end;
  end;
end;
 
 
function YesLinkToRRose_Any(HandleAny : Variant) : boolean;
//Проверяет, есть ли соединение с Rational Rose (не строго)
begin
 Result:=FALSE;
 if not VarIsEmpty(HandleAny) then Result:=TRUE;
end;

	19.05.2009, 16:52