DELPHI XE 10.3 三層數據庫應用 嚐鮮 之三 關閉連接等 成品了

繼續上一節

//服務端

unit uServerdm;

interface

uses
  System.SysUtils, System.Classes, System.Win.ScktComp;

type
  TdmServer = class(TDataModule)
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  dmServer: TdmServer;
  sLanConStr, sRemoteConStr: string;
  sUserPWD: string;
  iUserID: Integer;
implementation

{%CLASSGROUP 'Vcl.Controls.TControl'}

{$R *.dfm}

end.


unit Userver;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Data.DB, System.ImageList, Vcl.ImgList,
  System.Actions, Vcl.ActnList, Vcl.Menus, Vcl.Grids, Vcl.DBGrids,
  System.Win.ScktComp, Vcl.StdCtrls;

type
  TForm2 = class(TForm)
    MainMenu1: TMainMenu;
    ActionList1: TActionList;
    OpenDialog1: TOpenDialog;
    ImageList1: TImageList;
    SSKServer: TServerSocket;
    MEMO1: TMemo;
    DBGServer: TDBGrid;
    DBGaccount: TDBGrid;
    procedure SSKServerClientRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure disconnectall();
    procedure disconnect();
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}

uses uServerdm;

{CREATE TABLE [dbo].[TState](
    [lID] [int] IDENTITY(1,1) NOT NULL,
    [lIp] [nvarchar](50) NOT NULL,
    [lUser] [nvarchar](50) NOT NULL,
    [lPort] [int] NOT NULL,
    [lIntime] [datetime] NOT NULL,
    [lOuttime] [datetime] NULL,
    [lOperateName] [nvarchar](50) NULL,
    [lAccountName] [nvarchar](50) NULL,
 CONSTRAINT [PK_tstate] PRIMARY KEY CLUSTERED
(
    [lID] ASC
)WITH (PAD_INDEX  = OFF, STATISTICS_NORECOMPUTE  = OFF, IGNORE_DUP_KEY = OFF, ALLOW_ROW_LOCKS  = ON, ALLOW_PAGE_LOCKS  = ON) ON [PRIMARY]
) ON [PRIMARY]
}

//   //服務端主動關閉所有的連接,併發送關閉連接信息到客戶端,客戶端 SCKClientRead中處理該信息
procedure TForm2.disconnectall();
var
  h: Integer;
begin
//  if dmServer.tbState.RecordCount > 0 then
//  begin
//    for h := 0 to dmServer.tbState.RecordCount - 1 do
//    begin
//      try
//        SSKServer.Socket.Connections[h].SendText(c_Disconnect);    // <<<<<<<-------- 客戶端 SCKClientRead中處理該信息
//        SSKServer.Socket.Connections[h].Close;
//
//        dmServer.tbState.Delete;
//      except
//      end;
//    end;
//
//    with dmServer.tbState do
//      if Active then Requery else Open;
//
//    with dmServer.QAccountUsing do
//      if Active then Requery else Open;
//  end;
end;

   //服務端主動關閉所選擇的連接,併發送關閉連接信息到客戶端,客戶端 SCKClientRead中處理該信息
procedure TForm2.disconnect();
var
  I: Integer;
begin
  i := TStringGrid(DBGServer).Row;
  try
    SSKServer.Socket.Connections[i - 1].SendText('c_Disconnect');//// <<<<<<<-------- 客戶端 SCKClientRead中處理該信息
    SSKServer.Socket.Connections[i - 1].Close;

   // dmServer.tbState.Delete;
  except
  end;
  //with dmServer.tbState do
  //   if Active then Requery Else Open;

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

 //------>在ClientRead中可取得客戶端活動ID,IP,PORT,以及其它信息
procedure TForm2.SSKServerClientRead(Sender: TObject; Socket: TCustomWinSocket);
var
 smsg,sRemoteaddress,sRemotePort,sRemoteHost:string;
 i:integer;//取得活動ID
begin
//SCKClient.Socket.Sendtext(c_Connect+G_sSpace+sHost);
//c_Connect+G_sSpace+sHost    G_sSpace:=c_Lan  或  G_sSpace:=c_Remote;}
 smsg:= TRIM(Socket.ReceiveText);
 I:=SSKServer.Socket.ActiveConnections;
 sRemoteaddress:=SSKServer.Socket.Connections[I-1].RemoteAddress;
 sRemoteHost:=SSKSERVER.Socket.Connections[I-1].RemoteHost;
 sRemotePort:=SSKSERVER.Socket.Connections[I-1].RemotePort.TOSTRING;

memo1.lines.add(smsg);
memo1.lines.add(sRemoteaddress);
memo1.lines.add(sRemoteHost);
memo1.lines.add(sRemotePort);


if copy(smsg,1,7)='c_Connect' then
  begin
   if copy(smsg,8,3)='c_Lan' then
      SSKServer.Socket.Connections[I-1].SendText('Connect_C'+'Lan_0k')
   else if copy(sMSG,8,3)='c_Remote' then
      SSKServer.Socket.Connections[I-1].SendText('Connect_C'+'Remote_0k')   ;
   sRemoteHost:= COPY(sMsg,11,length(sMSG)-10);
     //收到客戶機信息後回短信並把客戶訪問信息添加到DBGRID中。
  end
  else if copy(smsg,1,5)='c_close' then  //如果收到客戶端的關閉窗口消息
  begin
      //從 dbgrid和表中刪除該條記錄。--->locate('lip,lport',varArrayOf([sRemoteAdrress, sRemotePort],[]))
  end;

