mysqlest让程序更好的管理数据库session

admin · 发表于 2019-6-25 22:52:44

首先使用在XC看板程序

创建：

procedure TDataModule2.DataModuleCreate(Sender: TObject);
var
user:string;
begin
getExeInfo;
self.MyConnection1.Server:= SYS_SFC_001_INC.getHostIP;
self.MyConnection1.Username:=SYS_SFC_001_INC.getUserName;
self.MyConnection1.Password:=SYS_SFC_001_INC.getPasswrod;
self.MyConnection1.Options.Charset:='gbk';
end;

复制代码

session需要用到的程序相关信息：

procedure TDataModule2.getExeInfo;
begin
strPath:=application.exename;
strExename:=extractfilename(strPath);
strExe:= Copy(strExename, 1, Length(strExename) - Length(ExtractFileExt(strExename)));
strVersion:='0.0.0.0';
try
strVersion:=getVersion(strPath);
except
end;
end;

复制代码

其中用到的getVersion参考：delphi获取程序版本的实现标准getVersion

添加session功能函数：

function TDataModule2.sessionstart(isJustone: boolean): string;
begin
with SELF.PRO_CHECK_SESSION do
begin
close;
StoredProcName:='SYANT.SESSION_START';
preparesql;
ParambyName('P_EXE').Asstring :=strExename;
ParambyName('P_VERSION').Asstring :=strVersion;
ParambyName('P_PATH').Asstring :=rightstr(strPath,150);
ParambyName('P_JUSTONE').AsBoolean:=isJustone ;
try
ExecProc;
result:=ParambyName('RES').AsString;
except
on e:exception do
begin
result:=e.Message;
end
end;
AgileLog.writelog('sessionstart: '+result);
end;
end;

复制代码

function TDataModule2.sessionstop(isJustone: boolean): string;
begin
with SELF.PRO_CHECK_SESSION do
begin
close;
StoredProcName:='SYANT.SESSION_STOP';
preparesql;
ParambyName('P_EXE').Asstring :=strExename;
ParambyName('P_VERSION').Asstring :=strVersion;
ParambyName('P_PATH').Asstring :=rightstr(strPath,150);
ParambyName('P_JUSTONE').AsBoolean:=isJustone;
try
ExecProc;
result:=ParambyName('RES').AsString;
except
on e:exception do
begin
result:=e.Message;
end
end;
end;
AgileLog.writelog('sessionstop: '+result);
end;

复制代码

绑定事件：

procedure TDataModule2.MyConnection1AfterConnect(Sender: TObject);
begin
if(MyConnection1.Tag=0)then
begin
MyConnection1.Tag:=1;
try //在东莞XC的实践证明：这里会有死循环，会在syant.z_session中产生巨量的数据
//self.MyConnection1.ExecSQL('SET sql_log_bin=0',[]);
strCheckVersion:=sessionstart(true);
finally
MyConnection1.Tag:=0;
end;
end;
end;

复制代码

导出功能函数：

function TDataModule2.checkVersion: string;
begin
with SELF.PRO_CHECK_VERSION do
begin
close;
StoredProcName:='SFC.CHECK_AP_VERSION';
preparesql;
ParambyName('P_EXE').Asstring :=strExe;
ParambyName('P_VERSION').Asstring :=strVersion;
ParambyName('P_PATH').Asstring :=rightstr(strPath,150);
try
ExecProc;
result:=ParambyName('RES').AsString;
except
on e:exception do
begin
result:=e.Message;
end
end;
AgileLog.writelog('sessionstart: '+result);
end;
end;

复制代码

使用方法：
procedure TForm1.FormShow(Sender: TObject);
var
  str:string;
begin
  str:=frmDM.DataModule2.checkVersion;
  if(str='OK')then
  begin
   ...

zhgc · 发表于 2019-10-20 00:40:29

总结一下：

引用头添加：
SYS_SFC_001_INC, windows, StrUtils, dialogs;

public下添加以下函数定义:

procedure getExeInfo;
function checkVersion:string;
function sessionstart(isJustone:boolean):string;
function sessionstop(isJustone:boolean):string;
function getVersion(myappname:string):string;

复制代码

定义内部变量：
{$R *.dfm}
var
strPath,strExe,strExename,strVersion:string;

function getVersion(myappname:string):string;
的定义在：http://www.nagomes.com/disc/foru ... d&tid=228&fromuid=1

事件添加:
procedure DataModuleCreate(Sender: TObject);
procedure MyConnection1AfterConnect(Sender: TObject);

procedure TDataModule2.MyConnection1AfterConnect(Sender: TObject);
begin
if(MyConnection1.Tag=0)then
begin
MyConnection1.Tag:=1;
try //在东莞XC的实践证明：这里会有死循环，会在syant.z_session中产生巨量的数据
//self.MyConnection1.ExecSQL('SET sql_log_bin=0',[]);
strCheckVersion:=sessionstart(true);
finally
MyConnection1.Tag:=0;
end;
end;
end;

复制代码

syant · 发表于 2019-11-4 09:50:24

建议把以下功用也加上：

function checkPrivilege(exe,fun,emp:string):boolean;
function checkPrivilegeExist(exe,fun:string):boolean;
function getValidSql(sql:string):string;

复制代码

PACK_CTN.exe已加入

function TDataModule1.checkPrivilege(exe, fun, emp: string): boolean;
var
mysql:string;
myday:string;
begin
  mysql:='select 1 from sfc.c_privilege where prg_name='''+exe+''' and fun='''+fun+''' and  emp='''+emp+''' and privilege=2 ';
  mysql:=getValidSql(mysql);
  self.MyQuery5.Close;
  self.MyQuery5.SQL.Text:=mysql;
  self.MyQuery5.Open;
  result:=not self.MyQuery5.Eof;
  self.MyQuery5.Close;
end;

function TDataModule1.checkPrivilegeExist(exe, fun: string): boolean;
var
mysql:string;
myday:string;
begin
  mysql:='select 1 from sfc.c_privilege where prg_name='''+exe+''' and fun='''+fun+''' and privilege=2 limit 1 ';
  mysql:=getValidSql(mysql);
  self.MyQuery5.Close;
  self.MyQuery5.SQL.Text:=mysql;
  self.MyQuery5.Open;
  result:=not self.MyQuery5.Eof;
  self.MyQuery5.Close;
end;

//做一下简单的防SQL代码注入
function TDataModule1.getValidSql(sql: string): string;
begin
  //注意，单引号应该在输入框过滤掉！
  result:=sql;
  AgileStrings.MyReplaceString(result,';','',false);
  AgileStrings.MyReplaceString(result,'-- ','',false);
end;

zhgc · 发表于 2020-3-29 23:40:19

本帖最后由 zhgc 于 2020-4-3 14:22 编辑

再次总结：从pack_ctn 复制到 onllineprint
1. 复制5个函数：
function getVersion(myappname: string): string;
procedure getExeInfo;
function checkVersion:string;
function sessionstart(isJustone:boolean):string;
function sessionstop(isJustone:boolean):string;

2. 定义MyConnection1AfterConnect

3. 定义变量
var
  strPath,strExe,strExename,strVersion:string;

4.改写create
procedure TDataModule1.DataModuleCreate(Sender: TObject);
begin
  getExeInfo;

5.复制两个Sp控件
6.
procedure TForm1.FormShow(Sender: TObject);
begin
if(frmdm.DataModule1.checkVersion <>'OK')then
begin
   Panel5.Visible:=true;
end else Panel5.Visible:=false;

		自动登录	找回密码
密码			立即注册

mysqlest让程序更好的管理数据库session

浏览过的版块