⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 ulan.pas

📁 linux下的RS485的驱动 值得一看
💻 PAS
字号:
🔍 
unit ulan;
interface

uses
{$IFDEF FPC}
  LResources,
{$ELSE}
  Windows,
{$ENDIF}
  SysUtils, Classes, ul_drvdef;

{$IFDEF FPC}
{$linklib libulan.dll}
{$PACKRECORDS C}
{$ENDIF}

type

  uloi_coninfo_t = record
    adr : longint;        	{ address of target module  }
    cmd : longint;        	{ service/cmd number for uLOI on target  }
    bcmd : longint;       	{ service/cmd number for returned messages  }
    sn : longint;         	{ sequence counter  }
    bsn : longint;        	{ sequence counter of target module  }
    outflg : longint;     	{ flags used for outgoing messages  }
    ul_fd : ul_fd_t;      	{ handle for ul_drv  }
    ul_fd1 : ul_fd_t;     	{ the auxiliary handle for ULOI direct reply  }
    timeout : longint;    	{ timeout  }
    error : longint;      	{ error condition occurred  }
    state : Longword;      	{ internal state  }
  end;

  pplongint = ^plongint;
  pul_msginfo  = ^ul_msginfo;
  puloi_coninfo_t  = ^uloi_coninfo_t;

{$IFNDEF FPC}
  size_t = longint;
{$ENDIF}
  ssize_t = longint;

  function ul_open(dev_name:pchar; options:Pchar):ul_fd_t;cdecl;external 'libulan.dll';
  function ul_close(ul_fd:ul_fd_t):longint;cdecl;external 'libulan.dll';
  function ul_drv_version(ul_fd:ul_fd_t):longint;cdecl;external 'libulan.dll';
  function ul_read(ul_fd:ul_fd_t; buffer:pointer; size:size_t):ssize_t;cdecl;external 'libulan.dll';
  function ul_write(ul_fd:ul_fd_t; buffer:pointer; size:size_t):ssize_t;cdecl;external'libulan.dll';
  function ul_newmsg(ul_fd:ul_fd_t; msginfo:pul_msginfo):longint;cdecl;external 'libulan.dll';
  function ul_tailmsg(ul_fd:ul_fd_t; msginfo:pul_msginfo):longint;cdecl;external 'libulan.dll';
  function ul_freemsg(ul_fd:ul_fd_t):longint;cdecl;external 'libulan.dll';
  function ul_acceptmsg(ul_fd:ul_fd_t; msginfo:pul_msginfo):longint;cdecl;external 'libulan.dll';
  function ul_actailmsg(ul_fd:ul_fd_t; msginfo:pul_msginfo):longint;cdecl;external 'libulan.dll';
  function ul_addfilt(ul_fd:ul_fd_t; msginfo:pul_msginfo):longint;cdecl;external 'libulan.dll';
  function ul_abortmsg(ul_fd:ul_fd_t):longint;cdecl;external 'libulan.dll';
  function ul_rewmsg(ul_fd:ul_fd_t):longint;cdecl;external 'libulan.dll';
  function ul_inepoll(ul_fd:ul_fd_t):longint;cdecl;external 'libulan.dll';
  function ul_drv_debflg(ul_fd:ul_fd_t; debug_msk:longint):longint;cdecl;external 'libulan.dll';
  function ul_fd_wait(ul_fd:ul_fd_t; wait_sec:longint):longint;cdecl;external 'libulan.dll';

  { simple message operations  }
  function ul_send_command(ul_fd:ul_fd_t; dadr:longint; cmd:longint; flg:longint; buf:pointer;
             len:longint):longint;cdecl;external 'libulan.dll';
  function ul_send_command_wait(ul_fd:ul_fd_t; dadr:longint; cmd:longint; flg:longint; buf:pointer;
             len:longint):longint;cdecl;external 'libulan.dll';
  function ul_send_query(ul_fd:ul_fd_t; dadr:longint; cmd:longint; flg:longint; buf:pointer;
             len:longint):longint;cdecl;external 'libulan.dll';
  function ul_send_query_wait(ul_fd:ul_fd_t; dadr:longint; cmd:longint; flg:longint; bufin:pointer;
             lenin:longint; bufout:Ppointer; lenout:Plongint):longint;cdecl;external 'libulan.dll';

  { basic uLan commands/services  }

  const
     UL_CMD_OISV = $10;     	{ Object Interface Service  }
     UL_CMD_LCDABS = $4f;       { Absorbance data block  }
     UL_CMD_LCDMRK = $4e;       { Mark  }
     UL_CMD_NCS = $7f;          { Network Control Service  }
     UL_CMD_GST = $c1;          { Fast module get status  }

  { definitions of basic uLan OI commands  }

     ULOI_AOID = 10;     	{ name is defined in ASCII for DOIx  }
     ULOI_DOII = 12;     	{ description of input objects  }
     ULOI_DOIO = 14;     	{ description of output objects  }
     ULOI_QOII = 16;     	{ ID numbers of recognized input objects  }
     ULOI_QOIO = 18;     	{ ID numbers of recognized output objects  }
     ULOI_RDRQ = 20;     	{ object values read request  }
     ULOI_STATUS = 30;          { read instrument status  }
     ULOI_ERRCLR = 31;   	{ clear error status  }


  { definitions of basic uLan OI functions  }

  function uloi_open(ul_dev_name:Pchar; adr:longint; cmd:longint; bcmd:longint; timeout:longint):puloi_coninfo_t;cdecl;external 'libulan.dll';
  procedure uloi_close(coninfo:puloi_coninfo_t);cdecl;external 'libulan.dll';
  function uloi_transfer(coninfo:puloi_coninfo_t; bufin:Pchar; lenin:longint; bufout:PPchar; lenout:Plongint):longint;cdecl;external 'libulan.dll';
  function uloi_set_var(coninfo:puloi_coninfo_t; oid:longint; val:pointer; size:longint):longint;cdecl;external 'libulan.dll';
  function uloi_get_var(coninfo:puloi_coninfo_t; oid:longint; val:pointer; size:longint):longint;cdecl;external 'libulan.dll';
  function uloi_set_var_u2(coninfo:puloi_coninfo_t; oid:longint; val:longword):longint;cdecl;external 'libulan.dll';
  function uloi_get_var_u2(coninfo:puloi_coninfo_t; oid:longint; val:Plongword):longint;cdecl;external 'libulan.dll';
  function uloi_send_cmd(coninfo:puloi_coninfo_t; oid:longint):longint;cdecl;external 'libulan.dll';
  function uloi_get_oids(coninfo:puloi_coninfo_t; list:longint; oids_list:pplongint):longint;cdecl;external 'libulan.dll';
  function uloi_get_oiddes(coninfo:puloi_coninfo_t; list:longint; oid:longint):longint;cdecl;external 'libulan.dll';
  function uloi_get_aoiddes(coninfo:puloi_coninfo_t; list:longint; aoid:Pchar):longint;cdecl;external 'libulan.dll';

  { UL_CMD_NCS	Network Control Service  }

