正文 

当前位置： 首页 > java > java教程

diocp之demo-登陆验证设计

author author     2022-08-02     245

关键词：

ECHOServer代码（不考虑粘包的处理）：

unit ufrmMain;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ActnList, diocp_tcp_server, ExtCtrls,
ComCtrls, utils_safeLogger, utils_BufferPool, utils_fileWriter, System.Actions, ComObj;

type
TfrmMain = class(TForm)
edtPort: TEdit;
btnOpen: TButton;
actlstMain: TActionList;
actOpen: TAction;
actStop: TAction;
btnDisconectAll: TButton;
pgcMain: TPageControl;
TabSheet1: TTabSheet;
tsLog: TTabSheet;
mmoLog: TMemo;
pnlMonitor: TPanel;
btnGetWorkerState: TButton;
btnFindContext: TButton;
pnlTop: TPanel;
btnPostWSAClose: TButton;
btnReOpenTest: TButton;
tmrKickOut: TTimer;
tmrTest: TTimer;
tmrInfo: TTimer;
chkLogDetails: TCheckBox;
tsOperator: TTabSheet;
mmoPushData: TMemo;
btnPushToAll: TButton;
actPushToAll: TAction;
btnPoolInfo: TButton;
edtThread: TEdit;
chkEcho: TCheckBox;
chkShowInMemo: TCheckBox;
chkSaveToFile: TCheckBox;
chkUseContextPool: TCheckBox;
chkUseBufferPool: TCheckBox;
mmo1: TMemo;
btn1: TButton;
mmo2: TMemo;
procedure actOpenExecute(Sender: TObject);
procedure actPushToAllExecute(Sender: TObject);
procedure actStopExecute(Sender: TObject);
procedure btnDisconectAllClick(Sender: TObject);
procedure btnFindContextClick(Sender: TObject);
procedure btnGetWorkerStateClick(Sender: TObject);
procedure btnPoolInfoClick(Sender: TObject);
procedure btnPostWSACloseClick(Sender: TObject);
procedure btnReOpenTestClick(Sender: TObject);
procedure chkEchoClick(Sender: TObject);
procedure chkLogDetailsClick(Sender: TObject);
procedure chkSaveToFileClick(Sender: TObject);
procedure chkShowInMemoClick(Sender: TObject);
procedure chkUseBufferPoolClick(Sender: TObject);
procedure tmrInfoTimer(Sender: TObject);
procedure tmrKickOutTimer(Sender: TObject);
procedure tmrTestTimer(Sender: TObject);
procedure btn1Click(Sender: TObject);
private
//iCounter:Integer;
FChkUseBufferPool:Boolean;
FChkEcho:Boolean;
FChkShowInMemo:Boolean;
FChkSaveToFile:Boolean;
FTcpServer: TDiocpTcpServer;
FPool:PBufferPool;
procedure ReadState;
procedure RefreshState;
procedure OnRecvBuffer(pvClientContext:TIocpClientContext; buf:Pointer;
len:cardinal; errCode:Integer);

procedure OnSendBufferCompleted(pvContext: TIocpClientContext; pvBuff: Pointer;
len: Cardinal; pvBufferTag, pvErrorCode: Integer);

procedure OnAccept(pvSocket: THandle; pvAddr: String; pvPort: Integer; var
vAllowAccept: Boolean);
procedure OnDisconnected(pvClientContext: TIocpClientContext);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
{ Public declarations }
end;

var
frmMain: TfrmMain;
LoginGUID:TStringList;
implementation

uses
uFMMonitor, diocp_core_engine, diocp_core_rawWinSocket,StrUtils;

{$R *.dfm}

constructor TfrmMain.Create(AOwner: TComponent);
begin
inherited Create(AOwner);

sfLogger.setAppender(TStringsAppender.Create(mmoLog.Lines));
sfLogger.AppendInMainThread := true;

