Как работать с БД из DELPHI

Skip to end of metadata
Go to start of metadata

На примере компонентов InterBase
1. Поместить на форму или на дата форму компонент БД TIBDatabase дать имя например dbBilling
установить свойства

Code:   

DataBaseName 10.128.0.0:/var/db/ics_main.gdb
    SQLDialect 3
    LoginPrompt
    params
         user_name=sysdba
         password=servicemode
         sql_role_name=admin
         lc_ctype=WIN1251

2. Поместить компонент TIBTransaction дать имя например, trDefault
установить свойства

Code:     

AutoStopAction saCommit
     DefaultDatabase dbBilling
     Params
         isc_tpb_read_committed
         isc_tpb_no_rec_version
         isc_tpb_wait

3. В компоненте TIBDatabase указать DefaultTransaction, trDefault

4. Поместить компонент TIBStoresProc дать имя splogin
установить свойства
Code:   

DefaultDatabase dbBilling
    StoresProcName CLN_AUTH_LOGIN
Нажать  Params, появится 0..6 параметров, закрыть params.

5. В коде программы выполнить по аналогии
Code:

//Подключение к БД
try
  dbBilling.Connected:=true;
  except on E: Exception do
      begin
         MessageDlg(E.Message, mtError, [mbOk],0);
         dbBilling.Connected := false;
      end;
end;


//Авторизация администратора
var SessionID: Int64;
UserID: integer;
with spLogin do
    try
      Params.ParamValues['LOGIN'] := fmLogin.edLogin.Text;
      Params.ParamValues['PASSWD'] := fmLogin.edPassword.Text;
      params.ParamValues['versionn'] := 9;
      ExecProc;
      SessionID := Params.ParamValues['SUID'];
      UserID := Params.ParamValues['USER_ID'];
    except
      on E: EIBInterbaseError do
      begin
         MessageDlg(E.Message, mtWarning, [mbOk],0);
         dbBilling.Connected := false;
      end;
    end;

Получаем SessionID - текущий сессионный ключ для работы этого администратора
UserID - Id администратора

6. Пример получения данных для отображения в таблице или форме.
Поместить компонент TIBQuery дать имя например qryUserProp
Указать Databаse dbBilling
Указать строку запроса

*Code:

select
    USER_ID,
    PARENT_ID,
    TARIF_ID,
    USE_PARENT_TARIF,
    LOGIN,
    NAME,
    EMAIL,
    PULL_ID,
    USE_PARENT_PULL,
    IP,
    SNATIP,
    USE_PARENT_SNATIP,
    NET_SIZE,
    OSTATOK,
    CREDIT,
    DEBIT,
    BALANCE,
    LIMIT,
    balance_buh,
    UNLIMITED,
    FINANCE_USER,
    ENABLED,
    DELETED,
    END_USER,
    ROOT_ADMIN,
    TECH_ADMIN,
    FIN_ADMIN,
    CARD_ADMIN,
    AUTO_ACCOUNT,
    AUTO_INTERVAL,
    SERVER,
    PSW,
    next_auto_acount,
   AUTO_ACCOUNT_LOCK,
   limit_lock,
   ALLOW_RECONNECT,
   ALLOW_MAIL,
   ALLOW_INTERNET_CONNECT,
  LIMIT_WARNING,
  use_LIMIT_WARNING,
  users_count,
  ALLOW_VIEW_PARENT_LIMIT,
  disabled_date,
  abonent_pay,
  redirect_mail,
AUTH_TYPE,
USE_PARENT_AUTH_TYPE,
             AD_IS,
             AD_BASEDN,
             AD_BINDDN,
             AD_PASS,
             AD_HOST,
             AD_UPDATE,
             AD_FILTER,
             DEF_ALLOW_MAIL,
             DEF_AUTO_ACCOUNT_INTERVAL,
             DEF_ALLOW_RECONNECT,
             DEF_ALLOW_INTERNET_CONNECT,
             DEF_ALLOW_VIEW_PARENT_LIMIT,
             DEF_OSTATOK,
             DEF_LIMIT,
             DEF_WARNING,
    AD_DOMAIN,
    AD_LDAP_GROUP,
    AD_WINDOWS_GROUP,
    mac,
