Российский производитель и разработчик сертифицированного измерительного оборудования с 1987 года


Форум

Вы не вошли.

 Поиск | Регистрация | Вход 

Страницы 1

#1 Re: Техническая поддержка » Пример на Delphi "l7xx.dpr" » 04.06.2021 16:49:12

Виталий_П

Алекс перестаньте! Ну, кто Вам будет это делать? Сказано же было lusbapi занимается Сергей, а LComp Павел. Но Павла уволили, он теперь только по тикетам техподдержки работает, так что пишите запрос, чтобы ему дали этот тикет и тогда он может быть поменяет в учебной программе l7xx.dpr номер слота по умолчанию и будет Вам счастье.
Но на самом деле это и не нужно, потому что учебная программа l7xx.dpr просто показывает Вам, как надо обращаться к процедурам модуля, вне программной среды она совершенно бесполезна, а с компилятором Вы можете пройти какие то части этой программы по шагам и посмотреть, как работают процедуры взаимодействия с Вашим модулем E14-440, как самостоятельную программу Вы вряд ли будете её использовать, в их библиотеке имеются куда более продвинутые бесплатные программы, единственное преимущество этой программы то, что она с исходниками и Вы можете посмотреть, как она работает и использовать это в своей программе.

#2 Re: Техническая поддержка » Модуль E14-140-M, Не могу открыть устройство » 03.06.2021 11:48:30

Виталий_П

РЕШЕНО!!!
Наверное стоит выложить здесь полностью модифицированный unit ifc_ldev,  с которым программа заработала с Lazarus'ом:

unit ifc_ldev;

{$IFDEF FPC}
  {$MODE Delphi}
{$ENDIF}

interface
   uses ioctl;

   {$INTERFACES CORBA}

const
   IID_ILDEV:TGUID  = '{32bb8320-b41b-11cf-a6bb-0080c7b2d682}';
   IID_ILDEV2:TGUID = '{c737c7ef-ecc2-49f2-ba4e-94c889f07399}';

type
LUnknown = interface //class
   function QueryInterface(const iid:TGUID; out ppv):HRESULT; virtual; stdcall; abstract;
   function AddRef:ULONG; virtual; stdcall; abstract;
   function Release:ULONG; virtual; stdcall; abstract;
end;

type
IDaqLDevice = interface(LUnknown) //class(LUnknown)

   function inbyte (offset:ULONG; var data:UCHAR; len:ULONG; key:ULONG ):ULONG; virtual; stdcall; abstract;
   function inword (offset:ULONG; var data:USHORT; len:ULONG; key:ULONG):ULONG; virtual; stdcall; abstract;
   function indword(offset:ULONG; var data:ULONG; len:ULONG; key:ULONG ):ULONG; virtual; stdcall; abstract;

   function outbyte (offset:ULONG; var data:UCHAR; len:ULONG; key:ULONG ):ULONG; virtual; stdcall; abstract;
   function outword (offset:ULONG; var data:USHORT; len:ULONG; key:ULONG):ULONG; virtual; stdcall; abstract;
   function outdword(offset:ULONG; var data:ULONG; len:ULONG; key:ULONG ):ULONG; virtual; stdcall; abstract;

   // Working with MEM ports
   function inmbyte (offset:ULONG; var data:UCHAR; len:ULONG; key:ULONG ):ULONG; virtual; stdcall; abstract;
   function inmword (offset:ULONG; var data:USHORT; len:ULONG; key:ULONG):ULONG; virtual; stdcall; abstract;
   function inmdword(offset:ULONG; var data:ULONG; len:ULONG; key:ULONG ):ULONG; virtual; stdcall; abstract;

   function outmbyte (offset:ULONG; var data:UCHAR; len:ULONG; key:ULONG ):ULONG; virtual; stdcall; abstract;
   function outmword (offset:ULONG; var data:USHORT; len:ULONG; key:ULONG):ULONG; virtual; stdcall; abstract;
   function outmdword(offset:ULONG; var data:ULONG; len:ULONG; key:ULONG ):ULONG; virtual; stdcall; abstract;

   function GetWord_DM(Addr:USHORT; var Data:USHORT):ULONG; virtual; stdcall; abstract;
   function PutWord_DM(Addr:USHORT; Data:USHORT):ULONG; virtual; stdcall; abstract;
   function PutWord_PM(Addr:USHORT; Data:ULONG):ULONG; virtual; stdcall; abstract;
   function GetWord_PM(Addr:USHORT; var Data:ULONG):ULONG; virtual; stdcall; abstract;

   function GetArray_DM(Addr:USHORT; Count:ULONG; var Data:USHORT):ULONG; virtual; stdcall; abstract;
   function PutArray_DM(Addr:USHORT; Count:ULONG; var Data:USHORT):ULONG; virtual; stdcall; abstract;
   function PutArray_PM(Addr:USHORT; Count:ULONG; var Data:ULONG):ULONG; virtual; stdcall; abstract;
   function GetArray_PM(Addr:USHORT; Count:ULONG; var Data:ULONG):ULONG; virtual; stdcall; abstract;

   function SendCommand(Cmd:USHORT):ULONG; virtual; stdcall; abstract;

   function PlataTest:ULONG; virtual; stdcall; abstract;

   function GetSlotParam(var slPar:SLOT_PAR):ULONG; virtual; stdcall; abstract;

   function OpenLDevice:THandle; virtual; stdcall; abstract;
   function CloseLDevice:ULONG; virtual; stdcall; abstract;