FTcpServer := TDiocpTcpServer.Create(Self);
FTcpServer.Name := ‘iocpSVR‘;
FTcpServer.OnDataReceived := self.OnRecvBuffer;
FTcpServer.OnContextAccept := OnAccept;
FTcpServer.createDataMonitor;
FTcpServer.OnSendBufferCompleted := OnSendBufferCompleted;
FTcpServer.OnContextDisconnected := OnDisconnected;
FPool := NewBufferPool(FTcpServer.WSARecvBufferSize);
TFMMonitor.createAsChild(pnlMonitor, FTcpServer);
ReadState;

LoginGUID:=TStringList.Create;
end;

destructor TfrmMain.Destroy;
begin
FTcpServer.SafeStop;
FreeBufferPool(FPool);
FTcpServer.Free;
LoginGUID.Free;
inherited Destroy;
end;

procedure TfrmMain.RefreshState;
begin
if FTcpServer.Active then
begin
btnOpen.Action := actStop;

end else
begin
LoginGUID.Clear;
btnOpen.Action := actOpen;
end;
chkUseContextPool.Enabled := not FTcpServer.Active;
edtPort.Enabled := not FTcpServer.Active;
edtThread.Enabled := not FTcpServer.Active;
end;

procedure TfrmMain.actOpenExecute(Sender: TObject);
begin
FTcpServer.WorkerCount := StrToInt(edtThread.Text);
FTcpServer.Port := StrToInt(edtPort.Text);
FTcpServer.OnDataReceived := self.OnRecvBuffer;
FTcpServer.UseObjectPool := chkUseContextPool.Checked;
FTcpServer.Active := true;
RefreshState;
end;

procedure TfrmMain.actPushToAllExecute(Sender: TObject);
var
ansiStr:AnsiString;
var
lvList:TList;
i:Integer;
lvContext:TIocpClientContext;
begin
ansiStr := mmoPushData.Lines.Text;
lvList := TList.Create;
try
FTcpServer.getOnlineContextList(lvList);
for i:=0 to lvList.Count -1 do
begin
lvContext := TIocpClientContext(lvList[i]);
lvContext.PostWSASendRequest(PAnsiChar(ansiStr), Length(ansiStr));
end;
finally
lvList.Free;
end;
end;

procedure TfrmMain.actStopExecute(Sender: TObject);
begin
FTcpServer.DisconnectAll;
FTcpServer.SafeStop;
RefreshState;
end;

procedure TfrmMain.btn1Click(Sender: TObject);
begin
mmo2.Text:=LoginGUID.Text;
end;

procedure TfrmMain.btnDisconectAllClick(Sender: TObject);
begin
FTcpServer.DisConnectAll();
end;

procedure TfrmMain.btnFindContextClick(Sender: TObject);
var
lvList:TList;
i:Integer;
begin
lvList := TList.Create;
try
FTcpServer.getOnlineContextList(lvList);
for i:=0 to lvList.Count -1 do
begin
FTcpServer.findContext(TIocpClientContext(lvList[i]).SocketHandle);
end;
finally
lvList.Free;
end;

end;

procedure TfrmMain.btnGetWorkerStateClick(Sender: TObject);
begin
ShowMessage(FTcpServer.IocpEngine.getWorkerStateInfo(0));
end;

procedure TfrmMain.btnPoolInfoClick(Sender: TObject);
var
s:string;
r:Integer;
begin
if FPool = nil then Exit;
s :=Format(‘get:%d, put:%d, addRef:%d, releaseRef:%d, size:%d‘,
[FPool.FGet, FPool.FPut, FPool.FAddRef, FPool.FReleaseRef, FPool.FSize]);
r := CheckBufferBounds(FPool);
s := s + sLineBreak + Format(‘池中共有:%d个内存块, 可能[%d]个内存块写入越界的情况‘, [FPool.FSize, r]);
ShowMessage(s);
end;

