ucomm.pas

这是一个用D6实现的对LineGuard进行通信的简单例程,通过该程序

unit UComm;

interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls,
  Dialogs, SerialNG, StdCtrls, ComCtrls;

  function OrganizeMsg(Msg : array of byte; var sendlength : integer): pchar;
  function DeOrganizeMsg(Msg : pchar;var outByte: array of byte):boolean;
  function IEEEFLOATTOSINGLE(byte1,byte2,byte3,byte4: BYTE) : single;
  procedure SINGLETOFOURBYTE(val : single; var byte1,byte2,byte3,byte4: BYTE);
  function IEEEFLOATTODATETIMESTRING(byte1,byte2,byte3,byte4,byte5,byte6,byte7,byte8: BYTE):string;

var
  _TOCHAR : array [0..15] of char;

implementation

function OrganizeMsg(Msg : array of byte; var sendlength : integer): pchar;
(*根据消息组织传输的消息串*)
var
  LRC : Byte;
  tmp : Byte;
  I   : Integer;
  Resultstr : String;
begin
  Resultstr := ':';
  LRC := 0;
  for I:=Low(Msg) to High(Msg) do
  begin
    tmp := Msg[I];
    Resultstr := Resultstr + _TOCHAR[(tmp and $F0) shr 4];
    Resultstr := Resultstr + _TOCHAR[tmp and $0F];
    LRC := LRC + tmp;
  end;
  LRC := (not LRC) + 1;
  Resultstr := Resultstr + _TOCHAR[(LRC and $F0) shr 4];
  Resultstr := Resultstr + _TOCHAR[LRC and $0F];
  Resultstr := Resultstr + Chr(13) + Chr(10);
  Result := AllocMem(length(ResultStr)+1);
  StrPCopy(Result,Resultstr);
  sendlength := Length(Result);
end;

function DeOrganizeMsg(Msg : pchar; var outByte: array of byte):Boolean;
(*根据接收的消息串反解成字节流存入outByte中,去掉开始符':'和结束符'CR''LF',并且要核对验证码,若出错则返回false*)
var
  I,J  : integer;
  LRC  : Byte;
  tmpH : Byte;
  tmpL : Byte;
  inLen : integer;
begin
  Result := False;
  (*参数检查*)
  inLen := Length(Msg);
  if inLen<11 then Exit;
  if Msg[0]<>':' then Exit;
  if (Msg[inLen-2] <> Chr(13)) or (Msg[inLen-1] <> Chr(10)) then Exit;
  if Msg[3]='8' then Exit;


  J:=0;
  LRC:=0;
  I := 1;
  while I < inLen -2 do
  begin
    //取出两字符组成一个字节
    tmpH := Ord(Msg[I]);
    if tmpH >= Ord('A') then
       tmpH := tmpH-Ord('A') + 10
    else
       tmpH := tmpH-Ord('0');

    INC(I);
    if (I = inLen - 2) then Exit;
    tmpL := Ord(Msg[I]);
    if tmpL >= Ord('A') then
      tmpL := tmpL-Ord('A') + 10
    else
      tmpL := tmpL-Ord('0');

    INC(I);
    tmpL := tmpH shl 4 + tmpL;
    //给结果赋值
    outByte[J] := tmpL;
    INC(J);
    //计算验证码
    if J <= High(outByte) then LRC := LRC + tmpL;
  end;
  LRC := (not LRC) + 1;
  if LRC <> outByte[High(outByte)] then Exit;
  Result := True;
end;

function IEEEFLOATTOSINGLE(byte1,byte2,byte3,byte4: BYTE) : single;
{*本过程将一个四字节的IEEE浮点数转为single数据,传入数据时高字节在前*}
var
  tempp : ^byte;
begin
  Result := 0.0;
  tempp := @Result;
  tempp^ := byte4;
  INC(tempp);
  tempp^ := byte3;
  INC(tempp);
  tempp^ := byte2;
  INC(tempp);
  tempp^ := byte1;
  exit;
end;

procedure SINGLETOFOURBYTE(val : single; var byte1,byte2,byte3,byte4: BYTE);
{*本过程将一个四字节的IEEE浮点数(single型)转为拆分为四个字节数据,高字节在前*}
var
  tempp : ^byte;
begin
  tempp := @val;
  byte4 := tempp^;
  INC(tempp);
  byte3 := tempp^;
  INC(tempp);
  byte2 := tempp^;
  INC(tempp);
  byte1 := tempp^;
end;

function IEEEFLOATTODATETIMESTRING(byte1,byte2,byte3,byte4,byte5,byte6,byte7,byte8: BYTE):string;
{*本过程将两个四字节的IEEE浮点数(single型)转为拆分为日期和时间,传入时高字节在前*}
var
  datesingle : single;
  timesingle : single;

  year,month,day,hour,minute,second : integer;

  tmp : String;
begin
  datesingle := IEEEFLOATTOSINGLE(byte1,byte2,byte3,byte4);
  timesingle := IEEEFLOATTOSINGLE(byte5,byte6,byte7,byte8);
  month := trunc(datesingle / 10000);
  day := trunc((datesingle - month * 10000) / 100);
  year := trunc(datesingle - month * 10000 - day * 100);
  month := month;
  year := year + 1900;

  hour   := trunc(timesingle / 10000);
  minute := trunc((timesingle - hour * 10000) / 100);
  second := trunc(timesingle - hour * 10000 - minute * 100);

  result := format('%.4d-%.2d-%.2d %.2d:%.2d:%.2d',[year,month,day,hour,minute,second]);
end;

initialization
  _TOCHAR[0]:='0';
  _TOCHAR[1]:='1';
  _TOCHAR[2]:='2';
  _TOCHAR[3]:='3';
  _TOCHAR[4]:='4';
  _TOCHAR[5]:='5';
  _TOCHAR[6]:='6';
  _TOCHAR[7]:='7';
  _TOCHAR[8]:='8';
  _TOCHAR[9]:='9';
  _TOCHAR[10]:='A';
  _TOCHAR[11]:='B';
  _TOCHAR[12]:='C';
  _TOCHAR[13]:='D';
  _TOCHAR[14]:='E';
  _TOCHAR[15]:='F';
end.