const
     ULNCS_ADR_RQ = $C0;     	{ SN0 SN1 SN2 SN3  }
     ULNCS_SET_ADDR = $C1;      { SN0 SN1 SN2 SN3 NEW_ADR  }
     ULNCS_SID_RQ = $C2;        { send serial num and ID string request  }
     ULNCS_SID_RPLY = $C3;      { SN0 SN1 SN2 SN3 ID ...  }
     ULNCS_ADDR_NVSV = $C4;     { SN0 SN1 SN2 SN3 - save addres to EEPROM  }
     ULNCS_BOOT_ACT = $C5;      { SN0 SN1 SN2 SN3  }
     ULNCS_BOOT_ACK = $C6;      { SN0 SN1 SN2 SN3  }

type
  TuMsg = procedure(FRcvMessage:ul_msginfo;BuffRx:pchar) of object;

  TuLan = class;                          //forward declaration

  TComThread = class (TThread)
    FuLan:TuLan;
    FRcvMessage:ul_msginfo;
    Buffer: Pchar;
  private
  protected
    procedure DispatchComMsg;
    procedure Execute;override;
  public
    constructor Create(uLan:TuLan);
  end;

  TuLan = class(TComponent)
  private
    FComThread: TComThread;
    FuMsg: TuMsg;
    FD: ul_fd_t;                         { Handle to uULan device driver. }
    FD1: ul_fd_t;                        { Handle to uULan device driver. }
    FOSDeviceName: string;
    procedure FlushMessages;
    function MessageAvailable: boolean;
    function MessageOpen: integer;
  protected
    { Protected declarations }
  public
    FRcvMessage:ul_msginfo;
    FSndMessage:ul_msginfo;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SetActive(OnOff: boolean);
    function GetActive: boolean;
    function GetDrvVersion: integer;
    function FilterAdd(ASrcAddr: integer; ACommand: integer):integer;
    function MessageCreate(ADestAddr: integer; ACommand: integer; AMessageFlags: integer): integer;
    function MessageTailCreate(ADestAddr: integer; ACommand: integer; AMessageFlags: integer): integer;
    function MessageWriteBuf(const ABuf; ABufSize: integer): integer;
    function MessageClose: integer;
    function MessageAbort: integer;

    function CommandSend(ADestAddr: integer; ACommand: integer;
                 AMessageFlags: integer; OutBuf: pointer; OutBufSize: integer): integer;
    function CommandSendWait(ADestAddr: integer; ACommand: integer;
                 AMessageFlags: integer; OutBuf: pointer; OutBufSize: integer): integer;
    function QuerySend(ADestAddr: integer; ACommand: integer;
                 AMessageFlags: integer; OutBuf: pointer; OutBufSize: integer): integer;
    function QuerySendWait(ADestAddr: integer; ACommand: integer;
                 AMessageFlags: integer; OutBuf: pointer; OutBufSize: integer;
                 var InBuf:pchar; var InBufSize: integer): integer;
  published
    property OnMessage: TuMsg read FuMsg write FuMsg;
    property Active: boolean read GetActive write SetActive default False;
    property OSDeviceName: string read FOSDeviceName write FOSDeviceName;
  end;

