📄 udm_jglr.pas
字号:
result := False;
end;
end;
end;
function TJGLRServer.F_GjjConnect(const ConnLx: smallint; const cServer, cDB:
string): boolean;
begin
result := False;
Conn_Gjj.Close;
case ConnLx of
2: Conn_Gjj.ConnectionString := 'Provider=SQLOLEDB.1;Password=' +
CONNECTDBPASSWORD + ';User ID=' + CONNECTDBUSER + ';Initial Catalog=' + cDB
+
';Data Source=' + cServer;
4: Conn_Gjj.ConnectionString := 'Provider=MSDASQL.1;Password=' +
CONNECTDBPASSWORD + ';Persist Security Info=True;User ID=' + CONNECTDBUSER
+
';Extended Properties="DRIVER={sybase system 11};UID=' + CONNECTDBUSER +
';PWD=' + CONNECTDBPASSWORD + ';SRVR=' + cServer + ';DB=' + cDB + '"';
else
Conn_Gjj.ConnectionString := '';
end;
if Conn_Gjj.ConnectionString <> '' then
begin
try
Conn_Gjj.Open();
result := True;
except
result := False;
end;
end;
end;
function TJGLRServer.F_CWConnect(const ConnLx: smallint; const cServer, cDB:
string): boolean;
begin
result := False;
Conn_CW.Close;
case ConnLx of
2: Conn_CW.ConnectionString := 'Provider=SQLOLEDB.1;Password=' +
CONNECTDBPASSWORD + ';User ID=' + CONNECTDBUSER + ';Initial Catalog=' + cDB
+
';Data Source=' + cServer;
4: Conn_CW.ConnectionString := 'Provider=MSDASQL.1;Password=' +
CONNECTDBPASSWORD + ';Persist Security Info=True;User ID=' + CONNECTDBUSER
+
';Extended Properties="DRIVER={sybase system 11};UID=' + CONNECTDBUSER +
';PWD=' + CONNECTDBPASSWORD + ';SRVR=' + cServer + ';DB=' + cDB + '"';
else
Conn_CW.ConnectionString := '';
end;
if Conn_CW.ConnectionString <> '' then
begin
try
Conn_CW.Open();
result := True;
except
result := False;
end;
end;
end;
function TJGLRServer.SystemPath: string;
var
cSysPath: Pchar;
cPath: string;
begin
cSysPath := StrAlloc(sizeof(char) * 255);
GetSystemDirectory(cSysPath, 200);
cPath := trim(cSysPath);
StrDispose(cSysPath);
if copy(cPath, length(cPath), 1) <> '\' then
cPath := cPath + '\';
result := cPath;
end;
procedure TJGLRServer.fLogin(const Uid, Pwd: WideString; var UserName,
UserQx, Ssds: WideString; var lResult: Integer);
var
iret: smallint;
begin
iret := -1;
if Conn_User.Connected then
begin
try
SP_Login.Close;
with SP_Login.Parameters do
begin
ParamByName('@cuser').Value := Uid;
ParamByName('@cpassword').Value := Pwd;
ParamByName('@cname').Value := '';
ParamByName('@cywqx').Value := '';
ParamByName('@ssds').Value := '';
ParamByName('@iret').Value := -1;
end;
SP_Login.ExecProc;
iret := SP_Login.Parameters.ParamByName('@iret').Value;
if iret = 0 then
begin
UserName := SP_Login.Parameters.ParamByName('@cname').Value;
UserQx := SP_Login.Parameters.ParamByName('@cywqx').Value;
Ssds := SP_Login.Parameters.ParamByName('@ssds').Value;
end
else
begin
UserName := '';
UserQx := '';
Ssds := '';
end;
SetComplete;
except
on Exception do
SetAbort;
end;
end;
lresult := iRet;
end;
procedure TJGLRServer.fUserDel(const UserId: WideString;
var lResult: Integer);
begin
try
if SP_User.Active = true then
SP_User.Close;
SP_User.ProcedureName := 'p_userdel';
SP_User.Parameters.Refresh;
with SP_User.Parameters do
begin
ParamByName('@userid').Value := UserId;
//ParamByName('@nret').Value := -1;
end;
SP_User.ExecProc;
lResult := SP_User.Parameters.ParamByName('@nret').Value;
SP_User.Close;
SetComplete;
except
on Exception do
SetAbort;
end;
end;
procedure TJGLRServer.fUserInf(var vData: OleVariant);
begin
self.cds_LR.Active := false;
self.cds_LR.CommandText := 'select * from bm_user order by userid';
try
try
self.cds_LR.Active := true;
vData := self.cds_LR.XMLData;
finally
self.cds_LR.Active := false;
end;
SetComplete;
except
on Exception do
SetAbort;
end;
end;
procedure TJGLRServer.fUserSav(const UserId, UserName, UserPwd, UserQx,
Ssds: WideString; var lResult: Integer);
begin
try
if SP_User.Active = true then
SP_User.Close;
SP_User.ProcedureName := 'p_usersave';
SP_User.Parameters.Refresh;
with SP_User.Parameters do
begin
ParamByName('@userid').Value := UserId;
ParamByName('@username').Value := UserName;
ParamByName('@userpwd').Value := UserPwd;
ParamByName('@userqx').Value := UserQx;
ParamByName('@ssds').Value := Ssds;
//ParamByName('@nret').Value := -1;
end;
SP_User.ExecProc;
lResult := SP_User.Parameters.ParamByName('@nret').Value;
SP_User.Close;
SetComplete;
except
on Exception do
SetAbort;
end;
end;
procedure TJGLRServer.MtsDataModuleCreate(Sender: TObject);
begin
if self.Conn_User.Connected = false then
ConnectInterface;
{ self.F_Connect(DatabaseType(INISYSTEMTYPE), ConnectServer(INISYSTEMTYPE),
ConnectDatabase(INISYSTEMTYPE));
}
// if self.Conn_Gjj.Connected = false then
// self.F_GjjConnect(DatabaseType(INIGJJMX),ConnectServer(INIGJJMX),ConnectDatabase(INIGJJMX));
if self.Conn_Cw.Connected = false then
self.F_CWConnect(DatabaseType(INICWBB), ConnectServer(INICWBB),
ConnectDatabase(INICWBB));
end;
procedure TJGLRServer.MtsDataModuleDeactivate(Sender: TObject);
begin
//self.Conn_User.Connected:= false;
if self.Conn_User.Connected = true then
self.Conn_User.Connected := false;
// if self.Conn_Gjj.Connected = true then
// self.Conn_Gjj.Connected:= false;
if self.Conn_Cw.Connected = true then
self.Conn_Cw.Connected := false;
end;
procedure TJGLRServer.fBbmlDel(const sBbbh: WideString;
var lResult: Integer);
begin
try
if SP_User.Active = true then
SP_User.Close;
SP_User.ProcedureName := 'p_bbmlb_del';
SP_User.Parameters.Refresh;
with SP_User.Parameters do
begin
ParamByName('@bbbh').Value := sbbbh;
//ParamByName('@nret').Value := -1;
end;
SP_User.ExecProc;
lResult := SP_User.Parameters.ParamByName('@nret').Value;
SP_User.Close;
SetComplete;
except
on Exception do
SetAbort;
end;
end;
procedure TJGLRServer.fBbmlInf(var vData: OleVariant);
begin
self.cds_LR.Active := false;
self.cds_LR.CommandText := 'select * from cw_bbmlb order by bbbh';
try
try
self.cds_LR.Active := true;
vData := self.cds_LR.XMLData;
finally
self.cds_LR.Active := false;
end;
SetComplete;
except
on Exception do
SetAbort;
end;
end;
procedure TJGLRServer.fBbmlSav(const sBbbh, sBbdm, sBbmc: WideString;
var lResult: Integer);
begin
try
if SP_User.Active = true then
SP_User.Close;
SP_User.ProcedureName := 'p_bbmlb_save';
SP_User.Parameters.Refresh;
with SP_User.Parameters do
begin
ParamByName('@bbbh').Value := sbbbh;
ParamByName('@bbdm').Value := sbbdm;
ParamByName('@bbmc').Value := sbbmc;
ParamByName('@nret').Direction:= pdInputOutput;
ParamByName('@nret').Value := -1;
end;
SP_User.ExecProc;
lResult := SP_User.Parameters.ParamByName('@nret').Value;
SP_User.Close;
SetComplete;
except
on Exception do
SetAbort;
end;
end;
procedure TJGLRServer.fBbgsDel(const sDsbh, sBbbh: WideString;
lGslx: Integer; var lResult: Integer);
begin
try
if SP_User.Active = true then
SP_User.Close;
SP_User.ProcedureName := 'p_bbgsdel';
SP_User.Parameters.Refresh;
with SP_User.Parameters do
begin
ParamByName('@ilx').Value := lGslx;
ParamByName('@dsbh').Value := sDsbh;
ParamByName('@cbh').Value := sBbbh;
//ParamByName('@nret').Value := -1;
end;
SP_User.ExecProc;
lResult := SP_User.Parameters.ParamByName('@ret').Value;
SP_User.Close;
SetComplete;
except
on Exception do
SetAbort;
end;
end;
procedure TJGLRServer.fBbgsInf(const sDsbh, sBbbh: WideString;
lGslx: Integer; var vData: OleVariant);
begin
self.cds_LR.Active := false;
self.cds_LR.CommandText := 'select dsbh,bbbh,row,col,gs,gslx from cw_bbgs '
+ ' where dsbh=''' + sDsbh
+ ''' and bbbh=''' + sBbbh
+ ''' and gslx=' + inttostr(lGslx);
try
try
self.cds_LR.Active := true;
vData := self.cds_LR.XMLData;
finally
self.cds_LR.Active := false;
end;
SetComplete;
except
on Exception do
SetAbort;
end;
end;
procedure TJGLRServer.fBbgsInf1(const sDsbh, sBbbh: WideString;
var vData: OleVariant);
begin
self.cds_LR.Active := false;
self.cds_LR.CommandText :=
'select a.dsbh,a.bbbh,a.row,a.col,a.gs ywgs,b.gs jtgs from cw_bbgs a, cw_bbgs b ' +
'where a.dsbh=''' + sDsbh + ''' and ' +
'a.bbbh=''' + sBbbh + ''' and ' +
'a.bbbh=b.bbbh and ' +
'a.row= b.row and ' +
'a.col=b.col and ' +
'a.gslx=2 and ' +
'b.gslx=1';
try
try
self.cds_LR.Active := true;
vData := self.cds_LR.XMLData;
finally
self.cds_LR.Active := false;
end;
SetComplete;
except
on Exception do
SetAbort;
end;
end;
procedure TJGLRServer.fBbgsSav(const sDsbh, sBbbh, sGs: WideString; lRow,
lCol, lGslx: Integer; var lResult: Integer);
begin
try
if SP_User.Active = true then
SP_User.Close;
SP_User.ProcedureName := 'p_bbgsadd';
SP_User.Parameters.Refresh;
with SP_User.Parameters do
begin
ParamByName('@ilx').Value := lGslx;
ParamByName('@cbh').Value := sBbbh;
ParamByName('@row').Value := lRow;
ParamByName('@col').Value := lCol;
ParamByName('@cgs').Value := sGs;
ParamByName('@dsbh').Value := sDsbh;
//ParamByName('@nret').Value := -1;
end;
SP_User.ExecProc;
lResult := SP_User.Parameters.ParamByName('@ret').Value;
SP_User.Close;
SetComplete;
except
on Exception do
SetAbort;
end;
end;
procedure TJGLRServer.fGjjConnected(var lResult: Integer);
begin
if self.Conn_Gjj.Connected = false then
begin
try
self.F_GjjConnect(DatabaseType(INIGJJMX), ConnectServer(INIGJJMX),
ConnectDatabase(INIGJJMX));
if self.Conn_Gjj.Connected = false then
lResult := -1
else
lResult := 0;
except
lResult := -1;
end;
end
else
lResult := 0;
end;
procedure TJGLRServer.fCwConnected(var lResult: Integer);
begin
if self.Conn_Cw.Connected = false then
begin
try
self.F_CWConnect(DatabaseType(INICWBB), ConnectServer(INICWBB),
ConnectDatabase(INICWBB));
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -