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

📄 udm_jglr.pas

📁 公积金监管系统Com中间件,是新疆公积金监管系统的客户端软件
💻 PAS
📖 第 1 页 / 共 5 页
字号:
      Parameters.ParamByName('@DWMC').Value := sDwmc;
      Parameters.ParamByName('@XMMC').Value := sXmmc;
      Parameters.ParamByName('@LXSPJG').Value := sLxspjg;
      Parameters.ParamByName('@DKHTH').Value := sDkhth;
      Parameters.ParamByName('@DKJE').Value := double(aAry[0]);
     // Parameters.ParamByName('@FFJE').Value := double(aAry[1]);
      Parameters.ParamByName('@DKQX').Value := lDkqx;
      Parameters.ParamByName('@FFRQ').Value := sFfrq;
      Parameters.ParamByName('@DKLL').Value := double(aAry[1]);
      Parameters.ParamByName('@QCYE').Value := double(aAry[2]);
      Parameters.ParamByName('@BQHS').Value := double(aAry[3]);
      Parameters.ParamByName('@QMYE').Value := double(aAry[4]);
      Parameters.ParamByName('@QZYQ').Value := double(aAry[5]);
      Parameters.ParamByName('@nret').Value := -1;
    end;
    SP_Xmdkb.ExecProc;
    lResult := SP_Xmdkb.Parameters.ParamByName('@nret').Value;
    SP_Xmdkb.Close;
    SetComplete;
  except
    on Exception do
      SetAbort;
  end;
end;

procedure TJGLRServer.fGetData(const sBbNumber, sDptNumber, sZth,
  sBbDate: WideString; lCol, lRow: Integer; var lResult: WideString);
begin
  try
    if (trim(sZth) = '') then
      self.F_CWConnect(DatabaseType(INICWBB), ConnectServer(INICWBB), 'cw0001')
    else
      self.F_CWConnect(DatabaseType(INICWBB), ConnectServer(INICWBB), 'cw' +
        sZth);

    if SP_GetData.Active = true then
      SP_GetData.Close;
    with SP_GetData do
    begin
      Parameters.ParamByName('@tasknumber').Value := '01';
      Parameters.ParamByName('@bbnumber').Value := sBbNumber;
      Parameters.ParamByName('@dptnumber').Value := sDptNumber;
      Parameters.ParamByName('@bbdate').Value := sBbDate;
      Parameters.ParamByName('@col').Value := lCol;
      Parameters.ParamByName('@row').Value := lRow;
      Parameters.ParamByName('@resulttype').Value := 0;
      // Parameters.ParamByName('@resultdata').Value := ' ';
    end;
    SP_GetData.ExecProc;
    lResult := trim(SP_GetData.Parameters.ParamByName('@resultdata').Value);
    SP_GetData.Close;
    SetComplete;
  except
    on Exception do
    begin
      self.F_CWConnect(DatabaseType(INICWBB), ConnectServer(INICWBB),
        ConnectDatabase(INICWBB));
      SetAbort;
    end;
  end;
end;

procedure TJGLRServer.fRelation(const sBbNumber: WideString;
  var vData: OleVariant);