procedure Register;

implementation

//Receive messages
constructor TComThread.Create(uLan:TuLan);
begin
  inherited Create(True);
  FuLan:=uLan;
end;

procedure TComThread.Execute;
var bytes_ret:longint;
    stamp:integer;
begin
  while not Terminated do begin
    if (ul_inepoll(FuLan.FD1)<>0) then begin
      ul_acceptmsg(FuLan.FD1,@FRcvMessage);
      stamp:=FRcvMessage.stamp;
      if (FRcvMessage.flg and UL_BFL_TAIL) <> 0 then begin
        ul_actailmsg(FuLan.FD1,@FRcvMessage);
        FRcvMessage.stamp:=stamp;
      end;
      try
        GetMem(Buffer,FRcvMessage.len);
        bytes_ret:=ul_read(FuLan.FD1,Buffer, FRcvMessage.len);
        ul_freemsg(FuLan.FD1);
        if (bytes_ret=FRcvMessage.len) then
{$IFDEF FPC}
          synchronize(@DispatchComMsg);
{$ELSE}
          synchronize(DispatchComMsg);
{$ENDIF}
      finally
        FreeMem(Buffer);
      end;
    end;
//    ul_fd_wait(FuLan.FD1,1);
    sleep(100);
  end;
end;

procedure TComThread.DispatchComMsg;
begin
  if Assigned(FuLan.FuMsg) then
    FuLan.OnMessage(FRcvMessage,Buffer);
end;

constructor TuLan.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FD := UL_FD_INVALID;
  FOSDeviceName := UL_DEV_NAME;
end;

destructor TuLan.Destroy;
begin
  Active := false;
  inherited Destroy;
end;

procedure TuLan.SetActive(OnOff: boolean);
var P : Pchar;
begin
  if OnOff then begin
    if not Active then begin
      p:=StrAlloc (length(FOSDeviceName)+1);
      StrPCopy (P,FOSDeviceName);
      FD := ul_open(p,nil);
      FD1 := ul_open(p,nil);
      StrDispose(P);
      if (FD = UL_FD_INVALID) or (FD1 = UL_FD_INVALID) then begin
        Active:=False;                       //fail
      end else begin
        FComThread := TComThread.Create(Self);
        FComThread.Priority := tpHigher;
        FComThread.Resume;
      end;
    end;
  end else begin
    if Active then begin
      FComThread.Terminate;
      ul_close(FD);
      ul_close(FD1);
      FD:=UL_FD_INVALID;
      FD1:=UL_FD_INVALID;
      Active:=False;
    end;
  end;
end;

function TuLan.GetActive: boolean;
begin
  Result := (FD <> UL_FD_INVALID);
end;

function Tulan.GetDrvVersion: integer;
begin
  Result := 0;
  if not Active then exit;  Result:=ul_drv_version(FD);end;

