ufrmmain.pas

图书电子阅览室门禁系统 v1.0

unit UfrmMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, Menus, ExtCtrls, RzPanel, RzButton,
  StdCtrls, RzEdit, fcClearPanel, fcButtonGroup, fcOutlookBar, RzGroupBar,
  ImgList, IdBaseComponent, IdComponent, IdTCPServer, RzTabs, RzLabel,
  RzLstBox, RzChkLst, Mask, RzCmboBx,IdStack, IdGlobal, IdSocketHandle, IdResourceStrings,
  DB, ADODB, IdAntiFreezeBase, IdAntiFreeze, cxStyles, cxCustomData,
  cxGraphics, cxFilter, cxData, cxDataStorage, cxEdit, cxDBData,
  cxGridLevel, cxClasses, cxControls, cxGridCustomView,
  cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxGrid, Grids,
  DBGrids, RzDBGrid,Registry;
const
  //客户机端信号
  KillConnect    ='断开连接';
  LoginConnect   ='申请连接';
  Door           ='学生入/出门';
  GetUserInfo    ='获取学生信息';
  InFlag         ='学生是否进门';
  //服务器端信号
  StopServerNow     ='关闭连接';
  BroadCast      ='系统广播';
  UserInfo       ='学生信息';
  //公共信号
  DATA           ='数据信息';
  GetDataSuccessIn ='接收入门数据成功';
  GetDataSuccessOut='接收出门数据成功';