begin
  self.cds_LR.Active := false;
  self.cds_LR.CommandText := 'select * ' +
    ///relationno,bbrelationl,bbrelation,bbrelationr'+
  'from bbrelation where bbnumber=''' + sbbnumber + ''' order by relationno';
  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.fRelationSav(const sBbNumber: WideString;
  lRelationNo: Integer; const sRelationL, sRelation,
  sRelationR: WideString; var lResult: Integer);
begin
  try
    if Sp_RelationSav.Active = true then
      Sp_RelationSav.Close;
    with Sp_RelationSav do
    begin
      Parameters.ParamByName('@bbnumber').Value := sbbnumber;
      Parameters.ParamByName('@relationno').Value := lrelationno;
      Parameters.ParamByName('@bbrelationl').Value := srelationl;
      Parameters.ParamByName('@bbrelationr').Value := srelationr;
      Parameters.ParamByName('@bbrelation').Value := srelation;
      Parameters.ParamByName('@ret').Value := -1;
    end;
    Sp_RelationSav.ExecProc;
    lResult := Sp_RelationSav.Parameters.ParamByName('@ret').Value;
    Sp_RelationSav.Close;
    SetComplete;
  except
    on Exception do
      SetAbort;
  end;
end;

procedure TJGLRServer.fRelationDel(const sBbNumber: WideString;
  lRelationNo: Integer; var lResult: Integer);
begin
  try
    if Sp_RelationDel.Active = true then
      Sp_RelationDel.Close;
    with Sp_RelationDel do
    begin
      Parameters.ParamByName('@bbnumber').Value := sbbnumber;
      Parameters.ParamByName('@relationno').Value := lrelationno;
      Parameters.ParamByName('@ret').Value := -1;
    end;
    Sp_RelationDel.ExecProc;
    lResult := Sp_RelationDel.Parameters.ParamByName('@ret').Value;
    Sp_RelationDel.Close;
    SetComplete;
  except
    on Exception do
      SetAbort;
  end;
end;

procedure TJGLRServer.fGjGet(lCol, lRow: Integer; const sBbNum, sDptNum,
  sDate: WideString; var dResult: Double);
begin
  try
    if Sp_GjGet.Active = true then
      Sp_GjGet.Close;
    with Sp_GjGet do
    begin
      Parameters.ParamByName('@bbnumber').Value := sbbnum;
      Parameters.ParamByName('@dptnumber').Value := sdptnum;
      Parameters.ParamByName('@bbdate').Value := sdate;
      Parameters.ParamByName('@col').Value := lcol;
      Parameters.ParamByName('@row').Value := lrow;
      Parameters.ParamByName('@resultdata').Value := -1;
    end;
    Sp_GjGet.ExecProc;
    dResult := Sp_GjGet.Parameters.ParamByName('@resultdata').Value;
    Sp_GjGet.Close;
    SetComplete;
  except
    on Exception do
      SetAbort;
  end;
end;

procedure TJGLRServer.fGjSumH(lCol, lRowb, lRowe: Integer; const sBbNum,
  sDptNum, sDate: WideString; var dResult: Double);
begin
  try
    if Sp_GjSumH.Active = true then
      Sp_GjSumH.Close;
    with Sp_GjSumH do
    begin
      Parameters.ParamByName('@bbnumber').Value := sbbnum;
      Parameters.ParamByName('@dptnumber').Value := sdptnum;
      Parameters.ParamByName('@bbdate').Value := sdate;
      Parameters.ParamByName('@col').Value := lcol;
      Parameters.ParamByName('@rowb').Value := lrowb;
      Parameters.ParamByName('@rowe').Value := lrowe;
      Parameters.ParamByName('@resultdata').Value := -1;
    end;
    Sp_GjSumH.ExecProc;
    dResult := Sp_GjSumH.Parameters.ParamByName('@resultdata').Value;
    Sp_GjSumH.Close;
    SetComplete;
  except
    on Exception do
      SetAbort;
  end;
end;

procedure TJGLRServer.fGjSumV(lColb, lCole, lRow: Integer; const sBbNum,
  sDptNum, sDate: WideString; var dResult: Double);
begin
  try
    if Sp_GjSumV.Active = true then
      Sp_GjSumV.Close;
    with Sp_GjSumV do
    begin
      Parameters.ParamByName('@bbnumber').Value := sbbnum;
      Parameters.ParamByName('@dptnumber').Value := sdptnum;
      Parameters.ParamByName('@bbdate').Value := sdate;
      Parameters.ParamByName('@colb').Value := lcolb;
      Parameters.ParamByName('@cole').Value := lcole;
      Parameters.ParamByName('@row').Value := lrow;
      Parameters.ParamByName('@resultdata').Value := -1;
    end;
    Sp_GjSumV.ExecProc;
    dResult := Sp_GjSumV.Parameters.ParamByName('@resultdata').Value;
    Sp_GjSumV.Close;
    SetComplete;
  except
    on Exception do
      SetAbort;
  end;
end;

procedure TJGLRServer.fBbSav(const sBbbh: WideString; vData: OleVariant;
  var lResult: Integer);
var
  BlobF: TBlobField;
  DataS: TAdoDataSet;
  ams: TMemoryStream;
  sqlstr: string;
  p: pointer;
  L: integer;
begin
  lResult := 0;
  if Qry_User.Active = true then
    Qry_User.Active := false;
  Qry_User.SQL.Clear;
  sqlstr := 'if not exists(select * from cw_bbjg where bbbh=''' + sBbbh + ''')'
    +
    ' insert cw_bbjg(bbbh) values(''' + sBbbh + ''')';
  Qry_User.SQL.Add(sqlstr);
  Qry_User.ExecSQL;
  Qry_User.Active := false;
  DataS := TAdoDataSet.Create(nil);
  BlobF := TBlobField.Create(DataS);
  ams := TMemoryStream.Create;
  try
    DataS.Connection := Conn_User;
    DataS.CommandType := cmdText;
    DataS.CommandText := 'select bbbh,bbwj from cw_bbjg where bbbh=''' + sBbbh +
      '''';
    BlobF.FieldName := 'bbwj';
    BlobF.DataSet := DataS;
    DataS.Open;
    BlobF.Index := DataS.FieldCount - 1;
    DataS.Edit;
    try
      L := VarArrayHighBound(vData, 1) - VarArrayLowBound(vData, 1) + 1;
      p := VarArrayLock(vData);
      ams.SetSize(L);
      Move(p^, ams.memory^, L);
      BlobF.LoadFromStream(ams);
      DataS.Post;
    finally
      VarArrayUnlock(vData);
      ams.Free;
    end;
    DataS.Close;
  except
    lResult := -1;
  end;
  BlobF.Free;
  DataS.Free;
end;

procedure TJGLRServer.fBbWj(const sBbbh: WideString; var vData: OleVariant;
  var lResult: Integer);
var
  BlobF: TBlobField;
  DataS: TAdoDataSet;
  ams: TMemoryStream;
  sqlstr: string;
  p: pointer;
  L: integer;
begin
  lResult := 0;
  if Qry_User.Active = true then
    Qry_User.Active := false;
  Qry_User.SQL.Clear;
  sqlstr := 'if not exists(select * from cw_bbjg where bbbh=''' + sBbbh + ''')'
    +
    ' insert cw_bbjg(bbbh) values(''' + sBbbh + ''')';
  Qry_User.SQL.Add(sqlstr);
  Qry_User.ExecSQL;
  Qry_User.Active := false;
  DataS := TAdoDataSet.Create(nil);
  BlobF := TBlobField.Create(DataS);
  ams := TMemoryStream.Create;
  try
    DataS.Connection := Conn_User;
    DataS.CommandType := cmdText;
    DataS.CommandText := 'select bbbh,bbwj from cw_bbjg where bbbh=''' + sBbbh +
      '''';
    BlobF.FieldName := 'bbwj';
    BlobF.DataSet := DataS;
    DataS.Open;
    BlobF.Index := DataS.FieldCount - 1;
    if BlobF.IsNull then
      lResult := 5
    else
    begin
      try
        BlobF.SaveToStream(ams);
        L := ams.Size;
        vData := varArrayCreate([0, L - 1], varByte);
        p := VarArrayLock(vData);
        Move(ams.memory^, P^, L);
      finally
        VarArrayUnlock(vData);
        ams.Free;
      end;
    end;
    DataS.Close;
  except
    lResult := -1;
  end;
  BlobF.Free;
  DataS.Free;
end;

procedure TJGLRServer.fGetBbData(const sNy, sBb: WideString;
  var vData: OleVariant);
begin
  self.cds_LR.Active := false;
  if uppercase(sBb) = 'V_ZZSYFPB_GJJ' then
    self.cds_LR.CommandText := 'select * from ' + uppercase(sBb)
      + ' where ND=''' + copy(sNy, 1, 4) + ''''
  else
    self.cds_LR.CommandText := 'select * from ' + uppercase(sBb)
      + ' where NY=''' + sNy + '''';
  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.fZhksyebInf1(const sNy: WideString;
  var vData: OleVariant);
begin
  self.cds_Gjj.Active := false;
  self.cds_Gjj.CommandText := 'select distinct * from V_ZHKSYEB where NY=''' +
    sNy
    + ''' order by KHYH';
  try
    try
      self.cds_Gjj.Active := true;
      vData := self.cds_Gjj.XMLData;
    finally
      self.cds_Gjj.Active := false;
    end;
    SetComplete;
  except
    on Exception do
      SetAbort;
  end;
end;

procedure TJGLRServer.fGetGjjtjb(const sDate1, sDate2: WideString;
  var aAry, aAry0: OleVariant);
begin
  try
    if SP_User.Active = true then
      SP_User.Close;
    SP_User.ProcedureName := 'p_zfgjjgrdkhzcx';
    SP_User.Parameters.Refresh;
    with SP_User do
    begin
      Parameters.ParamByName('@m_dk01').Direction := pdOutput;
      Parameters.ParamByName('@m_dk02').Direction := pdOutput;
      Parameters.ParamByName('@m_dk03').Direction := pdOutput;
      Parameters.ParamByName('@m_dk04').Direction := pdOutput;
      Parameters.ParamByName('@m_dk05').Direction := pdOutput;
      Parameters.ParamByName('@m_dk06').Direction := pdOutput;
      Parameters.ParamByName('@m_dk07').Direction := pdOutput;
      Parameters.ParamByName('@m_dk08').Direction := pdOutput;
      Parameters.ParamByName('@m_dk09').Direction := pdOutput;
      Parameters.ParamByName('@m_dk01').DataType := ftFloat;
      Parameters.ParamByName('@m_dk02').DataType := ftFloat;
      Parameters.ParamByName('@m_dk03').DataType := ftFloat;
      Parameters.ParamByName('@m_dk04').DataType := ftFloat;
      Parameters.ParamByName('@m_dk05').DataType := ftFloat;
      Parameters.ParamByName('@m_dk06').DataType := ftFloat;
      Parameters.ParamByName('@m_date1').Value := strtodate(sDate1);
      Parameters.ParamByName('@m_date2').Value := strtodate(sDate2);
    end;
    SP_User.ExecProc;
    aAry[0] := double(SP_User.Parameters.ParamByName('@m_dk01').Value);
    aAry[1] := double(SP_User.Parameters.ParamByName('@m_dk02').Value);
    aAry[2] := double(SP_User.Parameters.ParamByName('@m_dk03').Value);
    aAry[3] := double(SP_User.Parameters.ParamByName('@m_dk04').Value);
    aAry[4] := double(SP_User.Parameters.ParamByName('@m_dk05').Value);
    aAry[5] := double(SP_User.Parameters.ParamByName('@m_dk06').Value);
    aAry0[0] := integer(SP_User.Parameters.ParamByName('@m_dk07').Value);
    aAry0[1] := integer(SP_User.Parameters.ParamByName('@m_dk08').Value);
    aAry0[2] := integer(SP_User.Parameters.ParamByName('@m_dk09').Value);
    SP_User.Close;
    SP_User.ProcedureName := 'p_zfgjjjcqkhzcx';
    SP_User.Parameters.Refresh;
    with SP_User do
    begin
      Parameters.ParamByName('@m_zf01').Direction := pdOutput;
      Parameters.ParamByName('@m_zf02').Direction := pdOutput;
      Parameters.ParamByName('@m_zf03').Direction := pdOutput;
      Parameters.ParamByName('@m_zf04').Direction := pdOutput;
      Parameters.ParamByName('@m_zf05').Direction := pdOutput;
      Parameters.ParamByName('@m_zf06').Direction := pdOutput;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -