Форум пользователей ПО АСКОН

написал плагин для лоцмана. формирует дерево и записывает данные в эксел. все нормально работает. щас потребовалось еще реализовать вывод версии объектов. вроде реализовал. все работает но для маленьких сборок. с большими выдает ошибку.
код:

unit PT_Unit1;

interface

Uses
Forms,Dialogs,PIClasses, Unit1, ComObj,DBClient,Registry,StrUtils,DB, ADODB;

function InitUserDLL(Value : Pointer) : Integer; stdcall; export;
function PgiCheckMenuItem(stFunction : String; RunMethod : TRunMethod;
                          ParentVersion, ChildVersion : TVersion;
                          stLinkName, DataBaseName, stCheckOut : String) : Boolean; stdcall; export;

procedure PT_1(ParentHandle, ClientHandle : THandle;
               RunMethod : TRunMethod;
               PDMVersion : TVersion;
               DataBaseName : string;
               stCheckOut : String); stdcall; export;

Procedure Query(id:integer;Product,Version:string);
function GetRegistryValueDesktop(): string;
function GetstVersion(id:integer):string;

var _PDMVersion: TVersion;
    MsExcel: OLEVariant;
    NomStr: Integer;
    StProd: string;
    DBName: string;
    cdsTemp:TClientDataSet;
    cdsTemp1:TClientDataSet;
implementation

Uses
  Messages, SysUtils, Controls, Windows;

type
PAddMenu = ^TAddMenu;
TAddMenu =
record
   stMenu : String[255];
   stFunction : String[255];
end;


Const
WM_REFRESH             = WM_USER + 1;
WM_REFRESHPARENT       = WM_USER + 4;
WM_GOTOCHILD           = WM_USER + 5;
WM_REFRESHCHECKOUTLIST = WM_USER + 6;

Var
errCode,errMsg:OleVariant;

function InitUserDLL (Value : Pointer) : Integer; stdcall; export;
Var
item : PAddMenu;
begin
if Value = nil then
   begin
     Result := 1;
   end
  else
   begin
     item := Value;

     item.stMenu := 'AFTER_MI_TOOLS#Отчеты НИПОМ#Дерево изделия';
     item.stFunction := 'PT_1';
     inc(item);
     Result := 1;
   end;

end;

function PgiCheckMenuItem(stFunction : String; RunMethod : TRunMethod;
                          ParentVersion, ChildVersion : TVersion;
                          stLinkName, DataBaseName, stCheckOut : String) : Boolean; stdcall; export;
begin

  Result := False;
  if stFunction = 'PT_1' then
      Result := True;
end;

procedure PT_1(ParentHandle, ClientHandle : THandle;
                             RunMethod : TRunMethod;
                             PDMVersion : TVersion;
                             DataBaseName : string;
                             stCheckOut : String); stdcall; export;
var
ID:integer;
Product:string;
begin
  Application.Handle := ClientHandle;
  AssignRunMethod(RunMethod);
  _PDMVersion:=TVersion.FromIDVersion(PDMVersion.inID);
  DBName:=DataBaseName;
  if (_PDMVersion.stType='Сборочная единица') or (_PDMVersion.stType='Комплект') then
    Begin
        Form1 := TForm1.Create(Application);
        Form1.Hide;

        Product:=_PDMVersion.stProduct;
        ID:=_PDMVersion.inID;

        Form1.Show;
        Query(ID,Product,_PDMVersion.stVersion);
      application.processmessages;
      _PDMVersion.Free;
      Form1.ADOConnection1.Close;
      Form1.Free;
      PostMessage(ClientHandle, WM_REFRESHPARENT,0,0);
      Application.Handle := 0;
      exit;
    end
  else
     begin
      MessageDlg('Выбраный объект не является сборочной единицей или комплектом.',mtError,[mbOK],0);
      _PDMVersion.Free;
      Form1.Free;
      PostMessage(ClientHandle, WM_REFRESHPARENT,0,0);
      Application.Handle := 0;
      exit;
     end;
     
end;


procedure Query(id:integer;Product,Version:string);
var

