繼續上一節
//服務端
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.