Delphi World - Очень быстрая интеграция RecordSet-а в глобальную-временную или постоянную таблицу для MSSQL2000
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Очень быстрая интеграция RecordSet-а в глобальную-временную или постоянную таблицу для MSSQL2000

Автор: Delirium
WEB-сайт: http://delphibase.endimus.com

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Очень быстрая интеграция RecordSet-а в глобальную-временную
или постоянную таблицу для MSSQL2000

Практически любой формализм в подходах при разработке приложений для БД,
требует унификации операций записи/модификации информации.
Наиболее популярное решение в этом вопросе - использование ХП для
выполнения задач бизнес-логики. Однако зачастую, простая передача
параметров бывает не эффективна. Для повышения производительности,
рекомендуются помещать блок данных во временную таблицу, а затем,
передавать название временной таблицы бизнес-процедуре в качестве
параметра. Таким образом можно многократно ускорить
выполнение логических транзакций.

Зависимости: ADODB, ADOInt, ComObj, Variants
Автор:       Delirium, Master_BRAIN@beep.ru, ICQ:118395746, Москва
Copyright:   Delirium (Master BRAIN)
Дата:        15 февраля 2003 г.
***************************************************** }

procedure NewTableFromRecordSet(Connection: TADOConnection; ARecordSet:
  _RecordSet; TableName: string);
var
  Query: TADOQuery;
  adoStream: OleVariant;
begin
  adoStream := CreateOLEObject('ADODB.Stream');
  Variant(ARecordSet).Save(adoStream, adPersistXML);
  // XML -> SQL
  Query := TADOQuery.Create(nil);
  Query.Connection := Connection;
  Query.SQL.Text := 'exec ap_NewTableFromXML :XMLDATA, :TABLENAME';
  Query.Parameters.ParamByName('XMLDATA').DataType := ftWideString;
  Query.Parameters.ParamByName('XMLDATA').Value :=
    adoStream.ReadText(adoStream.Size);
  Query.Parameters.ParamByName('TABLENAME').DataType := ftString;
  Query.Parameters.ParamByName('TABLENAME').Value := TableName;
  Query.ExecSQL;
  // Чистить память
  Query.Close;
  Query.Free;
  adoStream := Unassigned;
end;

// Ниже приведён скрипт ap_NewTableFromXML,
// особая благодарность АМС (alexis@cashmere.ru)
// Реализация для MSSQL2000

(*
create procedure dbo.ap_NewTableFromXML(
@XMLText ntext,
@TableName sysname )
as
set nocount on
if object_id('tempdb..'+@TableName) is not null exec('drop table '+@TableName)
if object_id(@TableName) is not null exec('drop table '+@TableName)
DECLARE @XMLHandler int
EXEC sp_xml_preparedocument @XMLHandler OUTPUT, @xmltext,
  ''
-- Третий параметр описывает пространство имён, используемых в документе. Без него нельзя
-- применить OpenXML, т.к. он не понимает тэгов вида rs:data
-- Получить описание полей
select * into #t
from openxml(@XMLHandler, '//s:ElementType/s:AttributeType/s:datatype', 3)
     with (colnum int '../@rs:number',
           intname nvarchar(50) '../@name',
           bascolmn nvarchar(50) '../@rs:basecolumn',
           coltype nvarchar(50) '@dt:type',
           dbtype nvarchar(50) '@rs:dbtype',
           maxlen nvarchar(50) '@dt:maxLength',
           fixlen nvarchar(50) '@rs:fixedlength',
           prec nvarchar(50) '@rs:precision',
           scale nvarchar(50) '@rs:scale' )
-- Формируем select для выборки информации
declare @mainsel nvarchar(4000),
        @capsel nvarchar(4000),
        @headsel nvarchar(4000),
        @tailsel nvarchar(4000)
set @headsel='declare @HDOC int set @HDOC='+cast(@XMLHandler as varchar(20)) + CHAR(10)
-- Этот изврат нужен для того, чтобы передать хэндл в @HDOC
set @headsel=@headsel + 'SELECT '
set @tailsel=' FROM OpenXML(@HDOC,''//rs:data/z:row'', 0) WITH ('
set @capsel=''
declare CT cursor for select intname, bascolmn, coltype, maxlen, scale, prec from #t
declare @INN nvarchar(50),
        @BSC nvarchar(50),
        @CTYP nvarchar(50),
        @MXL nvarchar(50),
        @SCL nvarchar(50),
        @PRE nvarchar(50),
        @tail nvarchar(4000),
        @cap nvarchar(4000)
open CT
-- Приведение к основным типам MSSQL Server
while 1=1
  begin
  fetch from CT into @INN, @BSC, @CTYP, @MXL, @SCL, @PRE
  if @@fetch_status=-1 break
  if @@fetch_status=-2 continue
  set @tail=''
  set @cap =' '+@INN+' as '+@BSC+','
  if @CTYP='i8'
   begin
   set @tail=' '+@INN + ' bigint,'
   goto OK
   end
  if @CTYP='bin.hex'
   begin
   if Convert(bigint, @MXL)=2147483647
    begin
    set @tail=' '+@INN+' image,'
    goto OK
    end
   if Convert(bigint, @MXL)=8
    begin
    set @tail=' '+@INN+' timestamp,'
    goto OK
    end
   set @tail=' '+@INN+' varbinary('+@MXL+'),'
   goto OK
   end
  if @CTYP='boolean'
   begin
   set @tail=' '+@INN+' varchar(5),'
   set @cap=' Convert(bit, case '+@INN+' when ''True'' then 1 else 0 end) as '+@BSC+','
   goto OK
   end
  if @CTYP='string'
   begin
   if Convert(bigint, @MXL)=2147483647
    begin
    set @tail=' '+@INN+' text,'
    goto OK
    end
   if Convert(bigint, @MXL)=1073741823
    begin
    set @tail=' '+@INN+' ntext,'
    goto OK
    end
   if @MXL is Null
    begin
    set @tail=' '+@INN+' sql_variant,'
    goto OK
    end
   set @tail=' '+@INN+' varchar('+@MXL+'),'
   goto OK
   end
  if @CTYP='dateTime'
   begin
   set @tail=' '+@INN+' varchar(23),'
   set @cap=' convert(datetime,'+ @INN + ',126) as ' + @BSC + ','
   goto OK
   end
  if @CTYP='number'
   begin
   set @tail=' '+@INN+' numeric('+@PRE+', '+isNull(@SCL, 4)+'),'
   goto OK
   end
  if @CTYP='float'
   begin
   set @tail=' '+@INN+' float,'
   goto OK
   end
  if @CTYP='int'
   begin
   set @tail=' '+@INN+' int,'
   goto OK
   end
  if @CTYP='r4'
   begin
   set @tail=' '+@INN+' real,'
   goto OK
   end
  if @CTYP='i2'
   begin
   set @tail=' '+@INN+' smallint,'
   goto OK
   end
  if @CTYP='ui1'
   begin
   set @tail=' '+@INN+' tinyint,'
   goto OK
   end
  if @CTYP='uuid'
   set @tail=' '+@INN+' uniqueidentifier,'
  OK: -- С типом - определился
  set @tailsel=@tailsel+isNull(@tail, '')+CHAR(10)
  set @capsel =@capsel +isNull(@cap, '') +CHAR(10)
  end
deallocate CT
set @capsel=left(@capsel,len(@capsel)-2)+' '+CHAR(10)
set @tailsel=left(@tailsel,len(@tailsel)-2)+')'+CHAR(10)
set @mainsel=@headsel+@capsel+' into '+@TableName+@tailsel
exec (@mainsel)
EXEC sp_xml_removedocument @XMLHandler
*)

Пример использования:

// Помещаю выборку в таблицу ##Test
NewTableFromRecordSet(ADOConnection1, ADOQuery1.RecordSet, '##Test');
Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования