Декомпрессия тэгов WinCC - SCADA - Ответ 12523470

Option Explicit
 
Public Sub export()
 
Dim r As Integer
r = 1
 
Dim catalog As String
catalog = Cells(r, 2)
r = r + 1
 
Dim ds As String
ds = Cells(r, 2)
r = r + 1
 
Dim tag_name As String
tag_name = Cells(r, 2)
r = r + 1
 
Dim beg_t As String
beg_t = Cells(r, 2)
r = r + 1
 
Dim end_t As String
end_t = Cells(r, 2)
r = r + 1
 
Dim c As ADODB.Connection
Dim rs As ADODB.Recordset
Dim cmd As ADODB.Command
 
Set c = CreateObject("ADODB.Connection")
c.ConnectionString = "Provider=WinCCOLEDBProvider.1;Catalog=" + catalog + ";Data Source=" + ds + ";"
c.CursorLocation = 3
c.Open
 
Set cmd = CreateObject("ADODB.Command")
cmd.CommandType = 1
Set cmd.ActiveConnection = c
cmd.CommandText = "TAG:R,'" + tag_name + "','" + beg_t + "','" + end_t + "'"
 
r = r + 1
Cells(r, 1).Value = "timestamps"
Cells(r, 2).Value = "values"
r = r + 1
 
Set rs = CreateObject("ADODB.Recordset")
Set rs = cmd.Execute
 
If rs.EOF Then
  rs.MoveFirst
  Do While Not rs.EOF
    Cells(r, 1).Value = rs.Fields(1).Value
    Cells(r, 2).Value = rs.Fields(2).Value
    r = r + 1
  
    rs.MoveNext
  Loop
End If
 
rs.Close
Set rs = Nothing
Set cmd = Nothing
c.Close
Set c = Nothing
 
End Sub

Sub OnClick(Byval Item)                                                                                                                             
  HMIRuntime.ActiveScreen.ScreenItems.Item("StaticTextBusy").Visible = True
 
  Dim s
  Set s = GetObject("script:C:\utc.wsc")
 
  Dim tag_name_field
  Dim folder_name_field
  Dim start_t_field
  Dim end_t_field
  Dim utc_field
 
  Set tag_name_field = HMIRuntime.ActiveScreen.ScreenItems.Item("tag_name")
  Set folder_name_field = HMIRuntime.ActiveScreen.ScreenItems.Item("folder_name")
  Set start_t_field = HMIRuntime.ActiveScreen.ScreenItems.Item("start_t")
  Set end_t_field = HMIRuntime.ActiveScreen.ScreenItems.Item("end_t")
  Set utc_field = HMIRuntime.ActiveScreen.ScreenItems.Item("utc")
  
  Dim tag_name
  tag_name = tag_name_field.Text
 
  Dim folder_name
  folder_name = folder_name_field.Text
  
  Dim utc
  utc = utc_field.Process
 
  Dim original_start_t 
  original_start_t = CDate(start_t_field.Text)
  Dim start_t 
  start_t = original_start_t
  If utc = 0 Then
    start_t = s.local_time_to_utc(Year(start_t), Month(start_t), Day(start_t), Hour(start_t), Minute(start_t), Second(start_t))
  End If
  
  Dim start_t_str
  start_t_str = CStr(Year(start_t)) + "-" + CStr(Month(start_t)) + "-" + CStr(Day(start_t)) + " " + CStr(Hour(start_t)) + ":" + CStr(Minute(start_t)) + ":" + CStr(Second(start_t))
 
  Dim original_end_t
  original_end_t = CDate(end_t_field.Text)
  Dim end_t
  end_t = original_end_t
  If utc = 0 Then
    end_t = s.local_time_to_utc(Year(end_t), Month(end_t), Day(end_t), Hour(end_t), Minute(end_t), Second(end_t))
  End If
  
  Dim end_t_str
  end_t_str = CStr(Year(end_t)) + "-" + CStr(Month(end_t)) + "-" + CStr(Day(end_t)) + " " + CStr(Hour(end_t)) + ":" + CStr(Minute(end_t)) + ":" + CStr(Second(end_t))
 
  If start_t >= end_t Then
    HMIRuntime.ActiveScreen.ScreenItems.Item("StaticTextBusy").Visible = False
    Call MsgBox("Недопустимый период. Начало периода должно быть меньше конца периода.", vbOKOnly, "Ошибка")
    Exit Sub
  End If
  
  Dim db_catalog
  db_catalog = HMIRuntime.Tags.Item("@DatasourceNameRT").Read
 
  Dim db_host
  db_host = HMIRuntime.Tags.Item("@ServerName").Read
 
  Dim connection
  Dim rs
  Dim cmd
 
  Set connection = CreateObject("ADODB.Connection")
  connection.ConnectionString = "Provider=WinCCOLEDBProvider.1;Catalog=" + db_catalog + ";Data Source=" + db_host + "\WinCC;"
  connection.CursorLocation = 3
  connection.Open
 
  Set cmd = CreateObject("ADODB.Command")
  cmd.CommandType = 1
  Set cmd.ActiveConnection = connection
  cmd.CommandText = "TAG:R,'" + tag_name + "','" + start_t_str + "','" + end_t_str + "'"
 
  Set rs = CreateObject("ADODB.Recordset")
  Set rs = cmd.Execute
  
  If rs.EOF Then
    HMIRuntime.ActiveScreen.ScreenItems.Item("StaticTextBusy").Visible = False
    Call MsgBox("Не обнаружено архивных записей за заданный период.", vbOKOnly, "Сообщение")
    Exit Sub
  End If
 
  Dim cur_t
  cur_t = Now
  
  Dim t_res
 
  Dim fso
  Set fso = CreateObject("Scripting.FileSystemObject")
  
  Dim f
  Set f = fso.CreateTextFile(folder_name + "data-" + CStr(Year(cur_t)) + "-" + CStr(Month(cur_t)) + "-" + CStr(Day(cur_t)) + "-" + CStr(Hour(cur_t)) + "-" + CStr(Minute(cur_t)) + "-" + CStr(Second(cur_t)) + "-" + Replace(Replace(tag_name, "/", "_"), "\", "-") + ".csv", True)
 
  f.WriteLine("Данные")
  f.WriteLine("Дата создания;" + CStr(cur_t))
  f.WriteLine("Тэг;" + tag_name)
  f.WriteLine("Начало периода;" + CStr(original_start_t))
  f.WriteLine("Конец периода;" + CStr(original_end_t))
  If utc <> 0 Then
    f.WriteLine("UTC;Разрешено")
  Else
    f.WriteLine("UTC;Неразрешено")
  End If
  f.WriteLine("Время;Значение")
 
  rs.MoveFirst
 
  Do While Not rs.EOF
    t_res = rs.Fields(1).value
    If utc = 0 Then
      t_res = s.utc_to_local_time(Year(t_res), Month(t_res), Day(t_res), Hour(t_res), Minute(t_res), Second(t_res))
    End If
    f.WriteLine(CStr(t_res) + ";" + CStr(rs.Fields(2).value))
    rs.MoveNext
  Loop
  
  rs.Close
  connection.Close
  
  f.Close
 
  HMIRuntime.ActiveScreen.ScreenItems.Item("StaticTextBusy").Visible = False
  Call MsgBox("Экспорт прошел успешно.", vbOKOnly, "Сообщение")
End Sub