///
   function SetParametersStream(var ap:DAQ_PAR; var UsedSize:ULONG; out Data; out Sync; StreamId:ULONG):ULONG; virtual; stdcall; abstract;
   function RequestBufferStream(var Size:ULONG; StreamId:ULONG):ULONG; virtual; stdcall; abstract; //in words
   function FillDAQparameters(var ap:DAQ_PAR):ULONG; virtual; stdcall; abstract;
///

   function InitStartLDevice:ULONG; virtual; stdcall; abstract;
   function StartLDevice:ULONG; virtual; stdcall; abstract;
   function StopLDevice:ULONG; virtual; stdcall; abstract;

   function LoadBios(FileName:PAnsiChar):ULONG; virtual; stdcall; abstract;

{
   function InputADC(Chan:USHORT; var Data:USHORT):ULONG; virtual; stdcall; abstract;

   function InputTTL(var Data:ULONG; Mode:ULONG):ULONG; virtual; stdcall; abstract;
   function OutputTTL(Data:ULONG; Mode:ULONG):ULONG; virtual; stdcall; abstract;
   function ConfigTTL(Data:ULONG):ULONG; virtual; stdcall; abstract;

   function OutputDAC(Data:ShortInt; Mode:ULONG):ULONG; virtual; stdcall; abstract;
   function ConfigDAC(Mode:ULONG; Number:ULONG):ULONG; virtual; stdcall; abstract;
}

   function IoAsync(var sp:DAQ_PAR):ULONG; virtual; stdcall; abstract;

   function ReadPlataDescr(var pd):ULONG; virtual; stdcall; abstract;
   function WritePlataDescr(var pd; Ena:USHORT):ULONG; virtual; stdcall; abstract;
   function ReadFlashWord(FlashAddress:USHORT; var Data:USHORT):ULONG; virtual; stdcall; abstract;
   function WriteFlashWord(FlashAddress:USHORT; Data:USHORT):ULONG; virtual; stdcall; abstract;
   function EnableFlashWrite(Flag:USHORT):ULONG; virtual; stdcall; abstract;

   function EnableCorrection(Ena:USHORT):ULONG; virtual; stdcall; abstract;

   function GetParameter(name:ULONG; var param:ULONG):ULONG; virtual; stdcall; abstract;
   function SetParameter(name:ULONG; var param:ULONG):ULONG; virtual; stdcall; abstract;

   function SetLDeviceEvent(hEvent:THandle; EventId:ULONG):ULONG; virtual; stdcall; abstract;

end;

type
IDaqLDevice2 = interface(LUnknown)

   function InitStartLDeviceEx(StreamId:ULONG):ULONG; virtual; stdcall; abstract;
   function StartLDeviceEx(StreamId:ULONG):ULONG; virtual; stdcall; abstract;
   function StopLDeviceEx(StreamId:ULONG):ULONG; virtual; stdcall; abstract;

end;

implementation

end.

Я во все unit'ы добавил совместимость с Delphi:

{$IFDEF FPC}
  {$MODE Delphi}
{$ENDIF}

