Автор: 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');