1

Тема: VBS: Нужен совет по оптимизации копирования данных с IB в mysql

Добрый день!
Прошу помочь оптимизировать скрипт по скорости работы и удобочитаемости исходного кода, так как у самого опыта нет(((. Основной параметр - это время выполнения, сейчас его работа составляет около 80 - 90 секунд. Заранее благодарю.

' === Script Information Header ===

' ================================================================ Определяем переменные =========================================================================================
                                            log(" ")
                                            log(now() &"  1. Запускаем скрипт...")
'On Error Resume Next
x=timer
                                            
                                            log(now() &"  2. Объявляем переменные...")
Dim connA, connS
Dim rsA1, rsA2, rsA3                                                            ' Источник
Dim rsS1, rsS2, rsS3, rsS4, rsS5                                                    ' Клиент
Dim i, id
Dim DataNowVariable
Dim FirstArray(190)

Set dicGlobal = ParseAllINI("global.ini")                                                ' Задаем путь к файлу настроек
DataNowVariable = now()
'---------------------------------------------------------- Устанавливаем соединение с базой - mysql -----------------------------------------------------------------------------
                                            log(now() &"  3. Устанавливаем соединение с базой - mysql...")
Set connS = CreateObject("ADODB.Connection")
connS.Open ("Data Source = sphinx")                                                     ' Источник соединения с базой данных - Клиентом
set rsS2 = connS.Execute("SELECT personal.ID, personal.TYPE, personal.NAME FROM personal WHERE ((personal.TYPE)='DEP')")
                                            log(now() &"  4. Соединение установлено!")

'---------------------------------------------------------------- Удаление данных из таблиц - Клиента ----------------------------------------------------------------------------
connS.Execute("TRUNCATE TABLE PERSONAL")
                                            log(now() &"  5. В таблице PERSONAL удалены все записи...")
connS.Execute("TRUNCATE TABLE PHOTO")
                                            log(now() &"  6. В таблице PHOTO удалены все записи...")
connS.Execute("TRUNCATE TABLE RULEBINDINGS")
                                            log(now() &"  7. В таблице RULEBINDINGS удалены все записи...")
connS.Execute("TRUNCATE TABLE DEVBINDINGS")
                                            log(now() &"  8. В таблице DEVBINDINGS удалены все записи...")
connS.Execute("TRUNCATE TABLE DEVRULEBINDINGS")
                                            log(now() &"  9. В таблице DEVRULEBINDINGS удалены все записи...")


'---------------------------------------------------- Загружаем привязки режимов к устройствам DEVRULEBINDINGS --------------------------------------------------------------------
set rsS5 = CreateObject("ADODB.Recordset")
rsS5.CursorType = 3
rsS5.LockType = 3
rsS5.Open "DEVRULEBINDINGS", connS
For Each aKey In dicGlobal.Item("POINTS")                                                    ' Берем режим с конфигурационного файла
        rsS5.AddNew
        rsS5.Fields("DEV_ID").Value = aKey
        rsS5.Fields("RULE_ID").Value = dicGlobal.Item("POINTS").Item(aKey)                                ' Загружаем переменную режима в базу клиент
        rsS5.Update
                rsS5.MoveNext
Next
                                            log(now() &" 10. В таблице DEVRULEBINDINGS созданы привязки.")
rsS5.Close

'------------------------------------------------------------ Устанавливаем соединение с базой - IB -----------------------------------------------------------------------------
                                            log(now() &" 11. Устанавливаем соединение с базой - IB...")
Set connA = CreateObject("ADODB.Connection")
connA.Open ("Data Source=Апакс25") ' Здесь необходимо указать источник соединения с базой данных
set rsA1 = connA.Execute("SELECT TCARDISSUE.FID, TCARDHOLDERS.FLAST, TCARDHOLDERS.FFIRST, TCARDHOLDERS.FMIDDLE, TCARDISSUE.FACTIVE, TCARDISSUE.FDATETO, TCARDISSUE.FCARDNUM, TCARDISSUE.FCREATEDATE, TCARDHOLDERS.FTITLE, TCARDHOLDERS.FDEPT, TCARDIMAGES.FIMG, TOTHERVALUE.FOTHER11, TOTHERVALUE.FOTHER12, TOTHERVALUE.FOTHER13, TOTHERVALUE.FOTHER14, TOTHERVALUE.FOTHER15, TOTHERVALUE.FOTHER16 FROM (TCARDIMAGES INNER JOIN (TCARDHOLDERS INNER JOIN TCARDISSUE ON TCARDHOLDERS.FID = TCARDISSUE.FCHID) ON TCARDIMAGES.FID = TCARDHOLDERS.FPHOTO) INNER JOIN TOTHERVALUE ON TCARDISSUE.FCHID = TOTHERVALUE.FCHID ORDER BY TCARDISSUE.FID")
set rsA2 = connA.Execute("SELECT TCARDHOLDERS.FDEPT FROM TCARDHOLDERS GROUP BY TCARDHOLDERS.FDEPT ORDER BY TCARDHOLDERS.FDEPT")
set rsA3 = connA.Execute("SELECT TCARDAL.FCARDISSUE, TCARDAL.FAL FROM TCARDAL")
                                            log(now() &" 12. Соединение установлено!")

'----------------------------------------------------------------------Создание разделов-----------------------------------------------------------------------------------------
                                            log(now() &" 13. Создаем разделы...")
set rsS1 = CreateObject("ADODB.Recordset")
rsS1.CursorType = 3
rsS1.LockType = 3
rsS1.Open "PERSONAL", connS
rsA2.MoveFirst
id=4
do while not rsA2.eof
        id = id+1
        FirstArray(id) = rsA2(0)
    With rsS1
        .AddNew
        .Fields("ID").Value = id
        .Fields("PARENT_ID").Value = "0"
        .Fields("TYPE") = "DEP"
        .Fields("NAME").Value = FirstArray(id)
        .Fields("STATUS").Value = "AVAILABLE"
        .Fields("CREATEDTIME").Value = DataNowVariable
        .Fields("CODEKEYTIME").Value = DataNowVariable
        .Update
    End With
rsA2.MoveNext
loop
                                            log(now() &" 14. В таблице PERSONAL созданы разделы...Общим количеством - "& id &" раздела.")
rsA2.Close

'------------------------------------------------------------- Создание персонала, загрузка фотографий --------------------------------------------------------------------------
                                            log(now() &" 15. Создаем пользователей, загружаем фотографии и помещяем пользователей в разделы ...")
rsA1.MoveFirst
i=0
do while not rsA1.eof
i=i+1
    rsS1.AddNew
        rsS1.Fields("ID").Value = rsA1(0)
        For id = 5 to 190
                if FirstArray(id) = rsA1(9) then
                rsS1.Fields("PARENT_ID").Value = id
                    exit For
                end if
        Next                                                             ' Определяем отдел
        rsS1.Fields("NAME").Value = trim(""&rsA1(1)&" "&rsA1(2)&" "&rsA1(3))                                            ' Складываем фамилию, имя, отчество 
        rsS1.Fields("POS").Value = rsA1(8)                                            ' Должность
        rsS1.Fields("TABID").Value = rsA1(11)                                            ' Табельный номер
        rsS1.Fields("TYPE") = "EMP"                                                ' Присваиваем идентификатор персонала
        rsS1.Fields("EXPTIME").Value = rsA1(5)                                            ' Окончание срока действия карты
        rsS1.Fields("CREATEDTIME").Value = rsA1(7)                                        ' Дата создания
        rsS1.Fields("DESCRIPTION").Value = trim("Номер приказа:"&rsA1(12)&vbCrLf&"Примечание:"&rsA1(13)&vbCrLf&"№ АК:"&rsA1(14)&vbCrLf&"Страна:"&rsA1(15)&vbCrLf&"Срок действия АК:"&rsA1(16))        ' Складываем недостающие дополнительные поля
        rsS1.Fields("CODEKEY").Value = ConverterCodeKeyCart(rsA1(6))                                ' Преобразуем код карты
        Select Case rsA1(4)
            Case 1
            rsS1.Fields("STATUS").Value = "AVAILABLE"
            Case Else
            rsS1.Fields("STATUS").Value = "FIRED"
            rsS1.Fields("FIREDTIME").Value = rsA1(5)
        End Select
        rsS1.Fields("CODEKEYTIME").Value = DataNowVariable
        rsS1.Update
    
        data = rsA1(10)
Set objCommand = CreateObject("ADODB.Command")          
objCommand.ActiveConnection = connS                                
objCommand.CommandText = "INSERT INTO PHOTO (ID,PREVIEW_WIDTH,PREVIEW_HEIGHT,PREVIEW_RASTER,HIRES_WIDTH,HIRES_HEIGHT,HIRES_RASTER) VALUES ("&rsA1(0)&",256,307,?,256,307,?)"  ' Копируем фото из одной базы в другую
objCommand.CommandType = 1
objCommand.Parameters.Append( objCommand.CreateParameter("x",128,1,-1,data) )                                ' Создаем параметр 1
objCommand.Parameters.Append( objCommand.CreateParameter("y",128,1,-1,data) )                                ' Создаем параметр 2
objCommand.Execute()
rsA1.MoveNext
loop
                                            log(now() &" 16. Пользователи созданы...Общее количество - "& i &" пользователей.")

'------------------------------------------------------------------------- Добавляем режимы --------------------------------------------------------------------------------
'                                            log(now() &" 17. Добавляем исключения и режим по умолчанию в таблицу RULEBINDINGS")
'set rsS3 = CreateObject("ADODB.Recordset")
'rsS3.CursorType = 3
'rsS3.LockType = 3
'rsS3.Open "RULEBINDINGS", connS
'rsA3.MoveFirst
'do while not rsA3.eof
'       rsS3.AddNew 
'       rsS3.Fields("PERSONAL_ID").Value = rsA3(0)
'       rsS3.Fields("RULE_ID").Value = "1"
'       rsS3.Update
'       rsA3.MoveNext
'loop        
'
'do while not rsA3.eof
'       rsS3.AddNew 
'       rsS3.Fields("PERSONAL_ID").Value = rsA3(0)
'       rsS3.Fields("RULE_ID").Value = dicGlobal.Item("LEVELS").Item(trim(rsA3(1)))
'       rsS3.Update
'       rsA3.MoveNext
'loop        
'rsA3.Close                    
'                                            log(now() &" 18. В таблице RULEBINDINGS добавлены исключения.")

'--------------------------------------------------------------------------- Завершение работы ---------------------------------------------------------------------------------
                                            log(now() &" 19. Закрываем все соединения...")
connA.Close
connS.Close
                                            log(now() &" 20. Работа скрипта завершена.")
                                            log("время выполнения скрипта - " & (timer-x))

' ========================================================================= Функции и процедуры ================================================================================


' ------------------------------------------------------------------------------- Конвертер кода карты ------------------------------------------------------------------------- 
Function ConverterCodeKeyCart(CodeKey)
ConverterCodeKeyCart = trim("18" & String((6-Len(hex(CodeKey))), "0")& hex(CodeKey) & "00000000")
End Function

'------------------------------------------------------------------------------- Введение журнала событий ----------------------------------------------------------------------
Sub log(sData)
    Dim ts, ForAppending, fso
    Set fso = CreateObject("Scripting.FileSystemObject")
    ForAppending = 8
    Set ts = fso.OpenTextFile("log.txt", ForAppending, True)
    ts.Write sData & chr(13) & chr(10)
    ts.Close
    Set fso = nothing
End Sub

'---------------------------------------------------------------------------- Чтение настроек из файла --------------------------------------------------------------------------
Function ParseAllINI(strIniFileName)
'On Error Resume Next
Dim ParseAINI, blnFoundSection, strSection
Dim intEquals, sKey, sVal, i, sLine, tsIni
Set fso = CreateObject("Scripting.FileSystemObject")

blnFoundSection = False
Err.Clear
If FSO.FileExists(strIniFileName) Then

    Set tsIni = FSO.OpenTextFile(strIniFileName)
    Set ParseAllINI = WScript.CreateObject("Scripting.Dictionary")
    
    Do While Not tsIni.AtEndOfStream
        sLine = ""
        sLine = Trim(tsIni.ReadLine)
        If sLine <> "" Then                                                              ' проверяем не пустая строка
            If Left(sLine,1) <> ";" Then                                                 ' проверяем не комментарий ли это
                If Left(sLine,1) = "[" Then                                              ' проверяем не является ли строка наименованием секции
                    blnFoundSection = True                                               ' и если является устанавливаем параметр в "истинна"
                    'Msgbox sLine & " section found"
                    strSection = Left(sLine, Len(sLine) - 1)
                    strSection = Right(strSection, Len(strSection) - 1)
                    Set ParseAINI = Wscript.CreateObject("Scripting.Dictionary")
                    ParseAllINI.Add UCase(strSection), ParseAINI
                Else
                    'key and value logic
                    intEquals = InStr(1, sLine, "=")
                    If (intEquals <= 1) Then
                        'msgbox "error: the following line is invalid " & sLine
                    Else
                        'weve found a valid line
                        sKey = Left(sLine, intEquals - 1)
                        sVal = Right(sLine, Len(sLine) - intEquals)
                        
                        
                        Err.Clear
                        ParseAINI.Add Trim(LCase(sKey)), Trim(sVal)
                        If Err.Number <> 0 Then
                            'msgbox "unable to add to dictionary object"
                        End If
                        'msgbox strSection & " " & sKey & ";;;;" & sVal
                        
                    
                    'key and value logic end if
                    End If
                End If
            End If
        End If
    Loop
    
    tsIni.Close
    Set tsIni = Nothing
    
    If blnFoundSection = False Then
        Set ParseAllINI = Wscript.CreateObject("Scripting.Dictionary")
    End If

Else
    Set ParseAllINI = Wscript.CreateObject("Scripting.Dictionary")
End If

End Function
Кто рано встает того и тапки