/Gedemin/Common/gdUpdateIndiceStat.pas

  1unit gdUpdateIndiceStat;
  2
  3interface
  4
  5uses
  6  IBDatabase;
  7
  8type
  9  Tcst_def_KeyWords =
 10    (CURRENT_DATE, CURRENT_TIME, CURRENT_USER, CURRENT_ROLE, CURRENT_TIMESTAMP);
 11
 12const
 13  cst_def_KeyWords: array[Tcst_def_KeyWords] of String =
 14    ('CURRENT_DATE', 'CURRENT_TIME', 'CURRENT_USER', 'CURRENT_ROLE', 'CURRENT_TIMESTAMP');
 15
 16  function GetDefValueInQuotes(const DefaultValue: String): String;
 17  function GetDomainText(ADataBase : TIBDataBase; FieldName : String; const isCharSet: Boolean = True): String;
 18  function GetParamsText(ProcedureName : String; ADataBase : TIBDataBase): String;
 19  procedure UpdateIndicesStat(ADataBase : TIBDataBase);
 20  procedure RecompileTriggers(ADataBase : TIBDataBase);
 21  procedure RecompileProcedures(ADataBase : TIBDataBase);
 22  procedure ReCreateComputedFields(ADataBase : TIBDataBase);
 23  procedure ReCreateView(ADataBase : TIBDataBase);
 24
 25implementation
 26
 27uses
 28  IBSQL, IBHeader, IBCustomDataSet, SysUtils, Classes, at_frmSQLProcess;
 29
 30procedure UpdateIndicesStat(ADataBase : TIBDataBase);
 31var
 32  q1, q2: TIBSQL;
 33  Tr, ReadTr: TIBTransaction;
 34begin
 35  q1 := TIBSQL.Create(nil);
 36  q2 := TIBSQL.Create(nil);
 37  Tr := TIBTransaction.Create(nil);
 38  ReadTr := TIBTransaction.Create(nil);
 39  try
 40    Tr.DefaultDatabase := ADataBase;
 41    ReadTr.DefaultDatabase := ADataBase;
 42    ReadTr.StartTransaction;
 43    q1.Transaction := Tr;
 44
 45    q2.Transaction := ReadTr;
 46    q2.SQL.Text := 'SELECT rdb$index_name FROM rdb$indices ';
 47    q2.ExecQuery;
 48    while not q2.EOF do
 49    begin
 50      Tr.StartTransaction;
 51
 52      AddText('?????????? ?????????? ??????? ' + q2.Fields[0].AsTrimString);
 53
 54      q1.SQL.Text := 'SET STATISTICS INDEX "' + q2.Fields[0].AsTrimString + '"';;
 55      q1.ExecQuery;
 56
 57      q1.Close;
 58      Tr.Commit;
 59
 60      q2.Next;
 61    end;
 62    q2.Close;
 63    ReadTr.Commit;
 64  finally
 65    q1.Free;
 66    q2.Free;
 67    Tr.Free;
 68    ReadTr.Free;
 69  end;
 70end;
 71
 72procedure RecompileTriggers(ADataBase : TIBDataBase);
 73var
 74  q1, q2: TIBSQL;
 75  Tr, ReadTr: TIBTransaction;
 76begin
 77  q1 := TIBSQL.Create(nil);
 78  q2 := TIBSQL.Create(nil);
 79  Tr := TIBTransaction.Create(nil);
 80  ReadTr := TIBTransaction.Create(nil);
 81  try
 82    Tr.DefaultDatabase := ADataBase;
 83    ReadTr.DefaultDatabase := ADataBase;
 84    ReadTr.StartTransaction;
 85    q1.Transaction := Tr;
 86
 87    q2.Transaction := ReadTr;
 88    q2.SQL.Text := 'SELECT tr.RDB$TRIGGER_NAME, tr.RDB$TRIGGER_SOURCE FROM RDB$TRIGGERS tr '#13#10 +
 89      'WHERE NOT tr.RDB$TRIGGER_SOURCE IS NULL'#13#10 +
 90      'AND NOT tr.RDB$TRIGGER_NAME LIKE ''CHECK%''';
 91    q2.ExecQuery;
 92    while not q2.EOF do
 93    begin
 94      Tr.StartTransaction;
 95
 96      AddText('?????????????? ???????? ' + q2.Fields[0].AsTrimString);
 97
 98      q1.SQL.Text := 'ALTER TRIGGER "' + q2.Fields[0].AsTrimString + '" ' + q2.Fields[1].AsTrimString;
 99      q1.ParamCheck := False;