Может быть в каких то случаях это излишне, экспериментируйте.
Еще была рекомендация в unit'е ioctl заменить objects на packed records. Там не всё так просто, некоторые объекты с наследованием,
поэтому надо разбираться, но вроде и так всё заработало и без этого!

Одно замечание:
Так легко удалось заменить классы на интерфейсы из-за того, что  lcomp был сконструирован именно, как интерфейс.
В LUnknown определены GUID, функции QueryInterface, AddRef и Release и осталось только заменить class на interface.
С lusbapi так просто, скорее всего не получится.

Всем принявшим участие в обсуждении большое спасибо, если нужны дополнительные материалы, пишите на почту
vitaliper54@gmail.com.

#3 Re: Техническая поддержка » Модуль E14-140-M, Не могу открыть устройство » 02.06.2021 22:25:30

Виталий_П

Похоже проблема решена! Большое спасибо пользователю скалогрыз с форума freepascal

http://www.freepascal.ru/forum/viewtopi … 5&start=30

Вот, что было предложено:

Вот, что ты можешь попробовать сделать.
1) не используй Class, вместо него используй Interface.
2) объяви интерфейсы в своём модуле как CORBA. {$INTERFACES CORBA}
3) не используй object (как например в PLATA_DESCR_E140), только record-ы

Насчет object не подтвердилось, похоже их можно оставить, а вот с интерфейсами всё заработало:

af238377f44c4624d33483fa856f3a18-full.jpg

Конечно буду еще проверять и, если что то обнаружу, сообщу.
vitaliper54
новенький

Сообщения: 11
Зарегистрирован: 03.05.2021 21:19:56

#4 Re: Техническая поддержка » Актуальная Lusbapi » 02.06.2021 17:37:52

Виталий_П

С lusbapi и Lazarus'ом та же история, в Delphi это работает, с fpc нет, я сознательно использовал в качестве примера LComp, поскольку там классы инициализируются сразу один раз, в lusbapi это происходит в ходе поиска слота в цикле и ловить ошибки сложно.
Относительно Delphi чтобы это заработало в Delphi необходимо, чтобы версия lusbapi была не ниже 3.3, сейчас на сайте выложена версия 3.4. Кроме того, если Вы работаете на 64 битной ОС, то следует установить 64-х битный драйвер, он устанавливается программой LComp. Сама библиотека lusbapi 32-х битная, поэтому скомпилируйте свою программу, как 32-х битное приложение, если, конечно, Вам не пришлют 64-х битную версию lusbapi!
Ну, насчет Lazarus'а? Я вчера отправил запрос в техподдержку насчет pascal-интерфейса над wlcomp, пока молчат. Можно, конечно попытаться этот интерфейс сделать самим, но лучше, если это будет делать человек более опытный, я хочу просто получить хоть какой то ответ на мой запрос (подтверждение или отказ) и, исходя из этого ответа я решу, что делать дальше. Вы бы тоже отправили соответствующий запрос в техподдержку на ту же тему, это было бы полезно

#5 Re: Техническая поддержка » Модуль E14-140-M, Не могу открыть устройство » 01.06.2021 17:56:16

Виталий_П

Спасибо, написал в техподдержку

#6 Re: Техническая поддержка » Модуль E14-140-M, Не могу открыть устройство » 31.05.2021 19:31:32

Виталий_П

Хочу здесь также разместить, с небольшими сокращениями свой пост на форум freepascal.ru http://www.freepascal.ru/forum/viewtopi … 06#p162406

В комплект программного обеспечения для Delphi от L-Card входит учебная программа 17xxdpr, которая прекрасно компилируется и RAD Studio и правильно работает. Я попытался переписать эту программу под Lazarus, однако тут возникают проблемы, связанные с тем, что интерфейсная dll пытается передавать в программу на Lazarus классы и вот, что происходит:

процедуре FormCreate программы 17xxdpr:

