ulan/host/ul_drv/lazarus/uLan.pas

   1 unit ulan;\r
   2 interface\r
   3 \r
   4 uses\r
   5 {$IFDEF FPC}\r
   6   LResources,\r
   7 {$ELSE}\r
   8   Windows,\r
   9 {$ENDIF}\r
  10   SysUtils, Classes, ul_drvdef;\r
  11 \r
  12 {$IFDEF FPC}\r
  13 \r
  14 {$IFDEF WINDOWS}\r
  15   {$DEFINE DYNLINK}\r
  16 {$ENDIF}\r
  17 \r
  18 {$IFDEF DYNLINK}\r
  19 const\r
  20 {$IF Defined(WINDOWS)}\r
  21   ulanlib = 'libulan.dll';\r
  22 {$ELSEIF Defined(UNIX)}\r
  23   ulanlib = 'libulan.so';\r
  24 {$ELSE}\r
  25   {$MESSAGE ERROR 'DYNLINK not supported'}\r
  26 {$IFEND}\r
  27 {$ELSE}\r
  28   {$LINKLIB ulan}\r
  29 {$ENDIF}\r
  30 \r
  31 {$PACKRECORDS C}\r
  32 {$ENDIF}\r
  33 \r
  34 type\r
  35 \r
  36 {$IFDEF UNIX}\r
  37   size_t = longint;\r
  38 {$ENDIF}\r
  39 \r
  40   uloi_coninfo_t = record\r
  41     adr : longint;              { address of target module  }\r
  42     cmd : longint;              { service/cmd number for uLOI on target  }\r
  43     bcmd : longint;             { service/cmd number for returned messages  }\r
  44     sn : longint;               { sequence counter  }\r
  45     bsn : longint;              { sequence counter of target module  }\r
  46     outflg : longint;           { flags used for outgoing messages  }\r
  47     ul_fd : ul_fd_t;            { handle for ul_drv  }\r
  48     ul_fd1 : ul_fd_t;           { the auxiliary handle for ULOI direct reply  }\r
  49     timeout : longint;          { timeout  }\r
  50     error : longint;            { error condition occurred  }\r
  51     state : Longword;           { internal state  }\r
  52   end;\r
  53 \r
  54   pplongint = ^plongint;\r
  55   pul_msginfo  = ^ul_msginfo;\r
  56   puloi_coninfo_t  = ^uloi_coninfo_t;\r
  57   ppbyte  = ^pbyte;\r
  58 \r
  59 {$IFNDEF FPC}\r
  60   size_t = longint;\r
  61 {$ENDIF}\r
  62   ssize_t = longint;\r
  63 \r
  64   function ul_open(dev_name:pchar; options:Pchar):ul_fd_t;cdecl;external {$IFDEF DYNLINK}ulanlib{$ENDIF};\r
  65   function ul_close(ul_fd:ul_fd_t):longint;cdecl;external {$IFDEF DYNLINK}ulanlib{$ENDIF};\r
  66   function ul_drv_version(ul_fd:ul_fd_t):longint;cdecl;external {$IFDEF DYNLINK}ulanlib{$ENDIF};\r
  67   function ul_read(ul_fd:ul_fd_t; buffer:pointer; size:size_t):ssize_t;cdecl;external {$IFDEF DYNLINK}ulanlib{$ENDIF};\r
  68   function ul_write(ul_fd:ul_fd_t; buffer:pointer; size:size_t):ssize_t;cdecl;external{$IFDEF DYNLINK}ulanlib{$ENDIF};\r
  69   function ul_newmsg(ul_fd:ul_fd_t; msginfo:pul_msginfo):longint;cdecl;external {$IFDEF DYNLINK}ulanlib{$ENDIF};\r
  70   function ul_tailmsg(ul_fd:ul_fd_t; msginfo:pul_msginfo):longint;cdecl;external {$IFDEF DYNLINK}ulanlib{$ENDIF};\r
  71   function ul_freemsg(ul_fd:ul_fd_t):longint;cdecl;external {$IFDEF DYNLINK}ulanlib{$ENDIF};\r
  72   function ul_acceptmsg(ul_fd:ul_fd_t; msginfo:pul_msginfo):longint;cdecl;external {$IFDEF DYNLINK}ulanlib{$ENDIF};\r
  73   function ul_actailmsg(ul_fd:ul_fd_t; msginfo:pul_msginfo):longint;cdecl;external {$IFDEF DYNLINK}ulanlib{$ENDIF};\r
  74   function ul_addfilt(ul_fd:ul_fd_t; msginfo:pul_msginfo):longint;cdecl;external {$IFDEF DYNLINK}ulanlib{$ENDIF};\r
  75   function ul_abortmsg(ul_fd:ul_fd_t):longint;cdecl;external {$IFDEF DYNLINK}ulanlib{$ENDIF};\r
  76   function ul_rewmsg(ul_fd:ul_fd_t):longint;cdecl;external {$IFDEF DYNLINK}ulanlib{$ENDIF};\r
  77   function ul_inepoll(ul_fd:ul_fd_t):longint;cdecl;external {$IFDEF DYNLINK}ulanlib{$ENDIF};\r
  78   function ul_drv_debflg(ul_fd:ul_fd_t; debug_msk:longint):longint;cdecl;external {$IFDEF DYNLINK}ulanlib{$ENDIF};\r
  79   function ul_fd_wait(ul_fd:ul_fd_t; wait_sec:longint):longint;cdecl;external {$IFDEF DYNLINK}ulanlib{$ENDIF};\r
  80 \r
  81   { simple message operations  }\r
  82   function ul_send_command(ul_fd:ul_fd_t; dadr:longint; cmd:longint; flg:longint; buf:pointer;\r
  83              len:longint):longint;cdecl;external {$IFDEF DYNLINK}ulanlib{$ENDIF};\r
  84   function ul_send_command_wait(ul_fd:ul_fd_t; dadr:longint; cmd:longint; flg:longint; buf:pointer;\r
  85              len:longint):longint;cdecl;external {$IFDEF DYNLINK}ulanlib{$ENDIF};\r
  86   function ul_send_query(ul_fd:ul_fd_t; dadr:longint; cmd:longint; flg:longint; buf:pointer;\r
  87              len:longint):longint;cdecl;external {$IFDEF DYNLINK}ulanlib{$ENDIF};\r
  88   function ul_send_query_wait(ul_fd:ul_fd_t; dadr:longint; cmd:longint; flg:longint; bufin:pointer;\r
  89              lenin:longint; bufout:Ppointer; lenout:Plongint):longint;cdecl;external {$IFDEF DYNLINK}ulanlib{$ENDIF};\r
  90 \r
  91   { basic uLan commands/services  }\r
  92 \r
  93   const\r
  94      UL_CMD_OISV = $10;         { Object Interface Service  }\r
  95      UL_CMD_LCDABS = $4f;       { Absorbance data block  }\r
  96      UL_CMD_LCDMRK = $4e;       { Mark  }\r
  97      UL_CMD_NCS = $7f;          { Network Control Service  }\r
  98      UL_CMD_GST = $c1;          { Fast module get status  }\r
  99 \r
 100   { definitions of basic uLan OI commands  }\r
 101 \r
 102      ULOI_AOID = 10;            { name is defined in ASCII for DOIx  }\r
 103      ULOI_DOII = 12;            { description of input objects  }\r
 104      ULOI_DOIO = 14;            { description of output objects  }\r
 105      ULOI_QOII = 16;            { ID numbers of recognized input objects  }\r
 106      ULOI_QOIO = 18;            { ID numbers of recognized output objects  }\r
 107      ULOI_RDRQ = 20;            { object values read request  }\r
 108      ULOI_STATUS = 30;          { read instrument status  }\r
 109      ULOI_ERRCLR = 31;          { clear error status  }\r
 110 \r
 111 \r
 112   { definitions of basic uLan OI functions  }\r
 113 \r
 114   function uloi_open(ul_dev_name:Pchar; adr:longint; cmd:longint; bcmd:longint; timeout:longint):puloi_coninfo_t;cdecl;external {$IFDEF DYNLINK}ulanlib{$ENDIF};\r
 115   procedure uloi_close(coninfo:puloi_coninfo_t);cdecl;external {$IFDEF DYNLINK}ulanlib{$ENDIF};\r
 116   function uloi_transfer(coninfo:puloi_coninfo_t; bufin:Pchar; lenin:longint; bufout:PPchar; lenout:Plongint):longint;cdecl;external {$IFDEF DYNLINK}ulanlib{$ENDIF};\r
 117   function uloi_set_var(coninfo:puloi_coninfo_t; oid:longint; val:pointer; size:longint):longint;cdecl;external {$IFDEF DYNLINK}ulanlib{$ENDIF};\r
 118   function uloi_get_var(coninfo:puloi_coninfo_t; oid:longint; val:pointer; size:longint):longint;cdecl;external {$IFDEF DYNLINK}ulanlib{$ENDIF};\r
 119   function uloi_set_var_u2(coninfo:puloi_coninfo_t; oid:longint; val:longword):longint;cdecl;external {$IFDEF DYNLINK}ulanlib{$ENDIF};\r
 120   function uloi_get_var_u2(coninfo:puloi_coninfo_t; oid:longint; val:Plongword):longint;cdecl;external {$IFDEF DYNLINK}ulanlib{$ENDIF};\r
 121   function uloi_send_cmd(coninfo:puloi_coninfo_t; oid:longint):longint;cdecl;external {$IFDEF DYNLINK}ulanlib{$ENDIF};\r
 122   function uloi_get_oids(coninfo:puloi_coninfo_t; list:longint; oids_list:pplongint):longint;cdecl;external {$IFDEF DYNLINK}ulanlib{$ENDIF};\r
 123   function uloi_get_oiddes(coninfo:puloi_coninfo_t; list:longint; oid:longint; poiddespack:ppbyte):longint;cdecl;external {$IFDEF DYNLINK}ulanlib{$ENDIF};\r
 124   function uloi_get_aoiddes(coninfo:puloi_coninfo_t; list:longint; aoid:pchar; poiddespack:ppbyte):longint;cdecl;external {$IFDEF DYNLINK}ulanlib{$ENDIF};\r
 125   function uloi_oiddespack_getloc(despack:pbyte;strindex:longint):pbyte;cdecl;external {$IFDEF DYNLINK}ulanlib{$ENDIF};\r
 126   function uloi_oiddespack_strdup(despack:pbyte;strindex:longint):pchar;cdecl;external {$IFDEF DYNLINK}ulanlib{$ENDIF};\r
 127   procedure uloi_cfree(p:pointer);cdecl;external {$IFDEF DYNLINK}ulanlib{$ENDIF};\r
 128 \r
 129   { UL_CMD_NCS  Network Control Service  }\r
 130 \r
 131 const\r
 132      ULNCS_ADR_RQ = $C0;        { SN0 SN1 SN2 SN3  }\r
 133      ULNCS_SET_ADDR = $C1;      { SN0 SN1 SN2 SN3 NEW_ADR  }\r
 134      ULNCS_SID_RQ = $C2;        { send serial num and ID string request  }\r
 135      ULNCS_SID_RPLY = $C3;      { SN0 SN1 SN2 SN3 ID ...  }\r
 136      ULNCS_ADDR_NVSV = $C4;     { SN0 SN1 SN2 SN3 - save addres to EEPROM  }\r
 137      ULNCS_BOOT_ACT = $C5;      { SN0 SN1 SN2 SN3  }\r
 138      ULNCS_BOOT_ACK = $C6;      { SN0 SN1 SN2 SN3  }\r
 139 \r
 140   { UL_CMD_RES  Reinitialize RS485 or connected module }\r
 141 \r
 142      ULRES_LINK = $10;\r
 143      ULRES_BAUD = $12;\r
 144      ULRES_CPU = $21;    { password - default 0x55 0xAA }\r
 145 \r
 146 type\r
 147   TuMsg = procedure(FRcvMessage:ul_msginfo;BuffRx:pchar) of object;\r
 148 \r
 149   TuLan = class;                          //forward declaration\r
 150 \r
 151   TComThread = class (TThread)\r
 152     FuLan:TuLan;\r
 153     FRcvMessage:ul_msginfo;\r
 154     Buffer: Pchar;\r
 155   private\r
 156   protected\r
 157     procedure DispatchComMsg;\r
 158     procedure Execute;override;\r
 159   public\r
 160     constructor Create(uLan:TuLan);\r
 161   end;\r
 162 \r
 163   TuLan = class(TComponent)\r
 164   private\r
 165     FComThread: TComThread;\r
 166     FuMsg: TuMsg;\r
 167     FD: ul_fd_t;                         { Handle to uULan device driver. }\r
 168     FD1: ul_fd_t;                        { Handle to uULan device driver. }\r
 169     FOSDeviceName: string;\r
 170     procedure FlushMessages;\r
 171     function MessageAvailable: boolean;\r
 172     function MessageOpen: integer;\r
 173   protected\r
 174     { Protected declarations }\r
 175   public\r
 176     FRcvMessage:ul_msginfo;\r
 177     FSndMessage:ul_msginfo;\r
 178     constructor Create(AOwner: TComponent); override;\r
 179     destructor Destroy; override;\r
 180     procedure SetActive(OnOff: boolean);\r
 181     function GetActive: boolean;\r
 182     function GetDrvVersion: integer;\r
 183     function FilterAdd(ASrcAddr: integer; ACommand: integer):integer;\r
 184     function MessageCreate(ADestAddr: integer; ACommand: integer; AMessageFlags: integer): integer;\r
 185     function MessageTailCreate(ADestAddr: integer; ACommand: integer; AMessageFlags: integer): integer;\r
 186     function MessageWriteBuf(const ABuf; ABufSize: integer): integer;\r
 187     function MessageClose: integer;\r
 188     function MessageAbort: integer;\r
 189 \r
 190     function CommandSend(ADestAddr: integer; ACommand: integer;\r
 191                  AMessageFlags: integer; OutBuf: pointer; OutBufSize: integer): integer;\r
 192     function CommandSendWait(ADestAddr: integer; ACommand: integer;\r
 193                  AMessageFlags: integer; OutBuf: pointer; OutBufSize: integer): integer;\r
 194     function QuerySend(ADestAddr: integer; ACommand: integer;\r
 195                  AMessageFlags: integer; OutBuf: pointer; OutBufSize: integer): integer;\r
 196     function QuerySendWait(ADestAddr: integer; ACommand: integer;\r
 197                  AMessageFlags: integer; OutBuf: pointer; OutBufSize: integer;\r
 198                  var InBuf:pchar; var InBufSize: integer): integer;\r
 199   published\r
 200     property OnMessage: TuMsg read FuMsg write FuMsg;\r
 201     property Active: boolean read GetActive write SetActive default False;\r
 202     property OSDeviceName: string read FOSDeviceName write FOSDeviceName;\r
 203   end;\r
 204 \r
 205 procedure Register;\r
 206 \r
 207 implementation\r
 208 \r
 209 //Receive messages\r
 210 constructor TComThread.Create(uLan:TuLan);\r
 211 begin\r
 212   inherited Create(True);\r
 213   FuLan:=uLan;\r
 214 end;\r
 215 \r
 216 procedure TComThread.Execute;\r
 217 var bytes_ret:longint;\r
 218     stamp:integer;\r
 219 begin\r
 220   while not Terminated do begin\r
 221     if (ul_fd_wait(FuLan.FD1,1)>0) then begin\r
 222       ul_acceptmsg(FuLan.FD1,@FRcvMessage);\r
 223       stamp:=FRcvMessage.stamp;\r
 224       if (FRcvMessage.flg and UL_BFL_TAIL) <> 0 then begin\r
 225         ul_actailmsg(FuLan.FD1,@FRcvMessage);\r
 226         FRcvMessage.stamp:=stamp;\r
 227       end;\r
 228       try\r
 229         GetMem(Buffer,FRcvMessage.len);\r
 230         bytes_ret:=ul_read(FuLan.FD1,Buffer, FRcvMessage.len);\r
 231         ul_freemsg(FuLan.FD1);\r
 232         if (bytes_ret=FRcvMessage.len) then\r
 233 {$IFDEF FPC}\r
 234           synchronize(@DispatchComMsg);\r
 235 {$ELSE}\r
 236           synchronize(DispatchComMsg);\r
 237 {$ENDIF}\r
 238       finally\r
 239         FreeMem(Buffer);\r
 240       end;\r
 241     end;\r
 242   end;\r
 243 end;\r
 244 \r
 245 procedure TComThread.DispatchComMsg;\r
 246 begin\r
 247   if Assigned(FuLan.FuMsg) then\r
 248     FuLan.OnMessage(FRcvMessage,Buffer);\r
 249 end;\r
 250 \r
 251 constructor TuLan.Create(AOwner: TComponent);\r
 252 begin\r
 253   inherited Create(AOwner);\r
 254   FD := UL_FD_INVALID;\r
 255   FOSDeviceName := UL_DEV_NAME;\r
 256 end;\r
 257 \r
 258 destructor TuLan.Destroy;\r
 259 begin\r
 260   Active := false;\r
 261   inherited Destroy;\r
 262 end;\r
 263 \r
 264 procedure TuLan.SetActive(OnOff: boolean);\r
 265 var P : Pchar;\r
 266 begin\r
 267   if OnOff then begin\r
 268     if not Active then begin\r
 269       p:=StrAlloc (length(FOSDeviceName)+1);\r
 270       StrPCopy (P,FOSDeviceName);\r
 271       FD := ul_open(p,nil);\r
 272       FD1 := ul_open(p,nil);\r
 273       StrDispose(P);\r
 274       if (FD = UL_FD_INVALID) or (FD1 = UL_FD_INVALID) then begin\r
 275         Active:=False;                       //fail\r
 276       end else begin\r
 277         FComThread := TComThread.Create(Self);\r
 278         FComThread.Priority := tpHigher;\r
 279         FComThread.Resume;\r
 280       end;\r
 281     end;\r
 282   end else begin\r
 283     if Active then begin\r
 284       FComThread.Terminate;\r
 285       ul_close(FD);\r
 286       ul_close(FD1);\r
 287       FD:=UL_FD_INVALID;\r
 288       FD1:=UL_FD_INVALID;\r
 289       Active:=False;\r
 290     end;\r
 291   end;\r
 292 end;\r
 293 \r
 294 function TuLan.GetActive: boolean;\r
 295 begin\r
 296   Result := (FD <> UL_FD_INVALID);\r
 297 end;\r
 298 \r
 299 function Tulan.GetDrvVersion: integer;\r
 300 begin\r
 301   Result := 0;\r
 302   if not Active then exit;\r
 303   Result:=ul_drv_version(FD);\r
 304 end;\r
 305 \r
 306 function Tulan.FilterAdd(ASrcAddr: integer; ACommand: integer):integer;\r
 307 var FFiltMessage: ul_msginfo;\r
 308 begin\r
 309   Result := -1;\r
 310   if not Active then exit;\r
 311   FillChar(FFiltMessage, sizeof(FFiltMessage), 0);\r
 312   FFiltMessage.sadr := ASrcAddr;\r
 313   FFiltMessage.cmd := ACommand;\r
 314   if not Active then exit;\r
 315   Result:=ul_addfilt(FD1,@FFiltMessage);\r
 316 end;\r
 317 \r
 318 procedure TuLan.FlushMessages;\r
 319 begin\r
 320   //free messages from sending\r
 321   while MessageAvailable do begin\r
 322     MessageOpen;\r
 323     MessageClose;\r
 324   end;\r
 325 end;\r
 326 \r
 327 function TuLan.MessageAvailable: boolean;\r
 328 var ret:longint;\r
 329 begin\r
 330   Result := False;\r
 331   if not Active then exit;\r
 332   ret:=ul_inepoll(FD);\r
 333   Result := ret <> 0;\r
 334 end;\r
 335 \r
 336 function TuLan.MessageOpen: integer;\r
 337 begin\r
 338   Result := 0;\r
 339   if not Active then exit;\r
 340   Result:=ul_acceptmsg(FD,@FRcvMessage);\r
 341 end;\r
 342 \r
 343 function TuLan.MessageCreate(ADestAddr: integer; ACommand: integer; AMessageFlags: integer): integer;\r
 344 begin\r
 345   Result := 0;\r
 346   FillChar(FSndMessage, sizeof(FSndMessage), 0);\r
 347   FSndMessage.dadr := ADestAddr;\r
 348   FSndMessage.cmd := ACommand;\r
 349   FSndMessage.flg := AMessageFlags or UL_BFL_M2IN;\r
 350   if not Active then exit;\r
 351   FlushMessages;\r
 352   Result:=ul_newmsg(FD,@FSndMessage);\r
 353 end;\r
 354 \r
 355 function TuLan.MessageTailCreate(ADestAddr: integer; ACommand: integer; AMessageFlags: integer): integer;\r
 356 begin\r
 357   Result := 0;\r
 358   FillChar(FSndMessage, sizeof(FSndMessage), 0);\r
 359   FSndMessage.dadr := ADestAddr;\r
 360   FSndMessage.cmd := ACommand;\r
 361   FSndMessage.flg := AMessageFlags;\r
 362   if not Active then exit;\r
 363   FlushMessages;\r
 364   Result:=ul_tailmsg(FD,@FSndMessage);\r
 365 end;\r
 366 \r
 367 function TuLan.MessageWriteBuf(const ABuf; ABufSize: integer): integer;\r
 368 var b_ret: DWORD;\r
 369 begin\r
 370   Result := 0;\r
 371   if ABufSize = 0 then exit;\r
 372   if not Active then exit;\r
 373   b_ret:=ul_write(FD,@ABuf,ABufSize);\r
 374   if integer(b_ret) <> ABufSize then Result := -1\r
 375   else Result:=b_ret;\r
 376 end;\r
 377 \r
 378 function TuLan.MessageClose: integer;\r
 379 begin\r
 380   Result:=-1;\r
 381   if not Active then exit;\r
 382   Result:=ul_freemsg(FD);\r
 383 end;\r
 384 \r
 385 function TuLan.MessageAbort: integer;\r
 386 begin\r
 387   Result:=-1;\r
 388   if not Active then exit;\r
 389   Result:=ul_abortmsg(FD);\r
 390 end;\r
 391 \r
 392 function TuLan.CommandSend(ADestAddr: integer; ACommand: integer;\r
 393   AMessageFlags: integer; OutBuf: pointer; OutBufSize: integer): integer;\r
 394 begin\r
 395   Result:=-1;\r
 396   if not Active then exit;\r
 397   FlushMessages;\r
 398   result:=ul_send_command(FD,ADestAddr,ACommand,AMessageFlags,OutBuf,OutBufSize);\r
 399 end;\r
 400 \r
 401 function TuLan.CommandSendWait(ADestAddr: integer; ACommand: integer;\r
 402   AMessageFlags: integer; OutBuf: pointer; OutBufSize: integer): integer;\r
 403 begin\r
 404   Result:=-1;\r
 405   if not Active then exit;\r
 406   FlushMessages;\r
 407   result:=ul_send_command_wait(FD,ADestAddr,ACommand,AMessageFlags,OutBuf,OutBufSize);\r
 408 end;\r
 409 \r
 410 function TuLan.QuerySend(ADestAddr: integer; ACommand: integer;\r
 411   AMessageFlags: integer; OutBuf: pointer; OutBufSize: integer): integer;\r
 412 begin\r
 413   Result:=-1;\r
 414   if not Active then exit;\r
 415   FlushMessages;\r
 416   result:=ul_send_query(FD,ADestAddr,ACommand,AMessageFlags,OutBuf,OutBufSize);\r
 417 end;\r
 418 \r
 419 function TuLan.QuerySendWait(ADestAddr: integer; ACommand: integer;\r
 420    AMessageFlags: integer; OutBuf: pointer; OutBufSize: integer;\r
 421    var InBuf:pchar; var InBufSize: integer): integer;\r
 422 begin\r
 423   Result:=-1;\r
 424   if not Active then exit;\r
 425   FlushMessages;\r
 426   result:=ul_send_query_wait(FD,ADestAddr,ACommand,AMessageFlags,\r
 427           OutBuf,OutBufSize,@InBuf,@InBufSize);\r
 428 end;\r
 429 \r
 430 procedure Register;\r
 431 begin\r
 432   RegisterComponents('Communication', [TuLan]);\r
 433 end;\r
 434 \r
 435 initialization\r
 436 {$IFDEF FPC}\r
 437   {$i uLan.lrs}\r
 438 {$ELSE}\r
 439   {$R uLan.RES}\r
 440 {$ENDIF}\r
 441 end.\r