tcommfunc_unit.pas

这是一个非常实用的实时串口通讯程序

unit TCommFunc_Unit;

interface

uses windows, Messages, SysUtils,Variants;

type
     TCommFuncClass = Class
     public
       constructor Create; 
       destructor Destroy; override;
       function  FindBufHead(lpBuf:PByte;nLen:Integer):Integer;
       function  StatUp_Bus(Com,Path,Mac,OnOff :integer) :Boolean; //营业
       function  StatUp_ColdWater(Com,Path,Mac,TimeMoney:integer) :Boolean;//放冷水
       procedure InitPosSeting;    //初始化pos机设置
       procedure ReadCardPro(CardNo :Cardinal);      //伺服机读卡处理
       procedure ConCenter_Repos;  //退出系统初始化总控机
       function  GetKeyA(CardNo :Cardinal) : String;
       function VerifyCard(CardNo :Cardinal):integer;

end;

Const       //命令字
    STARSIGN  = $2A;       // *        2A
    WELLSIGN  = $23;       // #        23
    iTimeOut  = 30;       //延时
    QUERY     = $91;       // 查询     91
    SETUPCMD  = $A2;       //加载配置  A2
    RS485TEST = $B3;       // test 485 b3
    SaleMan = $C4;       //  营业    c4
    COLDWATER = $D5;       //放冷水    d5
    UPMACHINE = $E6;       //改机号    e6
    SETUPTIME = $F7;       //加载时间  f7
    RIGHT_CALL= $69;       //接受正确  69
    ERROR_CALL= $B4;       //接受错误  b4

var
 CommFunc : TCommFuncClass;

implementation

uses MAIN_UNIT, TMCommDriverClass_Unit, CRCMAC_Unit,
  TCommSendDataThread_Unit, GlbDataModule_Unit, GlbVar_Unit, AccInfoSet_Unit,
  BleepInt, SetCardNo_Unit, Searchset_Unit, SaveMoney_Unit,
  AccInfoHandle_Unit, AddOperator_Unit, UpdateOperator_Unit, OpenAccount_Unit,
  DoorSearchset_Unit, Mifare, CardInfo_Unit, UnitMoney_Unit ;

constructor TCommFuncClass.Create;
begin

end;

destructor TCommFuncClass.Destroy;
begin

end;



function TCommFuncClass.GetKeyA(CardNo :Cardinal) : String;
//获取密钥A
var
  b4CardNo        : array [0..3] of Byte;
  Crc16        : Word;
  NewKeyData:String;
  KeyA : array [0..5]  of Byte;       //某扇区的密码A、B
  i :integer;
  DZHX :array[0..3] of Byte;
begin
   DZHX[0] :=$44;  {DZHX 的 ASCII值}
   DZHX[1] :=$5A;
   DZHX[2] :=$48;
   DZHX[3] :=$58;
  CopyMemory(@b4CardNo[0],@CardNo,4);
  for i:=0 to 3 do
  begin
    KeyA[i] :=DZHX[i] Xor b4CardNo[i];
  end;
  //CopyMemory(@KeyA[0],@b4CardNo[0],4);
  Crc16 := chkcrc16(4,@KeyA[0]);
  CopyMemory(@KeyA[4],@CRC16,2);
  for i :=0 to 5 do
  begin
    NewKeyData :=NewKeyData+ IntToHex(KeyA[i],2);
  end;
  Result:= NewKeyData;
end;

function TCommFuncClass.VerifyCard(CardNo :Cardinal):integer;
Var
        rt:Integer;
	blockdata1:String;
        Key_Type ,sector :Integer;
        oldKey    :String;
begin
  SetLength(blockdata1,32);
  Key_Type := 0;
  sector   :=0;
  oldKey   :=GetKeyA(CardNo);

  rt := ReadCard(key_type,oldkey,sector * 4 + 3,blockdata1);
  if(rt <> 0) then
  begin
       Result := rt;
       Exit;
  end;
  result :=rt;
end;

function TCommFuncClass.FindBufHead(lpBuf:PByte;nLen:Integer):Integer;
var
   i     : Integer;
   iHead : Integer;
begin
   iHead :=0;
   for i:=1 to nLen do
      begin
         if ((pByte(Integer(lpBuf) + i-1))^ = $2A) then
             begin
                iHead := i ;
                Break;
             end;
      end;
   if (iHead=0) then
      Result := iHead
   else
      Result := iHead + 2;
end;

function TCommFuncClass.StatUp_Bus(Com,Path,Mac,OnOff :integer) :Boolean;
var
  bSendDataBuf : array [1..1024] of Byte;
  crc16        : Word;
  nLen         : Integer;
  iLength      : Integer;
  iHead        : Integer;
  crc161       : Word;
  SendSucc :Boolean;
  iCount : integer;
