Pavel Krivozubov
Смотрите сами :)
А насчет браузера... И дома, и на работе стоит Mozilla Firefox, версия 18.0.1. У моего самого свежего сообщения (4 минуты от создания) есть только кнопки "Удалить сообщение" и "Пожаловаться на это сообщение". У старых только последняя кнопка. Вчера видел еще "Редактировать" у новых постов, но сегодня нигде такого не наблюдается
__________________________________________________________________________________________________________________
Продолжаю дополнять статью не менее интересным материалом.
2. Использование Delphi для компиляции CIN'а.
Оказывается, можно использовать не только те среды программирования и компиляторы, что указаны в мануалах Code Interface Reference Manual и Using External Code In LabVIEW, а практически все, что способны создавать Native DLL, соблюдая некоторые условия. Мне долгое время казалось, что кроме C/C++ оболочки в Windows не создать CIN никак, в основном потому, что требуется подключать к проекту объектный файл cin.obj, две библиотеки labview.lib и lvsb.lib, а также файл экспорта функций lvsbmain.def. Файлы *.obj и *.lib в COFF-формате, а Delphi, например, его вообще не воспринимает. Однако, если не использовать labview.lib и разобрать в отладчике остальные файлы, то создать CIN в Delphi проще простого.
Чтобы не мучать читателя техническими подробностями, напишу кратко: для компиляции требуется воссоздать заголовок CIN, прописать в нём ссылки на основные CIN-функции, указать ещё кое какую информацию, а также экспортировать из библиотеки две функции: GetLVSBHeader и SetLVRTModule (вторая нужна больше для удобства). Ну, и соответственно, нужно описать прототипы всех CIN-функций. В результате получилась вот такая заготовка:
Код: Выделить всё
library Test;
uses
SysUtils,
Windows;
{$R *.res}
type
TCINHeader = Packed Record
Init: Cardinal; //CINInit
Dispose: Cardinal; //CINDispose
Abort: Cardinal; //CINAbort
Run: Cardinal; //CINRun
Load: Cardinal; //CINLoad
Save: Cardinal; //CINSave
Unload: Cardinal; //CINUnload
Properties: Cardinal; //CINProperties
LVSBHead: Cardinal;
Field10: Cardinal;
TypeString: Cardinal;
CINToolsVersion: Cardinal;
gLVExtCodeDispatchTable: Cardinal;
ReloadCounter: Cardinal;
Field15: Cardinal;
CINModuleAddress: Cardinal;
Field17: Cardinal;
LVRTTable: Cardinal;
LVSBHeaderPtr: Cardinal;
Field20: Cardinal;
Field21: Cardinal;
Field22: Cardinal;
Field23: Cardinal;
Field24: Cardinal;
Field25: Cardinal;
Field26: Cardinal;
Field27: Cardinal;
end;
var CIN: TCINHeader;
gLVRTModule: cardinal;
DbgPrintf: function(str: pchar): integer; cdecl;
CINSetArraySize: function(DataHandle: pointer; TDPtr: pointer;
ParamNumber: integer;
NewNumberOfElements: integer): integer; cdecl;
GetSetLVInfo: function(Action: integer; Data: integer): integer; cdecl;
// CIN-specific Functions //
function GetTDPtr: pointer; cdecl;
begin
Result:=Ptr(GetSetLVInfo(3,0));
end;
function SetCINArraySize(DataHandle: pointer; ParamNumber: integer;
NewNumberOfElements: integer): integer; cdecl;
var TD: pointer;
begin
TD := GetTDPtr;
Result := CINSetArraySize(DataHandle,TD,ParamNumber,NewNumberOfElements);
end;
function GetDSStorage: integer; cdecl;
begin
Result:=GetSetLVInfo(0,0);
end;
function SetDSStorage(NewValue: integer): integer; cdecl;
begin
Result:=GetSetLVInfo(1, NewValue);
end;
function GetLVInternals: pointer; cdecl;
begin
Result:=Ptr(GetSetLVInfo(4,0));
end;
// End of CIN-specific Functions //
function CINInit: integer; cdecl;
begin
if (@DbgPrintf<>nil) then DbgPrintf('CINInit');
Result:=0; //mgNoErr
end;
function CINDispose: integer; cdecl;
begin
if (@DbgPrintf<>nil) then DbgPrintf('CINDispose');
Result:=0; //mgNoErr
end;
function CINAbort: integer; cdecl;
begin
if (@DbgPrintf<>nil) then DbgPrintf('CINAbort');
Result:=0; //mgNoErr
end;
function CINRun(Num1: pointer; Num2: pointer; Sum: pointer): integer; cdecl;
var N1,N2,S: ^integer;
begin
if (@DbgPrintf<>nil) then DbgPrintf('CINRun');
N1:=Num1;
N2:=Num2;
S:=Sum;
S^ := N1^ + N2^;
Result:=0; //mgNoErr
end;
function CINLoad(Reserved: cardinal): integer; cdecl;
begin
if (@DbgPrintf<>nil) then DbgPrintf('CINLoad');
Result:=0; //mgNoErr
end;
function CINUnload: integer; cdecl;
begin
if (@DbgPrintf<>nil) then DbgPrintf('CINUnload');
Result:=0; //mgNoErr
end;
function CINSave(Reserved: cardinal): integer; cdecl;
begin
if (@DbgPrintf<>nil) then DbgPrintf('CINSave');
Result:=0; //mgNoErr
end;
function CINProperties(Selector: integer; Arg: pointer): integer; cdecl;
var Data: ^boolean;
begin
//if (@DbgPrintf<>nil) then DbgPrintf('CINProperties');
Data := Arg;
case Selector of
0: //kCINIsReentrant
begin
Data^ := True;
Result:=0; //mgNoErr
Exit;
end
else
Result:=53; //mgNotSupported
end;
end;
function GetLVSBHeader: Cardinal; cdecl;
begin
Result:=Cardinal(@CIN.LVSBHead);
end;
procedure SetLVRTModule(Module: Cardinal); cdecl;
begin
gLVRTModule:=Module;
//
if (gLVRTModule<>0) then begin
DbgPrintf := GetProcAddress(gLVRTModule, 'DbgPrintf');
//if (@DbgPrintf<>nil) then DbgPrintf('DbgPrintf found.');
CINSetArraySize := GetProcAddress(gLVRTModule, 'CINSetArraySize');
GetSetLVInfo := GetProcAddress(gLVRTModule, 'GetSetLVInfo');
end;
end;
exports
GetLVSBHeader name 'GetLVSBHeader',
SetLVRTModule name 'SetLVRTModule';
begin
CIN.Init:=Cardinal(@CINInit);
CIN.Dispose:=Cardinal(@CINDispose);
CIN.Abort:=Cardinal(@CINAbort);
CIN.Run:=Cardinal(@CINRun);
CIN.Load:=Cardinal(@CINLoad);
CIN.Save:=Cardinal(@CINSave);
CIN.Unload:=Cardinal(@CINUnload);
CIN.Properties:=Cardinal(@CINProperties);
CIN.LVSBHead:=0;
CIN.Field10:=0;
CIN.TypeString:=$204E4943; //String "CIN "
CIN.CINToolsVersion:=$00000004; //cintools Version
CIN.gLVExtCodeDispatchTable:=Cardinal(@CIN.Init);
CIN.ReloadCounter:=0;
CIN.Field15:=0;
CIN.CINModuleAddress:=0;
CIN.Field17:=0;
CIN.LVRTTable:=0;
CIN.LVSBHeaderPtr:=0;
CIN.Field20:=0;
CIN.Field21:=0;
CIN.Field22:=0;
CIN.Field23:=0;
CIN.Field24:=0;
CIN.Field25:=0;
CIN.Field26:=0;
CIN.Field27:=0;
end.
В функцию CINRun я поместил простейший код сложения двух чисел для проверки. Этот шаблон можно использовать для создания любого CIN'а в Delphi, банально скопировав код в свой проект. Что интересно, в отличие от MS Visual Studio в Delphi можно вообще не менять опции проекта, а использовать дефолтные настройки! Я даже не менял выравнивание структур (записей), а объявил их как
packed record. Всё, что требуется менять при создании нового CIN'а - это типовые функции CINRun, CINInit и т.д. Правда, есть всё же один минус - чтобы использовать встроенные функции самого LabVIEW, требуется прописывать их прототип и получать адрес (см. в качестве примера определение функции DbgPrintf). Это как раз тот недостаток, который появился при отключении labview.lib и заголовочного файла extcode.h. Соответственно, все макросы, облегчающие написание кода, тоже недоступны. Но вряд ли кто-то воспользуется всем функционалом
, обычно нужно применить несколько функций максимум. Для подстраховки можно найти адрес основного модуля в LibMain (между
begin и
end) и определить нужные функции так:
Код: Выделить всё
LVInstance := GetModuleHandle('lvrt.dll');
if (LVInstance = 0) then
LVInstance := GetModuleHandle(nil);
if (LVInstance <> 0) then begin
DbgPrintf = GetProcAddress(LVInstance, 'DbgPrintf');
if Assigned(DbgPrintf) then
...
else
//ошибка при определении функции
end
Или просто записать LVInstance в глобальную переменную gLVRTModule, а функции определить в SetLVRTModule. Но эти действия излишни, если CIN экспортирует SetLVRTModule, так как в этом случае мы гарантированно получаем адрес основного модуля labview.exe или lvrt.dll (если работаем в Run-Time Engine). Ещё один вариант, который применялся в CIN'ах последних версий - использование LVRTTable, т.е. таблицы со смещениями всех функций относительно базового адреса основного модуля. Рассмотрим этот вариант как-нибудь в другой раз.
Также стоит сказать, что после компиляции полученную библиотеку требуется преобразовать в *.lsb файл, чтобы потом загрузить в
. В Delphi 7 нет опций для задания пользовательских команд после компиляции (в отличие от более поздних версий RAD Studio XE или MS Visual Studio). Так что выход один - вручную (через командную строку) выполнить команду
"%CINTOOLS_DIR%\lvsbutil" -c имя_библиотеки. %CINTOOLS_DIR% - переменная среды, равная пути к папке cintools, например C:\Program Files (x86)\National Instruments\LabVIEW 2011\cintools. Имя библиотеки задаётся без расширения *.dll. Конвертация в *.lsb выполняется в папке, где лежит наша DLL. Если всё прошло успешно, то получим вот такое сообщение:
Далее я приведу пару примеров, подтверждающих нормальную работу CIN'ов, созданных в Delphi. Примеры взяты из изданий "Using External Code In LabVIEW" и "Code Interface Reference Manual".
Пример первый. CIN, вычисляющий векторное произведение двух двумерных массивов типа Double. Дополнительно возвращается статус ошибки, равный True, если перемножить массивы невозможно. Код на С выглядит так:
Код: Выделить всё
/*
* CIN source file
*/
#include "extcode.h"
#define ParamNumber 2
/* The return parameter is parameter 2 */
#define NumDimensions 2
/* 2D Array */
/*
* typedefs
*/
typedef struct {
int32 dimSizes[2];
float64 arg1[1];
} TD1;
typedef TD1 **TD1Hdl;
CIN MgErr CINRun(TD1Hdl ah, TD1Hdl bh, TD1Hdl resulth, LVBoolean *errorp);
CIN MgErr CINRun(TD1Hdl ah, TD1Hdl bh, TD1Hdl resulth, LVBoolean *errorp) {
int32 i,j,k,l;
int32 rows, cols;
float64 *aElmtp, *bElmtp, *resultElmtp;
MgErr err=noErr;
int32 newNumElmts;
if ((k = (*ah)->dimSizes[1]) != (*bh)->dimSizes[0]) {
*errorp = LVTRUE;
goto out;
}
*errorp = LVFALSE;
rows = (*ah)->dimSizes[0];
/* number of rows in a and result */
cols = (*bh)->dimSizes[1];
/* number of cols in b and result */
newNumElmts = rows * cols;
if (err = SetCINArraySize((UHandle)resulth,
ParamNumber, newNumElmts))
goto out;
(*resulth)->dimSizes[0] = rows;
(*resulth)->dimSizes[1] = cols;
aElmtp = (*ah)->arg1;
bElmtp = (*bh)->arg1;
resultElmtp = (*resulth)->arg1;
for (i=0; i<rows; i++)
for (j=0; j<cols; j++)
{
*resultElmtp = 0;
for (l=0; l<k; l++)
*resultElmtp += aElmtp[i*k + l] * bElmtp[l*cols + j];
resultElmtp++;
}
out:
return err;
}
Воссозданный в Delphi код получился таким:
Код: Выделить всё
library CIN_Array;
uses
SysUtils,
Windows;
{$R *.res}
type
TCINHeader = Packed Record
Init: Cardinal; //CINInit
Dispose: Cardinal; //CINDispose
Abort: Cardinal; //CINAbort
Run: Cardinal; //CINRun
Load: Cardinal; //CINLoad
Save: Cardinal; //CINSave
Unload: Cardinal; //CINUnload
Properties: Cardinal; //CINProperties
LVSBHead: Cardinal;
Field10: Cardinal;
TypeString: Cardinal;
CINToolsVersion: Cardinal;
gLVExtCodeDispatchTable: Cardinal;
ReloadCounter: Cardinal;
Field15: Cardinal;
CINModuleAddress: Cardinal;
Field17: Cardinal;
LVRTTable: Cardinal;
LVSBHeaderPtr: Cardinal;
Field20: Cardinal;
Field21: Cardinal;
Field22: Cardinal;
Field23: Cardinal;
Field24: Cardinal;
Field25: Cardinal;
Field26: Cardinal;
Field27: Cardinal;
end;
type
TD1 = Packed Record
dimSizes: array[0..1] of integer;
arg1: array[0..0] of double;
end;
type TD1Ptr = ^TD1;
type TD1Hdl = ^TD1Ptr;
type DblArr = array[0..0] of double;
const ParamNumber = 2;
// The return parameter is parameter 2 //
const NumDimensions = 2;
// 2D Array //
var CIN: TCINHeader;
gLVRTModule: cardinal;
DbgPrintf: function(str: pchar): integer; cdecl;
CINSetArraySize: function(DataHandle: pointer; TDPtr: pointer;
ParamNumber: integer;
NewNumberOfElements: integer): integer; cdecl;
GetSetLVInfo: function(Action: integer; Data: integer): integer; cdecl;
DSNewHandle: function(Size: integer): pointer; cdecl;
DSDisposeHandle: function(Handle: pointer): integer; cdecl;
// CIN-specific Functions //
function GetTDPtr: pointer; cdecl;
begin
Result:=Ptr(GetSetLVInfo(3,0));
end;
function SetCINArraySize(DataHandle: pointer; ParamNumber: integer;
NewNumberOfElements: integer): integer; cdecl;
var TD: pointer;
begin
TD := GetTDPtr;
Result := CINSetArraySize(DataHandle,TD,ParamNumber,NewNumberOfElements);
end;
function GetDSStorage: integer; cdecl;
begin
Result:=GetSetLVInfo(0,0);
end;
function SetDSStorage(NewValue: integer): integer; cdecl;
begin
Result:=GetSetLVInfo(1, NewValue);
end;
function GetLVInternals: pointer; cdecl;
begin
Result:=Ptr(GetSetLVInfo(4,0));
end;
// End of CIN-specific Functions //
function CINInit: integer; cdecl;
begin
//if (@DbgPrintf<>nil) then DbgPrintf('CINInit');
Result:=0; //mgnoErr
end;
function CINDispose: integer; cdecl;
begin
//if (@DbgPrintf<>nil) then DbgPrintf('CINDispose');
Result:=0; //mgNoErr
end;
function CINAbort: integer; cdecl;
begin
//if (@DbgPrintf<>nil) then DbgPrintf('CINAbort');
Result:=0; //mgNoErr
end;
function CINRun(ah: TD1Hdl; bh: TD1Hdl; resulth: TD1Hdl; errorp: pointer): integer; cdecl;
var i,j,k,l: integer;
rows,cols: integer;
aElmtp, bElmtp: ^DblArr;
resultElmtp: ^double;
err: integer;
newNumElmts: integer;
Error: ^byte;
label _Out;
begin
//if (@DbgPrintf<>nil) then DbgPrintf('CINRun');
Error:=errorp;
err:=0; //noErr;
k:=ah^.dimSizes[1];
if (k<>bh^.dimSizes[0]) then begin
Error^:=1;
goto _Out;
end;
Error^:=0;
rows:=ah^.dimSizes[0];
// number of rows in a and result //
cols:=bh^.dimSizes[1];
// number of cols in b and result //
newNumElmts := rows * cols;
err := SetCINArraySize(resulth,ParamNumber,newNumElmts);
if (err<>0) then goto _Out;
resulth^.dimSizes[0] := rows;
resulth^.dimSizes[1] := cols;
aElmtp := @ah^.arg1;
bElmtp := @bh^.arg1;
resultElmtp := @resulth^.arg1;
for i:=0 to rows-1 do
for j:=0 to cols-1 do begin
resultElmtp^ := 0;
for l:=0 to k-1 do
resultElmtp^ := resultElmtp^ + aElmtp^[i*k + l] * bElmtp^[l*cols + j];
Inc(resultElmtp);
end;
_Out:
Result:=err;
end;
function CINLoad(Reserved: cardinal): integer; cdecl;
begin
//if (@DbgPrintf<>nil) then DbgPrintf('CINLoad');
Result:=0; //mgNoErr
end;
function CINUnload: integer; cdecl;
begin
//if (@DbgPrintf<>nil) then DbgPrintf('CINUnload');
Result:=0; //mgNoErr
end;
function CINSave(Reserved: cardinal): integer; cdecl;
begin
//if (@DbgPrintf<>nil) then DbgPrintf('CINSave');
Result:=0; //mgNoErr
end;
function CINProperties(Selector: integer; Arg: pointer): integer; cdecl;
//var Data: ^boolean;
begin
//if (@DbgPrintf<>nil) then DbgPrintf('CINProperties');
{
Data := Arg;
case Selector of
0: //kCINIsReentrant
begin
Data^ := True;
Result:=0; //mgNoErr
Exit;
end
else}
Result:=53; //mgNotSupported
//end;
end;
function GetLVSBHeader: Cardinal; cdecl;
begin
Result:=Cardinal(@CIN.LVSBHead);
end;
procedure SetLVRTModule(Module: Cardinal); cdecl;
begin
gLVRTModule:=Module;
//
if (gLVRTModule<>0) then begin
DbgPrintf := GetProcAddress(gLVRTModule, 'DbgPrintf');
//if (@DbgPrintf<>nil) then DbgPrintf('DbgPrintf found.');
CINSetArraySize := GetProcAddress(gLVRTModule, 'CINSetArraySize');
GetSetLVInfo := GetProcAddress(gLVRTModule, 'GetSetLVInfo');
DSNewHandle := GetProcAddress(gLVRTModule, 'DSNewHandle');
DSDisposeHandle := GetProcAddress(gLVRTModule, 'DSDisposeHandle');
end;
end;
exports
GetLVSBHeader name 'GetLVSBHeader',
SetLVRTModule name 'SetLVRTModule';
begin
CIN.Init:=Cardinal(@CINInit);
CIN.Dispose:=Cardinal(@CINDispose);
CIN.Abort:=Cardinal(@CINAbort);
CIN.Run:=Cardinal(@CINRun);
CIN.Load:=Cardinal(@CINLoad);
CIN.Save:=Cardinal(@CINSave);
CIN.Unload:=Cardinal(@CINUnload);
CIN.Properties:=Cardinal(@CINProperties);
CIN.LVSBHead:=0;
CIN.Field10:=0;
CIN.TypeString:=$204E4943; //String "CIN "
CIN.CINToolsVersion:=$00000004; //cintools Version
CIN.gLVExtCodeDispatchTable:=Cardinal(@CIN.Init);
CIN.ReloadCounter:=0;
CIN.Field15:=0;
CIN.CINModuleAddress:=0;
CIN.Field17:=0;
CIN.LVRTTable:=0;
CIN.LVSBHeaderPtr:=0;
CIN.Field20:=0;
CIN.Field21:=0;
CIN.Field22:=0;
CIN.Field23:=0;
CIN.Field24:=0;
CIN.Field25:=0;
CIN.Field26:=0;
CIN.Field27:=0;
end.
Как видим, код во многом схож с кодом на С, чуть иначе ведётся работа с указателями, присутствуют определения типов TD1Ptr, TD1Hdl и прочих, но в целом алгоритм тот же самый.
Преобразуем *.dll в *.lsb и проверяем в
:
- Array_BD.jpg (18.56 КБ) 5885 просмотров
Очевидно, что полученный CIN работает прекрасно и практически ничем не отличается от своего "собрата" на С. Желающие могут сравнить сами CIN на С и CIN на Delphi, исходник, получившийся LSB-файл и сам
лежат в архиве.
Пример второй. CIN, вычисляющий скользящее среднее между текущим числом, поданным на вход, и предыдущим. В этом примере используется CIN Data Space - глобальное пространство CIN'а размером 4 байта, куда записывается указатель на структуру, содержащую общую сумму чисел, поданных на вход CIN'а, и количество поданных чисел. В функции CINInit выполняется создание структуры, первичное обнуление и запись в Data Space. В CINDispose структура удаляется из памяти. В CINRun структура считывается из Data Space, дополняется новым числом, а также вычисляется скользящее среднее. Код на С выглядит так:
Код: Выделить всё
/*
* CIN source file
*/
#include "extcode.h"
typedef struct {
float64 total;
int32 numElements;
} dsGlobalStruct;
CIN MgErr CINInit() {
dsGlobalStruct **dsGlobals;
MgErr err = noErr;
if (!(dsGlobals = (dsGlobalStruct **)
DSNewHandle(sizeof(dsGlobalStruct))))
{
/* if 0, ran out of memory */
err = mFullErr;
goto out;
}
(*dsGlobals)->numElements = 0;
(*dsGlobals)->total = 0;
SetDSStorage((int32) dsGlobals);
out:
return noErr;
}
CIN MgErr CINDispose()
{
dsGlobalStruct **dsGlobals;
dsGlobals=(dsGlobalStruct **) GetDSStorage();
if (dsGlobals)
DSDisposeHandle(dsGlobals);
return noErr;
}
CIN MgErr CINRun(float64 *new_num, float64 *avg)
{
dsGlobalStruct **dsGlobals;
dsGlobals=(dsGlobalStruct **) GetDSStorage();
if (dsGlobals) {
(*dsGlobals)->total += *new_num;
(*dsGlobals)->numElements++;
*avg = (*dsGlobals)->total / (*dsGlobals)->numElements;
}
return noErr;
}
Воссозданный в Delphi код получился таким:
Код: Выделить всё
library CIN_Avg;
uses
SysUtils,
Windows;
{$R *.res}
type
TCINHeader = Packed Record
Init: Cardinal; //CINInit
Dispose: Cardinal; //CINDispose
Abort: Cardinal; //CINAbort
Run: Cardinal; //CINRun
Load: Cardinal; //CINLoad
Save: Cardinal; //CINSave
Unload: Cardinal; //CINUnload
Properties: Cardinal; //CINProperties
LVSBHead: Cardinal;
Field10: Cardinal;
TypeString: Cardinal;
CINToolsVersion: Cardinal;
gLVExtCodeDispatchTable: Cardinal;
ReloadCounter: Cardinal;
Field15: Cardinal;
CINModuleAddress: Cardinal;
Field17: Cardinal;
LVRTTable: Cardinal;
LVSBHeaderPtr: Cardinal;
Field20: Cardinal;
Field21: Cardinal;
Field22: Cardinal;
Field23: Cardinal;
Field24: Cardinal;
Field25: Cardinal;
Field26: Cardinal;
Field27: Cardinal;
end;
type
dsGlobalStruct = Packed Record
total: double;
numElements: integer; //CINDispose
end;
type PdsGlobalStruct = ^dsGlobalStruct;
type HdsGlobalStruct = ^PdsGlobalStruct;
var CIN: TCINHeader;
gLVRTModule: cardinal;
DbgPrintf: function(str: pchar): integer; cdecl;
CINSetArraySize: function(DataHandle: pointer; TDPtr: pointer;
ParamNumber: integer;
NewNumberOfElements: integer): integer; cdecl;
GetSetLVInfo: function(Action: integer; Data: integer): integer; cdecl;
DSNewHandle: function(Size: integer): pointer; cdecl;
DSDisposeHandle: function(Handle: pointer): integer; cdecl;
// CIN-specific Functions //
function GetTDPtr: pointer; cdecl;
begin
Result:=Ptr(GetSetLVInfo(3,0));
end;
function SetCINArraySize(DataHandle: pointer; ParamNumber: integer;
NewNumberOfElements: integer): integer; cdecl;
var TD: pointer;
begin
TD := GetTDPtr;
Result := CINSetArraySize(DataHandle,TD,ParamNumber,NewNumberOfElements);
end;
function GetDSStorage: integer; cdecl;
begin
Result:=GetSetLVInfo(0,0);
end;
function SetDSStorage(NewValue: integer): integer; cdecl;
begin
Result:=GetSetLVInfo(1, NewValue);
end;
function GetLVInternals: pointer; cdecl;
begin
Result:=Ptr(GetSetLVInfo(4,0));
end;
// End of CIN-specific Functions //
function CINInit: integer; cdecl;
var dsGlobals: HdsGlobalStruct;
err: integer;
label _Out;
begin
//if (@DbgPrintf<>nil) then DbgPrintf('CINInit');
err := 0; //noErr
dsGlobals := DSNewHandle(SizeOf(dsGlobalStruct));
if not Assigned(dsGlobals) then begin
// if 0, ran out of memory //
err := 2; //mFullErr
goto _Out;
end;
dsGlobals^.numElements:=0;
dsGlobals^.total:=0;
SetDSStorage(Integer(dsGlobals));
_Out:
Result:=err;
end;
function CINDispose: integer; cdecl;
var dsGlobals: HdsGlobalStruct;
begin
//if (@DbgPrintf<>nil) then DbgPrintf('CINDispose');
dsGlobals := Ptr(GetDSStorage);
if Assigned(dsGlobals) then
DSDisposeHandle(dsGlobals);
Result:=0; //mgNoErr
end;
function CINAbort: integer; cdecl;
begin
//if (@DbgPrintf<>nil) then DbgPrintf('CINAbort');
Result:=0; //mgNoErr
end;
function CINRun(new_num: pointer; avg: pointer): integer; cdecl;
var NewNumber,Average: ^double;
dsGlobals: HdsGlobalStruct;
begin
//if (@DbgPrintf<>nil) then DbgPrintf('CINRun');
NewNumber:=new_num;
Average:=avg;
dsGlobals := Ptr(GetDSStorage);
if Assigned(dsGlobals) then begin
dsGlobals^.total := dsGlobals^.total + NewNumber^;
dsGlobals^.numElements := dsGlobals^.numElements + 1;
Average^ := dsGlobals^.total / dsGlobals^.numElements;
end;
Result:=0; //mgNoErr
end;
function CINLoad(Reserved: cardinal): integer; cdecl;
begin
//if (@DbgPrintf<>nil) then DbgPrintf('CINLoad');
Result:=0; //mgNoErr
end;
function CINUnload: integer; cdecl;
begin
//if (@DbgPrintf<>nil) then DbgPrintf('CINUnload');
Result:=0; //mgNoErr
end;
function CINSave(Reserved: cardinal): integer; cdecl;
begin
//if (@DbgPrintf<>nil) then DbgPrintf('CINSave');
Result:=0; //mgNoErr
end;
function CINProperties(Selector: integer; Arg: pointer): integer; cdecl;
//var Data: ^boolean;
begin
//if (@DbgPrintf<>nil) then DbgPrintf('CINProperties');
{
Data := Arg;
case Selector of
0: //kCINIsReentrant
begin
Data^ := True;
Result:=0; //mgNoErr
Exit;
end
else}
Result:=53; //mgNotSupported
//end;
end;
function GetLVSBHeader: Cardinal; cdecl;
begin
Result:=Cardinal(@CIN.LVSBHead);
end;
procedure SetLVRTModule(Module: Cardinal); cdecl;
begin
gLVRTModule:=Module;
//
if (gLVRTModule<>0) then begin
DbgPrintf := GetProcAddress(gLVRTModule, 'DbgPrintf');
//if (@DbgPrintf<>nil) then DbgPrintf('DbgPrintf found.');
CINSetArraySize := GetProcAddress(gLVRTModule, 'CINSetArraySize');
GetSetLVInfo := GetProcAddress(gLVRTModule, 'GetSetLVInfo');
DSNewHandle := GetProcAddress(gLVRTModule, 'DSNewHandle');
DSDisposeHandle := GetProcAddress(gLVRTModule, 'DSDisposeHandle');
end;
end;
exports
GetLVSBHeader name 'GetLVSBHeader',
SetLVRTModule name 'SetLVRTModule';
begin
CIN.Init:=Cardinal(@CINInit);
CIN.Dispose:=Cardinal(@CINDispose);
CIN.Abort:=Cardinal(@CINAbort);
CIN.Run:=Cardinal(@CINRun);
CIN.Load:=Cardinal(@CINLoad);
CIN.Save:=Cardinal(@CINSave);
CIN.Unload:=Cardinal(@CINUnload);
CIN.Properties:=Cardinal(@CINProperties);
CIN.LVSBHead:=0;
CIN.Field10:=0;
CIN.TypeString:=$204E4943; //String "CIN "
CIN.CINToolsVersion:=$00000004; //cintools Version
CIN.gLVExtCodeDispatchTable:=Cardinal(@CIN.Init);
CIN.ReloadCounter:=0;
CIN.Field15:=0;
CIN.CINModuleAddress:=0;
CIN.Field17:=0;
CIN.LVRTTable:=0;
CIN.LVSBHeaderPtr:=0;
CIN.Field20:=0;
CIN.Field21:=0;
CIN.Field22:=0;
CIN.Field23:=0;
CIN.Field24:=0;
CIN.Field25:=0;
CIN.Field26:=0;
CIN.Field27:=0;
end.
Опять же отличий от кода на С не так много. Испытаем сразу же полученный код в
:
- Average_BD.jpg (13.93 КБ) 5885 просмотров
- Average_FP.jpg (7.72 КБ) 5885 просмотров
Тестовая последовательность была равна 1, 2, 3, 4, 5. (1 + 2 + 3 + 4 + 5)/5 = 15/5 = 3. Всё работает как часы :) Архив с программой также прилагается:
Пример третий (и последний). Для того, чтобы лишний раз не нагружать читателя, возьмём пример из главы 0 "Альтернативный способ запуска CIN". Да, это будет как раз пример с вызовом внешней процедуры: sum.c - внешняя процедура, суммирующая n чисел в массиве типа double, calcmean.c - основной CIN, передающий в sum указатель на массив и размер массива n и получающий сумму элементов этого массива, после чего возвращающий среднее арифметическое всех элементов массива. Код на С выглядит так:
Код sum.c (внешняя процедура):
Код: Выделить всё
/*
* sum.c
*/
#include "extcode.h"
float64 LVSBMain(float64 *x, int32 n);
float64 LVSBMain(float64 *x, int32 n)
{
int32 i;
float64 sum;
sum = 0.0;
for (i=0; i<n; i++)
sum += *x++;
return sum;
}
Код calcmean.c (основной CIN):
Код: Выделить всё
/*
* CIN source file
*/
#include "extcode.h"
/*
* typedefs
*/
typedef struct {
int32 dimSize;
float64 arg1[1];
} TD1;
typedef TD1 **TD1Hdl;
extern float64 sum(float64 *x, int32 n);
CIN MgErr CINRun(TD1Hdl xArray, float64 *mean);
CIN MgErr CINRun(TD1Hdl xArray, float64 *mean)
{
float64 *x, total;
int32 n;
x = (*xArray)–>arg1;
n = (*xArray)–>dimSize;
total = sum(x, n);
*mean = total/(float64)n;
return noErr;
}
Попробуем теперь реализовать эти коды на Delphi.
Код sum (внешняя процедура):
Код: Выделить всё
library sum;
uses
SysUtils,
Windows;
{$R *.res}
type
TCINHeader = Packed Record
Main: Cardinal; //LVSBMain
Field2: Cardinal;
LVSBHead: Cardinal;
Field4: Cardinal;
TypeString: Cardinal;
CINToolsVersion: Cardinal;
gLVExtCodeDispatchTable: Cardinal;
Fied8: Cardinal;
Fied9: Cardinal;
CINModuleAddress: Cardinal;
Field11: Cardinal;
LVRTTable: Cardinal;
LVSBHeaderPtr: Cardinal;
Field14: Cardinal;
Field15: Cardinal;
Field16: Cardinal;
end;
var CIN: TCINHeader;
gLVRTModule: cardinal;
DbgPrintf: function(str: pchar): integer; cdecl;
CINSetArraySize: function(DataHandle: pointer; TDPtr: pointer;
ParamNumber: integer;
NewNumberOfElements: integer): integer; cdecl;
GetSetLVInfo: function(Action: integer; Data: integer): integer; cdecl;
// CIN-specific Functions //
function GetTDPtr: pointer; cdecl;
begin
Result:=Ptr(GetSetLVInfo(3,0));
end;
function SetCINArraySize(DataHandle: pointer; ParamNumber: integer;
NewNumberOfElements: integer): integer; cdecl;
var TD: pointer;
begin
TD := GetTDPtr;
Result := CINSetArraySize(DataHandle,TD,ParamNumber,NewNumberOfElements);
end;
function GetDSStorage: integer; cdecl;
begin
Result:=GetSetLVInfo(0,0);
end;
function SetDSStorage(NewValue: integer): integer; cdecl;
begin
Result:=GetSetLVInfo(1, NewValue);
end;
function GetLVInternals: pointer; cdecl;
begin
Result:=Ptr(GetSetLVInfo(4,0));
end;
// End of CIN-specific Functions //
function LVSBMain(x: pdouble; n: integer): double; cdecl;
var sum: double;
i: integer;
begin
//if (@DbgPrintf<>nil) then DbgPrintf('LVSBMain');
sum:=0;
for i:=0 to n-1 do begin
sum := sum + x^;
Inc(x);
end;
Result:=sum;
end;
function GetLVSBHeader: Cardinal; cdecl;
begin
Result:=Cardinal(@CIN.LVSBHead);
end;
procedure SetLVRTModule(Module: Cardinal); cdecl;
begin
gLVRTModule:=Module;
//
if (gLVRTModule<>0) then begin
DbgPrintf := GetProcAddress(gLVRTModule, 'DbgPrintf');
//if (@DbgPrintf<>nil) then DbgPrintf('DbgPrintf found.');
CINSetArraySize := GetProcAddress(gLVRTModule, 'CINSetArraySize');
GetSetLVInfo := GetProcAddress(gLVRTModule, 'GetSetLVInfo');
end;
end;
exports
GetLVSBHeader name 'GetLVSBHeader',
SetLVRTModule name 'SetLVRTModule';
begin
CIN.Main:=Cardinal(@LVSBMain);; //LVSBMain
CIN.Field2:=0;
CIN.LVSBHead:=0;
CIN.Field4:=0;
CIN.TypeString:=$4253564C; //String "LVSB"
CIN.CINToolsVersion:=$00000004; //cintools Version
CIN.gLVExtCodeDispatchTable:=Cardinal(@CIN.Main);
CIN.Fied8:=0;
CIN.Fied9:=0;
CIN.CINModuleAddress:=0;
CIN.Field11:=0;
CIN.LVRTTable:=0;
CIN.LVSBHeaderPtr:=0;
CIN.Field14:=0;
CIN.Field15:=0;
CIN.Field16:=0;
end.
Код calcmean (основной CIN):
Код: Выделить всё
library calcmean;
uses
SysUtils,
Windows;
{$R *.res}
type
TCINHeader = Packed Record
Init: Cardinal; //CINInit
Dispose: Cardinal; //CINDispose
Abort: Cardinal; //CINAbort
Run: Cardinal; //CINRun
Load: Cardinal; //CINLoad
Save: Cardinal; //CINSave
Unload: Cardinal; //CINUnload
Properties: Cardinal; //CINProperties
LVSBHead: Cardinal;
Field10: Cardinal;
TypeString: Cardinal;
CINToolsVersion: Cardinal;
gLVExtCodeDispatchTable: Cardinal;
ReloadCounter: Cardinal;
Field15: Cardinal;
CINModuleAddress: Cardinal;
Field17: Cardinal;
LVRTTable: Cardinal;
LVSBHeaderPtr: Cardinal;
Field20: Cardinal;
Field21: Cardinal;
Field22: Cardinal;
Field23: Cardinal;
Field24: Cardinal;
Field25: Cardinal;
Field26: Cardinal;
Field27: Cardinal;
end;
type
TD1 = Packed Record
dimSize: integer;
arg1: array[0..0] of double;
end;
type TD1Ptr = ^TD1;
type TD1Hdl = ^TD1Ptr;
var CIN: TCINHeader;
gLVRTModule: cardinal;
DbgPrintf: function(str: pchar): integer; cdecl;
CINSetArraySize: function(DataHandle: pointer; TDPtr: pointer;
ParamNumber: integer;
NewNumberOfElements: integer): integer; cdecl;
GetSetLVInfo: function(Action: integer; Data: integer): integer; cdecl;
function sum(x: pdouble; n: integer): double; cdecl;
begin
Result := 0;
asm
//pop edi
//pop esi
//pop ebx
leave
push CIN.Field23
ret
end;
end;
// CIN-specific Functions //
function GetTDPtr: pointer; cdecl;
begin
Result:=Ptr(GetSetLVInfo(3,0));
end;
function SetCINArraySize(DataHandle: pointer; ParamNumber: integer;
NewNumberOfElements: integer): integer; cdecl;
var TD: pointer;
begin
TD := GetTDPtr;
Result := CINSetArraySize(DataHandle,TD,ParamNumber,NewNumberOfElements);
end;
function GetDSStorage: integer; cdecl;
begin
Result:=GetSetLVInfo(0,0);
end;
function SetDSStorage(NewValue: integer): integer; cdecl;
begin
Result:=GetSetLVInfo(1, NewValue);
end;
function GetLVInternals: pointer; cdecl;
begin
Result:=Ptr(GetSetLVInfo(4,0));
end;
// End of CIN-specific Functions //
function CINInit: integer; cdecl;
begin
//if (@DbgPrintf<>nil) then DbgPrintf('CINInit');
Result:=0; //mgNoErr
end;
function CINDispose: integer; cdecl;
begin
//if (@DbgPrintf<>nil) then DbgPrintf('CINDispose');
Result:=0; //mgNoErr
end;
function CINAbort: integer; cdecl;
begin
//if (@DbgPrintf<>nil) then DbgPrintf('CINAbort');
Result:=0; //mgNoErr
end;
function CINRun(xarrayh: TD1Hdl; meanp: pdouble): integer; cdecl;
var x: pdouble;
total: double;
n: integer;
begin
//if (@DbgPrintf<>nil) then DbgPrintf('CINRun');
x := @xarrayh^.arg1;
n := xarrayh^.dimSize;
total := sum(x,n);
meanp^ := total/n;
Result:=0; //mgNoErr
end;
function CINLoad(Reserved: cardinal): integer; cdecl;
begin
//if (@DbgPrintf<>nil) then DbgPrintf('CINLoad');
Result:=0; //mgNoErr
end;
function CINUnload: integer; cdecl;
begin
//if (@DbgPrintf<>nil) then DbgPrintf('CINUnload');
Result:=0; //mgNoErr
end;
function CINSave(Reserved: cardinal): integer; cdecl;
begin
//if (@DbgPrintf<>nil) then DbgPrintf('CINSave');
Result:=0; //mgNoErr
end;
function CINProperties(Selector: integer; Arg: pointer): integer; cdecl;
var Data: ^boolean;
begin
//if (@DbgPrintf<>nil) then DbgPrintf('CINProperties');
Data := Arg;
case Selector of
0: //kCINIsReentrant
begin
Data^ := True;
Result:=0; //mgNoErr
Exit;
end
else
Result:=53; //mgNotSupported
end;
end;
function GetLVSBHeader: Cardinal; cdecl;
begin
Result:=Cardinal(@CIN.LVSBHead);
end;
procedure SetLVRTModule(Module: Cardinal); cdecl;
begin
gLVRTModule:=Module;
//
if (gLVRTModule<>0) then begin
DbgPrintf := GetProcAddress(gLVRTModule, 'DbgPrintf');
//if (@DbgPrintf<>nil) then DbgPrintf('DbgPrintf found.');
CINSetArraySize := GetProcAddress(gLVRTModule, 'CINSetArraySize');
GetSetLVInfo := GetProcAddress(gLVRTModule, 'GetSetLVInfo');
end;
end;
exports
GetLVSBHeader name 'GetLVSBHeader',
SetLVRTModule name 'SetLVRTModule';
begin
CIN.Init:=Cardinal(@CINInit);
CIN.Dispose:=Cardinal(@CINDispose);
CIN.Abort:=Cardinal(@CINAbort);
CIN.Run:=Cardinal(@CINRun);
CIN.Load:=Cardinal(@CINLoad);
CIN.Save:=Cardinal(@CINSave);
CIN.Unload:=Cardinal(@CINUnload);
CIN.Properties:=Cardinal(@CINProperties);
CIN.LVSBHead:=0;
CIN.Field10:=0;
CIN.TypeString:=$204E4943; //String "CIN "
CIN.CINToolsVersion:=$00000004; //cintools Version
CIN.gLVExtCodeDispatchTable:=Cardinal(@CIN.Init);
CIN.ReloadCounter:=0;
CIN.Field15:=0;
CIN.CINModuleAddress:=0;
CIN.Field17:=0;
CIN.LVRTTable:=0;
CIN.LVSBHeaderPtr:=0;
CIN.Field20:=0;
CIN.Field21:=0;
CIN.Field22:=0;
CIN.Field23:=$42534C56; //String "VLSB" for linking ext. subroutine
CIN.Field24:=0;
CIN.Field25:=0;
CIN.Field26:=0;
CIN.Field27:=0;
end.
Внимательный читатель уже, наверное, обратил внимание на некоторые отличия в коде шаблонов. Для внешней процедуры, во-первых, используется другой заголовок (TCINHeader), в котором присутствует только одна функция LVSBMain. Во-вторых, в заголовке внешней процедуры указан тип "LVSB", а не "CIN ". В-третьих, в заголовке основного CIN'а поле Filed23 не пусто, а содержит метку "VLSB" (см. главу 1 "Создание (компиляция) внешних процедур.", пункт "P.S."), куда
должен прописать адрес внешней процедуры sum при загрузке
. Следующие поля после Field23 могут теоретически содержать ссылки на другие внешние процедуры. Становится понятен смысл смещения 0x38 (56d) - столько нужно отступить от начала заголовка CIN'а (CIN.LVSBHead), чтобы попасть на поле CIN.Field23: 14 полей по 4 байта каждое -> 14 х 4 = 56. И наконец, в-четвёртых, способ вызова внешней процедуры sum из основного CIN'а calcmean. Так как эта внешняя процедура находится в другой библиотеке, то напрямую вызвать её мы не можем. Используем ассемблерную вставку-клей из главы 1 "Создание (компиляция) внешних процедур.", пункт "P.S.":
function sum(x: pdouble; n: integer): double; cdecl;
begin
Result := 0;
asm
//pop edi
//pop esi
//pop ebx
leave
push CIN.Field23
ret
end;
end;
Так как
пропишет в поле Field23 адрес внешней процедуры, то мы, вызывая эту вставку, будем всегда переходить в тело внешней процедуры. Вот так работает эта особая уличная магия!
Не знаю, кто в NI придумал такой способ коммуникации модулей (DLL), но опредлённо он заслужил медаль за это, ибо я ничего подобного раньше никогда не видел.
Компилируем в командной строке оба CIN'а.
Внешняя процедура:
%CINTOOLS_DIR_5%\win32\lvsbutil sum -t LVSB
Основной CIN:
%CINTOOLS_DIR_5%\win32\lvsbutil calcmean -t CIN
Для удобства можно написать батник, чтобы не открывать cmd каждый раз. Надеюсь, про map-файл не забыли перед компиляцией основного CIN'а?
0:0 _LVSBHead 10003020
0:0 _gLVSBsum 10003058
Если забыли, то см. главу 1 "Создание (компиляция) внешних процедур.", пункт "P.S.".
После успешной компиляции обоих CIN'ов проверяем их работу в
. Крайняя версия
, поддерживающего внешние процедуры, - 7.1. Заходя вперёд, скажу, что у меня получилось создать библиотеку, позволяющую запускать CIN'ы с внешними процедурами в
более поздних версий, начиная с LV2010. Но об этом в другой раз.
- mean_BD.jpg (12.03 КБ) 5885 просмотров
- mean_FP.jpg (19.92 КБ) 5885 просмотров
Легко увидеть, что всё работает именно так, как и должно быть: (1 + 2 + 3 + 4)/4 = 10/4 = 2,5. Ну и, по традиции, сами исходники:
