Rational Rose via COM (OLE Automation)

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

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

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

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

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

Delphi
1
2
3
4
5
6
7
8
//Запустить 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
1
2
3
4
5
6
7
8
9
10
11
12
13
  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
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
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
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
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;

Новые блоги и статьи Все статьи Все блоги /
Автоматическое создание документа при проведении другого документа Maks 29.03.2026 Реализация из решения ниже выполнена на нетиповых документах, разработанных в конфигурации КА2. Есть нетиповой документ "ЗаявкаНаРемонтСпецтехники" и нетиповой документ "ПланированиеСпецтехники". В. . .	Настройка движения справочника по регистру сведений Maks 29.03.2026 Решение ниже реализовано на примере нетипового справочника "ТарифыМобильнойСвязи" разработанного в конфигурации КА2, с целью учета корпоративной мобильной связи в коммерческом предприятии. . . .	Автозаполнение реквизита при выборе элемента справочника Maks 27.03.2026 Программный код из решения ниже на примере нетипового документа "ЗаявкаНаРемонтСпецтехники" разработанного в конфигурации КА2. При выборе "Спецтехники" (Тип Справочник. Спецтехника), заполняется. . .	Сумматор с применением элементов трёх состояний. Hrethgir 26.03.2026 Тут. https:/ / fips. ru/ EGD/ ab3c85c8-836d-4866-871b-c2f0c5d77fbc Первый документ красиво выглядит, но без схемы. Это конечно не даёт никаких плюсов автору, но тем не менее. . . всё может быть. . .
Автозаполнение реквизитов при создании документа Maks 26.03.2026 Программный код из решения ниже размещается в модуле объекта документа, в процедуре "ПриСозданииНаСервере". Алгоритм проверки заполнения реализован для исключения перезаписи значения реквизита,. . .	Команды формы и диалоговое окно Maks 26.03.2026 1. Команда формы "ЗаполнитьЗапчасти". Программный код из решения ниже на примере нетипового документа "ЗаявкаНаРемонтСпецтехники" разработанного в конфигурации КА2. В качестве источника данных. . .	Кому нужен AOT? DevAlt 26.03.2026 Решил сделать простой ланчер Написал заготовку: dotnet new console --aot -o UrlHandler var items = args. Split(":"); var tag = items; var id = items; var executable = args;. . .	Отправка уведомления на почту при создании или изменении элементов справочника Maks 24.03.2026 Программная отправка письма электронной почты на примере типового справочника "Склады" в конфигурации БП3. Перед реализацией необходимо выполнить настройку системной учетной записи электронной. . .