untservermain.pas

车辆管理系统

unit untServerMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Base_S, ActnList, Menus, StdCtrls, ExtCtrls, Grids, DBGrids,
  ScktComp, Registry, DB;

type
  TfrmServerMain = class(TfrmBase_S)
    PnlButtom: TPanel;
    GroupBox1: TGroupBox;
    ServerMMenu: TMainMenu;
    ServerAList: TActionList;
    acLoginIn: TAction;
    acLoginOut: TAction;
    acDisSelect: TAction;
    acDisAll: TAction;
    acExit: TAction;
    acChangePwd: TAction;
    acLinkSetting: TAction;
    acSendMessage: TAction;
    acReceiptMessage: TAction;
    System1: TMenuItem;
    acLoginIn1: TMenuItem;
    LoginOut1: TMenuItem;
    N1: TMenuItem;
    DisSelect1: TMenuItem;
    DisAll1: TMenuItem;
    N2: TMenuItem;
    LinkSetting1: TMenuItem;
    Message1: TMenuItem;
    SendMessage1: TMenuItem;
    ReceiptMessage1: TMenuItem;
    Security1: TMenuItem;
    ChangePwd1: TMenuItem;
    Exit1: TMenuItem;
    ClientGrid: TDBGrid;
    Label1: TLabel;
    Label2: TLabel;
    LblUsername: TLabel;
    SSKServer: TServerSocket;
    N3: TMenuItem;
    DsStatus: TDataSource;
    Label3: TLabel;
    lbloperatestatus: TLabel;
    Label4: TLabel;
    lbltablename: TLabel;
    Label6: TLabel;
    lblopeartecontents: TLabel;
    Lctotal: TLabel;
    acTableField: TAction;
    N4: TMenuItem;
    acTableField1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure acLinkSettingExecute(Sender: TObject);
    procedure acExitExecute(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure acDisSelectExecute(Sender: TObject);
    procedure acDisAllExecute(Sender: TObject);
    procedure acLoginInExecute(Sender: TObject);
    procedure acLoginOutExecute(Sender: TObject);
    procedure acChangePwdExecute(Sender: TObject);
    procedure acSendMessageExecute(Sender: TObject);
    procedure acReceiptMessageExecute(Sender: TObject);
    procedure SSKServerClientError(Sender: TObject;
      Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
      var ErrorCode: Integer);
    procedure SSKServerClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure acTableFieldExecute(Sender: TObject);
  private
    bSendError: Boolean;
    procedure writeRegist;
    procedure CheckMasterData;
    procedure disconnectall;
    procedure disconnect;
    procedure Disablefunction;
    procedure Enabledfunction;
    procedure RefreshStatus;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmServerMain: TfrmServerMain;

implementation

uses untADOLinkSetting, untDmServer, untConsts, untAdminLogin,
  untChangePwd, untSendMessage, untReceiptMessage, ComServ, untTableField;

{$R *.dfm}

procedure TfrmServerMain.FormCreate(Sender: TObject);
begin
  inherited;
  if not Assigned(DmServer) then
    DmServer:=TDmServer.Create(Application);
  if BADOconnection then
    begin
      SSKServer.Open;
      writeRegist;
      CheckMasterData;
      RefreshStatus;
    end
    else
    begin
      application.MessageBox('Ado Link Error , Please connection ADMIN !','Error',MB_ok+MB_iconError);
      Exit;
    end;
end;

procedure TfrmServerMain.writeRegist;
var
  registryini:Treginifile;
begin
  try
    registryini:=Treginifile.Create('');
    with registryini do
      begin
        Rootkey:=HKEY_CLASSES_ROOT;
        if keyExists('CLSID\{C3E65EEF-9C13-436C-AA24-C2E1BAF783D7}') then
          begin
            openkey('CLSID',true);
            writeString('{C3E65EEF-9C13-436C-AA24-C2E1BAF783D7}','Sockets','1');
          end;
      end;
  finally
    registryini.CloseKey;
    registryini.Destroy;
  end;
end;

procedure TfrmServerMain.acLinkSettingExecute(Sender: TObject);
begin
  inherited;
  if not Assigned(frmAdoLinkSetting) then
    frmAdoLinkSetting:=TfrmAdoLinkSetting.Create(Application);
    frmAdoLinkSetting.ShowModal;
end;

procedure TfrmServerMain.CheckMasterData;
begin
  if BADOconnection then
    begin
      with DmServer.DMasterDB do
        begin
          close;
          CommandText:='';
          CommandText:='select * from master..sysobjects where name = '+'''erpdb''';
          Open;
        end;
        if DmServer.DMasterDB.RecordCount = 0 then
          begin
            with DmServer.QMasterDB do
              begin
                close;
                sql.Clear;
                sql.Text:='CREATE TABLE erpdb(fid int IDENTITY(1,1) NOT NULL ,AccName nvarchar(42),DBname nvarchar(30),Remark nvarchar(68))';
                Execsql;
              end;
          end;

      with DmServer.DMasterDB do
        begin
          close;
          CommandText:='';
          CommandText:='select * from master..sysobjects where name = '+'''CState''';
          Open;
        end;
        if DmServer.DMasterDB.RecordCount = 0 then
          begin
            with DmServer.QMasterDB do
              begin
                close;
                sql.Clear;
                sql.Text:='Create table cstate(IIp nvarchar(38),IUser nvarchar(26),IPort nvarchar(20),IinTime Datetime)';
                Execsql;
              end;
          end;

      with DmServer.DMasterDB do
        begin
          close;
          CommandText:='';
          CommandText:='select * from master..sysobjects where name = '+'''Adminlogin''';
          Open;
        end;
        if DmServer.DMasterDB.RecordCount = 0 then
          begin
            with DmServer.QMasterDB do
              begin
                close;
                sql.Clear;
                sql.Text:='Create table adminlogin(Usercode nvarchar(20),Password nvarchar(20))';
                Execsql;
              end;
          end;

      with DmServer.DMasterDB do
        begin
          close;
          CommandText:='';
          CommandText:='select * from master..adminlogin where usercode = '+'''Admin''';
          Open;
        end;
        if DmServer.DMasterDB.RecordCount = 0 then
          begin
            with DmServer.QMasterDB do
              begin
                close;
                sql.Clear;
                sql.Text:='insert into adminlogin(Usercode,Password) values('+'''Admin'''+','+'''888888'''+')';
                Execsql;
              end;
          end;
    end;
end;

procedure TfrmServerMain.acExitExecute(Sender: TObject);
begin
  inherited;
  Close;
end;

procedure TfrmServerMain.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  inherited;
  frmServerMain:=nil;
end;

procedure TfrmServerMain.FormShow(Sender: TObject);
begin
  inherited;
  if BADOconnection then
    begin
      with DmServer.Qstatus do
        begin
          close;
          sql.Clear;
          sql.Text:='Select * from Master..Cstate';
          open;
        end;
      with DmServer.Qstatus do
        begin
          first;
          While not eof do
            begin
              Delete;
              Next;
            end;
        end;
    end;
  Enabledfunction;
end;

procedure TfrmServerMain.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  inherited;
  ComServer.UIInteractive:=False; 
  if Not dmServer.AdoConMain.Connected then
    exit;

  if dmServer.Qstatus.RecordCount > 0 then
    begin
      if MessageDlg('If you exit , Client will can not Run !',mtConfirmation, [mbok, mbcancel], 0) = mrcancel then
        canclose := false
      else
        disconnectall();
    end
    else
    begin
      if MessageDlg('Are you sure exit Server ? ', mtConfirmation, [mbok, mbcancel], 0) = mrcancel then
        canclose := False;
    end;
end;

procedure TfrmServerMain.disconnect;
var
  I: Integer;
begin
  i := TStringGrid(ClientGrid).Row;
  try
    SSKServer.Socket.Connections[i - 1].SendText(c_Disconnect);
    SSKServer.Socket.Connections[i - 1].Close;
    dmServer.Qstatus.Delete;
  except
  end;
  with dmServer.Qstatus do
     if Active then Requery Else Open;
end;

procedure TfrmServerMain.disconnectall;
var
  h: Integer;
begin
  if dmServer.Qstatus.RecordCount > 0 then
  begin
    for h := 0 to dmServer.Qstatus.RecordCount - 1 do
    begin
      try
        SSKServer.Socket.Connections[h].SendText(c_Disconnect);
        SSKServer.Socket.Connections[h].Close;

        dmServer.Qstatus.Delete;
      except
      end;
    end;

    with dmServer.Qstatus do
      if Active then Requery else Open;
  end;
end;

procedure TfrmServerMain.acDisSelectExecute(Sender: TObject);
begin
  inherited;
  if MessageDlg('Are you sure discon current user?', mtConfirmation, [mbyes, mbNo], 0) = mryes then
    disconnect();
  if dmServer.Qstatus.Fields[1].AsString = '' then
  begin
    acDisSelect.Enabled := false;
    acDisall.Enabled := false;
    acsendmessage.Enabled := false;
    acreceiptmessage.Enabled := false;
  end;
end;

procedure TfrmServerMain.acDisAllExecute(Sender: TObject);
begin
  inherited;
  if MessageDlg('Are you sure discon all user?', mtConfirmation, [mbyes, mbNo], 0) = mryes then
    disconnectall();

  if dmServer.Qstatus.Fields[1].AsString = '' then
  begin
    acDisSelect.Enabled := false;
    acDisall.Enabled := false;
    acsendmessage.Enabled := false;
    acreceiptmessage.Enabled := false;
  end;
end;

procedure TfrmServerMain.Disablefunction;
begin
  acLoginIn.Enabled:=False;
  acLoginOut.Enabled:=True;
  acChangePwd.Enabled:=True;
  acReceiptMessage.Enabled:=True;
  acTableField.Enabled:=True;  
  if dmServer.Qstatus.Fields[1].AsString<>'' then
    begin
      acDisSelect.Enabled:=True;
      acDisAll.Enabled:=True;
      acSendMessage.Enabled:=True;
    end
    else
    begin
      acDisSelect.Enabled:=False;
      acDisAll.Enabled:=False;
      acSendMessage.Enabled:=False;
    end;
end;

procedure TfrmServerMain.Enabledfunction;
begin
  acLoginIn.Enabled:=True;
  acLoginOut.Enabled:=False;
  acDisSelect.Enabled:=False;
  acDisAll.Enabled:=False;
  acChangePwd.Enabled:=False;
  acSendMessage.Enabled:=False;
  acReceiptMessage.Enabled:=False;
  acTableField.Enabled:=False;
end;

procedure TfrmServerMain.acLoginInExecute(Sender: TObject);
begin
  inherited;
  if not BADOconnection then Exit;

  if not assigned(frmAdminLogin) then
    frmAdminLogin := TfrmAdminLogin.Create(self);
  if frmAdminLogin.showmodal = mrOk then
  begin
    Disablefunction;
  end;
end;

procedure TfrmServerMain.acLoginOutExecute(Sender: TObject);
begin
  inherited;
  if MessageDlg('Are you sure loginOut?', mtConfirmation, [mbyes, mbNo], 0) = mryes then
  begin
    Enabledfunction;
  end;
end;

procedure TfrmServerMain.acChangePwdExecute(Sender: TObject);
begin
  inherited;
  if not assigned(frmChangepwd) then
    frmchangepwd:=Tfrmchangepwd.Create(application);
    frmchangepwd.showModal;  
end;

procedure TfrmServerMain.acSendMessageExecute(Sender: TObject);
begin
  inherited;
  bSendError:=True;
  if not assigned(frmsendmessage) then
    frmSendMessage:=Tfrmsendmessage.Create(Application);
    frmsendmessage.ShowModal;
  bsenderror:=False;
end;

procedure TfrmServerMain.acReceiptMessageExecute(Sender: TObject);
begin
  inherited;
  if not assigned(frmReceiptMessage) then
    frmReceiptMessage:=TfrmReceiptMessage.Create(application);
    frmReceiptMessage.ShowModal;
end;

procedure TfrmServerMain.SSKServerClientError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
  inherited;
  case errorevent of
    eeconnect:
      MessageDlg('Connect Error!', mtError, [mbOk], 0);
    eeSend:
      if bSendError then MessageDlg('Send MSG Error!', mtError, [mbOk], 0);
    eeReceive:
      MessageDlg('Receive Error!', mtError, [mbOk], 0);
    eeLookup:
      MessageDlg('Lookup Error!', mtError, [mbOk], 0);
  end;
  ErrorCode := 0;
end;

procedure TfrmServerMain.SSKServerClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
  sMsg, sRemoteAdrress, sRemotePort, sRemoteHost: string;
  i: Integer;
  sAccountName:String;
begin
  inherited;
  i := SSKServer.Socket.ActiveConnections;
  sMsg := Trim(Socket.ReceiveText);
  sRemoteAdrress := SSKServer.Socket.Connections[i - 1].RemoteAddress;
  sRemotePort := InttoStr(SSKServer.Socket.Connections[i - 1].RemotePort);

  if Copy(sMsg, 1, 7) = c_Connect then
  begin

    sRemoteHost := Copy(sMsg, 8, Length(sMsg) - 7);

    dmServer.Qstatus.append;
    dmServer.Qstatus.fieldbyName('iIP').AsString := sRemoteAdrress;
    dmServer.Qstatus.fieldbyName('iUser').AsString := sRemoteHost;
    dmServer.Qstatus.fieldbyName('iPort').AsString := sRemoteport;
    dmServer.Qstatus.fieldbyName('iInTime').AsDateTime := now();
    dmServer.Qstatus.Post;

    if dmServer.Qstatus.Active then dmServer.Qstatus.Requery else dmServer.Qstatus.Open;
    Lctotal.Caption:=inttostr(dmServer.Qstatus.RecordCount);

  end
  else if copy(sMsg, 1, 5) = c_Close then
  begin
    with dmServer.Qstatus do
      if Locate('iIP;iPort', varArrayof([sRemoteAdrress, sRemotePort]), []) then
        Delete;
      Lctotal.Caption:=inttostr(dmServer.Qstatus.RecordCount);
  end
  else if copy(sMsg, 1, 3) = c_msg then
  begin
    if not assigned(frmreceiptmessage) then
      frmreceiptmessage:=Tfrmreceiptmessage.Create(application);

    frmreceiptmessage.Memo1.Lines.Add('New MSG:' + formatDatetime('yyyy-mm-dd hh:mm:ss', Now()));
    frmreceiptmessage.Memo1.Lines.Add(copy(sMsg, 4, Length(sMsg)-3));
    frmreceiptmessage.Memo1.Lines.Add('-------------------------');
    frmreceiptmessage.Memo1.Lines.Add(' ');
  end
end;

procedure TfrmServerMain.RefreshStatus;
begin
  with DmServer.Qstatus do
    begin
      Close;
      sql.Clear;
      sql.Add('Select * from Master..Cstate');
      Open;
  end;
end;

procedure TfrmServerMain.acTableFieldExecute(Sender: TObject);
begin
  inherited;
  if not BADOconnection then Exit;
  if not assigned(frmTableField) then
    frmTableField:=TfrmTableField.Create(Application);
    frmTableField.showModal;
end;

end.