addmoneyform.~pas

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

unit AddMoneyForm;

interface

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

type
  TfrmAddMoney = class(TForm)
    Panel1: TPanel;
    edtCardId: TEdit;
    Label1: TLabel;
    edtMoney: TEdit;
    Label2: TLabel;
    bbnAddMoney: TBitBtn;
    bbnExit: TBitBtn;
    MSComm1: TMSComm;
    Timer1: TTimer;
    ADOQuery1: TADOQuery;
    procedure Timer1Timer(Sender: TObject);
    procedure bbnAddMoneyClick(Sender: TObject);
    procedure edtMoneyKeyPress(Sender: TObject; var Key: Char);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
    function AddMoney(ACardId:string;AMoney:double):integer;
    function QueryMoney(ACardId:string):double;
  public
    { Public declarations }
  end;

var
  frmAddMoney: TfrmAddMoney;

implementation
uses
    FunctionUnit,
    CardDM;

{$R *.DFM}

function TfrmAddMoney.AddMoney(ACardId: string; AMoney: double):integer;
begin
    Result := 1;
    with ADOQuery1 do
    begin
        Close;
        Connection := DMMain.cnnMain ;
        SQL.Clear;
        SQL.Add('update card set money = money + :AMoney ');
        SQL.Add('where card_id = :ACardId');
        Parameters.ParamByName('ACardId').Value := ACardId;
        Parameters.ParamByName('AMoney').Value := AMoney;
        try
            ExecSQL;
            //数据库中没有该卡号
            if RowsAffected < 1 then Result := -100;
        except
            Result := -1;
        end;
    end;
end;

procedure TfrmAddMoney.Timer1Timer(Sender: TObject);
var
    mByteAry: array of Byte;
    mIn :array of Byte ;
begin
    if MSComm1.PortOpen = False then
    begin
        try
            MSComm1.CommPort := ComStrToInt(Port);
            MSComm1.Settings := Speed + ','
                               + CheckBit[1] + ','
                               + DataBit + ','
                               + StopBit;
            MSComm1.PortOpen := True;
        except
            ShowMessage('串口不能打开，请检查串口的配置！');
            Exit;
        end;
    end;
    //构造上位机报文
    SetLength(mByteAry,5);
    mByteAry[0] := $0f;
    mByteAry[1] := $f0;
    mByteAry[2] := $5;
    mByteAry[3] := $1;
    mByteAry[4] := CalCheck(mByteAry,0,3);
    //发读第一区的命令
    MSComm1.Output := mByteAry;
    //等待读卡机的应答信息
    Sleep(60);
    if MSComm1.InBufferCount <> 13 then
    begin
        //下位机不应答，表示没有卡放入
        edtCardId.Text := '00000';
        Exit;
    end;

    //将下位机报文接受到缓冲区
    SetLength(mIn,MSComm1.inBufferCount);
    mIn := MSComm1.Input;
    if not IsArrayValid(mIn) then Exit;
    //在用户界面中显示卡号
    edtCardId.Text := Chr(mIn[4])
                     +Chr(mIn[5])
                     +Chr(mIn[6])
                     +Chr(mIn[7])
                     +Chr(mIn[8]);
     edtCardId.SetFocus;

end;

procedure TfrmAddMoney.bbnAddMoneyClick(Sender: TObject);
var
    mByteAry: array of Byte;
    mIn :array of Byte ;
    mMoney : Integer;
    mMoneyFloat : double;
    mB:array[0..5] of Byte;
    mRet,i:Integer;
begin
    try
        mMoneyFloat := StrToFloat(edtMoney.Text);
    except
        ShowMessage('数据转换错误，请输入正确的金额！');
        edtMoney.SetFocus;
        Exit;
    end;
    mRet := AddMoney(edtCardId.Text,mMoneyFloat);
    if mRet = -100 then
    begin
        ShowMessage('数据库中没有该卡号，请核查！');
        Exit;
    end;
    if mRet < 0 then
    begin
        ShowMessage('数据库出错，该加卡程序无法完成！');
        Exit;
    end;
    //从数据库中取出加入后的金额
    mMoneyFloat := QueryMoney(edtCardId.Text);
    if mMoneyFloat < 0 then
    begin
        ShowMessage('数据库出错，该加卡程序无法完成！');
        Exit;
    end;
    mMoney := Round(mMoneyFloat * 100);
    //取出金额中的每一位
    for i:=0 to 5 do
    begin
        mB[i] := mMoney mod 10;
        mMoney := mMoney div 10;
    end;
    Timer1.Enabled := False;
    //等待Timer时间函数执行完成
    Sleep(200);

    if MSComm1.PortOpen = False then
    begin
        try
            MSComm1.CommPort := ComStrToInt(Port);
            MSComm1.Settings := Speed + ','
                               + CheckBit[1] + ','
                               + DataBit + ','
                               + StopBit;
            MSComm1.PortOpen := True;
        except
            ShowMessage('串口不能打开，请检查串口的配置！');
            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区的命令
    MSComm1.Output := mByteAry;
    //等待读卡机的应答信息
    Sleep(60);
    if MSComm1.InBufferCount <> 6 then
    begin
        ShowMessage('写入数据时出错，请重试！');
        Exit;
    end;
    //将下位机报文接受到缓冲区
    SetLength(mIn,MSComm1.inBufferCount);
    mIn := MSComm1.Input;
    if not IsArrayValid(mIn) or (mIn[4] <> $0f) then
    begin
        ShowMessage('写入数据时出错，请重试！');
        Exit;
    end;
    ModalResult := mrOk;

end;

procedure TfrmAddMoney.edtMoneyKeyPress(Sender: TObject; var Key: Char);
begin
    if Key = #13 then bbnAddMoney.SetFocus;
    if not (Key in ['0'..'9'])
         and (Key <> '.') then
        Key := #0;
end;

procedure TfrmAddMoney.FormClose(Sender: TObject; var Action: TCloseAction);
begin
    //关闭串口，释放资源
    Timer1.Enabled := False;
    if MSComm1.PortOpen then MSComm1.PortOpen := False;
end;

function TfrmAddMoney.QueryMoney(ACardId: string): double;
begin
    with ADOQuery1 do
    begin
        Close;
        Connection := DMMain.cnnMain ;
        SQL.Clear;
        SQL.Add('select money from card ');
        SQL.Add('where card_id = :ACardId');
        Parameters.ParamByName('ACardId').Value := ACardId;
        try
            Open;
            //数据库中没有该卡号
            if RecordCount <> 1 then Result := -100.0
            else Result := FieldByName('money').AsFloat;
        except
            Result := -1.0;
        end;
    end;
end;

procedure TfrmAddMoney.FormShow(Sender: TObject);
begin
    Timer1.Enabled := True;
end;

end.