procedure TfrmMain.btnPostWSACloseClick(Sender: TObject);
var
lvList:TList;
i:Integer;
begin
lvList := TList.Create;
try
FTcpServer.getOnlineContextList(lvList);
for i:=0 to lvList.Count -1 do
begin
TIocpClientContext(lvList[i]).PostWSACloseRequest();
end;
finally
lvList.Free;
end;

end;

procedure TfrmMain.btnReOpenTestClick(Sender: TObject);
begin
FTcpServer.logMessage(‘DoHeartBeatChcek‘, ‘DEBUG‘, lgvDebug);
tmrTest.Enabled := not tmrTest.Enabled;
end;

 

procedure TfrmMain.chkLogDetailsClick(Sender: TObject);
begin
if chkLogDetails.Checked then
begin
FTcpServer.Logger.LogFilter := LogAllLevels;
end else
begin
FTcpServer.Logger.LogFilter := [lgvError]; // 只记录致命错误
end;
end;

procedure TfrmMain.chkEchoClick(Sender: TObject);
begin
ReadState;
end;

procedure TfrmMain.chkSaveToFileClick(Sender: TObject);
begin
ReadState;
end;

procedure TfrmMain.chkShowInMemoClick(Sender: TObject);
begin
ReadState;
end;

procedure TfrmMain.chkUseBufferPoolClick(Sender: TObject);
begin
ReadState;
end;

procedure TfrmMain.OnAccept(pvSocket: THandle; pvAddr: String; pvPort: Integer;
var vAllowAccept: Boolean);
begin
mmo1.Lines.Add(pvAddr+‘:‘+inttostr(pvPort));
// if pvAddr = ‘127.0.0.1‘ then
// vAllowAccept := false;

end;

procedure TfrmMain.OnDisconnected(pvClientContext: TIocpClientContext);
begin
if pvClientContext.Data <> nil then
begin
TObject(pvClientContext.Data).Free;
pvClientContext.Data := nil;
end;
end;

procedure TfrmMain.OnRecvBuffer(pvClientContext:TIocpClientContext;
buf:Pointer; len:cardinal; errCode:Integer);
var
j:Integer;
s:AnsiString;
lvBuff:PByte;
lvFileWriter:TSingleFileWriter;
sGUID:string;
PostGUID:string;
begin
if FChkShowInMemo then
begin
sGUID := CreateClassID;
// 如果客户端发送的为字符串，可以用下面代码进行显示
SetLength(s, len);
Move(buf^, s[1], len);
sfLogger.logMessage(s);
if Pos(‘GUID‘,s)>0 then
begin
PostGUID:=midstr(s,6,38);
if LoginGUID.IndexOf(PostGUID)<>-1 then

begin

pvClientContext.PostWSASendRequest( PAnsiChar(‘Success;GUID=‘+AnsiString(PostGUID)), Length(‘Success;GUID=‘+AnsiString(PostGUID)));

//这里可写其它的业务处理代码，就是一次交互数据等，客户端每次与服务器交互时都带上服务器分配的GUID做为身份名牌

end


else
pvClientContext.PostWSASendRequest(PAnsiChar(‘Eerror‘), Length(‘Eerror‘));
end
else
if s=‘stu=admin&pwd=admin123‘ then
begin
LoginGUID.Sorted:=True;
LoginGUID.Duplicates := dupIgnore;
LoginGUID.Add(sGUID);
pvClientContext.PostWSASendRequest( PAnsiChar(‘Success;GUID=‘+AnsiString(sGUID)), Length(‘Success;GUID=‘+AnsiString(sGUID)));

end
else
begin
pvClientContext.PostWSASendRequest(PAnsiChar(‘Eerror‘), Length(‘Eerror‘));
pvClientContext.DoDisconnect;
end;


end;
if FChkEcho then
begin
if FChkUseBufferPool then
begin

