You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

300 lines
12 KiB
QBasic

Attribute VB_Name = "MVWTrendConvert"
Option Explicit
'Modul mit Hilfsfunktionen für Trendkonvertierung
'© 2002, INOSOFT GmbH
'Version 4.05.000
'Methoden:
'- ArchiveConvert Konvertiert ein Archiv oder eine Archivdatei in eine
' CSV-Datei (Textdatei) oder MSAccess2000-Datenbank
'Abhängigkeiten/zusätzliche Dateien:
' - Verweise
' - DAO Microsoft DAO 3.6 Object Library (DAO360.dll)
' - Scripting Microsoft Scripting Runtime (scrrun.dll)
Public Enum ETrendConvertFormat
tcfCSV
tcfMDB
End Enum
Public Function ArchiveConvert(ByVal Archive As String, _
ByVal SourceFilename As String, _
ByVal StartTime As Date, ByVal EndTime As Date, _
ByVal DestFilename As String, _
ByVal Format As ETrendConvertFormat _
) As Boolean
'Konvertiert ein Archiv oder eine Archivdatei in eine
'CSV-Datei (Textdatei) oder MSAccess2000-Datenbank.
'Eingabe:
' Archive: Name des Archivs (== Parameter "Name" der Archivdefinition)
' SourceFileName: Pfad und Name der Archivdatei oder "", wenn StartTime und
' EndTime angegeben werden.
' Achtung: Angabe eines falschen Archivnamens oder einer
' falschen Archivdatei führt zu Fehlern und ggf. zum Absturz.
' StartTime/EndTime: Start- und Endzeitpunkt der zu konvertierenden Trenddaten.
' Bei Übergabe von 0 wird das gesamte Archiv ausgelesen.
' DestFileName: Pfad, Name inkl. Endung der Zieldatei in der die Daten
' gespeichert werden sollen.
' Achtung: Dateien mit gleichem Namen werden überschrieben!
' Falls DestFilename in einem externen Programm geöffnet ist,
' kann dies unter Umständen zu Problemen führen.
' Format: Format von DestFilename: entweder "mdb" oder "csv"
'Ausgabe:
' ArchiveConvert: True=erfolgreich konvertiert, False=Fehler
Const NewSession = -2147483648# 'Konstante für Status-Abfrage
Dim cntRet As Long 'Long für Status-Abfrage
Dim i As Long 'Long zum Zählen
Dim p() As Long 'Long-Array, das als Pointer benutzt wird
Dim xValues() As Variant 'Variant-Array zur Aufnahme der Aufzeichnungszeiten
Dim yValues() As Variant 'Variant-Array zur Aufnahme der Trenddaten
Dim sState() As Variant 'Variant-Array zur Aufnahme des Status
Dim vTimeNow As Date 'Variant für die Zeit der aktuellen Trendaufzeichnung
Dim vTimeEnd As Date 'Variant für die Zeit der letzten Trendaufzeichnung
Dim vTrends As Variant 'Variant zur Aufnahme der vorhandenen Trends
Dim tBrowser As VWSTrendBrowser 'TrendBrowser-Objekt
Dim tData As VWSTrendData 'TrendData-Objekt
Dim sNow As String 'Abfragestring
Dim sEnd As String 'Abfragestring
KillFile DestFilename 'Zieldatei löschen
On Error GoTo errArchiveConvert
'Neues TrendBrowser- und TrendData-Objekt erzeugen
Set tBrowser = New VWSTrendBrowser
Set tData = New VWSTrendData
'Füllen von vTrends
tBrowser.EnumTrends Archive, vTrends
'Redimensioniere die Arrays mit der Anzahl von vTrends
ReDim p(UBound(vTrends))
ReDim xValues(UBound(vTrends))
ReDim yValues(UBound(vTrends))
ReDim sState(UBound(vTrends))
'Ermittle Zeit der ersten und der letzten Trendaufzeichnung der Trend-Datei
If StartTime = #1/1/1900# Then
tBrowser.DataFileInfo Archive, SourceFilename, StartTime, EndTime
End If
'Welcher Dateityp wurde gewählt
Select Case Format
Case tcfCSV 'CSV-Datei wurde gewählt
Dim fso As FileSystemObject 'FileSystemObjekt
Dim ts As TextStream 'TextStream für fso
Dim s As String 'String für ts
'Neues FileSystem-Objekt erzeugen und Anlegen einer leeren "CSV-Datei"
Set fso = New FileSystemObject
Set ts = fso.CreateTextFile(DestFilename, True)
'Erzeugen einer Zeile mit "Time" und den Namen der Trends
'aus vTrends; Füllen der Arrays xValues,yValues und sState
s = "Time"
For i = 0 To UBound(vTrends)
s = s & ";" & vTrends(i)
s = Replace(s, ".", "_")
tData.GetTrendData Archive, SourceFilename, vTrends(i), StartTime, EndTime, xValues(i), yValues(i), sState(i)
Next i
ts.WriteLine s
'Ermitteln der Zeit der letzten Trendaufzeichnung
'in der gewählten Trenddatei
vTimeEnd = #1/1/1900#
For i = 0 To UBound(vTrends)
If Not IsEmpty(xValues(i)) Then
If DateDiff("s", xValues(i)(UBound(xValues(i))), vTimeEnd) < 0 Then
vTimeEnd = xValues(i)(UBound(xValues(i)))
End If
End If
Next i
'Schleife die läuft, bis die letzte Trendaufzeichnung der
'in der gewählten Datei bearbeitet wurde
Do
'Durchlaufen aller momentan ausgewählten
'Zeiten und ermitteln der niedrigsten Zeit
vTimeNow = Now
For i = 0 To UBound(vTrends)
If Not IsEmpty(xValues(i)) Then
If p(i) <= UBound(xValues(i)) Then
If DateDiff("s", xValues(i)(p(i)), vTimeNow) > 0 Then
vTimeNow = xValues(i)(p(i))
cntRet = i
End If
End If
End If
Next i
'Leere Zeile in die "CSV-Datei" einfügen,
'falls der Status der Trendaufzeichnung eine
'neue Session anzeigt
If sState(cntRet)(p(cntRet)) = NewSession Then
ts.WriteLine ""
End If
'Durchlaufen aller momentan ausgewählten Zeiten;
'falls das Array-Ende überschritten
'wurde wird s nur um das Trennzeichen ergänzt;
'ansonsten wird bei Übereinstimmung der momentan
'ausgewählten Zeit mit vTimeNow der String s
'um den zur momentan ausgewählten Zeit passenden
'Wert ergänzt und der zum Trend gehöhrende Pointer
'hochgezählt
s = vTimeNow
For i = 0 To UBound(vTrends)
If Not IsEmpty(xValues(i)) Then
If p(i) <= UBound(xValues(i)) Then
If xValues(i)(p(i)) = vTimeNow Then
s = s & ";" & yValues(i)(p(i))
p(i) = p(i) + 1
Else
s = s & ";" & yValues(i)(p(i))
End If
Else
s = s & ";"
End If
End If
Next i
'Schreiben der Zeile in die "CSV-Datei"
ts.WriteLine s
sNow = vTimeNow
sEnd = vTimeEnd
Loop Until sNow = sEnd
'Schließen des TextStreams
ts.Close
Case tcfMDB
Dim dbs As DAO.Database 'Datenbank-Objekt
Dim tdf As DAO.TableDef 'Tabellen-Objekt
Dim fld As DAO.Field 'Feld-Objekt
Dim rst As DAO.Recordset 'Recordset-Objekt
'Anlegen und öffnen der Datenbank;
Set dbs = CreateDatabase(DestFilename, dbLangGeneral)
Set dbs = OpenDatabase(DestFilename)
'Erzeugen der Tabelle "Trenddaten";
Set tdf = dbs.CreateTableDef("Trenddaten")
'Erzeugen des Feldes "Time" und hinzufügen des Feldes
'zur Tabelle "Trenddaten"
Set fld = tdf.CreateField("Time", dbDate)
tdf.Fields.Append fld
'Erzeugen von Feldern mit Namen der Trends aus vTrends
'und hinzufügen der Felder zur Tabelle "Trenddaten"
'Füllen der Arrays xValues,yValues und sState
For i = 0 To UBound(vTrends)
tData.GetTrendData Archive, SourceFilename, vTrends(i), StartTime, EndTime, xValues(i), yValues(i), sState(i)
s = vTrends(i)
s = Replace(s, ".", "_")
Set fld = tdf.CreateField(s, dbText)
fld.AllowZeroLength = True
tdf.Fields.Append fld
Next i
'Tabelle "Trenddaten" zur Datenbank hinzufügen
dbs.TableDefs.Append tdf
'Ermitteln der Zeit der letzten Trendaufzeichnung
'in der gewählten Trenddatei
vTimeEnd = #1/1/1900#
For i = 0 To UBound(vTrends)
If Not IsEmpty(xValues(i)) Then
If DateDiff("s", xValues(i)(UBound(xValues(i))), vTimeEnd) < 0 Then
vTimeEnd = xValues(i)(UBound(xValues(i)))
End If
End If
Next i
'neues Recordset-Objekt erzeugen
Set rst = tdf.OpenRecordset
'Schleife die läuft, bis die letzte Trendaufzeichnung der
'in der gewählten Datei bearbeitet wurde
Do
'Durchlaufen aller momentan ausgewählten
'Zeiten und ermitteln der niedrigsten Zeit
vTimeNow = Now
For i = 0 To UBound(vTrends)
If Not IsEmpty(xValues(i)) Then
If p(i) <= UBound(xValues(i)) Then
If DateDiff("s", xValues(i)(p(i)), vTimeNow) > 0 Then
vTimeNow = xValues(i)(p(i))
cntRet = i
End If
End If
End If
Next i
'Neuen Datensatz der Tabelle hinzufügen
rst.AddNew
'Leeren Datensatz in die Tabelle einfügen,
'falls der Status der Trendaufzeichnung eine
'neue Session anzeigt
If sState(cntRet)(p(cntRet)) = NewSession Then
rst.Update
rst.AddNew
rst.Fields("Time").Value = vTimeNow
Else
rst.Fields("Time").Value = vTimeNow
End If
'Durchlaufen aller momentan ausgewählten Zeiten;
'falls das Array-Ende überschritten
'wurde wird das Feld leergelassen
'ansonsten wird bei Übereinstimmung der momentan
'ausgewählten Zeit mit vTimeNow das Feld
'mit den zur momentan ausgewählten Zeit passenden
'Wert beschrieben und der zum Trend gehöhrende Pointer
'hochgezählt
For i = 0 To UBound(vTrends)
If Not IsEmpty(xValues(i)) Then
If p(i) <= UBound(xValues(i)) Then
If xValues(i)(p(i)) = vTimeNow Then
rst.Fields(vTrends(i)).Value = yValues(i)(p(i))
p(i) = p(i) + 1
Else
rst.Fields(vTrends(i)).Value = yValues(i)(p(i))
End If
Else
rst.Fields(vTrends(i)).Value = ""
End If
End If
Next i
rst.Update
sNow = vTimeNow
sEnd = vTimeEnd
Loop Until sNow = sEnd
'Datenbank wird geschlossen
dbs.Close
End Select
ArchiveConvert = True
Exit Function
errArchiveConvert:
ArchiveConvert = False
End Function
Private Sub KillFile(FileName As String)
On Error Resume Next
Kill FileName
End Sub