Поговорим об MS Script Control

[Gustav]

Уважаемые коллеги,

Обнаружен очередной весьма шустрый способ вываливания больших массивов данных из Аксапты в Excel. По предварительным оценкам он в полтора-два раза быстрее способа экспорта из темы Поговорим об ADO, при том, что и ADODB.Recordset, и Range.CopyFromRecordset в нем также присутствуют. Присутствует в нём еще одна штуковина, благодаря которой и достигаются лучшие характеристики.

Знакомьтесь, кто еще не в курсе - COM-сервер Microsoft Srcipt Control. Средство, хотя и существующее в природе с конца прошлого века, но на АксФоруме почему-то до сих пор не обыгранное. На момент написания этих строк я нашёл по строке "msscriptcontrol" буквально пару тем, одна из которых даже с моим участием, где Script Control упоминается мимоходом-мимолетом: Парсер арифметических выражений и Можно ли задать критерий поиска по форуму в строке адреса web-страницы? Настоящей же темой предлагаю воздать должное этому ActiveX'у.

Джоб ниже наследует традиции тем Axapta программирует Excel на VBA и Поговорим об ADO и выполняет тестовое задание темы Исследование скорости экспорта данных из Axapta в Excel (коллективный эксперимент) (чтобы было с чем сравнивать, у меня полное время выполнения составило около 40 секунд):

static void Job_Test_MSScriptControl(Args _args)
{
    LedgerTrans ledgerTrans;
    LedgerTable ledgerTable;

    COM         sc;
    str         vbCode;
    int         row;
    int         timeStart = timenow();
    str         stmt2exec;
    ;

    vbCode =
    'Option Explicit                                                       \r\n' +

    'Public rst                                                            \r\n' +
    'Public fieldList                                                      \r\n' +

    'Sub beforeLoop()                                                      \r\n' +
    '    Set rst = CreateObject("ADODB.Recordset")                         \r\n' +
    '    rst.Fields.Append "F1", 3          \r\n' +  // 3 = adInteger
    '    rst.Fields.Append "F2", 200, 30    \r\n' +  // 200 = adVarChar
    '    rst.Fields.Append "F3", 200, 100   \r\n' +
    '    rst.Fields.Append "F4", 200, 100   \r\n' +
    '    rst.Fields.Append "F5", 3          \r\n' +
    '    rst.Fields.Append "F6", 200, 30    \r\n' +
    '    rst.Fields.Append "F7", 133        \r\n' +  // 133 = adDBDate
    '    rst.Fields.Append "F8", 200, 150   \r\n' +
    '    rst.Fields.Append "F9", 6          \r\n' +  // 6 = adCurrency
    '    rst.Fields.Append "F10",200, 10    \r\n' +
    '    rst.Open                                                          \r\n' +
    '    fieldList = Array(0,1,2,3,4,5,6,7,8,9)                            \r\n' +
    'End Sub                                                               \r\n' +

    'Sub duringLoop(p1,p2,p3,p4,p5,p6,p7,p8,p9,p10)                        \r\n' +
    '    rst.AddNew fieldList, Array(p1,p2,p3,p4,p5,p6,p7,p8,p9,p10)       \r\n' +
    'End Sub                                                               \r\n' +

    'Sub afterLoop()                                                       \r\n' +
    '    Dim xlApp                                                         \r\n' +
    '    Dim headers, rngHeaders                                           \r\n' +
    '    rst.Update                                                        \r\n' +
    '    Set xlApp = CreateObject("Excel.Application")                     \r\n' +
    '    xlApp.Workbooks.Add.Application.Range("A2").CopyFromRecordset rst \r\n' +
    '    headers = Array("RecId", "AccountNum", "AccountName", _           \r\n' +
    '                    "AccountPlType", "BondBatchTrans_RU", _           \r\n' +
    '                    "BondBatch_RU", "TransDate", "Txt", _             \r\n' +
    '                    "AmountMST", "Crediting")                         \r\n' +
    '    Set rngHeaders = xlApp.Range(xlApp.Cells(1, 1), _                 \r\n' +
    '                                 xlApp.Cells(1, UBound(headers) + 1)) \r\n' +
    '    With rngHeaders                                                   \r\n' +
    '       .Value = headers                                               \r\n' +
    '       .Font.Bold = True                                              \r\n' +
    '       .EntireColumn.AutoFit                                          \r\n' +
    '    End With                                                          \r\n' +
    '    xlApp.Visible = True                                              \r\n' +
    'End Sub                                                                   '
    ;

    sc = new COM('MSScriptControl.ScriptControl');
    sc.Language('vbscript');

    sc.AddCode( vbCode );
    sc.ExecuteStatement('beforeLoop');

    row = 0;
    while select  ledgerTrans
            join  ledgerTable
            where ledgerTrans.AccountNum == ledgerTable.AccountNum
               && ledgerTrans.TransDate >= 01\01\2007 && ledgerTrans.TransDate <= 31\01\2007
    {
        //if (! row) timeStart = timenow();  // для оценки времени собственно вывода (для полного - закомментировать)
        row++;
        if (row > 50000) break;

        stmt2exec = strFmt('duringLoop %1,"%2","%3","%4",%5,"%6",%7,"%8",%9,"%10"',
            int2str(ledgerTrans.RecId),
            ledgerTrans.AccountNum,
            ledgerTable.AccountName,
            strfmt('%1', ledgerTable.AccountPlType),
            int2str(ledgerTrans.BondBatchTrans_RU),
            ledgerTrans.BondBatch_RU,
            strFmt('DateSerial(%1,%2,%3)', year(ledgerTrans.TransDate),
                                           mthofyr(ledgerTrans.TransDate),
                                           dayofmth(ledgerTrans.TransDate)),
            strReplace(ledgerTrans.Txt,'"','""'), // для полей, в которых возможны двойные кавычки
            num2str(ledgerTrans.AmountMST,-1,-1,1,0),
            strfmt('%1', ledgerTrans.Crediting));

        sc.ExecuteStatement(stmt2exec);
    }

    sc.ExecuteStatement('afterLoop');

    info(strFmt('Время выполнения, %1 сек',timenow()-timeStart));
}

Больше пока ничего говорить не буду. Запустите, посмотрите сами, пропустите через себя код.

Если джоб вдруг не запустится по причине отсутствия MSScriptControl'а на компьютере, взять его можно отсюда:
http://www.microsoft.com/download/en...s.aspx?id=1949
или отсюда http://www.runweloads.com/inter/publish/61204prog.html

Приведу также несколько ссылок для справки, которые мне наиболее понравились в процессе изучения вопроса:

Using the ScriptControl
Использование объекта Microsoft Script Control в среде 1С:Предприятие v7.7
Add Scripting to Your Apps with Microsoft ScriptControl
Использование Microsoft ScriptControl

Хочу также заметить, что демонстрация мощи данного инструмента на примере экспорта в Excel - лишь дань сложившейся традиции, способ привлечь внимание общественности для показа вкусностей. Кстати,о некоторых вкусностях хорошо говорится во второй ссылке (про 1С).