controlclass.pas

求是科技出版的《Delphi串口通信工程开发实例导航》所有的源代码。是一本很好的书。拿出来与大家共享。

    try
        //从$FF开始计算异或
        mByte := $FF;
        //从第六位开始计算校验位
        for i := 6 to FLen-1 do
        begin
            //对每一位进行异或
            mByte := mByte xor StrToInt('$' + Copy(FStrBuffer,i*2-1,2));
        end;
        mStr := IntToHex(mByte,2);
        //将结果写入
        FStrBuffer[FLen*2-1] := mStr[1];
        FStrBuffer[FLen*2] := mStr[2];
    except
        Result := -1;
        Exit;
    end;
    //函数执行成功
    Result := 1;
end;


{ TBottomMsg==========下位机返回信息类============ }

constructor TBottomMsg.Create(ABuffer: array of byte);
begin
    //
    SetBuffer(ABuffer);
end;

function TBottomMsg.BufToStrHex(ABuffer: array of byte): string;
var
    i: integer;
begin
    Result := '';
    for i:=0 to length(ABuffer)-1 do
    begin
        Result := Result + IntToHex(ABuffer[i],2);
    end;
end;

constructor TBottomMsg.Create;
begin
    //
end;

function TBottomMsg.GetPosStr(APos: integer): string;
begin
    if APos > FLen then
    begin
        Result := '';
        Exit;
    end;
    Result := Copy(FStrLines,2*APos-1,2);
end;

procedure TBottomMsg.SetBuffer(ABuffer: array of byte);
var
   i: integer;
begin
    FLen := Length(ABuffer);
    //分配内存
    SetLength(FBuffer,FLen);
    //按位付值
    for i := 0 to FLen-1 do
    begin
        FBuffer[i] := ABuffer[i];
    end;
    //将字节串解析为命令字符串
    FStrLines := BufToStrHex(FBuffer);
end;


function TBottomMsg.IsPosBitOn(APos, ABitPos: integer): boolean;
var
    mByte1,mByte2 : byte;
    i :integer;
begin
    //测试长度
    if APos > FLen then
    begin
        Result := False;
        Exit;
    end;
    //得到要测试的字节
    mByte1 := FBuffer[APos];
    //用乘2的方式构造测试字节
    //例如，测试第3位，构造00001000（2进制）
    mByte2 := 1;
    for i:=1 to ABitPos do
    begin
        mByte2 := mByte2 * 2;
    end;
    Result := (mByte1 and mByte2) <> 0;
end;

function TBottomMsg.GetPosByte(APos: integer): byte;
begin
    //测试长度
    if APos > FLen then Result := 0
    else Result := FBuffer[APos-1];
end;


{ TControlMachine }

//同步下位机时间
function TControlMachine.AsyTime(ADateTime: TDateTime;
  AWeekNo: integer): integer;
var
    mCounter : integer;
    mCommand : TCommand;
    mBottomMsg : TBottomMsg;
    Year1,Year2,Month,Day,Hour,Minute,Second :word;
    mBuf: array of byte;
begin

    //端口没有打开
    if not FMSComm.PortOpen then
    begin
        Result := -100;
        Exit;
    end;
    //构造上位机报文
    mCommand := TCommand.Create('B3B3B3 0C F3 XXXX 15 XXXX XXXX XXXX XXXX XX');
    ////构造下位机应答信息类，准备接收下位机消息
    mBottomMsg := TBottomMsg.Create();
    //解析时间
    DecodeDate(ADateTime,Year1,Month,Day);
    DecodeTime(ADateTime,Hour,Minute,Second,Year2); //Year2 没有用处
    Year2 := Year1 mod 100; // 低位
    Year1 := Year1 div 100; //高位
    //替换地址参数
    mCommand.ParamByPos(1,FAddr1);//地址
    mCommand.ParamByPos(2,FAddr2);//地址
    //替换时间参数
    mCommand.ParamByPos(3,GetBCD(Year1));
    mCommand.ParamByPos(4,GetBCD(Year2));
    mCommand.ParamByPos(5,GetBCD(Month));
    mCommand.ParamByPos(6,GetBCD(Day));

    mCommand.ParamByPos(7,GetBCD(Hour));
    mCommand.ParamByPos(8,GetBCD(Minute));
    mCommand.ParamByPos(9,GetBCD(Second));

    mCommand.ParamByPos(10,GetBCD(AWeekNo));
    //通信次数计数器
    mCounter := 0 ;
    while mCounter <  TRY_TIMES do
    begin
        //输出上位机报文
        FMSComm.Output := mCommand.FBuffer;
        //等待下位机响应
        Sleep(WAIT_TIME);
        //检查上传报文长度
        if FMSComm.InBufferCount >= 10 then
        begin
            //将OLE变量付值给树组
            SetLength(mBuf,FMSComm.InBufferCount);
            //读取上传报文
            mBuf := FMSComm.Input;
            //设置下位机应答信息类分析
            mBottomMsg.SetBuffer(mBuf);
            //分析应答数据
            if mBottomMsg.GetPosStr(9) = '00' then break;
        end;
        Inc(mCounter);
    end;
    //放弃通信
    if mCounter >= TRY_TIMES then
    begin
        Result := -1 ;
    end;
    Result := 1;

    mCommand.Free;
    mBottomMsg.Free;
end;

function TControlMachine.CardNo_HardToSoft(
  ACardNoHard: TCardNoHard): string;
var
    mCard: integer;
begin
    Result := '00000000';
end;

function TControlMachine.CardNo_SoftToHard(
  ACardNoSoft: string): TCardNoHard;
var
    mCard: integer;
    mResult : TCardNoHard;
    mStr : string;
begin
    if Length(ACardNoSoft) <> 8 then
    begin
        raise Exception.Create('卡号的位数不正确！');
    end;

    try
        //=============卡号的编码方式==================
        //mCard := StrToInt(ACardNoSoft);
        //mStr := Copy(ACardNoSoft,1,1);
        mResult.N1 := Copy(ACardNoSoft,1,2);
        mResult.N2 := Copy(ACardNoSoft,3,2);
        mResult.N3 := Copy(ACardNoSoft,5,2);
        mResult.N4 := Copy(ACardNoSoft,7,2);
    except
        mResult.N1 := '00';
        mResult.N2 := '00';
        mResult.N3 := '00';
        mResult.N4 := '00';
    end;
    Result := mResult;
end;

constructor TControlMachine.Create(Address: string;APortNo:integer);
begin
    SetAddress(Address);
    FPortNo := APortNo;

    FMSComm := TMSComm.Create(nil);
    OpenPort();

    //========================
    //TCommand.Create();
    TBottomMsg.Create();
end;

destructor TControlMachine.Destroy;
begin
    if FMSComm.PortOpen then FMSComm.PortOpen:= False;
    FMSComm.Free;
    //========================
    FCommand.Free;
    FBottomMsg.Free;
end;

function TControlMachine.GetBCD(AInt: integer):String;
var
    mResult : string;
    mLen : integer;
begin
    if AInt > 99 then
    begin
        raise Exception.Create('BCD编码错误，编码长度大余两位！');
    end;
    mResult := IntToStr(AInt);
    mLen := Length(mResult);
    while mLen < 2 do
    begin
        mResult := '0' + mResult;
        Inc(mLen);
    end;
    Result := mResult;
end;

function TControlMachine.DeBCD(AInt: integer): integer;
begin
    Result := StrToInt(IntToHex(AInt,2));
end;

function TControlMachine.DeBCD(AStr: string): integer;
begin
    Result := StrToInt(AStr);
end;

//开关命令
function TControlMachine.OnOffCommand(AOnOffCommand: integer): integer;
var
    mCounter : integer;
    mCommand : TCommand;
    mBottomMsg : TBottomMsg;
    mBuf: array of byte;
