Проверка наличия КОМПАСа

[Николай]

На определённом этапе программы необходимо перейти к работе с графической прогр. КОМПАС.
Причём: если программа вообще не установлена на компьютере- выдать об этом сообщение;
если установлена, но не запущена- запустить;
если запущена, то второй раз не запускать.
Такой кусочек кода (VB-6) запускает КОМПАС каждый раз, невзирая, что ранее КОМПАС уже был открыт. Это нехорошо.

Dim Kompas As Object
Set Kompas = CreateObject("KOMPAS.Application.5")
    If Not Kompas Is Nothing Then  'если KOMPAS не запущен, то включить. А всё равно запускает без проверки!
      Kompas.Visible = True 'Вкл.видимость

Прошу помощи.

[Makar]

Я не программист, но думаю Вам стоит обратить внимание на эту ветку реестра "HKEY_LOCAL_MACHINE\SOFTWARE\ASCON\KOMPAS-3D\" - это, что касаемо версии и пути.
Еще КОМПАС прописывает себя в реестре (правда не помню где) и его можно запускать через команду "Выполнить", написав там "kompas"

сомневаюсь, что чем-нибудь поможет, но всё же...

[Гость]

Вот пример получения пути к Компасу. Если вернет пустую строку, следовательно компас не прописан в реестре или есть проблеммы с некоторыми его параметрами (например, на компьютере было установлено 2 компас, один компас был удален и в реестре появились проблеммы). Правда пример дан на С++, но думаю вам легко будет его адаптировать.

BOOL GetKompasPath(char *KompasPath)
{
   DWORD  dwDataSize = 0, dwType = REG_SZ;
   HKEY   hKey;
   char buf[256],xm[256];
   
   sprintf(buf,"");
   BOOL res = FALSE;
   if(RegOpenKeyEx(HKEY_LOCAL_MACHINE, "SOFTWARE\\ASCON\\KOMPAS-3D", 0, KEY_READ, &hKey) == ERROR_SUCCESS)
   {  
      if(RegQueryValueEx(hKey, "CurrentVersion", NULL, &dwType, NULL, &dwDataSize) == ERROR_SUCCESS)
      {
         if(RegQueryValueEx(hKey, "CurrentVersion", NULL, &dwType, (LPBYTE)buf, &dwDataSize) == ERROR_SUCCESS)
         {
            sprintf(xm,"SOFTWARE\\ASCON\\KOMPAS-3D\\%s",buf);
            
            if(RegOpenKeyEx(HKEY_LOCAL_MACHINE, xm, 0, KEY_READ, &hKey) == ERROR_SUCCESS)
            {
               if(RegQueryValueEx(hKey, "InstallPath", NULL, &dwType, NULL, &dwDataSize) == ERROR_SUCCESS)
               {
                  if(RegQueryValueEx(hKey, "InstallPath", NULL, &dwType, (LPBYTE)buf, &dwDataSize) == ERROR_SUCCESS)
                  {
                     res=TRUE;
                     
                  }
               }
            }
         }
      }            
      RegCloseKey(hKey);
   }
   if(res == FALSE)
      sprintf(KompasPath,"");
   else
   {
      sprintf(KompasPath,"%s",buf);
      
   }
  return res;
}

[YorikER]

Я делаю вот так:

procedure CheckKompas;
var
  Result: HRESULT;
  Unknown: IInterface;
  s:        string;
  snew:     string;
begin
  Result := GetActiveObject(ProgIDToClassID('Kompas.Application.5'),nil,Unknown);
  if (Result = MK_E_UNAVAILABLE) then//если не доступен
  begin
    // Создать один экземпляр сервера
    Kompas_W := KompasObject( CreateOleObject('Kompas.Application.5') );
  end
  else begin
    // Соединиться с уже запущенной копией сервера
    Kompas_W := KompasObject(GetActiveOleObject('Kompas.Application.5'));
  end;
end;

где  Kompas_W:  KompasObject; // глобальная переменная в программе, объект KompasObject см. модуль ksTLB.pas

Далее с Kompas_W делайте все, что хотите согласно Kompas API

[Николай]

Спасибо за советы.
А сделал так: выводим список запущенных программ и,  построчно сравнивая с "KOMPAS.Exe" определяем, запущен или нет. Если нет- сообщение-" КОМПАС не запущен, чертёж получен быть не может". В противном случае же идёт работа по получению чертежа. Естественно, если на компьютере КОМПАС не установлен,
получим только расчётные данные для передачи хоть на кульман.
Если кому интересно, код выложу.

[nickvm]

  begin
    try
    // шукаємо запущений компас
    Kompas:= KompasObject( GetActiveOleObject('Kompas.Application.5') );
    except
     on EOleSysError do  // якщо немає то завантажуємо
      kompas:=KompasObject( CreateOleObject('Kompas.Application.5') );
    end;
  end;

а я делаю так

[Николай]

Дякую.
Код компактный, вот только его перевести на VB-6...
Если программисты помогут инженеру- буду благодарен.

[Prog2]

Пример обработки исключений: Visual Basic 6.0 code

Sub Foo()
   Dim errorSource As String
   Dim errorDescription As String
   Dim Arr() As Integer
   Dim i As Integer
   On Error GoTo ErrorHandler
       i = 0
       Arr(i -1) = Arr(i)
       Exit Sub
   ErrorHandler:
       MsgBox Err.description, , Err.Source
End Sub

Т.е. блок (On Error ... Goto) - то же самое, что и (Try ... Except).