test.bas

地面测试仪

Attribute VB_Name = "test"
Option Explicit
Option Base 1
Const hgCount = 320
Public Type dmyData
    dmyHead(11) As String
    dmyYT() As String
    dmyHL() As String
    dmyRep() As String
End Type
Function ByteToData(sbyte() As Byte, isAll As Integer) As dmyData
Dim tempData As dmyData
Dim strTemp As String
Dim timeArr() As Long
Dim i As Integer
Dim xianXing As Boolean
Dim startNum As Integer '开始位置
Dim hgCount As Integer, HgStart As Integer   '回归数据
Dim HlCount As Integer   '高低频数据

If isAll = 0 Then
    startNum = 0
    HgStart = 16384
    tempData.dmyHead(8) = sbyte(startNum + 42) + sbyte(startNum + 43) * 256 '高低频数据点数
Else
    startNum = 2
    HgStart = 2
    tempData.dmyHead(8) = "1" '高低频数据点数
End If

'表头
'WellNum As String       '井号
'RData As String         '日期
'RTime As String         '时间
'CloseWellTime As String '关井时间
'Ydeep As String         '液面深
'TPress As String        '套压
'VSound As String        '声速
'DataCount As String     '数据点数
'RPartition As String    '回归间隔
'Rcount As String        '回归点数
'FileName As String'文件名

'井号
For i = 0 To 11
    tempData.dmyHead(1) = tempData.dmyHead(1) & Chr(sbyte(startNum + i))
Next
'日期
For i = 12 To 19
    tempData.dmyHead(2) = tempData.dmyHead(2) & CStr(sbyte(startNum + i) And 15)
    If i = 15 Then
        tempData.dmyHead(2) = tempData.dmyHead(2) & "年"
    End If
    If i = 17 Then
        tempData.dmyHead(2) = tempData.dmyHead(2) & "月"
    End If
Next
tempData.dmyHead(2) = tempData.dmyHead(2) & "日"
'时间
For i = 20 To 23
    tempData.dmyHead(3) = tempData.dmyHead(3) & CStr(sbyte(startNum + i) And 15)
    If i = 21 Then tempData.dmyHead(3) = tempData.dmyHead(3) & ":"
Next
'关井时间


'获得液面深
tempData.dmyHead(5) = "0"
For i = 24 To 28
    tempData.dmyHead(5) = CStr(CSng(tempData.dmyHead(5)) + (sbyte(startNum + i) And 15) * 10 ^ (28 - i - 1))
Next

If sbyte(startNum + 29) = &H55 Then '时间是否线性
    xianXing = True
End If

 
'获得声速
tempData.dmyHead(7) = (sbyte(startNum + 36) + sbyte(startNum + 37) * 256) / 10

'获得套压
tempData.dmyHead(6) = "0"
For i = 38 To 41
    tempData.dmyHead(6) = CStr(CSng(tempData.dmyHead(6)) + (sbyte(startNum + i) And 15) * 10 ^ (41 - i))
Next
tempData.dmyHead(6) = Format(tempData.dmyHead(6) / 1000, "0.000")
'获得回归数据间隔(分钟) 间隔没有秒
tempData.dmyHead(9) = sbyte(HgStart + 30) + sbyte(HgStart + 31) * 60
'回归点数
tempData.dmyHead(10) = CStr(sbyte(HgStart + 44) + CLng(sbyte(HgStart + 45)) * 256)

'数据

hgCount = CInt(tempData.dmyHead(10))
HlCount = CInt(tempData.dmyHead(8))
'时间数组
timeArr = getTimeArr(CInt(tempData.dmyHead(9)), hgCount, xianXing)
ReDim tempData.dmyHL(HlCount, 3)
ReDim tempData.dmyYT(hgCount, 4)
'回归数据

For i = 1 To hgCount
    tempData.dmyYT(i, 1) = timeArr(i)
    tempData.dmyYT(i, 2) = Format((Trim(Str(sbyte(HgStart + 44 + i * 4))) + Trim(Str(sbyte(HgStart + 44 + i * 4 + 1))) * 256) / 10, "0.00")
    tempData.dmyYT(i, 3) = Format((Trim(Str(sbyte(HgStart + 44 + i * 4 + 2))) + Trim(Str(sbyte(HgStart + 44 + i * 4 + 3))) * 256) / 102.4, "0.000")
    tempData.dmyYT(i, 4) = "静压"
Next
'会少一点 补为0


'高低频
For i = 1 To HlCount
    tempData.dmyHL(i, 1) = Format(Trim(Str(sbyte(46 + i * 2))), "0.0")
    tempData.dmyHL(i, 2) = Format(Trim(Str(sbyte(46 + i * 2 + 1))), "0.0")
Next

ByteToData = tempData

End Function

'保存文件
Function saveFile(sdata As dmyData, strfile As String, isAll As Integer)
Dim fileNum As Integer, i As Integer

fileNum = FreeFile
   
Open strfile For Output As #fileNum
'写文件头
Print #fileNum, Space(20) & "地面测试仪数据记录" & IIf(isAll = 0, "", "(无高低频)")
Print #fileNum, Space(15) & "=========================="
Print #fileNum, Space(15) & "井    号:" & sdata.dmyHead(1)
Print #fileNum, Space(15) & "日    期:" & sdata.dmyHead(2)
Print #fileNum, Space(15) & "时    间:" & sdata.dmyHead(3)
Print #fileNum, Space(15) & "关井时间:" & sdata.dmyHead(4)
Print #fileNum, Space(15) & "液 面 深:" & Format(sdata.dmyHead(5), "0.0")
Print #fileNum, Space(15) & "套    压:" & sdata.dmyHead(6)
Print #fileNum, Space(15) & "声    速:" & sdata.dmyHead(7)
Print #fileNum, Space(15) & "数据点数:" & sdata.dmyHead(8)
Print #fileNum, Space(15) & "回归间隔:" & sdata.dmyHead(9)
Print #fileNum, Space(15) & "回归点数:" & sdata.dmyHead(10)
Print #fileNum, Space(15) & "文 件 名:" & strfile
Print #fileNum, " "

'写液面套压数据
Print #fileNum, Space(10) & "液面套压数据"
Print #fileNum, " "
Print #fileNum, "序号" & Space(6) & "累计时间(s)" & Space(6) _
              & "套压" & Space(6) & "液面数据"
Print #fileNum, " "
  
For i = 1 To CInt(sdata.dmyHead(10))
    Print #fileNum, strFormat(CStr(i), Chr(32), 10, False) & _
                    strFormat(sdata.dmyYT(i, 1), Chr(32), 10) & _
                    strFormat(Format(sdata.dmyYT(i, 3), "0.000"), Chr(32), 10) & _
                    strFormat(Format(sdata.dmyYT(i, 2), "0.00"), Chr(32), 10)
Next

'写液面高低频数据
If isAll = 0 Then
    Print #fileNum, Space(10) & "液面高低频数据"
    Print #fileNum, " "
    Print #fileNum, Space(5) & "序号" & Space(10) & "高频数据" & Space(10) & "低频数据"
    Print #fileNum, " "
    For i = 1 To CInt(sdata.dmyHead(8))
        Print #fileNum, strFormat(CStr(i), Chr(32), 10, False) & _
                        strFormat(sdata.dmyHL(i, 1), Chr(32), 10) & _
                        strFormat(sdata.dmyHL(i, 2), Chr(32), 10)
    Next
End If
Close #fileNum

End Function


Function getTimeArr(Interval As Integer, arrCount As Integer, isXianxing As Boolean) As Long()
Dim timerArr() As Long
ReDim timerArr(arrCount)
Dim i As Integer, j As Integer, k As Long

timerArr(1) = 0
For i = 2 To arrCount
    If Not isXianxing Then '时间非线性
        j = (i \ 8)
        Select Case True
        Case j <= 3
            k = Interval * 2 ^ j
        Case j < 3 And j <= 5
            k = Interval * 2 ^ 4
        Case Else
            k = Interval * 2 ^ 5
        End Select
        timerArr(i) = timerArr(i - 1) + k
    Else '时间线性增加
        timerArr(i) = Interval * (i - 1)
    End If
    Debug.Print timerArr(i)
Next
getTimeArr = timerArr
End Function
Public Function strFormat(strS As String, strb As String, iLen As Integer, Optional isLeft = True) As String
'strS '原字符串
'strB '补充字符
'iLen '补充后长度
'isLeft '默认左补齐
Dim strTemp As String

If Len(strS) >= iLen Then
    strFormat = strS
    Exit Function
Else
    If isLeft Then
        strTemp = Right(String(iLen, strb) & strS, iLen)
    Else
        strTemp = Left(strS & String(iLen, strb), iLen)
    End If
End If
strFormat = strTemp

End Function