lvBuff := GetBuffer(FPool);

Move(buf^, lvBuff^, len);

//
AddRef(lvBuff);


pvClientContext.PostWSASendRequest(lvBuff, len, dtNone, 1);
end else
begin
pvClientContext.PostWSASendRequest(buf, len);
end;
end;

if FChkShowInMemo then
begin
lvFileWriter := TSingleFileWriter(pvClientContext.Data);
if lvFileWriter = nil then
begin
lvFileWriter := TSingleFileWriter.Create;
pvClientContext.Data := lvFileWriter;
lvFileWriter.FilePreFix := Format(‘RECV_%d‘, [pvClientContext.SocketHandle]);
lvFileWriter.FilePerSize := 1024 * 1024 * 100;
end;

lvFileWriter.WriteBuffer(buf, len);
end;
end;

procedure TfrmMain.OnSendBufferCompleted(pvContext: TIocpClientContext; pvBuff:
Pointer; len: Cardinal; pvBufferTag, pvErrorCode: Integer);
begin
if pvBufferTag = 1 then
ReleaseRef(pvBuff);
end;

procedure TfrmMain.ReadState;
begin
FChkEcho := chkEcho.Checked;
FChkShowInMemo := chkShowInMemo.Checked;
FChkUseBufferPool := chkUseBufferPool.Checked;
FChkSaveToFile := chkSaveToFile.Checked;
end;

procedure TfrmMain.tmrInfoTimer(Sender: TObject);
begin
self.Caption := Format(‘DIOCP 测试:%d, %d‘, [__DebugWSACreateCounter, __DebugWSACloseCounter]);
end;

procedure TfrmMain.tmrKickOutTimer(Sender: TObject);
begin
FTcpServer.KickOut(30000);
end;

procedure TfrmMain.tmrTestTimer(Sender: TObject);
begin
actStop.Execute;


Application.ProcessMessages;

 

actOpen.Execute;

end;

end.

 

diocp之demo学习顺序及达到要求

...解粘包的理方式，即数据类型+数据长度+数据流第四个：diocp_utils_demo，理解字符处理函数，快速编程处理字符第五个：DiocpTask，任务投递，Task多线程使用方法以上只是个人学习的历程与体会 查看详情

diocp之demo-粘包问题及解决

什么是粘包问题？举个例子：sever发送20480个Ａ字母，可是由于client一次只收到10240个A，余下的又发送一次:第一个包中包括有此数据包的总长度,读取出长度，然后接收一个对比长度，如果当前长度<包标定长度,那么就等余下包,... 查看详情

diocp之开发流程图之client

本次分析开发流程图采用的是DIOCP群里的群友[彩蛋]所给的DEMO，依然是win7的画图作品。本人分析认为：学习网络开发不同本地开发，首先你应该知道完整的开发流程即网络程序运行的先后顺序，有个整体感知，不能一头深入到代... 查看详情

diocp之数据接收事件

一、不引用编码器与解码器的情况下（ECHO的DEMO）  类TIOCPtcpclient，接收服务器的数据事件：OnRecvBuffer  类TDiocpTcpServer,接收客户端数据事件：OnRecvBuffer  TIocpTcpServer  propertyOnDataReceived:TOnDataRec 查看详情

diocp之编写第一个应用程序

构建client界面：构建界面要比写代码更难爱，不是专业UI设计太丑，先有个界面，好写代码，客户端代码与界面设计思想：界面与数据之间分离处理，不能要接收数据的地方写代码，不然以后修改程序会死人的。 查看详情

diocp之编写第一个应用程序

Server设计功能如下：  1、支持客户端登录  2、连接数据库进行操作  3、推送信息  4、限制文件上传大小第一步：创建一个VCL-FormsApplication(创建一个标准VCL程序）第二步：引用必要的单元文件：diocp_co... 查看详情

diocp之编写第一个应用程序

Client设计功能如下：  1、建立与服务器连接  2、请求连接时，加密密码，采用Base64编码  3、时时发送心跳告诉服务器在线  4、进行相关的数据处理与交互第一步：创建一个VCL-FormsApplication(创建一个... 查看详情

diocp之获取在线用户列表

通过获取tcpserver.getonlinecontextlist来得到在线列表procedureTfrmMain.btn_refreshClick(Sender:TObject);varlvList:TList;i:Integer;lvClient:TMyClientContext;lvItem:TListItem;beginlstClientINfo.Items.Clear;lvList:= 查看详情

day87-bbs项目数据库设计与简单登陆验证码(代码片段)

一、BBS项目之项目分析项目流程：1搞清楚需求（产品经理）(1)基于用户认证组件和Ajax实现登录验证(图片验证码)(2)基于forms组件和Ajax实现注册功能(3)设计系统首页（文章列表渲染）(4)设计个人站点页面---跨表查询，分组查询(5)... 查看详情

java基于token验证之登陆验证

...加深记忆。对于前后端分离的项目来说session来判断是否登陆实现比较困难，token是比较好的方式。大概流程： 1.用户登陆，若成功则后台生成一个token，并把此token返回给客户端浏览器2.客户端接收 查看详情

jenkins持续集成之activedirectory身份登陆验证

一、安装ActiveDirectory插件二、配置ActiveDirectory身份登陆验证三、使用域帐户登陆，并安装相应权限控制插件四、为自己的AD域帐户添加相应的权限此时，该域帐户已经有有了Jenkins所有权限。 查看详情

djingo之登陆验证，cookie,session(代码片段)

一：会话技术：   1:什么是会话跟踪技术：　　　　首先我们应该知道，什么是会话。当浏览器（客户端）第一次访问某个网站的时候（服务器）。该浏览器便和服务器建立了单独的会话。直到浏览器关闭或服务器断... 查看详情

系统登陆简单的密码验证

<divclass="fm-item"> <labelfor="logonId"class="form-label">EOA系统登陆：</label><inputtype="text"class="form-controldengi-text"id="username"placeholder="请输入用户名"ajaxurl="demo/valid.jsp" 查看详情

spring+mybatis之注册功能demo

...dy部分然后写JavaScript部分，需要注意的是，这主要是为了验证用户名<scripttype="text/javascript"> //验证密码是否为空 functioncheckpw 查看详情

springboot项目之卖家扫码登陆获取openid（微信身份验证id）

卖家扫码登陆获取openid注：此功能只能是微信公众帐号能够使用，个人账号无此功能。一、打开微信开放平台（与支付阶段不同，特别注意！！！），进入网站应用的网站应用微信登陆开发指南。 二、你会发现和之前支付功... 查看详情

简易oa漫谈之工作流设计（一个demo），完成6年前的一个贴子

6年前在腾讯做OA，那时写了两篇心得。https://www.cnblogs.com/wangxiaohuo/archive/2012/08/22/2650893.htmlhttps://www.cnblogs.com/wangxiaohuo/archive/2012/08/24/2653968.html 现在看看挻初浅的，还有不少人回复，说明这个东西还是有需求的。近6年来转做互... 查看详情

简单的登陆验证

新建一个QtWidgetsApplication项目，项目名为login，这便生成一个桌面图形界面项目。如下图所示，然后新加一个Qt设计师界面类，模版选择DialogwithoutButtons，命名为LoginDialog。如下图：完成后向界面拖入两个Label、两个LineEdit和两个Push... 查看详情

抽屉之tornado实战--装饰器实现用户登录状态验证(代码片段)

...，以后用到web框架都会用到，最常见的场景就是只有用户登陆了才能执行某些操作，所以在执行这些操作前要先做登陆状态的验证。　　比如：点赞，发布，评论等需要验证，都需要用到ifself.session【‘is_login’】进行判断，你... 查看详情