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

📄 tdmpjgcom.pas

📁 公积金监管系统服务端Com中间件,是新疆公积金监管系统的客户端软件
💻 PAS
📖 第 1 页 / 共 5 页
字号:
        adoConn.ConnectionString := 'Provider=SQLOLEDB.1;Password=' + sPwd +
          ';User ID=' + sUid + ';Initial Catalog=' + sDB + ';Data Source=' +
            sSrv;
      end;
    4: //Sybase
      begin
        adoConn.ConnectionString :=
          'Provider=MSDASQL.1;Extended Properties="DRIVER={sybase system 11};UID=' +
          sUid + ';PWD=' + sPwd + ';SRVR=' + sSrv + ';DB=' + sDB + '"';
      end;
  else
    adoConn.ConnectionString := '';
  end;
  if adoConn.ConnectionString <> '' then
  begin
    try
      adoConn.Open;
      Result := 0;
    except
      Result := -1;
    end;
  end;
end;

procedure TPJgComServer.MtsDataModuleActivate(Sender: TObject);
{var
  sSrv, sDB: String;
  iLx: Smallint;
}
begin
  //  ReadDBMSInfo(_JGSYSTEM, sSrv, sDB, iLx);
  //  ConnectDB(sSrv, sDB, iLx, _DBUSER, _DBPASSWORD);
end;

function TPJgComServer.UserDelete(const sUid: WideString): Smallint;
begin
  Result := -1;
  if adoConn.Connected then
  begin
    try
      adoSpUserDel.Close;
      adoSpUserDel.Parameters.ParamByName('@userid').Value := sUid;
      adoSpUserDel.ExecProc;
      Result := adoSpUserDel.Parameters.ParamByName('@nret').Value;
      SetComplete;
    except
      SetAbort;
    end;
  end;
end;

function TPJgComServer.UserSave(const sUid, sPwd, sName, sQx,
  sSsds: WideString; lSys: WordBool): Smallint;
begin
  Result := -1;
  if adoConn.Connected then
  begin
    try
      adoSpUserSave.Close;
      with adoSpUserSave.Parameters do
      begin
        ParamByName('@userid').Value := sUid;
        ParamByName('@username').Value := sName;
        ParamByName('@userpwd').Value := sPwd;
        ParamByName('@userqx').Value := sQx;
        ParamByName('@ssds').Value := sSsds;
        ParamByName('@usersys').Value := lSys;
      end;
      adoSpUserSave.ExecProc;
      Result := adoSpUserSave.Parameters.ParamByName('@nret').Value;
      SetComplete;
    except
      SetAbort;
    end;
  end;
end;

function TPJgComServer.UserInfo(out vRec: OleVariant): Smallint;
begin
  Result := -1;
  cds.Active := False;
  cds.CommandText := 'select * from bm_user order by userid';
  try
    try
      cds.Active := True;
      vRec := cds.XMLData;
      Result := 0;
    finally
      cds.Active := False;
    end;
    SetComplete;
  except
    SetAbort;
  end;
end;

function TPJgComServer.ReadMainMap(out sCaption: WideString;
  out vData: OleVariant): Smallint;
var
  BlobF: TBlobField;
  DataS: TAdoDataSet;
  aMS: TMemoryStream;
  p: pointer;
  L: integer;
begin
  Result := -1;
  DataS := TAdoDataSet.Create(nil);
  BlobF := TBlobField.Create(DataS);
  ams := TMemoryStream.Create;
  try
    DataS.Connection := adoConn;
    DataS.CommandType := cmdText;
    DataS.CommandText := 'select caption,image from bm_map';
    BlobF.FieldName := 'image';
    BlobF.DataSet := DataS;
    DataS.Open;
    BlobF.Index := DataS.FieldCount - 1;
    if BlobF.IsNull then
      Result := 5
    else
    begin
      try
        BlobF.SaveToStream(ams);
        L := ams.Size;
        vData := varArrayCreate([0, L - 1], varByte);
        p := VarArrayLock(vData);
        Move(ams.memory^, P^, L);
        Result := 0;
      finally
        VarArrayUnlock(vData);
        ams.Free;
      end;
    end;
    DataS.Close;
    {    DataS.CommandText := 'select caption from bm_map';
        DataS.Open;
        sCaption := DataS.FieldByName('caption').AsString;
        DataS.Close;
  }except
    Result := -1;
  end;
  BlobF.Free;
  DataS.Free;
  sCaption := MainCaption;
