Почти все разработчики в области DBA (Database Access) рано или поздно сталкиваются с проблемой перемещения данных между базами данных, с которыми работают их приложения. В моей статье я продемонстрирую программное решение конкретной задачи по копированию данных из таблицы формата ДБФ в базу данных MS SQL Server. Сразу оговорюсь, что мое решение не претендует на идеальность, поэтому прошу помидорами не закидывать. Итак, передо мной стояла задача: нужно из какой-то точки локальной сети доступной серверной машине переместить данные, которые находятся в таблице формата ДБФ в базу данных MS SQL Server, причем база данных на сервере - произвольная, сервер тоже. Опять же у Вас могут быть вопросы, что типа, зачем это нужно и все такое, оказалось, что это вполне реальная задача при большом потоке входных файлов в формате ДБФ.

   Задачу я разбил на две подзадачи: 1 - получить информацию о структуре ДБФ файла. 2 - собственно загнать файл на сервер. Ну, первая это задачка можно сказать. Опытный ДБА программер предложит довольно много способов ее решения. Так как мы с Вами ВБ - эшники, то мы это сделать тоже можем довольно многими способами. После перебора нескольких из них я остановился на использовании широко известном обществу универсального провайдера данных MS ADO. Вторую задачу можно тоже решать достаточно многими способами. Я, выбрал не самый легкий путь - использование Microsoft DTS Package Object Library - dtspkg.dll. Что это? Это ActiveX in-process DLL, которая появляется на машине после установки на ней MS SQL Servera (\Mssql\Binn\Dtspkg.dll). Именно она вызывается, когда Вы ручками конфигурируете DTS пакет в MS SQL, вызываете каким-либо способом пакет и т.д. Компонент позволяет программно контролировать ДТС пакеты. Весит он 1,85 мБ.

   Само использование таких довольно тяжело переносимых объектов (особенно dtspkg.dll) привело к решению о том, что программу лучше не таскать по куче компов, а поставить на сервере и сделать удаленно выполняемой. Т.е. использовать механизм Remote Automation (удаленной автоматизации) он же RPC (Remote Procedure Calling - удаленный вызов процедур). Идея в том что реально клиентская программа находится на каком-то сетевом компе и получает от удаленно выполняемого out-process EXE-server-а экземпляры классов (объектов) которые реализуют свойства и методы для решения поставленной задачи. По сути ничего необычного в этих объектах нет, с той лишь разницей, что выполняются они на сервере. Всем известная выгода таких объектов - при хорошей сетке сервер исполняет код гораздо быстрее, чем клиент, в качестве которого на моей работе попадаются даже четверки. Итак, класс являться контейнером для dtspkg.dll, а для получения структуры ДБФ файла использует АДО. Весь код класса Вы можете прочитать, скачав исходник. Я остановлюсь подробнее только на некоторых ключевых моментах и возможных подводных камнях. Класс состоит из четырех внутренних функций и одной внешней. Внутренняя функция get_structure решает задачу получения структуры файла. Для идентификации типов полей и их размеров использует вторую внутреннюю функцию fild_type. Функция get_structure в качестве аргументов принимает путь к папке, в которой лежит ДБФ-таблица и имя таблицы. В качестве результата функция возвращает динамический двухмерный массив. В первой колонке - имя поля, во второй - его тип данных и размер (если поле текстовое). Обратите внимание, что для установления соединения к ДБФ-таблице используется Microsoft OLE DB Provider for ODBC Drivers:

db.Open "Provider=MSDASQL.1;Persist Security Info=False;Mode=ReadWrite;Extended _
  Properties=Driver={Microsoft FoxPro VFP Driver (*.dbf)};UID=;SourceDB=" & path &_
  ";SourceType=DBF;Exclusive=Yes;BackgroundFetch=Yes;Collate=Machine;_
  Null=Yes;Deleted=Yes;"

lrs.Open "select * from " & target_table, db, adOpenKeyset, adLockOptimistic

ReDim Preserve ff(lrs.Fields.Count - 1, 2)

For i = 0 To lrs.Fields.Count - 1
    ff(i, 1) = lrs.Fields(i).Name: ff(i, 2) = fild_type(lrs.Fields(i))
Next i

    В первый столбец массива вносится имя поля. Во второй через вызов функции fild_type его тип. После выхода из цикла присваиваем результат - результату функции. Затем нормальный выход.

get_structure = ff
Exit Function

    Функция fild_type в качестве аргумента принимает АДО-поле и в зависимости от его типа возвращает аналогичный тип поля SQL. Номера типов были получены опытным путем - прогонкой всех имеющихся в наличии ДБФ-ов через неё. Можно конечно было просто перечислить весь DataTypeEnum, однако для конкретного АДО-провайдера(в данном случае VFP) эти константы будут разные. Например, 133 это adDBDate хотя есть и 7 - adDate, но VFP провайдер такой Type не разу не показал и т.д. Если какого-то типа здесь не окажется, я не виноват.