function Tulan.FilterAdd(ASrcAddr: integer; ACommand: integer):integer;
var FFiltMessage: ul_msginfo;
begin
  Result := -1;
  if not Active then exit;
  FillChar(FFiltMessage, sizeof(FFiltMessage), 0);
  FFiltMessage.sadr := ASrcAddr;
  FFiltMessage.cmd := ACommand;
  if not Active then exit;
  Result:=ul_addfilt(FD1,@FFiltMessage);
end;

procedure TuLan.FlushMessages;
begin
  //free messages from sending
  while MessageAvailable do begin
    MessageOpen;
    MessageClose;
  end;
end;

function TuLan.MessageAvailable: boolean;
var ret:longint;begin  Result := False;  if not Active then exit;  ret:=ul_inepoll(FD);  Result := ret <> 0;end;

function TuLan.MessageOpen: integer;
begin  Result := 0;  if not Active then exit;  Result:=ul_acceptmsg(FD,@FRcvMessage);end;

function TuLan.MessageCreate(ADestAddr: integer; ACommand: integer; AMessageFlags: integer): integer;
begin
  Result := 0;
  FillChar(FSndMessage, sizeof(FSndMessage), 0);
  FSndMessage.dadr := ADestAddr;
  FSndMessage.cmd := ACommand;
  FSndMessage.flg := AMessageFlags or UL_BFL_M2IN;
  if not Active then exit;
  FlushMessages;
  Result:=ul_newmsg(FD,@FSndMessage);
end;

function TuLan.MessageTailCreate(ADestAddr: integer; ACommand: integer; AMessageFlags: integer): integer;
begin
  Result := 0;
  FillChar(FSndMessage, sizeof(FSndMessage), 0);
  FSndMessage.dadr := ADestAddr;
  FSndMessage.cmd := ACommand;
  FSndMessage.flg := AMessageFlags;
  if not Active then exit;
  FlushMessages;
  Result:=ul_tailmsg(FD,@FSndMessage);
end;

function TuLan.MessageWriteBuf(const ABuf; ABufSize: integer): integer;
var b_ret: DWORD;
begin
  Result := 0;
  if ABufSize = 0 then exit;
  if not Active then exit;
  b_ret:=ul_write(FD,@ABuf,ABufSize);
  if integer(b_ret) <> ABufSize then Result := -1
  else Result:=b_ret;
end;

function TuLan.MessageClose: integer;
begin
  Result:=-1;
  if not Active then exit;
  Result:=ul_freemsg(FD);
end;

function TuLan.MessageAbort: integer;
begin
  Result:=-1;
  if not Active then exit;
  Result:=ul_abortmsg(FD);
end;

function TuLan.CommandSend(ADestAddr: integer; ACommand: integer;
  AMessageFlags: integer; OutBuf: pointer; OutBufSize: integer): integer;
begin
  Result:=-1;
  if not Active then exit;
  FlushMessages;
  result:=ul_send_command(FD,ADestAddr,ACommand,AMessageFlags,OutBuf,OutBufSize);
end;

function TuLan.CommandSendWait(ADestAddr: integer; ACommand: integer;
  AMessageFlags: integer; OutBuf: pointer; OutBufSize: integer): integer;
begin
  Result:=-1;
  if not Active then exit;
  FlushMessages;
  result:=ul_send_command_wait(FD,ADestAddr,ACommand,AMessageFlags,OutBuf,OutBufSize);
end;

function TuLan.QuerySend(ADestAddr: integer; ACommand: integer;
  AMessageFlags: integer; OutBuf: pointer; OutBufSize: integer): integer;
begin
  Result:=-1;
  if not Active then exit;
  FlushMessages;
  result:=ul_send_query(FD,ADestAddr,ACommand,AMessageFlags,OutBuf,OutBufSize);
end;

function TuLan.QuerySendWait(ADestAddr: integer; ACommand: integer;
   AMessageFlags: integer; OutBuf: pointer; OutBufSize: integer;
   var InBuf:pchar; var InBufSize: integer): integer;
begin
  Result:=-1;
  if not Active then exit;
  FlushMessages;
  result:=ul_send_query_wait(FD,ADestAddr,ACommand,AMessageFlags,
          OutBuf,OutBufSize,@InBuf,@InBufSize);
end;

procedure Register;
begin
  RegisterComponents('Communication', [TuLan]);
end;

initialization
{$IFDEF FPC}
  {$i uLan.lrs}
{$ELSE}
  {$R uLan.RES}
{$ENDIF}
end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -