ulan.pas

一个linux下rs485驱动程序的源代码

      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;
  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.