begin
try
      CommNetDriver.m_hSection.Acquire;
      ZeroMemory(@CommNetDriver.GDataBuf,1024);
      CommNetDriver.m_hSection.Release;
      ZeroMemory(@bSendDataBuf,1024);
      bSendDataBuf[1] := STARSIGN;
      bSendDataBuf[2] := SaleMan;
      bSendDataBuf[3] := Path;
      bSendDataBuf[4] := Mac;
      if OnOff =0 then
        bSendDataBuf[5] := 2
      else
        bSendDataBuf[5] := 1;
      bSendDataBuf[6] := $00;
      bSendDataBuf[7] := $00;
      bSendDataBuf[8] := $00;
      bSendDataBuf[9] := WELLSIGN;
      crc16 :=chkcrc16(9,@bSendDataBuf);
      CopyMemory(@bSendDataBuf[11],@crc16,2);
      bSendDataBuf[10] := bSendDataBuf[12];
      bSendDataBuf[12] := $0;
      nLen :=CommNetDriver.ClientComm.SendData(@bSendDataBuf,11);
      if (nLen>0) then
      begin
         SendSucc :=false;
         iCount :=0;
         Sleep(5);
         while not SendSucc do
         begin
           if not AcceptData then
           begin
             inc(iCount);
             if iCount =3 then
               break;
             CommNetDriver.ClientComm.SendData(@bSendDataBuf,11);
           end
           else
           begin
             CommNetDriver.m_hSection.Acquire;
             iLength := 0;
             CopyMemory(@iLength,@CommNetDriver.GDataBuf,2);
             iHead := FindBufHead(@CommNetDriver.GDataBuf[3],iLength);
             CommNetDriver.m_hSection.Release;
             ReSetEvent(CommNetDriver.m_RWEvent);
             if (iHead>0) then
             begin
                Case CommNetDriver.GDataBuf[iHead+1] Of
                RIGHT_CALL:
                   begin
                     crc16:=chkcrc16(4,@CommNetDriver.GDataBuf[iHead]);
                     CopyMemory(@crc161,@CommNetDriver.GDataBuf[iHead+4],2);
                     if (crc16=crc161) then
                         begin
                            SendSucc :=true;
                            /////////修改数据库
                            With GLBDataModule.ADOQuery_salehand do
                            begin
                              Close;
                              if OnOff=1 then
                                 Sql.Text := 'UPDATE CTMachineTAB '+
                                          ' SET CT_SaleStatus = '+IntToStr(OnOff)+'  '+
                                          ' WHERE (CT_TCPathNUM = '+IntToStr(Path)+' ) AND '+
                                          ' (CT_MachineNUM = '+IntToStr(Mac)+') AND '+
                                          ' (CT_CommandNum = '+IntToStr(Com)+')'
                               else
                                 Sql.Text := 'UPDATE CTMachineTAB '+
                                          ' SET CT_SaleStatus = '+IntToStr(OnOff)+' , SetDinge=0, DingMoney =0 '+
                                          ' WHERE (CT_TCPathNUM = '+IntToStr(Path)+' ) AND '+
                                          ' (CT_MachineNUM = '+IntToStr(Mac)+') AND '+
                                          ' (CT_CommandNum = '+IntToStr(Com)+')';
                              try
                                ExecSql;
                              except
                              end;
                            end;
                            break;
                         end
                     else
                       begin
                         CommNetDriver.ClientComm.SendData(@bSendDataBuf,11);
                       end;
                   end;
                ERROR_CALL :
                   begin
                     CommNetDriver.ClientComm.SendData(@bSendDataBuf,11);
                   end;
                End;
             end;
           end;
         end;
         if iCount<3 then
           begin
             result :=true;
           end
         else
           begin
             result :=false;
           end;
      end;
except
end;
end;

function TCommFuncClass.StatUp_ColdWater(Com,Path,Mac,TimeMoney:integer) :Boolean;
var
  bSendDataBuf : array [1..1024] of Byte;
  crc16        : Word;
  nLen         : Integer;
  iLength      : Integer;
  iHead        : Integer;
  crc161       : Word;
  SendSucc :Boolean;
  iCount : integer;
begin
try
    CommNetDriver.m_hSection.Acquire;
    ZeroMemory(@CommNetDriver.GDataBuf,1024);
    CommNetDriver.m_hSection.Release;
    ZeroMemory(@bSendDataBuf,1024);
    bSendDataBuf[1] := STARSIGN;
    bSendDataBuf[2] := COLDWATER;
    bSendDataBuf[3] := Path;
    bSendDataBuf[4] := Mac;
    CopyMemory(@bSendDataBuf[6],@TimeMoney,2);
    bSendDataBuf[5] := bSendDataBuf[7];
    bSendDataBuf[7] := $64;
    bSendDataBuf[8] := $00;
    bSendDataBuf[9] := WELLSIGN;
    crc16 := chkcrc16(9,@bSendDataBuf);
    CopyMemory(@bSendDataBuf[11],@crc16,2);
    bSendDataBuf[10]:= bSendDataBuf[12];
    nLen := CommNetDriver.ClientComm.SendData(@bSendDataBuf,11);
    if (nLen>0) then
    begin
      SendSucc :=false;
      iCount :=0;
      Sleep(5);
      while not SendSucc do
      begin
        if not AcceptData then
        begin
          inc(iCount);
          if iCount =3 then
            break;
          CommNetDriver.ClientComm.SendData(@bSendDataBuf,11);
        end
        else
        begin
          CommNetDriver.m_hSection.Acquire;
          iLength := 0;
          CopyMemory(@iLength,@CommNetDriver.GDataBuf,2);
          iHead := FindBufHead(@CommNetDriver.GDataBuf[3],iLength);
          CommNetDriver.m_hSection.Release;
          ReSetEvent(CommNetDriver.m_RWEvent);
          if (iHead>0) then
          begin
            Case CommNetDriver.GDataBuf[iHead+1] Of
            RIGHT_CALL:
              begin
                crc16 := chkcrc16(4,@CommNetDriver.GDataBuf[iHead]);
                CopyMemory(@crc161,@CommNetDriver.GDataBuf[iHead+4],2);
                if (crc16=crc161) then
                   begin
                      SendSucc :=true;