allow_mail_internet,
DEF_ALLOW_MAIL_INTERNET,
ad_domain_isjoin,
contract_number,
USE_PARENT_ABONENT_PAY
from CLN_USR_GET(:SUID,:ID)

В событии Event BeforeOpen два раза щелкунуть и указать

Code: 

with DataSet as TIBQuery do
  begin
    Params.ParamValues['SUID'] :=SessionID;
  end;

7. Поместить компонент TDataSetProvider дать имя например prUserProp
Constrains False
DataSet qryUserProp
Exported False

8. Поместить TClientDataset дать имя clUserProp
ProviderName prUserProp
И САМОЕ ГЛАВНОЕ
Событие AfterOpen, двойной клик и указать
qryUserProp.Close;

9. Поместить TDataSource дать имя dsUserProp
Указать DataSet clUserProp

10. Для получения данных выполнять
Code:

with dmusers do
  begin
    qryUserProp.Params.ParamValues['ID'] := ID;
    if clUserProp.Active then clUserProp.Refresh;
     clUserProp.Open;
end

Для контроля нужно проверять на сервере под рутом
gstat -h /var/db/ics_main.gdb
Oldest transaction 263701
Oldest active 263702
Oldest snapshot 263702
Next transaction 263704

Все 4 числа должны должны не сильно отличаться.
Если Oldest transaction сильно отличается от Oldest active или Oldest active от Next transaction, значит работа с БД идет неправильно и накопленные незакрытые транзакции могут нарушить работу бд.

Пример операции приход
Получить след номер операции

select number, data_prev, OP_NAME
from CLN_FIN_OPER_PREPARE(:op_type,:user_id)

провести операцию
создаем компонент процедура
CLN_FIN_OPER_ADD,
выполняем заполнив поля
Params.ParamValues['SUID'] :=SessionID;
user_id
OP_DATE
SUMMA
DESCR
NUMBER
OP_TYPE

Quote:

Типы операций:
Знак, тип, комментарий
- 1 Расход - Выставление счета фактуры, сброс кредита в начльное состояние(N=K,K=0)
+ 2 Приход - Абонент оплатил деньги или за него оплачены виртуальные деньги D=D+sum
= 3 Баланс подвести - Остаток увеличить на дебет, сбросить дебет в ноль
= 4 Обнуление - Делаем баланс в ноль.
= 5 Счет - Выствление счета
= 6 Документы - договор и прочие выписки
- 7 Услуга - В текущей версии услуга проводится как пока как уменьшение дебета, D=D-sum

N-начальный остаток
K-Кредит текущий он же расход трафика с начала периода
D-Дебит оплата с начала периода

еще пример создания ХП для работы из PHP для связи с платежными системами.
Code:

Create PROCEDURE PAY_USR_ACT (
    ACT VARCHAR(32) CHARACTER SET WIN1251,
    PAY_ID INTEGER,
    USER_ID_IN INTEGER,
    CONTRACT_NUMBER VARCHAR(32) CHARACTER SET WIN1251,
    SUMMA NUMERIC(15,2),
    MD5SUM VARCHAR(32) CHARACTER SET WIN1251,
    PAY_OPERATOR VARCHAR(32) CHARACTER SET WIN1251,
    COMMENT_IN VARCHAR(64) CHARACTER SET WIN1251)
RETURNS (
    RES INTEGER,
    MSG VARCHAR(256) CHARACTER SET WIN1251,
    COMMENT VARCHAR(1024) CHARACTER SET WIN1251,
    USER_NAME VARCHAR(128) CHARACTER SET WIN1251,
    USER_LOGIN VARCHAR(32) CHARACTER SET WIN1251)
