newcardform.~pas

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

unit NewCardForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Grids, DBGrids, Db, StdCtrls, Buttons, ExtCtrls, OleCtrls, MSCommLib_TLB,
  ADODB;

type
  TfrmNewCard = class(TForm)
    Panel1: TPanel;
    bbnNewCard: TBitBtn;
    bbnExit: TBitBtn;
    dsUser: TDataSource;
    dbgUser: TDBGrid;
    edtMoney: TEdit;
    Label1: TLabel;
    edtUserId: TEdit;
    Label2: TLabel;
    mscCardWriter: TMSComm;
    ADOQuery1: TADOQuery;
    procedure edtUserIdKeyPress(Sender: TObject; var Key: Char);
    procedure edtMoneyKeyPress(Sender: TObject; var Key: Char);
    procedure bbnNewCardClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    function IsCardInWriter():boolean;
    function WriteCard(ACardNo:string):smallint;
    function WriteTime(ATime:TDateTime):smallint;
    function WriteMoney(AMoney:double):smallint;
    function GetNewCardId():string;
  public
    { Public declarations }
  end;

var
  frmNewCard: TfrmNewCard;

implementation
uses
     CardDM,
     FunctionUnit;

{$R *.DFM}

procedure TfrmNewCard.edtUserIdKeyPress(Sender: TObject; var Key: Char);
begin
    //用户按下回车键
    if Key = #13 then
    begin
        if Length(edtUserId.Text) = 0 then //学号为空
        begin
            edtUserId.SetFocus;
        end
        else begin
            with DMMain.tblStudent do
            begin
                Filter := 'user_id=' + ''''
                         + edtUserId.Text + '''';
                Filtered := True;
            end;
            if DMMain.tblStudent.RecordCount <= 0 then
            begin
                ShowMessage('学号为'+edtUserId.Text+ '的学生不存在！');
                edtUserId.SetFocus;
            end
            else edtMoney.SetFocus;
        end;
        Exit;
    end;
    //验证输入的合法性
    if (not (Key in ['0'..'9'])) and (Key <> #8) //退回键
        and (not (Key in ['a'..'z']))
        and (not (Key in ['A'..'Z'])) then
    begin
        Key :=#0;
    end;
end;

procedure TfrmNewCard.edtMoneyKeyPress(Sender: TObject; var Key: Char);
begin
    //用户按下回车键
    if Key = #13 then
    begin
        if Length(edtMoney.Text) = 0 then //学号为空
        begin
            edtMoney.Text := '0';
        end;
        bbnNewCard.SetFocus;
        Exit;
    end;
    //验证输入的合法性
    if (not (Key in ['0'..'9'])        //数字
        and (Key <> '.') and (Key <> #8) ) then //小数点和退回键
    begin
        Key :=#0;
    end;
end;

procedure TfrmNewCard.bbnNewCardClick(Sender: TObject);
var
    mMoney: double;
    mBuf: array[0..7] of byte;
    mCardId: string;
    mTime: TDateTime;
    mRet : smallint;
label
    Error;
begin
    //确定唯一的办卡人
    if DMMain.tblStudent.RecordCount < 1 then
    begin
        ShowMessage('办卡人不确定，请输入正确的学号！');
        edtUserId.SetFocus;
        Exit;
    end;
    //尝试将输入的字符转换为浮点数
    try
        mMoney := StrToFloat(edtMoney.Text);
    except
        ShowMessage('数据转换错误，请输入正确的金额！');
        edtMoney.SetFocus;
        Exit;
    end;

    if not Self.IsCardInWriter then
    begin
        ShowMessage('系统检查不到银卡，请将一张新卡放入写卡器！');
        //?Exit;
    end;
    //在数据库中读取可用的新卡号
    mCardId := Self.GetNewCardId();
    //在数据库中读取可用的新卡号失败
    if mCardId = '#####' then
    begin
        ShowMessage('数据库中数据错误，请立即和开发方联系！');
        Close;
        Exit;
    end;

    //向数据库中写入数据
    mTime := Now();
    //===============================
    DMMain.cnnMain.BeginTrans ;
    
    with DMMain.tblCard do
    begin
        Append;
        FieldByName('card_id').AsString := mCardId;
        FieldByName('user_id').AsString := DMMain.tblStudent.FieldByName('user_id').AsString;
        FieldByName('create_date').AsDateTime := mTime;
        FieldByName('money').AsFloat := mMoney;
        FieldByName('state').AsString := '0';
        Post;
    end;

    mRet := WriteCard(mCardId);
    if mRet < 0 then goto Error;
    mRet := WriteTime(mTime);
    if mRet < 0 then goto Error;
    mRet := WriteMoney(mMoney);
    if mRet < 0 then goto Error;

    DMMain.cnnMain.CommitTrans ;
    ShowMessage('新卡办理成功！');
    Exit;


Error:
    case mRet of
      -1:ShowMessage('写卡器端口打开异常，请检查系统配着！');
      -2:ShowMessage('写卡器没有正常应答，请检查写卡器连接是否正确！');
      -3:ShowMessage('写卡器读写校验错误，请重试！');
      else ShowMessage('不能确定的读写错误，请重试！');
    end;
    DMMain.cnnMain.RollbackTrans;
end;

//向卡中写入卡号
function TfrmNewCard.WriteCard(ACardNo: string): smallint;
var
    mByteAry: array of byte;
    mIn: array of byte;
begin
    if mscCardWriter.PortOpen = False then
    begin
        try
            mscCardWriter.CommPort := ComStrToInt(Port);
            mscCardWriter.Settings := Speed + ','
                               + CheckBit[1] + ','
                               + DataBit + ','
                               + StopBit;
            mscCardWriter.PortOpen := True;
        except
            Result := -1;
            Exit;
        end;
    end;
    //构造上位机报文
    SetLength(mByteAry,13);
    mByteAry[0] := $0f;
    mByteAry[1] := $f0;
    mByteAry[2] := $03;  //写命令
    mByteAry[3] := $01;  //第1区
    //卡号数据写入

    mByteAry[4] := Ord(ACardNo[1]);
    mByteAry[5] := Ord(ACardNo[2]);
    mByteAry[6] := Ord(ACardNo[3]);
    mByteAry[7] := Ord(ACardNo[4]);
    mByteAry[8] := Ord(ACardNo[5]);

    mByteAry[9] := $00; //保留
    mByteAry[10] := $00;//保留
    mByteAry[11] := $FF;//数据区以$FF结尾
    //计算报文的校验位
    mByteAry[12] := CalCheck(mByteAry,0,11);
    //发写第1区的命令
    mscCardWriter.Output := mByteAry;
    //等待读卡机的应答信息
    Sleep(60);
    if mscCardWriter.InBufferCount < 6 then
    begin
        Result := -2;
        Exit;
    end;
    //将下位机报文接受到缓冲区
    SetLength(mIn,mscCardWriter.inBufferCount);
    mIn := mscCardWriter.Input;
    if not IsArrayValid(mIn) or (mIn[4] <> $0f) then
    begin
        Result := -3;
        Exit;
    end;
    Result := 1;
end;

function TfrmNewCard.WriteTime(ATime: TDateTime): smallint;
var
    mByteAry: array of byte;
    mIn: array of byte;
var
    Year,Month,Day:word;
    Year1,Year2,Month1,Month2,Day1,Day2:byte;
    //将两位数分解
    procedure _Decode(S:word;var D1,D2:byte);
    begin
        D1 := S mod 10;
        D2 := (S div 10) mod 10;
    end;
begin
    DecodeDate(ATime,Year,Month,Day);
    _Decode(Year,Year1,Year2);
    _Decode(Month,Month1,Month2);
    _Decode(Day,Day1,Day2);

    if mscCardWriter.PortOpen = False then
    begin
        try
            mscCardWriter.CommPort := ComStrToInt(Port);
            mscCardWriter.Settings := Speed + ','
                               + CheckBit[1] + ','
                               + DataBit + ','
                               + StopBit;
            mscCardWriter.PortOpen := True;
        except
            Result := -1;
            Exit;
        end;
    end;

    //构造上位机报文
    SetLength(mByteAry,13);
    mByteAry[0] := $0f;
    mByteAry[1] := $f0;
    mByteAry[2] := $03;  //写命令
    mByteAry[3] := $02;  //第2区
    //时间数据按协议编码写入
    mByteAry[4] := Year1;
    mByteAry[5] := Year2;
    mByteAry[6] := Month1;
    mByteAry[7] := Month2;
    mByteAry[8] := Day1;
    mByteAry[9] := Day2;
    mByteAry[10] := DayOfWeek(ATime);
    mByteAry[11] := $FF;//数据区以$FF结尾
    //计算报文的校验位
    mByteAry[12] := CalCheck(mByteAry,0,11);
    //发写第2区的命令
    mscCardWriter.Output := mByteAry;
    //等待读卡机的应答信息
    Sleep(60);
    if mscCardWriter.InBufferCount < 6 then
    begin
        Result := -2;
        Exit;
    end;
    //将下位机报文接受到缓冲区
    SetLength(mIn,mscCardWriter.inBufferCount);
    mIn := mscCardWriter.Input;
    if not IsArrayValid(mIn) or (mIn[4] <> $0f) then
    begin
        Result := -3;
        Exit;
    end;
    Result := 1;
end;

function TfrmNewCard.WriteMoney(AMoney: double): smallint;
var
    mMoney:integer;
    mB : array[0..5] of byte;
    mIn,mByteAry: array of byte;
    i: integer;
begin
    mMoney := Round(AMoney * 100);
    //取出金额中的每一位
    for i:=0 to 5 do
    begin
        mB[i] := mMoney mod 10;
        mMoney := mMoney div 10;
    end;
    if mscCardWriter.PortOpen = False then
    begin
        try
            mscCardWriter.CommPort := ComStrToInt(Port);
            mscCardWriter.Settings := Speed + ','
                               + CheckBit[1] + ','
                               + DataBit + ','
                               + StopBit;
            mscCardWriter.PortOpen := True;
        except
            Result := -1;
            Exit;
        end;
    end;
    //构造上位机报文
    SetLength(mByteAry,13);
    mByteAry[0] := $0f;
    mByteAry[1] := $f0;
    mByteAry[2] := $03;  //写命令
    mByteAry[3] := $03;  //第3区
    //金额数据加密写入
    mByteAry[4] := Encrypt(mB[0]);
    mByteAry[5] := Encrypt(mB[1]);
    mByteAry[6] := Encrypt(mB[2]);
    mByteAry[7] := Encrypt(mB[3]);
    mByteAry[8] := Encrypt(mB[4]);
    mByteAry[9] := Encrypt(mB[5]);
    mByteAry[10] := CalMoneyCheck(mByteAry,4,9);
    mByteAry[11] := $FF;//数据区以$FF结尾
    //计算报文的校验位
    mByteAry[12] := CalCheck(mByteAry,0,11);
    //发写第3区的命令
    mscCardWriter.Output := mByteAry;
    //等待读卡机的应答信息
    Sleep(60);
    if mscCardWriter.InBufferCount < 6 then
    begin
        Result := -2;
        Exit;
    end;
    //将下位机报文接受到缓冲区
    SetLength(mIn,mscCardWriter.inBufferCount);
    mIn := mscCardWriter.Input;
    if not IsArrayValid(mIn) or (mIn[4] <> $0f) then
    begin
        Result := -3;
        Exit;
    end;
    Result := 1;
end;

function TfrmNewCard.GetNewCardId: string;
var
    mResult : integer;

    function _IntToStr5(AInt:integer):string;
    var
        mStr : string;
    begin
        mStr := IntToStr(AInt);
        mStr := Copy(mStr,1,5);
        case Length(mStr) of
        1: mStr := '0000' + mStr  ;
        2: mStr := '000' + mStr ;
        3: mStr := '00' + mStr ;
        4: mStr := '0' + mStr ;
        end;
        Result := mStr;
    end;
begin
    with ADOQuery1 do
    begin
        Close;
        Connection := DMMain.cnnMain ;
        SQL.Clear;
        SQL.Add('select max(card_id) as maxid from card');
        try
            Open;
            if RecordCount > 0 then
            begin
                 //数据库为空
                if Trim(FieldByName('maxid').AsString) = '' then
                begin
                    Result := '00001';
                end
                else begin
                    mResult := FieldByName('maxid').AsInteger;
                    Result := _IntToStr5(mResult + 1);
                end;
            end
            //
            else raise Exception.Create('');
        except
            Result := '#####';
            Exit;
        end;
    end;
end;

//判断读卡机中是否有卡
function TfrmNewCard.IsCardInWriter: boolean;
var
    mByteAry: array of byte;
    mIn: array of byte;
begin
    if mscCardWriter.PortOpen = False then
    begin
        try
            mscCardWriter.CommPort := ComStrToInt(Port);
            mscCardWriter.Settings := Speed + ','
                               + CheckBit[1] + ','
                               + DataBit + ','
                               + StopBit;
            mscCardWriter.PortOpen := True;
        except
            Result := False;
            Exit;
        end;
    end;
    //构造上位机报文
    SetLength(mByteAry,4);
    mByteAry[0] := $0f;
    mByteAry[1] := $f0;
    mByteAry[2] := $01;  //读物理卡号
    //计算报文的校验位
    mByteAry[3] := CalCheck(mByteAry,0,2);
    //发读物理卡号命令
    mscCardWriter.Output := mByteAry;
    //等待读卡机的应答信息
    Sleep(60);
    //读卡失败
    if mscCardWriter.InBufferCount <> 13 then
    begin
        Result := False;
        Exit;
    end;
    //将下位机报文接受到缓冲区
    SetLength(mIn,mscCardWriter.inBufferCount);
    mIn := mscCardWriter.Input;
    //校验位错误
    if not IsArrayValid(mIn) or (mIn[3] = $ff) then
    begin
        Result := False;
        Exit;
    end;
    //如果读卡器中没有卡，物理卡号每一位都是$ff
    if (mIn[3] = $ff) and (mIn[4] = $ff) and (mIn[5] = $ff) and
       (mIn[6] = $ff) and (mIn[7] = $ff) and (mIn[8] = $ff) and
       (mIn[9] = $ff) and (mIn[10] = $ff)  then
    begin
        Result := False;
        Exit;
    end;
    Result := True;

end;

procedure TfrmNewCard.FormShow(Sender: TObject);
begin
    with DMMain.tblStudent do
    begin
        //不显示任何学生
        Filter := 'user_id= "----------"';
        Filtered := True;
    end;
    edtUserId.SetFocus;
end;

procedure TfrmNewCard.FormClose(Sender: TObject; var Action: TCloseAction);
begin
    //关闭串口 
    if mscCardWriter.PortOpen = True then mscCardWriter.PortOpen := False;
end;

end.