限制同一账户多地登录并选择强行踢人操作
2019-11-15 16:01:53来源:博客园 阅读 ()
限制同一账户多地登录并选择强行踢人操作
软件类型:CS
开发工具:Delphi
功能:限制同一账户多地登录并选择强行踢人操作。
1、 采用临时表判断当前账户是否已经登录。这里简单介绍一下临时表法,当软件第一次登录成功时,创建一个全局临时表CREATE TABLE ##UserID (ID int);其中##UserID为表名,UserID为当前用户的唯一ID。关于临时表,可以百度一下,本地临时表,全局临时表。这里创建为全局临时表。
2、 通过判断该临时表是否存在读取当前用户是否在登录的状态。
function TLoginFrm.UserLogined(AdoConn: TADOConnection; AUserID: string): Boolean; var Qry: TADOQuery; strSQL: string; begin try QryCreate(Qry,AdoConn); try strSQL := Format('SELECT OBJECT_ID(N''tempdb..##%s'', N''U'') AS TabID', [AUserID]); Qry.SQL.Text := strSQL; Qry.Open; result := not Qry.FieldByName('TabID').IsNull; finally Qry.Free; end; except Result := False; Exit; end; end;
3、 当前登录用户表增加用户在线状态字段”online”默认值为0。登录成功时,创建临时表并更新当前用户状态为1。注:0离线,1在线;
function TLoginFrm.RegUserLogined(AdoConn: TADOConnection; AUserID: string): Boolean; var Qry, QryComm: TADOQuery; strSQL: string; begin try QryCreate(Qry,AdoConn); QryCreate(QryComm, adocCommon); try strSQL := Format('CREATE TABLE ##%s(ID int); ', [AUserID]); Qry.SQL.Text := strSQL; Qry.ExecSQL; strSQL := Format('update Personnel_set set online=1 where Per_id=%S', [QuotedStr(AUserID)]); QryComm.SQL.Text := strSQL; QryComm.ExecSQL; finally Qry.Free; QryComm.Free; end; except Result := False; Exit; end; Result := True; end;
4、 点击确定按钮登录界面
//判断 当前登录用户是否已经登记 if not UserLogined(adocWMS, adoqPersonnal.FieldByName('EmployeeCode').AsString) then begin //针对 异常退出未更新人员在线状态的情况,更新人员状态为0 if GetUserOnline(adocCommon, adoqPersonnal.FieldByName('EmployeeCode').AsString) then UpdateOnline(adocCommon, adoqPersonnal.FieldByName('EmployeeCode').AsString); //创建临时表记录当前人员的登录状态 RegUserLogined(adocWMS, adoqPersonnal.FieldByName('EmployeeCode').AsString) end else begin if MessageBox(Handle, '当前用户已经在登录中, 是否强行登录?', '提示', MB_YESNO)=id_yes then begin //更新登录状态 = 0 UpdateOnline(adocCommon, adoqPersonnal.FieldByName('EmployeeCode').AsString); //设置timer事件监控人员状态为0且临时表存在的情况直接踢下线。等用户下线/ while UserLogined(adocWMS, adoqPersonnal.FieldByName('EmployeeCode').AsString) do begin // end; //重新注册 临时表。 RegUserLogined(adocWMS, adoqPersonnal.FieldByName('EmployeeCode').AsString); end else Exit; end;
5、 监控人员登录状态,人员状态为0且临时表存在的情况直接踢下线。这里涉及了一个非阻塞式的弹出提示框。
function WTSSendMessage(Server: HWND; SessionId: DWORD; Title: PChar; TitleLength: DWORD; AMessage: PChar; MessageLength: DWORD; Style: DWORD; Timeout: DWORD; var Response: DWORD; Wait: Boolean): Boolean; stdcall; external 'wtsapi32.dll' name 'WTSSendMessageA'; function WTSGetActiveConsoleSessionId: DWORD; stdcall; external kernel32 name 'WTSGetActiveConsoleSessionId'; procedure TLoginFrm.Timer1Timer(Sender: TObject); const WTS_CURRENT_SERVER_HANDLE = 0; var nTitle, nMessage: string; nResponse: DWORD; begin if UserLogined(adocCommon, Parameter[4]) and not GetUserOnline(adocCommon, Parameter[4]) then begin Timer1.Enabled := False; nTitle := '提示'; nMessage := '当前用户已在其它地方登录, 您已被踢下线!'; WTSSendMessage(WTS_CURRENT_SERVER_HANDLE, WTSGetActiveConsoleSessionId, PChar(nTitle), Length(nTitle), PChar(nMessage), Length(nMessage), MB_OK, 0, nResponse, False); TerminateProcess(GetCurrentProcess, 0); end; end;
6、 获取、更新人员状态函数。
function TLoginFrm.GetUserOnline(AdoConn: TADOConnection; AUserID: string): Boolean; var QryComm: TADOQuery; begin Result := False; QryCreate(QryComm, AdoConn); try QryComm.SQL.Text := Format('select online from Personnel_set where per_id=%S', [QuotedStr(AUserID)]); QryComm.Open; if QryComm.FieldByName('online').AsInteger = 1 then Result := True; finally QryComm.Free; end; end; function TLoginFrm.UpdateOnline(AdoConn: TADOConnection; AUserID: string; online: Integer): Boolean; var T: TADOQuery; begin QryCreate(T, AdoConn); try T.SQL.Text := Format('update Personnel_set set online=%D where Per_id=%S', [online, QuotedStr(AUserID)]); T.ExecSQL; finally T.Free; end; end;
效果
原文链接:https://www.cnblogs.com/adsoft/p/11867546.html
如有疑问请与原作者联系
标签:
版权申明:本站文章部分自网络,如有侵权,请联系:west999com@outlook.com
特别注意:本站所有转载文章言论不代表本站观点,本站所提供的摄影照片,插画,设计作品,如需使用,请与原作者联系,版权归原作者所有
上一篇:Delphi-基础
下一篇:Delphi-基础(运算符)
- C#:访问修饰符 2018-06-17
- 同一DataTable下创建多个结构数据相同的DataView的小问题 2018-06-17
- IIS解决上传文件大小限制 2018-06-17
- 一次性搞定Session 2018-06-17
- 8.仿阿里云虚拟云服务器的FTP(包括FTP文件夹大小限制) 2018-06-17
IDC资讯: 主机资讯 注册资讯 托管资讯 vps资讯 网站建设
网站运营: 建站经验 策划盈利 搜索优化 网站推广 免费资源
网络编程: Asp.Net编程 Asp编程 Php编程 Xml编程 Access Mssql Mysql 其它
服务器技术: Web服务器 Ftp服务器 Mail服务器 Dns服务器 安全防护
软件技巧: 其它软件 Word Excel Powerpoint Ghost Vista QQ空间 QQ FlashGet 迅雷
网页制作: FrontPages Dreamweaver Javascript css photoshop fireworks Flash