Тема: 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