controlclass.pas

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

unit ControlClass;

interface
uses
    OleCtrls, MSCommLib_TLB;
{=================上位机命令类=====================}
type TCommand = class
protected
    FStrLines : string;       //带有参数的命令行
    FStrBuffer: string;       //参数已经付值的命令行
    FLen : integer;    //命令字节长度
    //所有参数，包括校验参数都准备好
    function IsParamsOK(): boolean;
    //除校验参数外的所有参数都准备好
    function IsParamsReady(): boolean;
    //FStrLines的APos位是否是参数
    function IsLinesPosToken(APos:integer): boolean;
    //FStrBuffer的APos位是否是参数
    function IsBufferPosToken(APos:integer): boolean;
    //验证合法性
    function CheckValid(AStr:string): boolean;
    //得到字节串
    procedure GetValue();
    //去掉命令行中的空格
    function TrimAll(AStr :string ):string;
    //计算校验位－－虚函数
    function CalCheck() : integer;virtual;
public
    //输出的字节串
    FBuffer: array of byte ;
    //构造函数
    constructor Create(AStrLine: string);
    //添加一个命令行
    procedure Add(ALines : string);
    //清除命令行
    procedure Clear();
    //参数替换
    procedure ParamByPos(AParamPos:integer;AValue:string);
    //得到参数已经付值的命令行
    function GetStrBuffer() :string;
end;

type TCardCommand = class(TCommand)
private
    //重载计算校验位的函数
    function CalCheck() : integer;override;
public


end;
{=================下位机消息类==================}
type TBottomMsg = class
private
    FBuffer: array of byte;
    FLen: integer;
    //字节树组到16进制字符串
    function BufToStrHex(ABuffer: array of byte): string;
public
    FStrLines : string;
    //重载构造函数
    constructor Create(ABuffer: array of byte);overload;
    constructor Create();overload;
    //设置分析字节
    procedure SetBuffer(ABuffer: array of byte);
    //得到某位，返回某位（字符串）
    function GetPosStr(APos: integer):string;
    //得到某位，返回某位（字节）
    function GetPosByte(APos: integer): byte;
    //测试某字节的某位是否为“1”
    function IsPosBitOn(APos,ABitPos: integer):boolean;
end;

{==================卡使用记录=================}
type TCardUse = record
    Card:string;
    EnterState : byte; //按硬件
    EnterTime: TDateTime; //进入和离开时间
    LeaveTime: TDateTime;
    //记录号
    RecordNo: byte;  //

end;

type TComplexCardUse = record
    Card: string;
    EnterState : byte; //按硬件
    EnterTime: TDateTime; //进入和离开时间
    LeaveTime: TDateTime;

    MainClass : string;
    SlaveClass : string;
    EnterAddr1 : string;
    EnterAddr2 : string;
    LeaveAddr1 : string;
    LeaveAddr2 : string;
end;

{==============硬件的卡号============}
type TCardNoHard = record
    N1,N2,N3,N4:string;
end;

type TMachineTime = record
    DateTime : TDateTime;
    WeekNo : integer;
end;


const

{===========开关命令============}
    ONOFF_UP = 0;
    ONOFF_UP_LOCK = 1;
    ONOFF_UNLOCK = 2;
    ONOFF_FULL_LIGHT_ON =3 ;
    ONOFF_FULL_LIGHT_OFF = 4;
    //ONOFF_ : mCommand.ParamByPos(3,);
    ONOFF_FLOOD_LIGHT_ON = 6;
    ONOFF_FLOOD_LIGHT_OFF = 7;
    ONOFF_FLOOD_LIGHT_AUTO = 8;
    ONOFF_ALLOW_CARD_OUT = 9;
    ONOFF_NOT_ALLOW_CARD_OUT = 10;
    ONOFF_NOT_ALLOW_IN_TWICE = 11;
    ONOFF_ALLOW_IN_TWICE = 12;
    ONOFF_ALLOW_PICTURE = 13;
    ONOFF_NOT_ALLOW_PICTURE =14;
    ONOFF_CAR_ROAD_ON = 15;
    ONOFF_CAR_ROAD_OFF = 16;
    ONOFF_PICTURE_UP = 17;

{==============写节假日常数=================}
    FESTIVAL_START = 0;
    FESTIVAL_APPEND = 1;
    FESTIVAL_END = 2;

{==============修改名单状态================}
    UPDATE_CLAIM_LOSE = 1;
    UPDATE_NOT_CLAIM_LOSE = 2;
    UPDATE_ALLOW_IN = 3;
    UPDATE_ALLOW_OUT = 4;