type
  TfrmMain = class(TForm)
    StatusBar1: TStatusBar;
    RzPanel1: TRzPanel;
    RzPanel2: TRzPanel;
    RzPanel3: TRzPanel;
    RzGroupBar1: TRzGroupBar;
    RzGroup1: TRzGroup;
    RzGroup2: TRzGroup;
    RzGroup3: TRzGroup;
    RzGroup4: TRzGroup;
    ImageListMenu: TImageList;
    IdTCPServer: TIdTCPServer;
    RzPageControl1: TRzPageControl;
    TabSheet1: TRzTabSheet;
    TabSheet2: TRzTabSheet;
    RzMemoLog: TRzMemo;
    RzLabel1: TRzLabel;
    lplIPs: TRzCheckList;
    RzLabel2: TRzLabel;
    edtPort: TRzEdit;
    RzLabel3: TRzLabel;
    cboPorts: TRzComboBox;
    ADOConn: TADOConnection;
    qryAdd: TADOQuery;
    qryUpdate: TADOQuery;
    qrySelect: TADOQuery;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    TabSheet3: TRzTabSheet;
    RzGroupBox1: TRzGroupBox;
    RzGroupBox2: TRzGroupBox;
    RzComboBox1: TRzComboBox;
    RzLabel4: TRzLabel;
    qryViewInfo: TADOQuery;
    DataSourceViewInfo: TDataSource;
    RzLabel5: TRzLabel;
    RzLabel6: TRzLabel;
    RzEdit1: TRzEdit;
    RzComboBox2: TRzComboBox;
    btnSearch: TRzBitBtn;
    RzDBGrid1: TRzDBGrid;
    RzDBGrid2: TRzDBGrid;
    RzPanel4: TRzPanel;
    DataSourceViewLog: TDataSource;
    ADOTableViewLog: TADOTable;
    RzPanel5: TRzPanel;
    RzPanel6: TRzPanel;
    procedure RzGroup2Items0Click(Sender: TObject);
    procedure RzGroup1Items4Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure RzGroup1Items0Click(Sender: TObject);
    procedure RzGroup1Items1Click(Sender: TObject);
    procedure IdTCPServerConnect(AThread: TIdPeerThread);
    procedure IdTCPServerExecute(AThread: TIdPeerThread);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure cboPortsChange(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure IdTCPServerDisconnect(AThread: TIdPeerThread);
    procedure RzGroup2Items1Click(Sender: TObject);
    procedure RzGroup2Items2Click(Sender: TObject);
    procedure RzComboBox1Change(Sender: TObject);
    procedure RzGroup4Items0Click(Sender: TObject);
    procedure RzGroup4Items1Click(Sender: TObject);
    procedure RzGroup4Items2Click(Sender: TObject);
    procedure btnSearchClick(Sender: TObject);
    procedure RzGroup1Items2Click(Sender: TObject);
    procedure RzGroup3Items0Click(Sender: TObject);
    procedure RzGroup3Items1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    DBPath:string;
    fErrors : TStringList;
    fServerRunning : boolean;
    procedure PopulateIPAddresses;
    function PortDescription(const PortNumber: integer): string;
    function StartServer:Boolean;
    function StopServer:Boolean;
    function ConcatStr(nCommand:string;nMsg:string):string;  //待发送消息编码
    procedure SplitStr(nMsg:string);                         //分解收到的消息
  end;

var
  frmMain: TfrmMain;
  //----------------------------------
  nCommand:string;
  nStr:array[0..4] of Variant;
  //----------------------------------
implementation

uses UfrmAbout,UfrmDBBAK;

{$R *.dfm}

procedure TfrmMain.RzGroup2Items0Click(Sender: TObject);
begin
     self.RzMemoLog.Lines.Clear;
end;

procedure TfrmMain.RzGroup1Items4Click(Sender: TObject);
begin
     Close;
end;

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
     if Application.MessageBox('确定退出本系统吗？','提示',MB_OKCANCEL+MB_ICONQUESTION)<>IDOK then
     begin
        Abort;
     end;
end;

procedure TfrmMain.PopulateIPAddresses;
var
    i : integer;
begin
    with lplIPs do
    begin
         Clear;
         Items := GStack.LocalAddresses;
         Items.Insert(0, '127.0.0.1');
    end;
    self.lplIPs.ItemChecked[0]:=True;
    try
         cboPorts.Items.Add(RSBindingAny);
         cboPorts.Items.BeginUpdate;
         for i := 0 to IdPorts.Count - 1 do
             cboPorts.Items.Add(PortDescription(Integer(IdPorts[i])));
    finally
         cboPorts.Items.EndUpdate;
    end;
end;

function TfrmMain.PortDescription(const PortNumber: integer): string;
begin
    with GStack.WSGetServByPort(PortNumber) do
    begin
         try
            Result := '';
            if Count > 0 then begin
              Result := Format('%d: %s', [PortNumber, CommaText]);    {Do not Localize}
            end;
         finally
            Free;
         end;
    end;
end;

function TfrmMain.StartServer: Boolean;
var
    Binding : TIdSocketHandle;
    i : integer;
    SL : TStringList;
begin
    SL := TStringList.Create;  
    if not StopServer then
    begin
       fErrors.Append('停止服务器运行出现错误');
       Result := false;
       exit;
    end;

    IdTCPServer.Bindings.Clear; // bindings cannot be cleared until TidTCPServer is inactive
    try
        try
            for i := 0 to Self.lplIPs.Count-1 do
            begin
                //Self.lplIPs.ItemChecked[i]
                if Self.lplIPs.ItemChecked[i] then
                begin
                    Binding := IdTCPServer.Bindings.Add;
                    Binding.IP := Self.lplIPs.Items.Strings[i];
                    Binding.Port := StrToInt(edtPort.Text);
                    SL.append('服务器绑定的IP地址为：' + Binding.IP + ' 绑定的端口为：' + edtPort.Text);
                end;
            end;
            IdTCPServer.Active := true;
            result := IdTCPServer.Active;
            fServerRunning := result;
            Self.RzMemoLog.Lines.AddStrings(SL);
            //self.RzMemoLog.Items.AddStrings(SL);
            Self.RzMemoLog.Lines.Append('服务器启动...');

            if result then
                StatusBar1.SimpleText := '服务器运行中...'
            else
                StatusBar1.SimpleText := '服务器停止';
        except
            on E : Exception do
            begin
                Self.RzMemoLog.Lines.Append('服务器没有启动');
                fErrors.append(E.Message);
                Result := false;
                fServerRunning := result;
            end;
        end;
    finally
        FreeAndNil(SL);
    end;
end;

function TfrmMain.StopServer: Boolean;
begin
    IdTCPServer.Active := false;
    IdTCPServer.Bindings.Clear;
    Result := not IdTCPServer.Active;
    fServerRunning := result;
    if result then
    begin
        //StatusBar.SimpleText := '服务器停止';
        Self.RzMemoLog.Lines.Append('服务器停止');
    end
    else
    begin
        //StatusBar.SimpleText := '服务器运行中...';
        Self.RzMemoLog.Lines.Append('服务器没有停止');
    end;
end;

procedure TfrmMain.RzGroup1Items0Click(Sender: TObject);
var
    x,i : integer;
begin
    x := 0;
    for i := 0 to Self.lplIPs.Count-1 do
        if self.lplIPs.ItemChecked[i] then
           inc(x);
    if x < 1 then
    begin
        //ShowMessage('Cannot proceed until you select at least one IP to bind!');
        Self.RzMemoLog.Lines.Append('不能启动服务器，直到您选择了至少一个IP地址进行绑定！');
        exit;
    end;
    fErrors.Clear;
    if not StartServer then
        //ShowMessage('启动服务器出现错误：' + #13 + #13 + fErrors.text)
        Self.RzMemoLog.Lines.Append('启动服务器出现错误：' + #13 + #13 + fErrors.text)
    else
        //ShowMessage('服务器启动成功！');
        Self.RzMemoLog.Lines.Append('服务器启动成功！');
end;

procedure TfrmMain.RzGroup1Items1Click(Sender: TObject);
begin
    fErrors.Clear;
    if not fServerRunning then
    begin
       //ShowMessage('Server it not running - no need to stop !');
       Self.RzMemoLog.Lines.Append('服务器没有启动，没有必要停止！');
       Exit;
    end;
    if not StopServer then
       //ShowMessage('停止服务器出现错误：' + #13 + #13 + fErrors.Text)
       Self.RzMemoLog.Lines.Append('停止服务器出现错误：' + #13 + #13 + fErrors.Text)
    else
       //ShowMessage('服务器停止成功！');
       Self.RzMemoLog.Lines.Append('服务器停止成功！');
end;

procedure TfrmMain.IdTCPServerConnect(AThread: TIdPeerThread);
begin
    try
        self.RzMemoLog.Lines.Append('客户端IP地址为：'+AThread.Connection.Socket.Binding.PeerIP+' 成功连接本服务器...');
        AThread.Connection.WriteLn('欢迎来到服务器！');
    except
        Exit;
    end;  
end;

procedure TfrmMain.IdTCPServerExecute(AThread: TIdPeerThread);
var
    nID:string;
    nName:string;
    sMsg:string;
    nMsg:string;

    uName:string;  //服务器：返回用户名称
begin
    sMsg:=AThread.Connection.ReadLn;
    self.SplitStr(sMsg);
    //学生入门
    if nCommand=Door then
    begin
       if nStr[0]<>'' then
       begin
          nID:=nStr[0];
          with self.qrySelect do
          begin
               Close;
               with SQL do
               begin
                    Clear;
                    Add('select * from USER_TABLE where ID=:sID');
               end;
               Parameters.ParamByName('sID').Value:=nID;
               Prepared;
               Open;
               if RecordCount>0 then    //存在该用户信息
               begin
                  uName:=FieldByName('NAME').Value;
                  with self.qryAdd do
                  begin
                       Close;
                       with SQL do
                       begin
                            Clear;
                            Add('select ID from DOOR_TABLE where ID=:sID and RQ=:sRQ and Flag=:sFlag');
                       end;
                       Parameters.ParamByName('sID').Value:=nID;
                       Parameters.ParamByName('sRQ').Value:=Date;
                       Parameters.ParamByName('sFlag').Value:=1;
                       Prepared;
                       Open;
                       if RecordCount>0 then  //如果已经入门，那么执行出门
                       begin
                          Close;
                          with SQL do         //1:未出门  2：已出门
                          begin
                               Clear;
                               Add('Update DOOR_TABLE set OUTTIME=:oTime , FLAG=:nFlag where ID=:sID and RQ=:sRQ');
                          end;
                          Parameters.ParamByName('oTime').Value   :=Time;
                          Parameters.ParamByName('nFlag').Value   :=2;
                          Parameters.ParamByName('sID').Value     :=nID;
                          Parameters.ParamByName('sRQ').Value     :=Date;
                          Prepared;
                          ExecSQL;
                          sMsg:=uName+'%YW%';
                          sMsg:=self.ConcatStr(GetDataSuccessOut,sMsg);
                          AThread.Connection.WriteLn(sMsg);
                          self.RzMemoLog.Lines.Append('向客户端发送数据:  '+sMsg+'  成功');
                       end
                       else                   //如果尚未入门，那么执行入门
                       begin
                          Close;
                          with SQL do       //1:未出门  2：已出门
                          begin
                               Clear;
                               Add('Insert into DOOR_TABLE values(:sRQ,:sID,:sINTIME,:sOUTTIME,:sFLAG)');