Войти | Регистрация | Забыли пароль?
Сервисы поддержки I-поддержка Форумы Примеры Новости База знаний Видеоролики Документация
Сервисы поддержки / Форумы / RSL / Обсуждение:DLM API для Delphi

Обсуждение:DLM API для Delphi

5 (1)
Открыть все сообщения Скрыть все сообщения
  • Развернуть Обсуждение:DLM API для Delphi ( Обсуждение примера  18.09.2003 15:45 )
    3(2)
    Реализован движок DLMAPI в Delphi.
    На данном этапе это позволяет разработчикам писать DLM модули
    на Delphi, используя огромное кол-во компонент написанных для оной.

    На данном этапе он может только принимать и передавать параметры вызывающей функции.
    Выполнять команды типа print,MsgBox... и несколько других.

    Понимаю что это очень мало но для полного аналога DLMAPI нужны время...
    А время деньги. Мне этого пока достаточно. Для всех желающих (лучше умеющих:)
    прошу присоединится к данному проекту.
    Посмотреть пример
    >> Ответить
    • Развернуть Что-то не очень работает... ( IZVER  18.03.2005 07:42 )
      0(0)
      Скомпилировал в D7 с помощью DCC32
      При выполнении макроса
      import "rsldlm.d32";

println(DemoCPP(3.25,"sen",3));
      Выводит 2 MessageBox-а, потом зависает


      >> Ответить
    • Развернуть Нифига это не реализация... За такую работу со стеком руки отрывать надо... Примерно так делать надо ( JVR  26.04.2005 09:25 )
      0(0)
      library RSLDLM;

      {$A1}
      {$E d32}
      uses
      DLMSys in 'DLMSys.pas',
      Unit1 in 'Unit1.pas';

      exports
      RslSetCallBacks,
      InitExec,
      DoneExec,
      DlmMain,
      AddModuleObjects;

      begin
      end.

      unit DLMSys;

      interface
      uses Windows;

      type
      VALTYPE=(V_UNDEF,V_INTEGER,V_MONEY,V_DOUBLE,V_MONEYL,V_DOUBLEL,V_STRING,
      V_BOOL, V_UNUSED, V_DATE, V_TIME,V_FREF, V_BINST, V_SREF, V_SINST, V_AREF, V_AINST,
      V_TREF, V_TINST, V_GENOBJ,V_PROC,V_UNUSED5,V_UNUSED6,V_DTTM, V_MEMADDR,V_ENDLIST = 100);

      BACKENTRY=packed array of DWORD;


      Type ISYMBOL=packed Record
      name:PChar;
      end;

      Type SYMPROC=packed Record
      dummy:Integer;
      end;

      Type
      TRSLDate=packed record
      Year:WORD; // Year (4-digit)
      Month:BYTE; // Month
      Day:BYTE; // Day of month
      end;

      TRSLTime=packed record
      Hour:Byte;
      Min:Byte;
      Sec:Byte;
      MSec:Byte;
      end;

      TRSLDateTime=packed Record
      RSLdate:TRSLDate;
      RSLtime:TRSLTime;
      end;

      FDecimal_t=packed record
      m_Lo:ULONG;
      m_Hi:ULONG;
      end;


      type
      PAINST=^AINST;
      AINST=packed record
      RSLarray:PVALUE; // Элементы массива
      size:Integer; // Кол-во эл. массива
      end;

      TAREF=packed record
      sym:Pointer;
      inst:^AINST;
      end;

      TPROCREF=packed record
      sym:Pointer; // pointer to SYMPROC
      end;

      type
      VALDATA=packed Record
      intval:Integer; //4
      doubval:double; //8
      RSLstring:PChar;//4
      boolval:Boolean;//1
      doubvalL:Extended; //10
      RSLdate:TRSLDate; //4
      RSLtime:TRSLTime; //4
      obj:Pointer; //4
      aref:TAREF; //8
      proc:TPROCREF; // 4
      addr:Pointer; // V_MEMADDR 4
      dttm:TRSLDateTime; // V_DTTM 8
      monval:double; //8
      monvalL:Extended; //10
      dummy:array [0..10] of char;

      end;

      Type PVALDATA=^VALDATA;

      type
      VALUE=packed Record
      case v_type:VALTYPE of
      V_INTEGER:(intval:Integer); //4
      V_DOUBLE:(doubval:double); //8
      V_STRING:(RSLstring:PChar);//4
      V_BOOL:(boolval:Boolean);//1
      V_DOUBLEL:(doubvalL:Extended); //10
      V_DATE:(RSLdate:TRSLDate); //4
      V_TIME:(RSLtime:TRSLTime); //4
      V_GENOBJ:(obj:Pointer); //4
      V_AREF:(aref:TAREF); //8
      V_PROC:(proc:TPROCREF); // 4
      V_MEMADDR:(addr:Pointer); // V_MEMADDR 4
      V_DTTM:(dttm:TRSLDateTime); // V_DTTM 8
      V_MONEY:(monval:double); //8
      V_MONEYL:(monvalL:Extended); //10
      //value:VALDATA;
      end;

      Type
      PVALUE=^VALUE;
      LPVALUE=^PVALUE;

      var
      ExeExports:BACKENTRY;
      RSLPrint: function(fmt:PChar):Integer; cdecl;
      RSLMessage: function(fmt:PChar):Integer; cdecl;
      RSLMsgBox: function(fmt:PChar):Integer; cdecl;
      RSLGetParm: function(n:Integer;const val:Pointer):Boolean; cdecl;
      RSLPutParm: function(n:Integer;v_type:VALTYPE;ptr:Pointer):Boolean; cdecl;
      RSLGetNumParm: function():Integer; cdecl;
      RSLReturnVal: procedure(v_type:VALTYPE;ptr:Pointer); cdecl;
      RSLAddSymGlobal: function(v_type:VALTYPE ;name:PChar):ISYMBOL; cdecl;
      RSLFindSymbolProc: function(name:PChar;sym:SYMPROC):ISYMBOL; cdecl;
      RSLSymGlobalSet: procedure(sym:ISYMBOL;v_type:VALTYPE;ptr:Pointer); cdecl;
      RSLSymGlobalGet: procedure(sym:ISYMBOL); cdecl;
      RSLAddStdProc: function(v_type:VALTYPE ;name:PChar;proc:Pointer;attr:Integer):SYMPROC; cdecl;
      RSLRslError: procedure(fmt:PChar); cdecl;

      procedure ExportObject(const Name:string;Handle:pointer;RetVal:VALTYPE);

      function RslSetCallBacks(cmd:BACKENTRY):Integer; stdcall;
      procedure InitExec; stdcall;
      procedure DoneExec; stdcall;
      function DlmMain (isLoad:Integer; anyL:Pointer):Integer; stdcall;
      procedure AddModuleObjects; stdcall;

      //DateTime convert routines
      function DateTimeToRSLDate(Date:TDateTime):TRSLDate;
      function RSLDateToDateTime(RSLDate:TRSLDate):TDateTime;
      function DateTimeToRSLtime(Time:TDateTime):TRSLTime;
      function RSLtimeToDateTime(RSLTime:TRSLTime):TDateTime;

      //Std stack routines
      function RSLPrintStd(fmt:PChar;args:array of pointer):Integer;stdcall;
      function RSLMessageStd(fmt:PChar;args:array of pointer):Integer; stdcall;
      function RSLMsgBoxStd(fmt:PChar;args:array of pointer):Integer; stdcall;
      procedure RSLRslErrorStd(fmt:PChar;args:array of pointer);stdcall;


      implementation
      uses SysUtils;

      type
      PExportsObject=^TExportsObject;
      TExportsObject=record
      Next:PExportsObject;
      Name:string;
      Handle:pointer;
      RetVal: VALTYPE;
      end;

      var ExportsObjectList:PExportsObject=nil;

      procedure ExportObject(const Name:string;Handle:pointer;RetVal:VALTYPE);
      var P: PExportsObject;
      begin
      New(P);
      P^.Next:=ExportsObjectList;
      P^.Name:=Name;
      P^.Handle:=Handle;
      P^.RetVal:=RetVal;
      ExportsObjectList:=P;
      end;

      procedure FreeExportsObjectList;
      var P:PExportsObject;
      begin
      while ExportsObjectList<>nil do
      begin
      P:=ExportsObjectList;
      ExportsObjectList:=P^.Next;
      Dispose(P);
      end;
      end;

      function RslSetCallBacks(cmd:BACKENTRY):Integer; stdcall;
      begin
      @RSLprint:=Ptr(cmd[0]);
      @RSLMessage:=Ptr(cmd[1]);
      @RSLMsgBox:=Ptr(cmd[2]);
      @RSLGetParm:=Ptr(cmd[3]);
      @RSLPutParm:=Ptr(cmd[4]);
      @RSLGetNumParm:=Ptr(cmd[5]);
      @RSLReturnVal:=Ptr(cmd[6]);
      @RSLAddSymGlobal:=Ptr(cmd[7]);
      @RSLFindSymbolProc:=Ptr(cmd[8]);
      @RSLSymGlobalSet:=Ptr(cmd[9]);
      @RSLSymGlobalGet:=Ptr(cmd[10]);
      @RSLAddStdProc:=Ptr(cmd[11]);
      @RSLRslError:=Ptr(cmd[12]);
      ExeExports:=cmd;
      result:=304;
      end;

      procedure InitExec; stdcall;
      begin
      end;

      procedure DoneExec; stdcall;
      begin
      end;

      function DlmMain (isLoad:Integer; anyL:Pointer):Integer; stdcall;
      begin
      result:=0;
      end;

      procedure AddModuleObjects; stdcall;
      var P:PExportsObject;
      begin
      P:=ExportsObjectList;
      while P<>nil do
      begin
      RSLAddStdProc(P^.RetVal,PChar(P^.Name),P^.Handle,0);
      P:=P^.Next;
      end;
      end;

      //DateTime convert routines

      function DateTimeToRSLDate(Date:TDateTime):TRSLDate;
      var Year,Month,Day:word;
      begin
      DecodeDate(Date,Year,Month,Day);
      result.Year:=Year;
      result.Month:=Month;
      result.Day:=Day;
      end;

      function RSLDateToDateTime(RSLDate:TRSLDate):TDateTime;
      begin
      result:=EncodeDate(RSLDate.year,RSLDate.Month,RSLDate.Day);
      end;

      function DateTimeToRSLtime(Time:TDateTime):TRSLTime;
      var Hour,Min,Sec,MSec:Word;
      begin
      DecodeTime(Time, Hour, Min, Sec, MSec);
      result.Hour:=Hour;
      result.Min:=Min;
      result.Sec:=Sec;
      result.MSec:=MSec;
      end;

      function RSLtimeToDateTime(RSLTime:TRSLTime):TDateTime;
      begin
      result:=EncodeTime(RSLTime.Hour,RSLTime.Min,RSLTime.Sec,RSLTime.MSec);
      end;

      //Std stack routines

      function RSLPrintStd(fmt:PChar;args:array of pointer):Integer;stdcall;
      begin
      result:=RSLprint(fmt);
      end;

      function RSLMessageStd(fmt:PChar;args:array of pointer):Integer; stdcall;
      begin
      result:=RSLMessage(fmt);
      end;

      function RSLMsgBoxStd(fmt:PChar;args:array of pointer):Integer; stdcall;
      begin
      result:=RSLMsgBox(fmt);
      end;

      procedure RSLRslErrorStd(fmt:PChar;args:array of pointer);stdcall;
      begin
      RSLRslError(fmt);
      end;



      initialization

      finalization
      FreeExportsObjectList;

      end.

      unit Unit1;

      interface

      implementation

      uses DLMSys;

      Procedure DemoCPP; cdecl;
      var
      val:double;
      par:^VALUE;
      begin
      //RSLGetParm(1,@par);

      //Тестируем print
      RSLPrintStd('Hello from Delphi %d',[pointer(par.v_type)]);
      RSLPrintStd('Hello from Delphi %d %d '#13, [pointer(5),pointer(6)]);
      //Тестируем MsgBox
      RSLMsgBoxStd('Hello from Delphi %d ', [pointer(5)]);
      RSLMsgBoxStd(par.RSLstring,[]);

      //Тестируем ReturnVal (возрат параметра)
      val := 3.14;
      RSLReturnVal (V_DOUBLE,@val);
      end;

      initialization
      ExportObject('DemoCPP',@DemoCPP,V_UNDEF);

      end.


      >> Ответить
    • Развернуть runtime error 217 на этапе финализации ( Isay  06.05.2009 13:37 )
      0(0)
      если я правильно понял, dlm на делфи выглядит так:

      в DLL экспортируем две процедуры
      RslSetCallBacks которая "загружает" (точнее узнает и запоминает) адреса функций RSL
      AddModuleObjects которая с помощью загруженной функции AddStdProc выполняет регистрацию процедур и функций

      но почему после отработки макроса, при финализации работы, на сервере (либо в двузвенке) появляется окошко с исключением в рс-банке и следом runtime error 217 длл-ки?????

      где я не прав, как обработать ошибку?

      >> Ответить
    • Развернуть Обсуждение:DLM API для Delphi ( rabbit  21.10.2014 15:49 )
      0(0)
      Не работает функция RSLPutParm.

      В C-шных файлах она объявлена как
      bool DLMAPI PutParm (int n,VALTYPE v_type,void *ptr);

      В предложенных API она объявлена как
      RSLPutParm: function(n: Integer; v_type: RSL_VALTYPE; ptr: Pointer): Boolean; cdecl;

      пример из оф. документации:
      Static void DLMAPIC RetDemo (void)
      {
      long val = 200;
      PutParm ( 0, V_INTEGER, &val );
      }

      на Delphi не работает:
      procedure RetDemo; cdecl;
      var
      val: Longword;
      begin
      val := 200;
      RSLPutParm( 0, v_integer, PLongword(val) );
      end;
      >> Ответить
    • Развернуть Передача массива ( Oleg_S  24.05.2016 11:09 )
      0(0)
      Кто-нибудь занимался этим вопросом. Очень надо!!!
      >> Ответить