Помочь с кодом для плагина. выдает ошибку

gsdim · 01.12.11, 15:34:26

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

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.

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

Chaa · 02.12.11, 06:49:11

Основная ошибка у вас в том, что вы пользуетесь старой документацией от 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, это поможет лучше понять, в чем могут быть проблемы.

gsdim · 02.12.11, 09:42:40

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

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

Новости:

Помочь с кодом для плагина. выдает ошибку

gsdim

Chaa

gsdim