{//============控制器类=============}

type TControlMachine = class
private
    FMSComm : TMSComm;
    procedure OpenPort();
    function CardNo_HardToSoft(ACardNoHard:TCardNoHard):string;
    function CardNo_SoftToHard(ACardNoSoft:string):TCardNoHard;

    //得到BCD编码
    //function GetBCD(AInt: integer):integer;
    function GetBCD(AInt: integer):string;
    //反BCD编码
    function DeBCD(AInt: integer): integer;overload;
    function DeBCD(AStr: string): integer;overload;
public
    FAddr1 : string;//地址1
    FAddr2 : string;//地址2
    FPortNo: integer;//端口号

    //==============================
    FCommand : TCommand;
    FBottomMsg : TBottomMsg;
    //================================
    constructor Create(Address: string;APortNo:integer);
    destructor Destroy();override;
    procedure SetAddress(Address : string);

    //和下位机通信相关的函数
    //握手函数
    function ShakeHands() : TBottomMsg;
    //开关命令
    function OnOffCommand(AOnOffCommand:integer): integer;
    //写节假日
    function WriteFestival(ACommandNo:integer;ADate:TDateTime;
             ARecordNo:integer):integer;
    //时间同步
    function AsyTime(ADateTime:TDateTime;AWeekNo: integer):integer;
    //写名单
    function WriteFixCardUser(ACommandNo:integer;ACardNo:string;
             ACardState:integer;ADateTime:TDateTime;ARecordNo:byte):integer;
    //修改库名单状态
    function UpdateFixCardUser(ACommandNo:integer;ACardNo:string):integer;
    //读下位机时间
    function ReadBottomTime(): TMachineTime;
    //读进出记录
    function ReadInOutRecords(ACommandNo:byte;ARecordNo:byte;var ACardUse:TCardUse):integer;
    //写照明灯自动开关时间
    function WriteLightAutoTime(AOnHour,AOnMinute,AOffHour,AOffMinute:integer):integer;
    //设置临时卡号
    function WriteCasualCardNo(ACardNo: string):integer;
    //设置图象对比响应时间
    function WritePictureTime(AOneTenthSecond: integer):integer;

private

end;


type TCardReader = class
private
    FMSComm : TMSComm;
    procedure OpenPort();
    function CardNo_HardToSoft(ACardNoHard:TCardNoHard):string;
    function CardNo_SoftToHard(ACardNoSoft:string):TCardNoHard;

    //==写一个区=========
    function WriteArea(Area:integer;AContent : string) : integer;

public
    FAddr1 : string;//地址1
    FAddr2 : string;//地址2
    FPortNo: integer;//端口号

    //==============================
    FCommand : TCommand;
    FBottomMsg : TBottomMsg;
    //================================
    constructor Create(Address: string;APortNo:integer);overload;
    constructor Create(APortNo: integer);overload;
    destructor Destroy();override;
    procedure SetAddress(Address : string);
    function ReadCard(var ACardUse : TCardUse):integer;
    function ReadComplexCard(var ACardUse : TComplexCardUse):integer;
    function WriteAddr(EnterAddr1,EnterAddr2,
                   LeaveAddr1,LeaveAddr2: string): integer;
    function WriteLeaveTime(ADateTime: TDateTime) : integer;
end;



implementation
uses
    Sysutils,Windows;

const
    TOKEN_CHAR = 'X';

    //=============TControlMachine=================
    TRY_TIMES = 3;
    WAIT_TIME = 100; //100 ms
    //=============================================

{  Global function}
function IntToStr2(Aint : integer): string;
var
    mResult : string;
    mLen : integer;
begin
    mResult := IntToStr(Aint);

    mLen := Length(mResult);
    case mLen of
        0: mResult := '00';
        1: mResult := '0' + mResult;
        else mResult := Copy(mResult,1,2);
    end;
    Result:=mResult;
end;

{ TCommand }

//添加一个字符串命令
procedure TCommand.Add(ALines: string);
begin
    //去除所有的空格
    ALines := TrimAll(ALines);
    if not CheckValid(ALines) then
    begin
        raise Exception.Create('非法字符串长度！');
    end;

    FStrLines := ALines;
    FStrBuffer := ALines;
    FLen := Length(FStrLines) div 2;

    GetValue();

end;

function TCommand.CheckValid(AStr: string): boolean;
begin
    //长度为偶数则合法
    if (Length(AStr) mod 2) = 0 then Result := True
    else Result := False;
end;

procedure TCommand.Clear;
begin
    FStrLines := '';
    FStrLines := '';
    FLen := 0;
    setLength(FBuffer,0);
end;

constructor TCommand.Create(AStrLine: string);
begin
    inherited Create();
    Add(AStrLine);
end;


function TCommand.GetStrBuffer: string;
begin
    Result := FStrBuffer;
end;


procedure TCommand.GetValue;
var
    i :integer;
    mStr :string;
begin
    //参数没有完全被替换
    if not IsParamsReady() then
    begin
        SetLength(FBuffer,0);
        Exit;
    end;
    //参数中只剩校验位，计算校验位
    CalCheck();
    //测试所有的参数都准备好。
    if not IsParamsOK() then
    begin
        //抛出异常
        raise Exception.Create('命令行中含有未知参数！');
    end;
    //分配内存
    SetLength(Fbuffer,FLen);
    for i := 1 to FLen do
    begin
        //命令字符串转换为16进制
        mStr := '$' + Copy(FStrBuffer,i*2-1,2);
        try
            //动态数组从零开始计算
            FBuffer[i-1] := StrToInt(mStr);
        except
            Exit;
        end;
    end;

end;

//所有参数，包括校验参数都准备好
function TCommand.IsParamsOK: boolean;
var
    i : integer;
begin
    i := 1 ;

    while i <= FLen do
    begin
        //本位置是参数
        if IsBufferPosToken(i) then
        begin
            Result := False;
            Exit;
        end;
        Inc(i);
    end;
    Result := True;
end;

//除校验参数外的所有参数都准备好
function TCommand.IsParamsReady(): boolean;
var
    i: integer;
begin
    i := 1 ;

    while i <= FLen-1 do
    begin
        if IsBufferPosToken(i) then
        begin
            Result := False;
            Exit;
        end;
        Inc(i);
    end;
    Result := True;

end;

function TCommand.IsLinesPosToken(APos: integer): boolean;
var
    mRealIndex :integer;
begin
    //计算在命令字符串中的位置
    mRealIndex := APos*2 -1;
    //超过命令字符串的长度
    if mRealIndex > FLen*2 then
    begin
        Result := False;
        Exit;
    end;
    //测试连续两个字符是否是‘XX’
    if (FStrLines[mRealIndex] = TOKEN_CHAR)
      and (FStrLines[mRealIndex + 1] = TOKEN_CHAR) then
    begin
        Result := True;
    end
    else begin
        Result := False;
    end;
end;

function TCommand.IsBufferPosToken(APos:integer): boolean;
var
    mRealIndex :integer;
begin
    //计算在命令字符串中的位置
    mRealIndex := APos*2 -1;
    //超过命令字符串的长度
    if mRealIndex > FLen*2 then
    begin
        Result := False;
        Exit;
    end;
    //测试连续两个字符是否是‘XX’
    if (FStrBuffer[mRealIndex] = TOKEN_CHAR)
      and (FStrBuffer[mRealIndex + 1] = TOKEN_CHAR) then
    begin
        Result := True;
    end
    else begin
        Result := False;
    end;
end;
procedure TCommand.ParamByPos(AParamPos: integer; AValue: string);
var
    i,mCounter : integer;
begin
    //检查合法性
    if not CheckValid(AValue) then
    begin
        raise Exception.Create('参数值错误!');
    end;
    if AParamPos < 0 then Exit;

    i := 1;
    mCounter := 0;
    while i <= FLen do
    begin
        //查找第AParamPos参数的位置
        if IsLinesPosToken(i) then  Inc(mCounter);
        if mCounter = AParamPos then
        begin
            //替换参数
            FStrBuffer[i*2-1] := AValue[1];
            FStrBuffer[i*2] := AValue[2];
            //计算输出字节串
            GetValue();
            Exit;
        end;
        Inc(i);
    end;
end;

//去掉所有的空格
function TCommand.TrimAll(AStr: string): string;
var
    mLen,i:integer;
begin
    mLen := Length(AStr);
    //初始化返回值
    Result := '';
    for i:=1 to mLen do
    begin
        //是空格就去掉
        if AStr[i] = ' ' then continue;
        Result := Result + AStr[i];
    end;
end;

//计算校验位
function TCommand.CalCheck: integer;
var
    mByte : byte ;
    i : integer;
    mStr : string;
begin
    //测试校验位是否已经付值
    if not IsBufferPosToken(FLen) then
    begin
        Result := 0;
        Exit;
    end;