AS
DECLARE VARIABLE USER_ID INTEGER;
DECLARE VARIABLE NUSER INTEGER;
DECLARE VARIABLE MSG1 VARCHAR(128);
DECLARE VARIABLE SUM_VALUE NUMERIC(18,0);
DECLARE VARIABLE NUMBER VARCHAR(10);
DECLARE VARIABLE MONEY NUMERIC(18,0);
DECLARE VARIABLE NEW_ID INTEGER;
begin
RES=-1;
MSG='Unknow error in procedure PAY_USR_ACT';
COMMENT='';
select vpn_const.const_value
  from vpn_const
  where vpn_const.const_id = 1
  into :money;
if (USER_ID_IN=0) then USER_ID_IN=NULL;
if (CONTRACT_NUMBER='') then CONTRACT_NUMBER=null;
if (CONTRACT_NUMBER is null and USER_ID is null) then
    begin
    RES=251;
    MSG='Error: key field is null';
    end
if (PAY_OPERATOR is null or PAY_OPERATOR='') then
    begin
    RES=251;
    MSG='Error: pay_operator is null';
    end
if (PAY_ID is null or PAY_ID=0 and upper(act)='PAY') then
    begin
    RES=251;
    MSG='Error: pay_ID is null';
    end


if ((upper(act)='PAY' or upper(act)='CHECK') and RES=-1) then
begin
    user_login=null;
    USER_NAME=null;
    user_id=null;
    nuser=0;
    for select id, login, identify from users
        where (:user_id_IN is null or id=:user_id_IN)
          and (CONTRACT_NUMBER=:CONTRACT_NUMBER or :CONTRACT_NUMBER is null)
        into user_id, user_login, user_name
        do
        begin
        nuser=nuser+1;
        end
    while(1=1) do
    begin
    if (nuser=0) then
    begin
    RES=1;
    MSG='Error: User not found';
    COMMENT='';
    break;
    end
    if (nuser>1) then
    begin
    RES=2;
    MSG='Error: Double user found';
    COMMENT='';
    break;
    end
--Îñíîâíîé àëãîðèòì îïëàòû
    if (exists(select * from finance_operations
        where
        operator_name=:PAY_OPERATOR
        and operator_pay_id=:pay_id
        )) then
        begin
        RES=3;
        MSG='Error: PAY ID already exists';
        COMMENT='';
        break;
        end
    if (upper(act)='CHECK') then
        begin
        RES=0;
        MSG='Allow';
        break;
    end
    SUM_VALUE=summa*money;
    select NUMBER from CLN_FIN_OPER_PREPARE(2,:USER_ID) into :number;
    msg1=comment_in;
    if (msg1 is null or msg1='') then
        begin
        msg1=PAY_OPERATOR;
        end
    new_id=null;
    execute procedure  gln_fin_add_debet(:user_id,'now',:SUM_VALUE,:msg1,:user_id,:number) returning_values :new_id;
    if (new_id is null) then
        begin
        RES=4;
        MSG='Error: cant create operation debet';
        break;
    end
    update FINANCE_OPERATIONS
        set operator_name=:PAY_OPERATOR,
            operator_pay_id=:pay_id
        where FINANCE_OPERATIONS.op_id=:new_id;
    RES=0;
    MSG='ACCEPTED';
    break;
   end
end
  INSERT INTO PAY_LOG (
    ID,
    PAY_ID_IN,
    USER_ID_IN,
    CONTRACT_NUMBER_IN,
    SUMMA_IN,
    MD5SUM_IN,
    RES_OUT,
    MSG_OUT,
    COMMENT_OUT,
    USER_ID_OUT,
    USER_NAME_OUT,
    USER_LOGIN_OUT,
    ACT_IN,
    DATE_CREATE,
    PAY_OPERATOR)
  VALUES (
    null,
    :PAY_ID,
    :USER_ID_IN,
    :CONTRACT_NUMBER,
    :SUMMA,
    :MD5SUM,
    :RES,
    :MSG,
    :COMMENT,
    :USER_ID,
    :USER_NAME,
    :USER_LOGIN,
    :ACT,
    'now',
    :PAY_OPERATOR);
suspend;
exit;
end
Введите метки, чтобы добавить к этой странице:
Please wait 
Ищите метку? просто начните печатать.