end;

end.

//客戶端

 

unit uCLIENTDM;

interface

uses
  System.SysUtils, System.Classes, System.Win.ScktComp,Vcl.Dialogs,Inifiles,System.UITypes;

type
  Tdmclient = class(TDataModule)
    SCKClient: TClientSocket;
    procedure SCKClientConnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure SCKClientError(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure DataModuleCreate(Sender: TObject);
    procedure SCKClientRead(Sender: TObject; Socket: TCustomWinSocket);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 const
  c_ScreenWidth = 800;
  c_ScreenHeight = 600;
   {通信消息標識}
  c_Msg = 'MSG';
  c_Connect = 'Connect';
  c_Close = 'Close';
  c_DisConnect = 'Disconnect';
  c_OpenAccount = 'OpenAccount';
   {局域,遠程標識}
  c_Lan = 'Lan';
  c_Remote = 'Rem';
   {權限Check表示符}
  c_Check = '+';
  c_UnCheck = '-';
   {用於樹型結構}
  C_CharArray = 'ABCDEFGH';
   {星期數組}
  sWeek: array[1..7] of string = ('日', '一', '二', '叄', '四', '五', '六');
var
  dmclient: Tdmclient;
  G_iUserID, G_iDepID: integer; {用戶內部ID,所屬部門內部ID}
  G_sUserCode, G_sUserName, G_sDepName: string; {用戶代碼,用戶名,所屬部門名}
  G_bAdmin, G_bTakeEffect: Boolean; {是否超級用戶,帳套是否啓用}
  G_iAccountID: integer; {當前打開的帳套ID}
  G_sPWD: string; {用戶密碼}
  G_sSpace: string; {局域網/遠程}
  G_bAppEnabled: Boolean; {程序是否可使用}
implementation

{%CLASSGROUP 'Vcl.Controls.TControl'}

{$R *.dfm}

procedure Tdmclient.DataModuleCreate(Sender: TObject);
var

// sProvider,sPassWord,sPSI,sUserID:String;
 sFileName,sServer,sIsRemote:string;
 MyIniFile:TInifile;
begin
     //內容自己整。firedac數據庫訪問技術沒有ADO複雜!
    Try
          sFileName:=ExtractFilePath(paramstr(0))+'Client.ini';
          MyIniFile:=TIniFile.Create(sFileName);
          sServer:=MyIniFile.ReadString('Client','ServerAddress','127.0.0.1');
          sIsRemote:=MyIniFile.ReadString('Client','IsRemote','False');
    finally
           MyIniFile.Free ;
    end;

if Trim(sIsRemote)='False' then
   G_sSpace:=c_Lan
   else
   G_sSpace:=c_Remote;

SCKClient.Address:=sServer;
SCKClient.Open ;
end;

procedure Tdmclient.SCKClientConnect(Sender: TObject; Socket: TCustomWinSocket);
var
shost:string;
begin
  //Socket.SendText('您好') ;
 shost:=socket.LocalHost;
 SCKClient.Socket.Sendtext(c_Connect+G_sSpace+sHost); //發送信息到服務器,服務器收到信息後會返回 信息
end;

procedure Tdmclient.SCKClientError(Sender: TObject; Socket: TCustomWinSocket;
  ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
//TErrorEvent = (eeGeneral, eeSend, eeReceive, eeConnect, eeDisconnect, eeAccept, eeLookup);
   case errorevent of
     eeconnect:
         begin
         MessageDlg('連接服務端失敗!'+#13#10+'請確定服務器端是否打開或網絡是否暢通!',mtError,[mbOk],0);
         end;
     eeSend:
        MessageDlg('發送消息失敗!',mtError,[mbOk],0);
     eeReceive:
        MessageDlg('接收消息失敗!',mtError,[mbOk],0);
     eeDisconnect:
        MessageDlg('斷開連接失敗!',mtError,[mbOk],0);
     eeLookup:
        MessageDlg('查找失敗!',mtError,[mbOk],0);
end;
Errorcode:=0;

end;

procedure Tdmclient.SCKClientRead(Sender: TObject; Socket: TCustomWinSocket);
var
str,con:string;
begin
   str:=SCKClient.Socket.ReceiveText;
   if copy(str,1,8)='Connect_C' then
   begin
     //開始讀硬盤上的配置文件,並連接CONNECTION
   end
   else  if str='c_Disconnect' then
   begin
   //接收到服務端disconnect()、disconnect(All) 信息後
   //關閉連接。
   end;

end;

end.


unit UClient;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs;

type
  TFrmCLIENT = class(TForm)
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FrmCLIENT: TFrmCLIENT;

implementation

{$R *.dfm}

uses uCLIENTDM;

procedure TFrmCLIENT.FormClose(Sender: TObject; var Action: TCloseAction);
begin
      if   dmclient.SCKClient.Socket.Connected then
    begin
    dmClient.SCKClient.Socket.Sendtext('c_Close');
//    dmClient.adocnClothingSys.Connected:=false;
//    dmClient.adocnClothing.Connected:=false;
    end;
end;

end.

發表評論
所有評論
還沒有人評論,想成為第一個評論的人麼? 請在上方評論欄輸入並且點擊發布.
相關文章