⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 udm_jglr.pas

📁 公积金监管系统Com中间件,是新疆公积金监管系统的客户端软件
💻 PAS
📖 第 1 页 / 共 5 页
字号:
      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 + -