begin
    //端口没有打开
    if not FMSComm.PortOpen then
    begin
        Result := -100;
        Exit;
    end;
    //构造上位机报文
    mCommand := TCommand.Create('B3B3B3 05 FA XXXX 12 XXXX');
    //替换地址参数
    mCommand.ParamByPos(1,FAddr1);//地址
    mCommand.ParamByPos(2,FAddr2);//地址
    //分析子命令
    case AOnOffCommand of
        ONOFF_UP : mCommand.ParamByPos(3,'00');
        ONOFF_UP_LOCK : mCommand.ParamByPos(3,'01');
        ONOFF_UNLOCK : mCommand.ParamByPos(3,'02');
        ONOFF_FULL_LIGHT_ON : mCommand.ParamByPos(3,'03');
        ONOFF_FULL_LIGHT_OFF : mCommand.ParamByPos(3,'04');
        //ONOFF_ : mCommand.ParamByPos(3,);
        ONOFF_FLOOD_LIGHT_ON : mCommand.ParamByPos(3,'06');
        ONOFF_FLOOD_LIGHT_OFF : mCommand.ParamByPos(3,'07');
        ONOFF_FLOOD_LIGHT_AUTO : mCommand.ParamByPos(3,'08');
        ONOFF_ALLOW_CARD_OUT : mCommand.ParamByPos(3,'09');
        ONOFF_NOT_ALLOW_CARD_OUT : mCommand.ParamByPos(3,'0A');
        ONOFF_NOT_ALLOW_IN_TWICE : mCommand.ParamByPos(3,'0B');
        ONOFF_ALLOW_IN_TWICE : mCommand.ParamByPos(3,'0C');
        ONOFF_ALLOW_PICTURE : mCommand.ParamByPos(3,'0D');
        ONOFF_NOT_ALLOW_PICTURE : mCommand.ParamByPos(3,'0E');
        ONOFF_CAR_ROAD_ON : mCommand.ParamByPos(3,'0F');
        ONOFF_CAR_ROAD_OFF : mCommand.ParamByPos(3,'10');
        ONOFF_PICTURE_UP : mCommand.ParamByPos(3,'11');
        else mCommand.ParamByPos(3,'FE');
    end;
    //通信次数计数器
    mCounter := 0 ;
    while mCounter <  TRY_TIMES do
    begin
        FMSComm.Output := mCommand.FBuffer;
        //等待下位机响应
        Sleep(WAIT_TIME);
        //检查上传报文长度
        if FMSComm.InBufferCount >= 10 then
        begin
            //将OLE变量付值给树组
            SetLength(mBuf,FMSComm.InBufferCount);
            mBuf := FMSComm.Input;
            //构造下位机应答信息类
            mBottomMsg := TBottomMsg.Create();
            //设置下位机应答信息类分析
            mBottomMsg.SetBuffer(mBuf);
            //分析应答数据
            if mBottomMsg.GetPosStr(9) = '00' then break;
        end;
        Inc(mCounter);
    end;
    //放弃通信
    if mCounter >= TRY_TIMES then
    begin
        Result := -1 ;
        Exit;
    end;
    Result := 1;
end;

procedure TControlMachine.OpenPort;
begin
    FMSComm.InputMode := 1; //comInputModeBinary;
    FMSComm.CommPort := FPortNo;
    FMSComm.Settings := '9600,n,8,1';
    //open the port
    if not FMSComm.PortOpen then
    begin
        try
            FMSComm.PortOpen:= True;
        except
            //端口错误
        end;
    end;

end;

//读下位机时间
function TControlMachine.ReadBottomTime: TMachineTime;
var
    mCounter : integer;
    mCommand : TCommand;
    mBottomMsg : TBottomMsg;
    Year1,Year2,Month,Day,Hour,Minute,Second,WeekNo :integer;
    mMachineTime : TMachineTime;
    mBuf : array of byte ;
begin

    //端口没有打开
    if not FMSComm.PortOpen then
    begin
        //设置返回数据结果
        mMachineTime.DateTime := 0;
        mMachineTime.WeekNo := -1;
        Result := mMachineTime;
        Exit;
    end;

    //产生上位机数据包的类　
    mCommand := TCommand.Create('B3B3B3 04 FB XXXX 1A XX');
    //替换地址参数
    mCommand.ParamByPos(1,FAddr1);//地址
    mCommand.ParamByPos(2,FAddr2);//地址

    //产生应答数据包的类
    mBottomMsg := TBottomMsg.Create();
    //通信次数计数器
    mCounter := 0 ;
    while mCounter <  TRY_TIMES do
    begin
        //输出上位机报文
        FMSComm.Output := mCommand.FBuffer;
        //等待下位机响应
        Sleep(WAIT_TIME);
        //检查上传报文长度
        if FMSComm.InBufferCount >= 10 then
        begin
            SetLength(mBuf,FMSComm.InBufferCount);
            //读取上传报文
            mBuf := FMSComm.Input;
            //设置下位机应答信息类分析
            mBottomMsg.SetBuffer(mBuf);
            //分析应答数据
            if mBottomMsg.GetPosStr(9) = '00' then break; //接收正确
        end;
        Inc(mCounter);
    end;

    //放弃通信
    if mCounter >= TRY_TIMES then
    begin
        mMachineTime.DateTime := 0;
        mMachineTime.WeekNo := -1;
    end else
    begin
        try
            //解析时间
            Year1 := StrToInt(mBottomMsg.GetPosStr(10));
            Year2 := StrToInt(mBottomMsg.GetPosStr(11));
            Month := StrToInt(mBottomMsg.GetPosStr(12));
            Day := StrToInt(mBottomMsg.GetPosStr(13));
            Hour := StrToInt(mBottomMsg.GetPosStr(14));
            Minute := StrToInt(mBottomMsg.GetPosStr(15));
            Second := StrToInt(mBottomMsg.GetPosStr(16));
            WeekNo := StrToInt(mBottomMsg.GetPosStr(17));
         except
             mMachineTime.DateTime := 0;
             mMachineTime.WeekNo := -1;
             Result := mMachineTime;
             Exit;
         end;
        mMachineTime.DateTime := EncodeDate(Year1*100+Year2,Month,Day)
                           + EncodeTime(Hour,Minute,Second,0);//微秒为零。
        mMachineTime.WeekNo := WeekNo;
    end;
    //释放资源
    mCommand.Free;
    mBottomMsg.Free;

    Result := mMachineTime;
end;

function TControlMachine.ReadInOutRecords(ACommandNo:byte;ARecordNo:byte;var ACardUse: TCardUse): integer;
var
    mCounter : integer;
    mCommand : TCommand;
    mBottomMsg : TBottomMsg;
    mBuf : array of byte ;
    Year1,Year2,Month,Day,Hour,Minute,Second :word;
    mStr : string;
begin

    //端口没有打开
    if not FMSComm.PortOpen then
    begin
        Result := -100;
        Exit;
    end;

    //产生上位机数据包的类　
    mCommand := TCommand.Create('B3B3B3 06 F9 XXXX 1B XX XX XX');

    mCommand.ParamByPos(1,FAddr1);//地址
    mCommand.ParamByPos(2,FAddr2);//地址

    case ACommandNo of
    0:mCommand.ParamByPos(3,'00');
    4:mCommand.ParamByPos(3,'04');
    else mCommand.ParamByPos(3,'00');
    end;

    mCommand.ParamByPos(4,IntToHex(ARecordNo,2));

    //产生应答数据包的类
    mBottomMsg := TBottomMsg.Create();
    mCounter := 0 ;
    while mCounter <  TRY_TIMES do
    begin
        FMSComm.Output := mCommand.FBuffer;
        Sleep(WAIT_TIME);
        if FMSComm.InBufferCount >= 10 then
        begin
            SetLength(mBuf,FMSComm.InBufferCount);
            mBuf := FMSComm.Input;

            mBottomMsg.SetBuffer(mBuf);
            //分析应答数据
            if mBottomMsg.GetPosStr(9) = '00' then break; //接收正确
        end;
        Inc(mCounter);