📄 form1.frm
字号:
VERSION 5.00
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 6165
ClientLeft = 3960
ClientTop = 2040
ClientWidth = 7245
LinkTopic = "Form1"
ScaleHeight = 6165
ScaleWidth = 7245
Begin VB.TextBox Text2
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 240
TabIndex = 3
Text = "请输入保存数据的目标文件名！"
Top = 1200
Width = 6735
End
Begin VB.TextBox Text1
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 240
TabIndex = 2
Text = "请输入要转换的源文件名！"
Top = 600
Width = 6735
End
Begin VB.CommandButton Command2
Caption = "方入文件内容"
Height = 495
Left = 3600
TabIndex = 1
Top = 5640
Width = 1935
End
Begin VB.CommandButton Command1
Caption = "读入源文件名及内容"
Height = 495
Left = 1320
TabIndex = 0
Top = 5640
Width = 1935
End
Begin VB.Label Label4
Caption = "读入文件中数据内容："
Height = 375
Left = 240
TabIndex = 7
Top = 2280
Width = 1815
End
Begin VB.Label Label3
Caption = "Label3"
Height = 2655
Left = 120
TabIndex = 6
Top = 2640
Width = 6975
End
Begin VB.Label Label2
Height = 375
Left = 240
TabIndex = 5
Top = 1800
Width = 6735
End
Begin VB.Label Label1
Caption = "延寿前兆数据转换程序"
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000040C0&
Height = 375
Left = 1920
TabIndex = 4
Top = 120
Width = 2895
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim s As String
Dim Txtfile(1 To 8) As TextStream
'************************使用 File System Objects 读取文件*****************************************
Private Sub Command1_Click()
On Error Resume Next
Dim Len1 As String
Dim Len1numb As Integer
Dim Msg As String
Dim TimeRead As Date
Dim StrTime As String
Dim HangHao
Dim A, b
Dim ShiJian 'As String
Dim ShiJianLastChr
Dim ShiJianUpChr
Dim ShiJianCha '时间差
Dim DataRead(1 To 8) As Variant
Dim i As Long
Dim j As Long
Dim iASC As String
'生成目标文件的路径 -〉在当前路径内
Set fso = CreateObject("Scripting.FileSystemObject")
'Set Txtfile = fso.CreateTextFile(Text2.Text, False) '不覆盖已有文件'
Set Txtfile(1) = fso.CreateTextFile(Text2.Text & "水位.txt") ', False) '不覆盖已有文件'
Set Txtfile(2) = fso.CreateTextFile(Text2.Text & "水温.txt") ', False) '不覆盖已有文件'
Set Txtfile(3) = fso.CreateTextFile(Text2.Text & "气压.txt") ', False) '不覆盖已有文件'
Set Txtfile(4) = fso.CreateTextFile(Text2.Text & "气温.txt") ', False) '不覆盖已有文件'
Set Txtfile(5) = fso.CreateTextFile(Text2.Text & "深层水温1.txt") ', False) '不覆盖已有文件'
Set Txtfile(6) = fso.CreateTextFile(Text2.Text & "东西倾斜.txt") ', False) '不覆盖已有文件'
Set Txtfile(7) = fso.CreateTextFile(Text2.Text & "南北倾斜.txt") ', False) '不覆盖已有文件'
Set Txtfile(8) = fso.CreateTextFile(Text2.Text & "深层水温2.txt") ', False) '不覆盖已有文件'
'''' 1441 , 10
''''行号,时间,1,2,3,4,5,6,7,8,
''''1,05-03-19 00:00:00,7.1420,6.80,1001.5,0.51,-3.2768,0.8510,-0.0688,0.0951,
''''2,05-03-19 00:01:00,7.1425,6.80,1001.6,0.51,-3.2768,0.8509,-0.0688,0.0951,
''''3,05-03-19 00:02:00,7.1425,6.80,1001.6,0.51,-3.2768,0.8502,-0.0694,0.0951,
''''4,05-03-19 00:03:00,7.1425,6.80,1001.6,0.51,-3.2768,0.8502,-0.0694,0.0951,
''''5,05-03-19 00:04:00,7.1425,6.80,1001.6,0.51,-3.2768,0.8500,-0.0695,0.0951,
''''6,05-03-19 00:05:00,7.1420,6.80,1001.7,0.51,-3.2768,0.8504,-0.0693,0.0951,
''''7,05-03-19 00:06:00,7.1420,6.80,1001.7,0.51,-3.2768,0.8505,-0.0691,0.0951,
''''8,05-03-19 00:07:00,7.1425,6.80,1001.7,0.51,-3.2768,0.8501,-0.0694,0.0951,
''''9,05-03-19 00:08:00,7.1425,6.81,1001.7,0.51,-3.2768,0.8503,-0.0694,0.0951,
''''10,05-03-19 00:09:00,7.1425,6.81,999.9.7,0.51,-3.2768,0.8505,-0.0693,0.0951, #####999.9#####字符数变了
''''11,05-03-19 00:10:00,7.1425,6.81,999,0.51,-3.2768,0.8506,-0.0691,0.0951,
''''12,05-03-19 00:11:00,7.1425,6.81,998.6,0.51,-3.2768,0.8506,-0.0692,0.0951,
'跳过2行
Set fso = CreateObject("Scripting.FileSystemObject")
Set fil = fso.GetFile(Form1.Text1.Text)
Set Ts = fil.OpenAsTextStream(ForReading)
'
''Ts.SkipLine
''Ts.SkipLine
'ShiJianLastChr = ""
'ShiJianUpChr = "-1"
Time1 = ""
Time2 = ""
ShiJianCha = 0
HangHao = ""
A = 0
b = 0
Do
'行号:
ReadData (0)
HangHao = Read1Tiao
If HangHao = " " Then
GoTo ErrEnd
End If
'时间:
Q: ReadData (0)
ShiJian = Read1Tiao
If Len(ShiJian) = 17 Then
GoTo P:
Else
GoTo Q:
End If
P: Time2 = ShiJian
If Time1 = "" Then
GoTo L:
Else
Time2 = ShiJian
Time2_1
ShiJianCha = TimeDiff
If ShiJianCha = 1 Then
GoTo L:
Else
For j = 1 To ShiJianCha - 1
Txtfile(1).Write "99999" & " "
Txtfile(2).Write "99999" & " "
Txtfile(3).Write "99999" & " "
Txtfile(4).Write "99999" & " "
Txtfile(5).Write "99999" & " "
Txtfile(6).Write "99999" & " "
Txtfile(7).Write "99999" & " "
Txtfile(8).Write "99999" & " "
Next j
End If
End If
L: Time1 = Time2
If Right(ShiJian, 8) = "00:00:00" Then
Txtfile(1).WriteBlankLines (2) ' 向文件中写入1个换行符。
Txtfile(2).WriteBlankLines (2) ' 向文件中写入1个换行符。
Txtfile(3).WriteBlankLines (2) ' 向文件中写入1个换行符。
Txtfile(4).WriteBlankLines (2) ' 向文件中写入1个换行符。
Txtfile(5).WriteBlankLines (2) ' 向文件中写入1个换行符。
Txtfile(6).WriteBlankLines (2) ' 向文件中写入1个换行符。
Txtfile(7).WriteBlankLines (2) ' 向文件中写入1个换行符。
Txtfile(8).WriteBlankLines (2) ' 向文件中写入1个换行符。
End If
'水位:
ReadData (0)
DataRead(1) = Read1Tiao
If DataRead(1) = -3.2768 Then
DataRead(1) = 99999
GoTo A1:
Else
If DataRead(1) = 99999 Then
GoTo A1:
Else
End If
End If
A1: Txtfile(1).Write DataRead(1) & " " '**向目标文件内写数据
'水温:
ReadData (0)
DataRead(2) = Read1Tiao
If DataRead(2) = -3.2768 Then
DataRead(2) = 99999
GoTo A2:
Else
If DataRead(2) = 99999 Then
GoTo A2:
Else
End If
End If
A2: Txtfile(2).Write DataRead(2) & " " '**向目标文件内写数据
'气压:
ReadData (0)
DataRead(3) = Read1Tiao
If DataRead(3) = -3.2768 Then
DataRead(3) = 99999
GoTo A3:
Else
If DataRead(3) = 99999 Then
GoTo A3:
Else
End If
End If
A3: Txtfile(3).Write DataRead(3) & " " '向目标文件内写数据
'气温:
ReadData (0)
DataRead(4) = Read1Tiao
If DataRead(4) = -3.2768 Then
DataRead(4) = 99999
GoTo A4:
Else
If DataRead(4) = 99999 Then
GoTo A4:
Else
End If
End If
''Read1Chr = ""
''Read1Tiao = ""
A4: Txtfile(4).Write DataRead(4) & " " '向目标文件内写数据
'深层水温1:
ReadData (0)
DataRead(5) = Read1Tiao
If DataRead(5) = -3.2768 Then
DataRead(5) = 99999
GoTo A5:
Else
If DataRead(5) = 99999 Then
GoTo A5:
Else
DataRead(5) = DataRead(5) * 5 + 10
End If
End If
A5: Txtfile(5).Write DataRead(5) & " " '向目标文件内写数据
'东西倾斜:
ReadData (0)
DataRead(6) = Read1Tiao
If DataRead(6) = -3.2768 Then
DataRead(6) = 99999
GoTo A6:
Else
If DataRead(6) = 99999 Then
GoTo A6:
Else
DataRead(6) = DataRead(6) * 0.5
End If
End If
A6: Txtfile(6).Write DataRead(6) & " " '向目标文件内写数据
'南北倾斜:
ReadData (0)
DataRead(7) = Read1Tiao
If DataRead(7) = -3.2768 Then
DataRead(7) = 99999
GoTo A7:
Else
If DataRead(7) = 99999 Then
GoTo A7:
Else
DataRead(7) = DataRead(7) * 0.482
End If
End If
A7: Txtfile(7).Write DataRead(7) & " " '向目标文件内写数据
'深层水温2:
ReadData (0)
DataRead(8) = Read1Tiao
If DataRead(8) = -3.2768 Then
DataRead(8) = 99999
GoTo A8:
Else
If DataRead(8) = 99999 Then
GoTo A8:
Else
DataRead(8) = DataRead(8) * 5 + 10
End If
End If
A8: Txtfile(8).Write DataRead(8) & " " '向目标文件内写数据
'Loop Until HangHao = 1440 Or HangHao = "" '****************************$$$$$$
Loop Until HangHao = " "
''Loop Until Time1 = "05-07-31 23:59:59"
Txtfile(1).WriteBlankLines (2) ' 向文件中写入1个换行符。
Txtfile(2).WriteBlankLines (2) ' 向文件中写入1个换行符。
Txtfile(3).WriteBlankLines (2) ' 向文件中写入1个换行符。
Txtfile(4).WriteBlankLines (2) ' 向文件中写入1个换行符。
Txtfile(5).WriteBlankLines (2) ' 向文件中写入1个换行符。
Txtfile(6).WriteBlankLines (2) ' 向文件中写入1个换行符。
Txtfile(7).WriteBlankLines (2) ' 向文件中写入1个换行符。
Txtfile(8).WriteBlankLines (2) ' 向文件中写入1个换行符。
ErrEnd:
End Sub
'**************************添加数据到文件*********************************************************
Private Sub Command2_Click()
On Error Resume Next
'生成目标文件的路径 -〉在当前路径内
Set fso = CreateObject("Scripting.FileSystemObject")
''Set txtfile = fso.CreateTextFile("目标文件\testdata.txt", True)
Set Txtfile = fso.CreateTextFile(Text2.Text, False) '不覆盖已有文件'
''Set fil = fso.GetFile("testdata.txt")
''Set ts = fil.OpenAsTextStream(ForWriting)
' 写入一行。
Txtfile.Write (s) 'Command1读入的数据s
' 写入一行带有换行符的文本。
Txtfile.WriteLine ("Testing 1, 2, 3.")
' 向文件中写入三个换行符。
Txtfile.WriteBlankLines (3)
Txtfile.Write ("这是龚飞的测试例子。") ' 再写入一行。
'txtfile.Close 'close就不能再写入
End Sub
Private Sub Text1_Click()
mubiaoFILEname = False
YuanFILEname = True
Form2.Show
End Sub
'********************************判断源文件是否为前兆数据**********************************************
Private Sub Text1_Change()
On Error Resume Next
Dim Len1 As String
Dim Len2 As String
Dim Len1numb As Integer
Dim Len2numb As Integer
Dim Msg As String
Dim StrRead As String
Set fso = CreateObject("Scripting.FileSystemObject")
Set fil = fso.GetFile(Text1.Text)
Set Ts = fil.OpenAsTextStream(ForReading)
s = Ts.ReadAll
StrRead = Left(s, 10)
Set fil = fso.GetFile(Text1.Text) '重新输入
Set Ts = fil.OpenAsTextStream(ForReading)
Len1 = Ts.ReadLine '读第一行
'MsgBox "Len1" & Len1
Len1numb = Len(Len1)
'Msg = MsgBox("第一行内容：“" & Len1 & "”" & " 字符数：" & Len1numb & "个")
Label2.Caption = Len1
If Len1numb = 11 Then
'ts.SkipLine '跳到下一行
Len2 = Ts.ReadLine '不用跳到下一行；第二次使用ReadLine既是度地二行
' MsgBox Len2
Len2numb = Len(Len2)
' MsgBox Len2numb
If Len2numb = 22 Then
Label2.Caption = ""
Label2.Caption = "读入文件数据内容正确！"
Set fil = fso.GetFile(Text1.Text) '重新输入
Set Ts = fil.OpenAsTextStream(ForReading)
Label3.Caption = Ts.ReadAll
Else
Label2.Caption = ""
Label2.Caption = " 读入数据内容不是延寿前兆数据，请检查文件：" & Text1.Text
Label3.Caption = s
End If
Else
Label2.Caption = ""
Label2.Caption = " 读入数据内容不是延寿前兆数据,请检查文件：." & Text1.Text
Label3.Caption = s
End If
' ts.SkipLine
' ts.Close
End Sub
Private Sub Text2_Click()
YuanFILEname = False
mubiaoFILEname = True
Form2.Show
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -