mdataoperate.bas

地面测试仪

Attribute VB_Name = "mDataOperate"
Option Base 1
Option Explicit
'数据操作模块
'文件读取 转换 保存
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Private Declare Function GetPrivateProfileSection Lib "kernel32" Alias "GetPrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Const strRepSc = "报表"
Const strOp = "参数"


'获得参数
Function getOp(strHs As String, strZs As String, strFile As String)
'**********************************************************************
'* 函数名称:getOp
'* 函数描述:获得静压计算的参数
'* 参数列表:strHs含水, strZs油层中深, strFile文件名
'* 返    回:
'* 作    者:
'* 创建日期: 2007-10-08
'**********************************************************************
strHs = ReadIni(strOp, "含水", strFile)
strZs = ReadIni(strOp, "中深", strFile)

strHs = IIf(strHs = "", "0", strHs)
strZs = IIf(strZs = "", "0", strZs)

End Function
'写参数
Function writeOp(strHs As String, strZs As String, strFile As String)
'**********************************************************************
'* 函数名称:writeOp
'* 函数描述:保存静压计算的参数
'* 参数列表:strHs含水, strZs油层中深, strFile文件名
'* 返    回:
'* 作    者:
'* 创建日期: 2007-10-08
'**********************************************************************
WriteINI strOp, "含水", strHs, strFile
WriteINI strOp, "中深", strZs, strFile
End Function

'
Public Function havaRep(strPath) As Boolean
'**********************************************************************
'* 函数名称:havaRep
'* 函数描述:判断是否包含报表
'* 参数列表:strPath文件名
'* 返    回:布尔值
'* 作    者:
'* 创建日期: 2007-10-08
'**********************************************************************
Dim strTemp As String * 2000
Dim strT As String
Dim intNum As Long
intNum = Len(strRepSc)

GetPrivateProfileSection strRepSc, strTemp, 2000, strPath
strT = Mid(strTemp, 1, InStr(1, strTemp, Chr(0)))
strT = Replace(strT, Chr(0), "")
If strT = "" Then
    havaRep = False
Else
    havaRep = True
End If

End Function

'读取ini
Public Function ReadIni(Appname As String, KeyName As String, StrFileName As String) As String
'**********************************************************************
'* 函数名称:ReadIni
'* 函数描述:读取ini
'* 参数列表:Appname节名, KeyName键名, StrFileName文件名
'* 返    回:字符串
'* 作    者:
'* 创建日期: 2007-10-08
'**********************************************************************
On Error GoTo errlab
    Dim rc As Long
    Dim re As String * 1000
    rc = GetPrivateProfileString(ByVal Appname, ByVal KeyName, ByVal "", ByVal re, ByVal 1000, ByVal StrFileName)
    If rc > 0 Then
        rc = InStr(1, re, Chr(0))
        ReadIni = Left(re, rc - 1)
    Else
        ReadIni = ""
    End If
errlab:
    Exit Function
End Function
'写ini
Public Sub WriteINI(Appname As String, KeyName As String, KeyVal As String, StrFileName As String)
'**********************************************************************
'* 函数名称:WriteINI
'* 函数描述:保存ini
'* 参数列表:Appname节名, KeyName键名, KeyVal键值, StrFileName文件名
'* 返    回:字符串
'* 作    者:
'* 创建日期: 2007-10-08
'**********************************************************************
On Error GoTo Errdeal
    WritePrivateProfileString ByVal Appname, ByVal KeyName, ByVal KeyVal, ByVal StrFileName
Exit Sub
Errdeal:
        Resume Next
End Sub
'存报表
Public Sub SaveRep(repArr() As String, strPath As String)
'**********************************************************************
'* 函数名称:SaveRep
'* 函数描述:保存报表
'* 参数列表:repArr()报表数组, strPath文件名
'* 返    回:
'* 作    者:
'* 创建日期: 2007-10-08
'**********************************************************************
Dim i As Integer

For i = 1 To UBound(repArr)
    WriteINI strRepSc, "Data" & i, repArr(i), strPath
Next
End Sub

'读报表
Public Function ReadRep(strPath As String, repArr() As String)
'**********************************************************************
'* 函数名称:ReadRep
'* 函数描述:读取报表
'* 参数列表: strPath文件名,repArr()报表数组
'* 返    回:
'* 作    者:
'* 创建日期: 2007-10-08
'**********************************************************************
Dim i As Integer
For i = 1 To UBound(repArr)
    repArr(i) = ReadIni(strRepSc, "data" & i, strPath)