end;

function TPJgComServer.ReadMap(const sDsbh: WideString;
  out vData: OleVariant): Smallint;
var
  BlobF: TBlobField;
  DataS: TAdoDataSet;
  aMS: TMemoryStream;
  p: pointer;
  L: integer;
begin
  Result := -1;
  DataS := TAdoDataSet.Create(nil);
  BlobF := TBlobField.Create(DataS);
  ams := TMemoryStream.Create;
  try
    DataS.Connection := adoConn;
    DataS.CommandType := cmdText;
    DataS.CommandText := 'select dsbh,image from bm_dsbmb where dsbh=''' + sDsbh
      + '''';
    BlobF.FieldName := 'image';
    BlobF.DataSet := DataS;
    DataS.Open;
    BlobF.Index := DataS.FieldCount - 1;
    if BlobF.IsNull then
      Result := 5
    else
    begin
      try
        BlobF.SaveToStream(ams);
        L := ams.Size;
        vData := varArrayCreate([0, L - 1], varByte);
        p := VarArrayLock(vData);
        Move(ams.memory^, P^, L);
        Result := 0;
      finally
        VarArrayUnlock(vData);
        ams.Free;
      end;
    end;
    DataS.Close;
  except
    Result := -1;
  end;
  BlobF.Free;
  DataS.Free;
end;

function TPJgComServer.WriteMainMap(const sCaption: WideString;
  vData: OleVariant): Smallint;
var
  BlobF: TBlobField;
  DataS: TAdoDataSet;
  aMS: TMemoryStream;
  sStr: string;
  p: pointer;
  L: integer;
begin
  Result := -1;
  if adoQry.Active = true then
    adoQry.Active := false;
  adoQry.SQL.Clear;
  sStr := 'if not exists(select 1 from bm_map) ' +
    ' insert bm_map(caption) values(''' + sCaption + ''') ' +
    ' else update bm_map set caption = ''' + sCaption + '''';
  adoQry.SQL.Add(sStr);
  adoQry.ExecSQL;
  adoQry.Active := false;
  DataS := TAdoDataSet.Create(nil);
  BlobF := TBlobField.Create(DataS);
  try
    ams := TMemoryStream.Create;
    DataS.Connection := adoConn;
    DataS.CommandType := cmdText;
    DataS.CommandText := 'select caption,image from bm_map ';
    BlobF.FieldName := 'image';
    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;
      Result := 0;
    finally
      VarArrayUnlock(vData);
      ams.Free;
    end;
    DataS.Close;
  except
    Result := -1;
  end;
  BlobF.Free;
  DataS.Free;
end;

function TPJgComServer.WriteMap(const sDsbh: WideString;
  vData: OleVariant): Smallint;
var
  BlobF: TBlobField;
  DataS: TAdoDataSet;
  aMS: TMemoryStream;
  //  sStr: string;
  p: pointer;
  L: integer;
begin
  Result := -1;
  DataS := TAdoDataSet.Create(nil);
  BlobF := TBlobField.Create(DataS);
  ams := TMemoryStream.Create;
  try
    DataS.Connection := adoConn;
    DataS.CommandType := cmdText;
    DataS.CommandText := 'select dsbh,image from bm_dsbmb where dsbh=''' + sDsbh
      + '''';
    BlobF.FieldName := 'image';
    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;
      Result := 0;
    finally
      VarArrayUnlock(vData);
      ams.Free;
    end;
    DataS.Close;
  except
    Result := -1;
  end;
  BlobF.Free;
  DataS.Free;
end;

procedure TPJgComServer.fZcfzbGjjInf(const sDsbh, sNy: WideString;
  var vData: OleVariant);
begin
  self.cds_Cx.Active := false;
  if sDsbh = '' then
    self.cds_Cx.CommandText := 'select * from V_ZCFZB_GJJ where NY=''' + sNy +
     ''''
  else
    self.cds_Cx.CommandText := 'select * from V_ZCFZB_GJJ where NY=''' + sNy +
     ''' and dsbh='''+ sDsbh +'''';
  try
    try
      self.cds_Cx.Active := true;
      vData := self.cds_Cx.XMLData;
    finally
      self.cds_Cx.Active := false;
    end;
    SetComplete;
  except
    on Exception do
      SetAbort;
  end;
end;

procedure TPJgComServer.fZcfzbGjjSav(const sDsbh, sNy: WideString;
  aAry: OleVariant; var lResult: Integer);
var
  i: smallint;
begin
  try
    if SP_Cx.Active = true then
      SP_Cx.Close;
    with SP_Cx do
    begin
      ProcedureName := 'p_ZCFZBGJJ_save';
      Parameters.Refresh;
      Parameters.ParamByName('@dsbh').Value := sDsbh;
      Parameters.ParamByName('@NY').Value := sNy;
      for i := 0 to 34 do
      begin
        Parameters[i + 3].DataType := ftFloat;
        Parameters[i + 3].Value := double(aAry[i]);
      end;
      Parameters.ParamByName('@nret').Direction := pdInputOutput;
      Parameters.ParamByName('@nret').Value := -1;
    end;
    SP_Cx.ExecProc;
    lresult := SP_Cx.Parameters.ParamByName('@nret').Value;
    SP_Cx.Close;
    SetComplete;
  except
    on Exception do
      SetAbort;
  end;
end;

procedure TPJgComServer.fZzsybGjjInf(const sDsbh, sNy: WideString;
  var vData: OleVariant);
begin
  self.cds_Cx.Active := false;
  if sDsbh = '' then
    self.cds_Cx.CommandText := 'select * from V_ZZSYB_GJJ where NY=''' + sNy +
     ''''
  else
    self.cds_Cx.CommandText := 'select * from V_ZZSYB_GJJ where NY=''' + sNy +
     ''' and dsbh='''+ sDsbh +'''';
  try
    try
      self.cds_Cx.Active := true;
      vData := self.cds_Cx.XMLData;
    finally
      self.cds_Cx.Active := false;
    end;
    SetComplete;
  except
    on Exception do
      SetAbort;
  end;
end;

procedure TPJgComServer.fZzsybGjjSav(const sDsbh, sNy: WideString;
  aAry: OleVariant; var lResult: Integer);
var
  i: smallint;
begin
  try
    if SP_Cx.Active = true then
      SP_Cx.Close;
    with SP_Cx do
    begin
      ProcedureName := 'p_ZZSYBGJJ_save';
      Parameters.Refresh;
      Parameters.ParamByName('@dsbh').Value := sDsbh;
      Parameters.ParamByName('@NY').Value := sNy;
      for i := 0 to 15 do
      begin
        Parameters[i + 3].DataType := ftFloat;
        Parameters[i + 3].Value := double(aAry[i]);
      end;
      Parameters.ParamByName('@nret').Direction := pdInputOutput;
      Parameters.ParamByName('@nret').Value := -1;
    end;
    SP_Cx.ExecProc;
    lresult := SP_Cx.Parameters.ParamByName('@nret').Value;
    SP_Cx.Close;
    SetComplete;
  except
    on Exception do
      SetAbort;

⌨️ 快捷键说明

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