имеется код для доступа к БД SQL Server 2005 в клиент-серверной архитектуре
Spoiler
Show
Code: Select all
Sub OnClick(Byval Item)
'=====================================================================================
'Определяем значение локального(местного) и системного(UTC) времени
'=====================================================================================
Dim UTC_Time,Local_Time,objDateTime
Local_Time = Now()
Set objDateTime = CreateObject("WbemScripting.SWbemDateTime")
objDateTime.SetVarDate (Now())
UTC_Time = objDateTime.GetVarDate(False)
HMIRuntime.Trace "Определяем значение локального (местного) и системного (UTC) времени" &vbNewLine
HMIRuntime.Trace "Local Time : " &Local_Time &vbNewLine
HMIRuntime.Trace "UTC Time : " &UTC_Time &vbNewLine
'=====================================================================================
'Вычисляем разницу между локальным(местным) и системным(UTC) временем
'=====================================================================================
Dim Diff
Diff = DateDiff("h",UTC_Time,Local_Time)
HMIRuntime.Trace "Разница между локальным (местным) и системным (UTC) временем составляет " &Diff
HMIRuntime.Trace " часа" &vbNewLine
'=====================================================================================
'Определяем начало и конец даты-времени для выборки значений архивного тэга
'=====================================================================================
Dim StartY,StartM,StartD,StartH,StartMin,StartS
Dim EndY,EndM,EndD,EndH,EndMin,EndS
StartY = ScreenItems("DateTimePicker").Year
StartM = ScreenItems("DateTimePicker").Month
StartD = ScreenItems("DateTimePicker").Day
StartH = 0
StartMin = 0
StartS = 0
EndY = StartY
EndM = StartM
EndD = StartD
EndH = 23
EndMin = 59
EndS = 59
'=====================================================================================
'Формируем начальную и конечную строку типа дата-время для выборки значений архивного тэга
'=====================================================================================
Dim StartDate,EndDate
StartDate = CDate(StartY&"."&StartM&"."&StartD&" "&StartH&":"&StartMin&":"&StartS)
EndDate = CDate(EndY&"."&EndM&"."&EndD&" "&EndH&":"&EndMin&":"&EndS)
HMIRuntime.Trace "-----------------------------------------" &vbNewLine
HMIRuntime.Trace " Определяем диапазон даты и времени для отчета" &vbNewLine
HMIRuntime.Trace " Начало отчета " &StartDate &vbNewLine
HMIRuntime.Trace " Конец отчета " &EndDate &vbNewLine
HMIRuntime.Trace "-----------------------------------------" &vbNewLine
'Корректируем вышеполученные значения с учетом разницы времен
Dim corStartDate, corEndDate
corStartDate = DateAdd("h",-Diff,StartDate)
corEndDate = DateAdd("h",-Diff,EndDate)
HMIRuntime.Trace "Корректируем вышеполученные значения с учетом разницы локального (местного) и системного (UTC) времени" &vbNewLine
HMIRuntime.Trace " Начало отчета " &corStartDate &vbNewLine
HMIRuntime.Trace " Конец отчета " &corEndDate &vbNewLine
HMIRuntime.Trace "-----------------------------------------" &vbNewLine
If corEndDate <= corStartDate Then
ScreenItems("StPleaseWait").Visible = False
HMIRuntime.Trace "Выбран неверный диапазон времени ! ПРОВЕРТЕ !"& vbNewLine
Exit Sub
End If
HMIRuntime.Trace "-----------------------------------------" &vbNewLine
'=====================================================================================
'Читаем имя сервера
'=====================================================================================
Dim objServerName,SrvName
Set objServerName = HMIRuntime.Tags("@ServerName")
objServerName.Read
SrvName = objServerName.Value
HMIRuntime.Trace "Имя сервера : " &SrvName &vbNewLine
'=====================================================================================
'Читаем имя рантайм базы данных проекта
'=====================================================================================
Dim objDatasourceNameRT,DSN
Set objDatasourceNameRT = HMIRuntime.Tags("@DatasourceNameRT")
objDatasourceNameRT.Read
DSN = objDatasourceNameRT.Value
HMIRuntime.Trace "Имя рантайм базы данных проекта : " &DSN &vbNewLine
HMIRuntime.Trace "-----------------------------------------" &vbNewLine
'=====================================================================================
'Формируем строку подключения для провайдера WinCCOLEDBProvider
'=====================================================================================
Dim ConnStr
ConnStr = "Provider=WinCCOLEDBProvider.1;Catalog="&DSN&";Data Source="&SrvName&"\WinCC"
'=====================================================================================
'Работа с объектом ADODB.Connection
'=====================================================================================
'Устанавливаем соединение с БД SQL Server
Dim objConnection
Set objConnection = CreateObject("ADODB.Connection")
objConnection.ConnectionString = ConnStr 'строка подключения
objConnection.CursorLocation = 3 'положение курсора = 3 (всегда для нашего случая)
objConnection.open
If objConnection.state = 1 Then
HMIRuntime.Trace "Соединение с БД УСТАНОВЛЕННО" &vbNewLine
Else
HMIRuntime.Trace "Соединение с БД НЕ УСТАНОВЛЕННО" &vbNewLine
Exit Sub
End If
HMIRuntime.Trace "-----------------------------------------" &vbNewLine
'=====================================================================================
'Выбор ID архивного тега
'=====================================================================================
Dim TagID
TagID = 3
'=====================================================================================
'Формируем строку запроса к БД
'=====================================================================================
'Образец строки запроса: sSql = "Tag:R,1,'0000-00-00 00:01:00.000','0000-00-00 00:00:00.000'"
Dim sSql
sSql = "Tag:R, "&TagID&" , '"&Year(corStartDate)&"-"&Month(corStartDate)&"-"&Day(corStartDate)&_
" " & Hour(corStartDate)&":"&Minute(corStartDate)&":"&Second(corStartDate)&".000' , '"&_
Year(corEndDate)&"-"&Month(corEndDate)&"-"&Day(corEndDate)&" "&_
Hour(corEndDate)&":"&Minute(corEndDate)&":"&Second(corEndDate)&".000'"
HMIRuntime.Trace " " &vbNewLine
HMIRuntime.Trace "ID архивного тега : " &TagID &vbNewLine
If TagID <= 0 Then
HMIRuntime.Trace "ВНИМАНИЕ ! ОШИБКА ! ID архивного тэга <= 0. Прекращение выполниния программы !"& vbNewLine
Exit Sub
End If
HMIRuntime.Trace "Формируем строку запроса к БД : " &sSql &vbNewLine
HMIRuntime.Trace "-----------------------------------------" &vbNewLine
'=====================================================================================
'Работа с объектом ADODB.Command
'=====================================================================================
Dim objCommand
Set objCommand = CreateObject("ADODB.Command")
objCommand.CommandType = 1 'тип команды = 1 (текстовый)
Set objCommand.ActiveConnection = objConnection 'активное подключение
objCommand.CommandText = sSQL
'=====================================================================================
'Работа с объектом ADODB.RecordSet
'=====================================================================================
'Объекты RecordSet будут создаваться и удаляться отдельно для каждого тэга
Dim objRecordset
Set objRecordset = CreateObject("ADODB.Recordset")
Set objRecordset = objCommand.Execute ' извлекаем данные тэга из БД
Dim fields,records
fields = objRecordset.Fields.Count 'количество полей (столбцов) в таблице
records = objRecordset.RecordCount 'количество записе (строк) в таблице
HMIRuntime.Trace "количество полей (столбцов) в таблице БД для данного архивного тэга = " &fields &vbNewLine
HMIRuntime.Trace "количество записей (строк) в таблице БД для данного архивного тэга за сутки = " &records &vbNewLine
HMIRuntime.Trace "-----------------------------------------" &vbNewLine
'данный код демонстрирует строки таблици БД
objRecordset.MoveFirst
Dim f,s
For s=1 To 10
For f=0 To fields-1
HMIRuntime.Trace objRecordset.Fields(f) & " "
Next
HMIRuntime.Trace vbNewLine
objRecordset.MoveNext
Next
HMIRuntime.Trace "-----------------------------------------"
HMIRuntime.Trace " " &vbNewLine
End Sub
Пробовал также в строку конекции прописать UID и PWD учетки админа винды или студии БД (пользователь sa) но это тоже не принесло успеха
Code: Select all
ConnStr = "Provider=WinCCOLEDBProvider.1;Catalog="&DSN&";Data Source="&SrvName&"\WinCC"