100      q1.ExecQuery;
101
102      q1.Close;
103      Tr.Commit;
104
105      q2.Next;
106    end;
107    q2.Close;
108    ReadTr.Commit;
109  finally
110    q1.Free;
111    q2.Free;
112    Tr.Free;
113    ReadTr.Free;
114  end;
115end;
116
117procedure RecompileProcedures(ADataBase : TIBDataBase);
118var
119  q1, q2: TIBSQL;
120  Tr, ReadTr: TIBTransaction;
121begin
122  q1 := TIBSQL.Create(nil);
123  q2 := TIBSQL.Create(nil);
124  Tr := TIBTransaction.Create(nil);
125  ReadTr := TIBTransaction.Create(nil);
126  try
127    Tr.DefaultDatabase := ADataBase;
128    ReadTr.DefaultDatabase := ADataBase;
129    ReadTr.StartTransaction;
130    q1.Transaction := Tr;
131
132    q2.Transaction := ReadTr;
133    q2.SQL.Text := 'SELECT pr.RDB$PROCEDURE_NAME, pr.RDB$PROCEDURE_SOURCE FROM RDB$PROCEDURES pr '#13#10 +
134      'WHERE NOT pr.RDB$PROCEDURE_SOURCE IS NULL';
135    q2.ExecQuery;
136    while not q2.EOF do
137    begin
138      Tr.StartTransaction;
139
140      AddText('?????????????? ????????? ' + q2.Fields[0].AsTrimString);
141
142      q1.SQL.Text := 'ALTER PROCEDURE "' + q2.Fields[0].AsTrimString + '" ' + GetParamsText(q2.FieldByName('RDB$PROCEDURE_NAME').AsString , ADataBase) +
143        ' AS ' + q2.Fields[1].AsTrimString;
144      q1.ParamCheck := False;
145      q1.ExecQuery;
146
147      q1.Close;
148      Tr.Commit;
149
150      q2.Next;
151    end;
152    q2.Close;
153    ReadTr.Commit;
154  finally
155    q1.Free;
156    q2.Free;
157    Tr.Free;
158    ReadTr.Free;
159  end;
160end;
161
162function GetParamsText(ProcedureName : String; ADataBase : TIBDataBase ): String;
163var
164  ibsql: TIBSQl;
165  S1, S2: String;
166  Tr : TIBTransaction;
167begin
168  Result := '';
169  ibsql := TIBSQL.Create(nil);;
170  Tr := TIBTransaction.Create(nil);
171  try
172    Tr.DefaultDatabase := ADataBase;
173    Tr.StartTransaction;
174
175    ibsql.Transaction := Tr;
176    ibsql.SQL.Text := 'SELECT * FROM rdb$procedure_parameters pr ' +
177                      'WHERE pr.rdb$procedure_name = :pn AND pr.rdb$parameter_type = :pt ' +
178                      'ORDER BY pr.rdb$parameter_number ASC ';
179    ibsql.ParamByName('pn').AsString := ProcedureName;
180    ibsql.ParamByName('pt').AsInteger := 0;
181    ibsql.ExecQuery;
182
183    S1 := '';
184    while not ibsql.EOF do
185    begin
186      if S1 = '' then
187        S1 := '('#13#10;
188      S1 := S1 + '    ' + Trim(ibsql.FieldByName('rdb$parameter_name').AsString) + ' ' +
189         GetDomainText(ADataBase ,ibsql.FieldByName('rdb$field_source').AsString, False);
190      ibsql.Next;
191      if not ibsql.EOF then
192        S1 := S1 + ','#13#10
193      else
194        S1 := S1 + ')';
195    end;
196
197    S1 := S1 + #13#10;
198
199    ibsql.Close;
200    ibsql.ParamByName('pt').AsInteger := 1;
201
202    ibsql.ExecQuery;
203    S2 := '';
204    while not ibsql.EOF do
205    begin
206      if S2 = '' then
207        S2 := 'RETURNS ( '#13#10;
208      S2 := S2 + '    ' + Trim(ibsql.FieldByName('rdb$parameter_name').AsString) + ' ' + GetDomainText(ADataBase, ibsql.FieldByName('rdb$field_source').AsString, False);
209      ibsql.Next;
210      if not ibsql.EOF then
211        S2 := S2 + ','#13#10
212      else
213        S2 := S2 + ')'#13#10;
214    end;
215
216    Result := S1 + S2;
217    Tr.Commit
218  finally
219    ibsql.Free;
220    Tr.Free;
221  end;
222end;
223
224function GetDomainText(ADataBase : TIBDataBase; FieldName :String; const isCharSet: Boolean = True): String;
225
226  function FormFloatDomain(dsDomain: TIBSQL): String;
227  var
228    fscale: Integer;
229  begin
230    if dsDomain.FieldByName('fsubtype').AsInteger = 1 then
231      Result := 'NUMERIC'
232    else
233      Result := 'DECIMAL';
234
235    if dsDomain.FieldByName('fscale').AsInteger < 0 then
236      fscale := -dsDomain.FieldByName('fscale').AsInteger
237    else
238      fscale := dsDomain.FieldByName('fscale').AsInteger;
239
240    if dsDomain.FieldByName('fprecision').AsInteger = 0 then
241      Result := Format('%s(9, %s)',
242        [Result, IntToStr(fscale)])
243    else
244      Result := Format('%s(%s, %s)',
245        [Result, dsDomain.FieldByName('fprecision').AsString, IntToStr(fscale)]);
246  end;
247
248  function GetDomain (dsDomain: TIBSQL): String;
249  begin
250    case dsDomain.FieldByName('ffieldtype').AsInteger of
251
252    blr_Text, blr_varying:
253      begin
254        if dsDomain.FieldByName('ffieldtype').AsInteger = blr_Text then
255          Result := 'CHAR'
256        else
257          Result := 'VARCHAR';
258
259        Result := Format('%s(%s)', [Result, dsDomain.FieldByName('fcharlength').AsString]);
260
261        if isCharSet and (dsDomain.FieldByName('CHARSET').AsString <> '') then
262        begin
263          Result := Format('%s CHARACTER SET %s',
264            [Result, Trim(dsDomain.FieldByName('CHARSET').AsString)]);
265        end;
266      end;
267
268    blr_d_float, blr_double, blr_float:
269      Result := 'DOUBLE PRECISION';
270
271    blr_int64:
272      if (dsDomain.FieldByName('fsubtype').AsInteger > 0) or
273        (dsDomain.FieldByName('fprecision').AsInteger > 0) or
274        (dsDomain.FieldByName('fscale').AsInteger < 0) then
275      begin
276        Result := FormFloatDomain(dsDomain)
277      end else
278        Result := 'BIGINT';
279
280    blr_long:
281      if (dsDomain.FieldByName('fsubtype').AsInteger > 0) or
282        (dsDomain.FieldByName('fprecision').AsInteger > 0) or
283        (dsDomain.FieldByName('fscale').AsInteger < 0) then
284      begin
285        Result := FormFloatDomain(dsDomain)
286      end else
287        Result := 'INTEGER';
288
289    blr_short:
290      if (dsDomain.FieldByName('fsubtype').AsInteger > 0) or
291        (dsDomain.FieldByName('fprecision').AsInteger > 0) or
292        (dsDomain.FieldByName('fscale').AsInteger < 0) then
293      begin
294        Result := FormFloatDomain(dsDomain)
295      end else
296        Result := 'SMALLINT';
297
298    blr_sql_time:
299      Result := 'TIME';
300
301    blr_sql_date:
302      Result := 'DATE';
303
304    blr_timestamp:
305      Result := 'TIMESTAMP';
306
307    blr_blob:
308      begin
309        Result := 'BLOB';
310        Result := Format
311        (
312          ' %s SUB_TYPE %s SEGMENT SIZE %s',
313          [
314            Result,
315            dsDomain.FieldByName('fsubtype').AsString,
316            dsDomain.FieldByName('seglength').AsString
317          ]
318        );
319        if isCharSet and (dsDomain.FieldByName('CHARSET').AsString <> '') then
320        begin
321          Result := Format('%s CHARACTER SET %s',
322            [Result, dsDomain.FieldByName('CHARSET').AsString]);
323        end;
324
325      end;
326    end;
327    Result := Trim(Result);
328  end;
329
330var
331  qry: TIBSQL;
332  Transaction : TIBTransaction;
333begin
334  qry := TIBSQL.Create(nil);
335  Transaction := TIBTransaction.Create(nil);
336  try
337    Transaction.DefaultDatabase := ADataBase;
338    Transaction.StartTransaction;
339    qry.Transaction := Transaction;
340    try
341      qry.SQL.Text := 'SELECT ' +
342        ' /* z.*,  refr.lname as reflname, refrf.lname as reflistlname, ' +
343        '  setr.lname as setlistlname, */ rdb.rdb$null_flag AS flag, ' +
344        '  rdb.rdb$field_type as ffieldtype, ' +
345        '  rdb.rdb$field_sub_type as fsubtype, ' +
346        '  rdb.rdb$field_precision as fprecision, ' +
347        '  rdb.rdb$field_scale as fscale, ' +
348        '  rdb.rdb$field_length as flength, ' +
349        '  rdb.rdb$character_length as fcharlength, ' +
350        '  rdb.rdb$segment_length as seglength, ' +
351        '  rdb.rdb$validation_source AS checksource, ' +
352        '  rdb.rdb$default_source as defsource, ' +
353        '  rdb.rdb$computed_source as computed_value, ' +
354        '  cs.rdb$character_set_name AS charset, ' +
355        '  cl.rdb$collation_name AS collation ' +
356        '  FROM rdb$fields rdb ' +
357        '    LEFT JOIN ' +
358        '      rdb$character_sets cs ' +
359        '    ON ' +
360        '      rdb.rdb$character_set_id = cs.rdb$character_set_id ' +
361        '    LEFT JOIN ' +
362        '      rdb$collations cl ' +
363        '    ON ' +
364        '      rdb.rdb$collation_id = cl.rdb$collation_id ' +
365        '        AND ' +
366        '      rdb.rdb$character_set_id = cl.rdb$character_set_id ' +
367        '    LEFT JOIN at_fields z ON ' +
368        '     rdb.rdb$field_name = z.fieldname ' +
369        ' WHERE rdb.rdb$field_name = :fieldname ';
370
371      qry.ParamByName('fieldname').AsString := FieldName;
372      qry.ExecQuery;
373
374      if qry.RecordCount > 0 then
375        Result := GetDomain(qry)
376      else
377        raise Exception.Create('??????????? ??? ??????');
378
379      if Transaction.InTransaction then
380        Transaction.Commit;
381    except
382      if Transaction.InTransaction then
383        Transaction.Rollback;
384      raise;
385    end;
386  finally
387    qry.Free;
388    Transaction.Free;
389  end;
390end;
391
392//????????? ???????? ?? ????????? ? ???????
393//??? ???? ???? ????????: ???? ???????? ??? ? ????????, ?? ??? ??? ? ????????????
394//? ???????? ??????, ???? ??????? ??????????? ?????? ??????, ?? ??? ???????????
395function GetDefValueInQuotes(const DefaultValue: String): String;
396var
397  I: Integer;
398  DefSt: String;
399  L: Tcst_def_KeyWords;
400begin
401  if AnsiPos('DEFAULT', Trim(AnsiUpperCase(DefaultValue))) = 1 then
402    DefSt := Trim(Copy(Trim(DefaultValue), 8, Length(Trim(DefaultValue)) - 1))
403  else
404    DefSt := DefaultValue;
405
406  for L := Low(cst_def_KeyWords) to High(cst_def_KeyWords) do
407  begin
408    if AnsiCompareText(DefSt, cst_def_KeyWords[L]) = 0 then
409    begin
410      Result := DefSt;
411      Exit;
412    end;
413  end;
414
415  if (DefSt[1] = '''') and (DefSt[Length(DefSt)] = '''') then
416  begin
417    Result := DefSt;
418  end else
419  begin
420    Result := '';
421    for I := 1 to Length(DefSt) do
422    begin
423      if DefSt[I] = '''' then
424        Result := Result + '''';
425      Result := Result + DefSt[I];
426    end;
427    Result := '''' + Result + '''';
428  end;
429end;
430
431{???????????? ??????????? ?????.
432??? ? YA ? ? FB ??? Alter ??? Computed fields, ??????
4331. ??????? ??????? ? ??????????? ?????.
4342. ??????? ??? ???? ??????????? ????.
4353. ????????? blr ?? ??????? ???? ? ??????.
4364. ??????? ?????? ????.
437}
438procedure ReCreateComputedFields(ADataBase : TIBDataBase);
439var
440  q1, q2: TIBSQL;
441  Tr, ReadTr: TIBTransaction;
442begin
443  q1 := TIBSQL.Create(nil);
444  q2 := TIBSQL.Create(nil);
445  Tr := TIBTransaction.Create(nil);
446  ReadTr := TIBTransaction.Create(nil);
447  try
448    Tr.DefaultDatabase := ADataBase;
449    q1.Transaction := Tr;
450
451    ReadTr.DefaultDatabase := ADataBase;
452    ReadTr.StartTransaction;
453    q2.Transaction := ReadTr;
454
455    q2.SQL.Text :=
456      'SELECT ' +
457      '  F.RDB$COMPUTED_SOURCE AS COMPUTED_SOURCE, ' +
458      '  RF.RDB$FIELD_NAME AS FIELD_NAME, ' +
459      '  RF.RDB$RELATION_NAME AS TABLE_NAME ' +
460      'FROM ' +
461      '  RDB$FIELDS F ' +
462      '  JOIN RDB$RELATION_FIELDS RF ON RF.RDB$FIELD_SOURCE = F.RDB$FIELD_NAME ' +
463      '  JOIN RDB$RELATIONS R ON R.RDB$RELATION_NAME = RF.RDB$RELATION_NAME ' +
464      'WHERE ' +
465      '  F.RDB$COMPUTED_SOURCE IS NOT NULL AND R.RDB$VIEW_SOURCE IS NULL';
466    q2.ExecQuery;
467    while not q2.EOF do
468    begin
469      Tr.StartTransaction;
470
471      AddText('?????????????? ???? ' + q2.FieldByName('field_name').AsTrimString +
472        ' ??????? ' + q2.FieldByName('table_name').AsTrimString);
473
474      q1.SQL.Text :=
475        'ALTER TABLE "' + q2.FieldByName('table_name').AsTrimString +
476        '" ALTER "' + q2.FieldByName('field_name').AsTrimString +
477        '" COMPUTED BY ' + q2.FieldByName('computed_source').AsTrimString;
478      q1.ExecQuery;
479      q1.Close;
480      Tr.Commit;
481
482      q2.Next;
483    end;
484    q2.Close;
485    ReadTr.Commit;
486  finally
487    q1.Free;
488    q2.Free;
489    Tr.Free;
490    ReadTr.Free;
491  end;
492end;
493
494procedure ReCreateView(ADataBase : TIBDataBase);
495var
496  q1, q2: TIBSQL;
497  Tr, ReadTr: TIBTransaction;
498
499  function GetViewText(const FSQL: TIBSQL; const ReadTr: TIBTransaction): String;
500  var
501    S: String;
502    ibsql: TIBSQL;
503  begin
504    ibsql := TIBSQL.Create(nil);
505    try
506      S := '';
507      
508      ibsql.Transaction := ReadTr;
509      ibsql.SQL.Text := 'SELECT * FROM rdb$relation_fields ' +
510        ' WHERE rdb$relation_name = :rn ORDER BY rdb$field_position ';
511      ibsql.ParamByName('rn').AsString := FSQL.FieldByName('RDB$RELATION_NAME').AsTrimString;
512      ibsql.ExecQuery;
513      if not ibsql.EOF then
514      begin
515        while not ibsql.EOF do
516        begin
517          S := S + ibsql.FieldByName('rdb$field_name').AsTrimString + ','#13#10;
518          ibsql.Next;
519        end;
520        SetLength(S, Length(S) - 3);
521      end;
522    finally
523      ibsql.Free;
524    end;
525
526    Result :=
527      Format('ALTER VIEW "%s" '#13#10 +
528        ' ('#13#10, [FSQL.FieldByName('RDB$RELATION_NAME').AsTrimString]) +
529      S + #13#10') '#13#10' AS ' +
530      FSQL.FieldByName('RDB$VIEW_SOURCE').AsString;
531  end;
532
533begin
534  q1 := TIBSQL.Create(nil);
535  q2 := TIBSQL.Create(nil);
536  Tr := TIBTransaction.Create(nil);
537  ReadTr := TIBTransaction.Create(nil);
538  try
539    Tr.DefaultDatabase := ADataBase;
540    q1.Transaction := Tr;
541
542    ReadTr.DefaultDatabase := ADataBase;
543    ReadTr.StartTransaction;
544    q2.Transaction := ReadTr;
545
546    q2.SQL.Text :=
547      'SELECT R.RDB$RELATION_NAME, R.RDB$VIEW_SOURCE ' +
548      'FROM RDB$RELATIONS R ' +
549      'WHERE R.RDB$VIEW_SOURCE IS NOT NULL ';
550    q2.ExecQuery;
551    while not q2.EOF do
552    begin
553      Tr.StartTransaction;
554
555      AddText('?????????????? ????????????? ' + q2.FieldByName('RDB$RELATION_NAME').AsTrimString);
556
557      q1.SQL.Text := GetViewText(q2, ReadTr);
558      q1.ExecQuery;
559      q1.Close;
560      Tr.Commit;
561
562      q2.Next;
563    end;
564    q2.Close;
565    ReadTr.Commit;
566  finally
567    q1.Free;
568    q2.Free;
569    Tr.Free;
570    ReadTr.Free;
571  end;
572end;
573
574end.