Select Case f.Type
    Case 131
        Select Case f.Precision
            Case 1 To 4
                fild_type = "smallint"
            Case Is > 4
                fild_type = "float"
        End Select
    Case 133
        fild_type = "smalldatetime"
    Case 129
        fild_type = "nvarchar (" & f.ActualSize & ")"
End Select

    Для текстовых полей добавляется еще и их размер. Внешняя функция trans непосредственно получает аргументы от приложения - клиента. Согласно этим аргументам проводит конфигурирование ДТС - пакета и затем его выполняет, что приводит к переносу данных из ДБФ - таблицы на сервер. Аргументы функции: path_to_source_file - путь к копируемому файлу, target_server - SQL сервер на который будем переносить, Dbase_on_the_server - БД на этом сервере - она получит таблицу, file_to_transer - имя ДБФ-таблицы.

Dim goPackage As New DTS.Package
goPackage.Name = "DTS"

    Это создается объектная переменная goPackage объекта DTS.Package. DTS.Package - самый верхний в иерархии Microsoft DTSPackage Object Library:

    Далее по коду будет происходить заполнение различных свойств объектов показанной иерархии. После заполнения всех необходимых свойств пакет можно будет выполнить. Настройка свойств пакета из кода напоминает визуальное проектирование пакета через Enterprise Manager. Преимущество использования кода в том, что каждый пакет будет динамически создан под любую перемещаемую таблицу. Ниже показана схема созданного руками ДТС-пакета в Enterprise Manager. Эта схема показана лишь для того, чтобы Вы могли сопоставить создаваемые из кода объекты этой схеме.

Dim oConnection As DTS.Connection
Set oConnection = goPackage.Connections.New("Microsoft.Jet.OLEDB.4.0")
oConnection.Name = "Connection 1"
...
goPackage.Connections.Add oConnection
Set oConnection = Nothing

Set oConnection = goPackage.Connections.New("SQLOLEDB")
oConnection.Name = "Connection 2"
...
goPackage.Connections.Add oConnection
Set oConnection = Nothing

    В коллекцию Connections добавляются два объекта Connection содержащие информацию о соединениях к OLE DB сервис-провайдерам. На схеме соответственно показано визуальное отображение этих объектов: Connection 1 и Connection 2 (обозначены цифрами 1 и 2).

Dim oStep As DTS.Step
...
Set oStep = goPackage.Steps.New
oStep.Name = "Create Table [" & Dbase_on_the_server & "].[dbo].[" & file_to_transer & "] Step"
oStep.Description = "Create Table [" & Dbase_on_the_server & "].[dbo].[" & file_to_transer & "] Step" ...
goPackage.Steps.Add oStep
Set oStep = Nothing
Set oStep = goPackage.Steps.New
oStep.Name = "Copy Data from " & file_to_transer & " to [" & Dbase_on_the_server & "].[dbo].[" &_
   file_to_transer & "] Step"
oStep.Description = "Copy Data from " & file_to_transer & " to [" & Dbase_on_the_server &_
  "].[dbo].[" & file_to_transer & "] Step"
...
goPackage.Steps.Add oStep
Set oStep = Nothing

    В коллекцию Steps (шаги) добавляются два объекта Step, которые содержат информацию о схеме(flow) пакета и выполняемых им задачах. Опять же на схеме шаги это два выделенных цветом вектора, показывающие направление исполнения пакета (цифры 3 и 4).

Dim fs() As String
fs = get_structure(path_to_source_file, file_to_transer)

    Вызов функции get_structure для получения структуры таблицы. Вызов происходит в этом месте т.к. структура перемещаемой таблицы сейчас понадобится первый раз.

Dim oTask As DTS.Task
...
Dim oCustomTask1 As DTS.ExecuteSQLTask
Set oTask = goPackage.Tasks.New("DTSExecuteSQLTask")
Set oCustomTask1 = oTask.CustomTask

    Здесь на первый взгляд запутанное присвоение объектных переменных вызвано оригинальностью иерархии (см. рис.)

oCustomTask1.Name = "Create Table [" & Dbase_on_the_server & "].[dbo]._
  [" & file_to_transer & "] Task"
oCustomTask1.Description = "Create Table [" & Dbase_on_the_server & "]._
  [dbo].[" & file_to_transer & "] Task"
oCustomTask1.SQLStatement = "if exists(SELECT [name] FROM [" & Dbase_on_the_server _
  & "].[dbo].[sysobjects] WHERE [name] = '" & file_to_transer & "' AND type = 'U') DROP TABLE [" &_
  Dbase_on_the_server & "].[dbo].[" & file_to_transer & "] CREATE TABLE [" &_
  Dbase_on_the_server & "].[dbo].[" & file_to_transer & "] (" & c1(fs) & ")"
...
goPackage.Tasks.Add oTask
Set oCustomTask1 = Nothing
Set oTask = Nothing

    В коллекцию задач Tasks добавляется объект Task, CustomTask которого это ExecuteSQLTask (на схеме это элемент с названием Create Table и номером 5). При запуске пакета эта задача будет первой операцией, которая будет производить какие-либо физические операции с БД. А именно создаст, пустую таблицу в БД на сервере согласно свойству CustomTask.SQLStatement. В него дополнительно к обычному SQL выражению Create Table добавлена проверка на существование таблицы с таким же именем (выражение if exists…). Если таблица уже есть она будет удалена. Таким грубым образом избегаем ошибки существования таблицы, наверное, знакомой многим пользователям ДТС-пакетов. В SQLStatement также присутствует вызов вспомогательной внутренней функции c1, которая разворачивает массив в одну строку вида:

[имя поля1] тип поля1 NULL, [имя поля2] тип поля2 NULL … [имя поляN] тип поляN NULL

Dim oCustomTask2 As DTS.DataPumpTask, i As Integer
Set oTask = goPackage.Tasks.New("DTSDataPumpTask")
Set oCustomTask2 = oTask.CustomTask
oCustomTask2.Name = "Copy Data from " & file_to_transer & "_
     to [" & Dbase_on_the_server & "].[dbo].[" & file_to_transer & "] Task"
oCustomTask2.Description = "Copy Data from " & file_to_transer & "_
     to [" & Dbase_on_the_server & "].[dbo].[" & file_to_transer & "] Task"
...
oCustomTask2.SourceSQLStatement = "select " & c2(fs) & " from `" & file_to_transer & "`"

    В коллекцию задач Tasks добавляется второй объект Task, CustomTask которого это DTSDataPumpTask (на схеме это вектор который совпадает с одним из векторов Step - номер 6). DTSDataPumpTask - это OLE DB сервис-провайдер который импортирует, экспортирует или трансформирует данные между гетерогенными источниками данных. Свойство oCustomTask2.SourceSQLStatement сделает выборку из исходного ДБФ-файла. Функция c2 разворачивает массив в строку вида: `имя поля1`, `имя поля2` … `имя поляN` Ниже показана иерархия объектов DTSDataPumpTask:

Set oTransformation = oCustomTask2.Transformations.New("DTS.DataPumpTransformCopy")
oTransformation.Name = "DirectCopyXform"
...

    В коллекцию задач Transformations добавляется объект Transformation содержащий информацию о преобразовании колонок исходной таблицы к полям таблицы получателя.

...
Dim ordinal As Long, name_ As String, flag As Long, size As Long, datatype As Long
For i = LBound(fs) To UBound(fs)
    ordinal = i + 1: name_ = fs(i, 1)
    If fs(i, 2) = "float" Or fs(i, 2) = "smalldatetime" Or fs(i, 2) = "smallint" Then     flag = 118: size = 0
    f fs(i, 2) = "float" Then datatype = 5
    If fs(i, 2) = "smalldatetime" Then datatype = 7
    If fs(i, 2) = "smallint" Then datatype = 2
    End If
    If Left(fs(i, 2), 8) = "nvarchar" Then flag = 102: size = Abs(Right(fs(i, 2), Len(fs(i, 2)) - 8)): datatype = 130
...

    Циклом перебираем поля источника и устанавливаем значения переменных ordinal (позиция поля), name (имя поля), flag (определяет DBCOLUMNFLAGS), size (макс. размер поля, для текстовых), datatype (тип даннях поля).

...
  Set oColumn = oTransformation.SourceColumns.New(name_, ordinal)
  oColumn.Name = name_
  oColumn.ordinal = ordinal
  oColumn.Flags = flag
  oColumn.size = size
  oColumn.datatype = datatype
  oColumn.Precision = 0
  oColumn.NumericScale = 0
  oColumn.Nullable = True
  oTransformation.SourceColumns.Add oColumn
  Set oColumn = Nothing
...

...
  Set oColumn = oTransformation.DestinationColumns.New(name_, ordinal)
  oColumn.Name = name_
  oColumn.ordinal = ordinal
  oColumn.Flags = flag
  oColumn.size = size
  oColumn.datatype = datatype
  oColumn.Precision = 0
  oColumn.NumericScale = 0
  oColumn.Nullable = True
  oTransformation.DestinationColumns.Add oColumn
  Set oColumn = Nothing
...

...
  Next i

  oCustomTask2.Transformations.Add oTransformation
  Set oTransformation = Nothing

 goPackage.Tasks.Add oTask
 Set oCustomTask2 = Nothing
 Set oTask = Nothing

    Последние команды, заполняющие коллекцию преобразований и задач. Таким образом, все объекты, показанные на визуальной схеме пакета, сконфигурированы. Пакет готов к выполнению.

 'goPackage.SaveToSQLServer target_server, "sa", "s"
 goPackage.Execute
 Set goPackage = Nothing

    Закомментированная строчка сохраняет пакет на сервере. goPackage.Execute - выполняет. Объект уничтожается и происходит нормальный выход из функции. Процесс разработки выглядел примерно так: написание модуля класса - отладка на локальной машине с локальным SQL сервером; перенос класса в проект ActiveX DLL - компиляция, отладка на локальной машине с локальным SQL сервером; перенос класса в проект ActiveX EXE - компиляция, вызов серверной части, работающей с любым доступным серверу домена SQL сервером через клиентскую часть на удаленной машине. EXE-сервер - обычный проект EXE-сервера, рекомендации по компиляции и отладке доступны(собственно цель статьи - показать возможности динамического создания ДТС-пакетов, а не разжевывание довольно простого в VB процесса создания объектов удаленной автоматизации). Не забудьте поставить флажок во вкладке Component окна Project Properties - Remote Server Files. Запуск откомпилированного файла на сервере зарегистрирует COM-класс на сервере. После чего установите с помощью программы Racmgr32.exe доступ во вкладке Client Access - Allow All Remote Creates. На сервере должна крутится программа Autmgr32.exe - менеджер удаленной автоматизации. Если я ничего не забыл, то на сервере все. На любой клиентской машине также регистрируется COM-класс с помощью такой строки:

clireg32 dbf_ADO_and_DTSka2.VBR -t dbf_ADO_and_DTSka2.TLB -s RRP

    Важно понимать, что удаленному серверу автоматизации доступна лишь та файловая система, которая доступна компу на котором этот сервер работает. То есть если Вы в качестве параметра будете передавать локальный путь клиентской машины, то для объекта автоматизации этот путь будет восприниматься как его сервера локальный путь. То есть, чтобы избежать тому подобных граблей, нужно соблюдать правило: в качестве пути удаленному классу передавать только лишь путь, который доступен этому серверу. Можно конечно шарить диски клиентской машины под сервер, и из клиентского приложения передавать локальный путь в стандарте UNC. Я избегаю этих сложностей использованием общедоступного диска на файл-сервере или сервере домена, который одинаково доступен для клиентской и серверной части.

Рекомендую сначала отладить класс на локальной машине с сервером. Хотя я испытывал сервер на 4-5 компах с Win2K, и вроде проблем не было, возможно, что Вам все-таки что-то придется подправить, а именно - ссылки в референсах могут меняться на АДО 2.5 - 2.6 и т.п. Я думаю для Вас это не будет проблемой. Другая грабля это состоит в том, что не все свойства могут быть настраиваемы в различных объектах иерархии DTS.Package. Причем это зависит в основном от версий OLE DB провайдеров или версии ДЛЛ. С этим тоже несложно бороться. Если при отладке класс выругается на ошибку присвоения какого-то либо свойства из кода, то это всего лишь означает что это свойство только на Read. Например ошибка: OleDBProperty 'Use Encryption for Data' was not found. Закомментируйте эту строку. И еще одна грабля. При отладке в IDE VB замечен один глючок: первый запуск из IDE почему-то не выполняет трансфер данных, а только создает, пустую таблицу. Следующие за этим запуски - нормально. В откомпилированном двоичном файле как-то сервер или просто екзешник не глючит, т.е. глюк чисто IDE.

    Вот пример простейшего клиентского приложения: на форме две кнопки и FileListBox.

Private Sub Form_Load()
    File1.path = "\\rrp\d\test" - общедоступный путь
End Sub

Private Sub Command1_Click()
Dim cc As New dbf_ADO_and_DTSka2.DTSka
    cc.trans "\\rrp\d\test ", "scooter", "test", "Rab"
End Sub

    Здесь SQL-сервер scooter, база - test, копируемый файл Rab.dbf. Нажми кнопку и получишь таблицу на сервере.

Private Sub Command2_Click()
Dim cc As New dbf_ADO_and_DTSka2.DTSka, i As Integer, s As String
    For i = 0 To File1.ListCount - 1
        s = File1.List(i)
        Debug.Print s
        cc.trans "\\rrp\d\test ", "scooter", "test", Left$(s, Len(s) - 4)
    Next i
End Sub

    Здесь все тоже только копируем на сервер в цикле пачку таблиц.

    Ну, очень интересный вопрос - производительность. Думаю понятно, что ДТС-пакет выполниться гораздо быстрее, чем insert по одной записи. А при больших таблицах отрыв возрастает. Плюс пакет конфигурируется в ОЗУ, а если еще на мощном сервере...

DBest Regards.