procedure TForm1.FormCreate(Sender: TObject);
begin

  skip:=1;
   Timer1.Enabled:=False;
   Timer2.Enabled:=False;

   LockXY:= TCriticalSection.Create;

   Memo1.Lines.Clear;
   Memo1.Lines.Add('Testing library');
   if(CallCreateInstance('lcomp64.dll')=1) then
   begin
      Memo1.Lines.Add('Loading library - success.');
      Memo1.Lines.Add('');
   end;
{Укажите здесь виртуальный слот той платы с которой хотите работать}
   pIUnknown:=CreateInstance(slot);
   dec(PInteger(pIUnknown)^, sizeof(TVmt));
   // Уменьшаем указатель на размер VMT
   hr := pIUnknown.QueryInterface(IID_ILDEV,pLDev);
   if(not Succeeded(hr)) then MessageBox(0,'Get interface failed','Error',MB_OK);
   inc(PInteger(pIUnknown)^, sizeof(TVmt)); //Перед освобождением памяти
   // возвращаем значение указателя
   pIUnknown.Release;
   dec(PInteger(pLDev)^, sizeof(TVmt)); // то же проделываем с указателем pLDev
   dev:=pLDev.OpenLDevice;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
   data:=NIL;
   sync:=NIL;
   Timer1.Enabled:=False;
   Timer2.Enabled:=False;
   pLDev.StopLDevice;
   pLDev.CloseLDevice;
   inc(PInteger(pLDev)^, sizeof(TVmt)); // возвращаем значение указателя pLDev
   pLDev.Release;
   LockXY.Free;
end;

Для pIUnknown и pLDev мне пришлось сместить точку входа на размер VMT, соответственно перед освобождением памяти
возвращаю указатели в прежнее значение. Если этого не сделать, то получаем ошибку sigsegv и на этом всё заканчивается,
а здесь мне удалось хотя бы открыть устройство (pLDev.OpenLDevice), но далее, при попытке прочитать параметры устройства,
возникает ошибка:

pLDev.GetSlotParam(sl); // здесь читает правильно

   Memo1.Lines.Add('');
   Memo1.Lines.Add('Slot parameters');
   Memo1.Lines.Add('Base - '+IntToHex(sl.Base,4));
   Memo1.Lines.Add('BaseL - '+IntToHex(sl.BaseL,4));
   Memo1.Lines.Add('Mem - '+IntToHex(sl.Mem,8));
   Memo1.Lines.Add('MemL - '+IntToHex(sl.MemL,8));
   Memo1.Lines.Add('Type - '+IntToStr(sl.BoardType));
   Memo1.Lines.Add('DSPType - '+IntToStr(sl.DSPType));
   Memo1.Lines.Add('Irq - '+IntToStr(sl.Irq));
   Memo1.Lines.Add('');

pLDev.GetSlotParam(sl) отработал правильно, но уже в следующем блоке

s:=IntToStr(pLDev.LoadBios('e440'));          {no bios needed}
           Memo1.Lines.Add('LoadBios status '+s);
           s:=IntToStr(pLDev.ReadPlataDescr(pd)); // Ошибка !!!
           Memo1.Lines.Add('ReadPlataDescr status '+s);

           Memo1.Lines.Add('');
           Memo1.Lines.Add('Serial Num. '+pd.t5.SerNum);
           Memo1.Lines.Add('Board Name '+pd.t5.BrdName);
           Memo1.Lines.Add('Revision '+pd.t5.Rev);
           Memo1.Lines.Add('DSP Type '+pd.t5.DspType);
           Memo1.Lines.Add('Quartz '+IntToStr(pd.t5.Quartz));

при попытке выполнить pLDev.ReadPlataDescr(pd) ошибка

Вот результат работы программы на Lazarus

77d7ce897aed7778c182d1e205969639-full.jpg

А вот тот же результат в Delphi (Rad Studio 10.4)

6fd2a0590692e9f302a33291103a0e15-full.jpg

Когда я размещал тут свой начальный пост, то рассчитывал, что кто-нибудь из разработчиков откликнется, но вот прошло 2 месяца,
пошли отклики, но никого из разработчиков? Правда откликнулся один из бывших разработчиков, и на том спасибо. Ну, я то что
есть отклики, доказывает, что это не только моя проблема. Я уже было начал писать на Delphi, но обидно,
во-первых Delphi дорогущая (самая дешевая версия стоит 140 тысяч, а цена блока 27 тысяч, почувствуйте разницу), кроме того современная версия
Lazarus'а объективно лучше (по крайней мере то, что сделано под Windows), но из-за отсутствия интерфейса я не могу ее использовать.

PoulCh предлагает использовать в качестве враппера библиотеку wlcomp? Может быть это и идея, но к этой dll нужен паскалевский интерфейс?
Может мне кто-нибудь поможет, уверяю, спасибо Вам скажу не только я, но многие здесь.

#7 Re: Техническая поддержка » Модуль E14-140-M, Не могу открыть устройство » 31.05.2021 18:37:17

Виталий_П
PoulCh пишет:

Я как автор этой библиотеки (LComp) попробовал из этого треда методы - ничего не получилось в лоб. Если мне тикет заведут, то могу враппер wlcomp попробовать адаптировать к fpc (но правда не очень быстро. я не особо мастерски работаю с паскалем - давно это было).
    ex-сотрудник Poul.

Спасибо, хоть за какой то ответ, где то на этом форуме читал, что wlcomp написан на чистом Си (не C++), возможно с ним будет полегче, но нужны интерфейсные модули на паскале (может быть и дельфийские подойдут).

#8 Re: Техническая поддержка » Модуль E14-140-M, Не могу открыть устройство » 30.05.2021 22:49:55

Виталий_П
PoulCh пишет:

ничего не получится. Если только работать через C-враппер wlcomp. как-почему тут обсуждается http://www.freepascal.ru/forum/viewtopic.php?f=5&t=5811

Я эту публикацию сразу заметил, но она не окончена, а других таких публикаций нет,
потому, создал публикацию и там по этой теме, может кто-нибудь ответит, всё-таки мне кое что в этих программах удалось оживить

http://freepascal.ru/forum/viewtopic.ph … =43255&e=0

А вообще, я уже было плюнул и начал работать в Delphi, но всё равно обидно, ведь Lazarus (по крайней мере последние версии) объективно
лучше.

#9 Re: Техническая поддержка » Модуль E14-140-M, Не могу открыть устройство » 30.05.2021 22:43:25

Виталий_П
Алекс Прокофьев пишет:

Виталий, здравствуйте.

Вы всё ещё ждёте ответа? Я вот тоже...

У меня предложение - давайте ждать вместе! В хорошей компании веселее даже ожидание big_smile

Написал в форум freepascal

http://freepascal.ru/forum/viewtopic.ph … =43255&e=0

Завтра может быть и сюда добавлю

#10 Re: Техническая поддержка » Модуль E14-140-M, Не могу открыть устройство » 30.05.2021 22:41:37

Виталий_П

Написал в форум freepascal.ru

http://freepascal.ru/forum/viewtopic.ph … =43255&e=0

#11 Техническая поддержка » Модуль E14-140-M, Не могу открыть устройство » 19.03.2021 21:04:34

Виталий_П
Ответов: 16

Я пытаюсь создать программу для работы с модулем E14-140-M для 64-х битной Windows 10 в программной среде Lazarus 2.0.12
Пробная программа, с которой возникли трудности, практически переписана из мануала к LCARD SDK (программа LCOMP) и использует модули
uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, Buttons, StdCtrls,
  E140Cmd, ifc_ldev, ioctl, Create, Windows;   

Модули E140Cmd, ifc_ldev, ioctl, Create взяты из директории LCard\Library\Delphi и туда добавлены директивы Lazarus совместимости с Delphi,
вместо библиотеки lcomp.dll загружается библиотека lcomp64.dll, поскольку lcomp.dll в 64-битной ОС отсутствует.
dll загружается успешно, проходит CreateInstance и даже QueryInterface, но при попытке открыть девайс (OpenLDevice)
возникает ошибка сегментации SIGSEGV! Как можно это исправить?



procedure TForm1.Button1Click(Sender: TObject);
var
  pLDev: IDaqLDevice;
  pIUnknown:LUnknown;
  hr:Integer;
  dev: THandle;
begin
   if(CallCreateInstance('lcomp64.dll')=1) then
           ShowMessage('The dll library lcomp64.dll loaded')
           else ShowMessage('Operation failed');
   pIUnknown:=CreateInstance(0);
   hr := pIUnknown.QueryInterface(IID_ILDEV,pLDev);
   if(not Succeeded(hr)) then ShowMessage('Get interface failed') else
     ShowMessage('Get interface loaded');
   pIUnknown.Release;
   try
   dev := pLDev.OpenLDevice; // Здесь возникает ошибка сегментации SIGSEGV
   ShowMessage('The device open');
   except
     ShowMessage('Cant open device');
     exit;
   end;
   pLDev.CloseLDevice;
   pLDev.Release;

end;

Страницы 1