VBS, доступ к БД SQL Server 2005

Панели оператора PP/OP/TP/TD/MP.
Программные пакеты ProTool/WinCC flexible, SCADA система WinCC
FreshMan
Posts: 4
Joined: Fri Jun 29, 2018 11:25 am

VBS, доступ к БД SQL Server 2005

Post by FreshMan »

здравствуйте
имеется код для доступа к БД 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
данный код работает только в том случае когда на клиенте(Windows 7) создать такогоже админа с таким же паролем как на сервере(Windows Server 2008), в протином случае подключение к БД происходит, но поля recordset не читаются.
Пробовал также в строку конекции прописать UID и PWD учетки админа винды или студии БД (пользователь sa) но это тоже не принесло успеха

Code: Select all

ConnStr = "Provider=WinCCOLEDBProvider.1;Catalog="&DSN&";Data Source="&SrvName&"\WinCC"
Прошу помощи у сообщества
serg_58
Posts: 99
Joined: Thu Jun 03, 2010 7:43 pm
Location: Russia

Re: VBS, доступ к БД SQL Server 2005

Post by serg_58 »

Тут дело не строках VBS, а в правах доступа к SQL-серверу. Правила предоставления удалённого подключения к серверу, используя службы OLEDB или ODBC, подробно описаны в документации на сам SQL на сайте мелкомягких или в специализированных форумах.