Next
End Function

'将字节转换为数据
Function ByteToData(sByte() As Byte, isAll As Integer) As dmyData
'**********************************************************************
'* 函数名称:ByteToData
'* 函数描述:将字节转换为数据
'* 参数列表: sbyte()字节数组, isAll 0包括高低频，其他只有回归数据
'* 返    回:地面仪数据
'* 作    者:
'* 创建日期: 2007-10-08
'**********************************************************************
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   '高低频数据
On Error GoTo errlab

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

'表头
'1      '井号
'2      '日期
'3      '时间
'4      '关井时间
'5      '液面深
'6      '套压
'7      '声速
'8      '数据点数
'9      '回归间隔
'10     '回归点数
'11     '文件名

'井号
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, 5)
'回归数据

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

'高低频
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
tempData.ReadSuc = True
ByteToData = tempData

Exit Function
errlab:

tempData.ReadSuc = False
ByteToData = tempData
End Function

'将数据转换为字节
Function DataToByte(SData As dmyData) As Byte()
'**********************************************************************
'* 函数名称:ByteToData
'* 函数描述:将数据转换为字节
'* 参数列表:SData 地面仪数据
'* 返    回:字节数组
'* 作    者:
'* 创建日期: 2007-10-08
'**********************************************************************

Dim tempData() As Byte
Dim strTemp As String
Dim i As Integer
Dim startNum As Integer
'井号
startNum = 2 '为了测试用，应该改为0
ReDim tempData(0 To startNum + 47)
strTemp = SData.dmyHead(1)
For i = 0 To 11
    If i <= Len(strTemp) - 1 Then
        tempData(startNum + i) = Asc(Mid(strTemp, i + 1, 1))
    Else
        tempData(startNum + i) = 32
    End If
Next
'日期
strTemp = Format(SData.dmyHead(2), "YYYYMMDD")
For i = 12 To 19
    tempData(startNum + i) = Asc(Mid(strTemp, i - 11, 1))
Next
'时间
strTemp = Format(SData.dmyHead(3), "HHMM")
For i = 20 To 23
    tempData(startNum + i) = Asc(Mid(strTemp, i - 19, 1))
Next
'液面深
strTemp = Format(SData.dmyHead(5) * 10, "00000")
For i = 24 To 28
    tempData(startNum + i) = 0 & Mid(strTemp, i - 23, 1)
Next
'是否线性
If CInt(SData.dmyYT(9, 1) - SData.dmyYT(8, 1)) = CInt(SData.dmyHead(9)) Then
    tempData(startNum + 29) = &H55
Else
    tempData(startNum + 29) = &HFF
End If
'时间间隔
strTemp = SData.dmyHead(9)
tempData(startNum + 30) = strTemp Mod 60
tempData(startNum + 31) = strTemp \ 60
'声速
strTemp = Format(SData.dmyHead(7) * 10, "0000")
tempData(startNum + 36) = strTemp Mod 256
tempData(startNum + 37) = strTemp \ 256
'套压
strTemp = Format(SData.dmyHead(6) * 1000, "0000")
For i = 38 To 41
    tempData(startNum + i) = 0 & Mid(strTemp, i - 37, 1)
Next
'点数
strTemp = SData.dmyHead(10)
tempData(startNum + 44) = strTemp Mod 256
tempData(startNum + 45) = strTemp \ 256
'----------------------------------------------------------
'数据48开始 4位一组
'-----------------------------------------------------------
ReDim Preserve tempData(0 To startNum + 47 + strTemp * 4)
For i = 1 To strTemp
   tempData(startNum + 48 + (i - 1) * 4) = (SData.dmyYT(i, 2) * 10) Mod 256
   tempData(startNum + 48 + (i - 1) * 4 + 1) = (SData.dmyYT(i, 2) * 10) \ 256
   tempData(startNum + 48 + (i - 1) * 4 + 2) = (SData.dmyYT(i, 3) * 102.4) Mod 256
   tempData(startNum + 48 + (i - 1) * 4 + 3) = (SData.dmyYT(i, 3) * 102.4) \ 256
Next
DataToByte = tempData

End Function


'保存文件
Function saveFile(SData As dmyData, strFile As String)
'**********************************************************************
'* 函数名称:saveFile