i:integer;
Inscript:String;
N:Double;
FormaName,fname,naimen,naimend: String;
begin
  naimen:=' ';
  naimend:=' ';
  cdsTemp:=TClientDataSet.Create(nil);
  cdsTemp1:=TClientDataSet.Create(nil);
  FormaName:='\\ascon\Forms$\tree.xls';
  fname:=GetRegistryValueDesktop+'\Дерево изделия '+Product+'.xls';
  NomStr:=3;
  CopyFile(PAnsiChar(FormaName),PAnsiChar(fname),false);
  MsExcel:=CreateOLEObject('Excel.Application');
  MsExcel.Visible:=False;
  MsExcel.Workbooks.Open(fname);
  MsExcel.Cells(1,2):=Product;
  MsExcel.Cells(1,5):=Version;
  cdsTemp1.Data:=RunMethod('GetInfoAboutVersion',['','','',id,2,errCode,errMsg]);
  cdsTemp1.First;
  if cdsTemp1.Locate('_NAME','Наименование',[]) then
    begin
    naimen:=cdsTemp1.FieldValues['_VALUE']
    end;
   if cdsTemp1.Locate('_NAME','Наименование дополнительное',[]) then
    begin
    naimend:=cdsTemp1.FieldValues['_VALUE']
    end;

    MsExcel.Cells(1,3):=naimen+' '+naimend;
  if cdsTemp1.Locate('_NAME','Разработал перечень',[]) then
    MsExcel.Cells(1,4):=cdsTemp1.FieldValues['_VALUE'];

  cdsTemp1.Free;

    with Form1.ADOQuery1 do
    begin
      SQL.Clear;
      SQL.Add('dt_setpropertytr0');
      Open;
      close;

    end;

    with Form1.ADOQuery2 do
    begin
      SQL.Clear;
      SQL.Add('dt_setpropertytr1');
      SQL.Add(IntToStr(id));
      Open;
      close;

    end;

    with Form1.ADOQuery3 do
    begin
      SQL.Clear;
      SQL.Add('dt_setpropertytr2');
      Open;
      close;

    end;

    with Form1.ADOQuery4 do
    begin
      SQL.Clear;
      SQL.Add('dt_setpropertytr3');
      SQL.Add(IntToStr(id));
      Open;
      close;

    end;

    with Form1.ADOQuery5 do
    begin
      SQL.Clear;
      SQL.Add('dt_setpropertytr4');
      Open;
      if RecordCount<>0 then
        begin
          First;
          Form1.ProgressBar1.Max:=RecordCount;
          N:=RecordCount;
          for i:=1 to RecordCount do
            begin
              Form1.ProgressBar1.StepBy(1);
              Inscript:= Format('Осталось - %.0f',[N/RecordCount*100])+'%'+' Проверяется '+FieldValues['keyattr'];
              Form1.Label1.Caption:=Inscript;
              application.processmessages;
              N:=N-1;
              MsExcel.Cells(NomStr,1):=FieldValues['LEVEL'];
              MsExcel.Cells(NomStr,2):=FieldValues['keyattr'];
              MsExcel.Cells(NomStr,3):=FieldValues['naimen'];
              MsExcel.Cells(NomStr,4):=FieldValues['kolvo'];
              MsExcel.Cells(NomStr,5):=FieldValues['primpost'];
              MsExcel.Cells(NomStr,6):=FieldValues['poziciy'];
              MsExcel.Cells(NomStr,7):=FieldValues['kod'];
              MsExcel.Cells(NomStr,8):=FieldValues['type'];
              MsExcel.Cells(NomStr,9):=FieldValues['primper'];
              MsExcel.Cells(NomStr,10):=FieldValues['pozicoboz'];
--------------MsExcel.Cells(NomStr,11):=GetstVersion(FieldByName('idchild').AsInteger);
              NomStr:=NomStr+1;
              Next;
            end;
        end;
      Close;
    end;

  MsExcel.Run('begin');
  MsExcel.Visible:=True;
  MsExcel.ActiveWorkbook.Save;
  cdsTemp.Free;
  VarClear(MsExcel);
end;

function GetRegistryValueDesktop(): string;
var
  Registry: TRegistry;
  KeyName:String;
begin
  Registry := TRegistry.Create(KEY_READ);
  try
    Registry.RootKey := HKEY_CURRENT_USER;
    KeyName:= 'Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders';
    Registry.OpenKey(KeyName, False);
    Result := Registry.ReadString('Desktop');
  finally
    Registry.Free;
  end;
end;
-----------------------------
function GetstVersion(id:Integer):string;
var
  cdsTemp:TClientDataSet;
begin
  cdsTemp:=TClientDataSet.Create(nil);
  cdsTemp.Data:=RunMethod('GetInfoAboutVersion',['','','',id,15,errCode,errMsg]);
  GetstVersion:=cdsTemp.FieldByName('_VERSION').AsString;
end;

end.

пунктиром отмечены пункты связанные с выводом версии объекта. где ошибка?

Основная ошибка у вас в том, что вы пользуетесь старой документацией от 8-й версии, в которой много ошибок. Например прототип функции плагина должен быть таким (для 8.5 SP2):
procedure PT_1(ParentHandle, ClientHandle: THandle;
    RunMethod: TRunMethod; PDMVersion: TVersion; DbName,
    CheckOut: String; IDLink: LongInt); stdcall;
Кроме того вы пользуетесь объектами String и TVersion, переданными из клиента в плагин, что при неудачном стечении обстоятельств может приводить к порче памяти.
Пользоваться объектом TVersion и строками лучше так:
var
    LProduct: String;
begin
    LProduct := PChar(PDMVersion.stProduct);
end;
Замените:
Application.Handle := ParentHandle;
И уберите Application.ProcessMessages. Это также может приводить к проблемам, если у вас не точно такая же версия Delphi, как та, в которой собран клиент Лоцмана.
P.S.
Напишите версию Лоцмана и Delphi, это поможет лучше понять, в чем могут быть проблемы.

спасобо за совет. уже решил проблему  :)