📄 lclist2val.frm
字号:
VERSION 5.00
Begin VB.Form lclst2val
Appearance = 0 'Flat
AutoRedraw = -1 'True
BackColor = &H00FFFFFF&
Caption = " LC87-LST2VAL"
ClientHeight = 3930
ClientLeft = 6720
ClientTop = 1440
ClientWidth = 6000
DrawStyle = 6 'Inside Solid
ForeColor = &H00000000&
Icon = "lclist2val.frx":0000
LinkTopic = "csXS"
PaletteMode = 1 'UseZOrder
ScaleHeight = 3930
ScaleWidth = 6000
Begin VB.TextBox filelisttxt
Height = 270
Left = 0
TabIndex = 11
Top = 3240
Width = 6135
End
Begin VB.CommandButton lst2val
BackColor = &H0000FF00&
Caption = "lst2val"
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 0
MaskColor = &H0000FF00&
TabIndex = 7
Top = 0
Width = 1575
End
Begin VB.Timer Timer1
Interval = 10
Left = 1320
Top = 0
End
Begin VB.DirListBox fdir
Height = 2610
Left = 0
TabIndex = 6
Top = 720
Width = 3615
End
Begin VB.DriveListBox fDrive
Height = 300
Left = 0
TabIndex = 5
Top = 480
Width = 3615
End
Begin VB.FileListBox Flist
Height = 2610
Left = 3600
Pattern = "*.lst"
TabIndex = 4
Top = 480
Width = 2415
End
Begin VB.TextBox outText
Height = 2145
Left = 480
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 2
Text = "lclist2val.frx":27A2
Top = 720
Width = 3135
End
Begin VB.CommandButton exit
Caption = "exit"
Height = 375
Left = 3840
TabIndex = 1
Top = 0
Width = 1215
End
Begin VB.Label Label3
Caption = "OutputFileName:"
Height = 255
Left = 3240
TabIndex = 10
Top = 3480
Width = 2775
End
Begin VB.Label OUTFILE
BackStyle = 0 'Transparent
Caption = "OUTFILE"
Height = 255
Left = 3240
TabIndex = 9
Top = 3720
Width = 2895
End
Begin VB.Label Label1
BackColor = &H00C0FFC0&
Caption = "InputFileName:"
Height = 255
Left = 0
TabIndex = 8
Top = 3480
Width = 3255
End
Begin VB.Label FNAME
BackStyle = 0 'Transparent
Caption = "FNAME"
Height = 255
Left = 0
TabIndex = 3
Top = 3720
Width = 3015
End
Begin VB.Label timelbl
BackColor = &H00FFC0FF&
BackStyle = 0 'Transparent
Caption = "12:12:12 am"
Height = 255
Left = 1920
TabIndex = 0
Top = 0
Width = 1215
End
End
Attribute VB_Name = "lclst2val"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim in1, lstfl, valfl, ln1, ln2, ln3 As String
Dim X, Y As String
Dim drvstr, pathstr, OUTFLSTR, flstr As String
Dim fin(1 To 1000) As String
Dim fout(1 To 10000) As String
Dim datstr, mainloop, strx(100), ln11(100) As String
Dim datold, I, J, K, L As Long
Dim n As Integer
Dim str30, str300, str3000, kc, cx As String
Dim filelisttxtText, SFR(66666) As String
Private Sub GETOUTFILE()
OUTFLSTR = FNAME.Caption
dnum = InStr(OUTFLSTR, ".")
LNUM = Len(OUTFLSTR)
If dnum > 1 Then
OUTFLSTR = Left$(OUTFLSTR, dnum - 1) + "_A_C.Hxx"
End If
End Sub
Private Sub exit_Click()
End
End Sub
Private Sub filelisttxt_Change()
On Error GoTo exitsub
FdirPath = fdir.Path
FlistPath = Flist.Path
I = InStr(filelisttxt.Text, ":")
If I > 1 Then
drvstr = Left(filelisttxt.Text, I)
End If
I = InStr(filelisttxt.Text, ".")
If I = 0 And FlistPath <> Flist.Path And FdirPath <> fdir.Path Then
flstr = ""
FNAME.Caption = flstr
OUTFILE = ""
OUTFLSTR = ""
End If
pathstr = filelisttxt.Text
fDrive.Drive = drvstr
fdir.Path = pathstr
Flist.Path = pathstr
wtfile
Exit Sub
exitsub:
filelisttxt.Text = filelisttxtText
fdir.Path = FdirPath
Flist.Path = FlistPath
End Sub
Private Sub flist_Click()
flstr = Flist.FileName
FNAME.Caption = Flist.FileName
GETOUTFILE
OUTFILE = OUTFLSTR
wtfile
End Sub
Private Sub fdir_Change()
pathstr = fdir.Path
Flist.Path = fdir.Path
wtfile
End Sub
Private Sub fDrive_Change()
drvstr = fDrive.Drive
fdir.Path = fDrive.Drive
Flist.Path = fdir.Path
wtfile
End Sub
Private Sub wtfile()
Open "c:\lclst2val.txt" For Output As #2
Print #2, drvstr
Print #2, pathstr
Print #2, flstr
Close #2
filelisttxtText = pathstr
filelisttxt.Text = pathstr
End Sub
Private Sub Form_Load()
Timer1.Interval = 108
Timer1.Enabled = True
On Error GoTo NOFILE
Open "c:\LClst2val.txt" For Input As #1
Input #1, drvstr
Input #1, pathstr
Input #1, flstr
Close #1
GoTo flini
NOFILE:
drvstr = "c:\"
pathstr = "c:\"
flstr = ""
Close #1
wtfile
flini:
Flist.Path = pathstr
fdir.Path = pathstr
fDrive.Drive = drvstr
FNAME.Caption = flstr
GETOUTFILE
OUTFILE = OUTFLSTR
RXSTR = ""
wtfile
timelbl.Caption = ""
outText.Text = ""
End Sub
Private Sub Form_Unload(Cancel As Integer)
End
End Sub
Function str2val(ByVal a As String) As Long
alen = Len(a)
abak = a
str2val = 0
str2mul = 1
alx = 0
Do While alen > 0
ABC = Asc(Right(abak, 1))
If ABC = Asc("X") Or ABC = Asc("x") Then
Exit Do
End If
If alen > 1 Then
abak = Left(abak, alen - 1)
End If
alen = alen - 1
If (ABC < 58 And ABC > 47) Or (ABC < 71 And ABC > 64) Or (ABC < 103 And ABC > 96) Then
If (ABC < 58 And ABC > 47) Then
str2val = str2val + str2mul * (ABC - 48)
ElseIf (ABC < 80 And ABC > 64) Then
str2val = str2val + str2mul * (ABC - 55)
ElseIf (ABC < 112 And ABC > 96) Then
str2val = str2val + str2mul * (ABC - 95)
End If
str2mul = str2mul * 16
End If
Loop
End Function
Function str2dec(ByVal a As String) As Long
alen = Len(a)
abak = a
str2dec = 0
str2mul = 1
alx = 0
Do While alen > 0
ABC = Asc(Right(abak, 1))
If ABC = Asc("X") Or ABC = Asc("x") Then
Exit Do
End If
If alen > 1 Then
abak = Left(abak, alen - 1)
End If
alen = alen - 1
If (ABC < 58 And ABC > 47) Or (ABC < 71 And ABC > 64) Or (ABC < 103 And ABC > 96) Then
If (ABC < 58 And ABC > 47) Then
str2dec = str2dec + str2mul * (ABC - 48)
ElseIf (ABC < 80 And ABC > 64) Then
str2dec = str2dec + str2mul * (ABC - 55)
ElseIf (ABC < 112 And ABC > 96) Then
str2dec = str2dec + str2mul * (ABC - 95)
End If
str2mul = str2mul * 10
End If
Loop
End Function
Function bstr2str(ByVal a As String) As String
alen = Len(a)
abak = a
bstr2val = 0
str2mul = 1
alx = 0
Do While alen > 0
ABC = Right(abak, 1)
If alen > 1 Then
abak = Left(abak, alen - 1)
End If
alen = alen - 1
If ABC = "0" Or ABC = "1" Then
If ABC = "1" Then
bstr2val = bstr2val + str2mul
End If
str2mul = str2mul * 2
End If
Loop
bstr2str = Format(bstr2val, "#####0")
End Function
Function toupcase(ByVal a As String) As String
la = Len(a) + 1
I = 1
toupcase = ""
Do While I < la
A1 = Asc(Mid(a, I, 1))
If A1 > 96 Then
A1 = A1 - 32
End If
toupcase = toupcase + Chr(A1)
I = I + 1
Loop
End Function
Private Sub lst2val_Click()
timelbl.Caption = "Waiting"
On Error GoTo NOFILE
outText = ""
FLN = pathstr + "\" + flstr
Open FLN For Input As #10
OUTLN = pathstr + "\" + OUTFLSTR
Open OUTLN For Output As #20
I = 1
ILN = 0
lnxyz = 0
LNCON = 0
For K = 1 To 2048
SFR(K) = " "
Next
SFR(65024) = "A_reg"
SFR(65025) = "B_reg"
SFR(65026) = "C_reg" '7 8 9
SFR(65027) = "D_reg" '7 8 9
SFR(65028) = "E_reg" '7 8 9
SFR(65029) = "F_reg" '7 8 9
SFR(65030) = "PSW_reg"
SFR(65031) = "PCON_reg"
SFR(65032) = "IE_reg"
SFR(65033) = "IP_reg"
SFR(65034) = "SPL_reg"
SFR(65035) = "SPH_reg"
For K = 65036 To 65536
SFR(K) = " "
Next
Print #20, "_sfrbyte A_reg _at(0XFE00);"
Print #20, "_sfrbyte B_reg _at(0XFE01);"
Print #20, "_sfrbyte C_reg _at(0XFE02);"
Print #20, "_sfrbyte PSW_reg _at(0XFE06);"
Print #20, "_sfrbyte PCON_reg _at(0XFE07);"
Print #20, "_sfrbyte IE_reg _at(0XFE08);"
Print #20, "_sfrbyte IP_reg _at(0XFE09);"
Print #20, "_sfrbyte SPL_reg _at(0XFE0A);"
Print #20, "_sfrbyte SPH_reg _at(0XFE0B);"
Print #20, "_sfrbyte A _at(0XFE00);"
Print #20, "_sfrbyte B _at(0XFE01);"
Print #20, "_sfrword SP _at(0XFE0A);"
Print #20, "_sfrbyte PSW _at(0XFE06);"
Print #20, "_sfrbyte PCON _at(0XFE07);"
Print #20, "_sfrbyte IE _at(0XFE08);"
Print #20, "_sfrbyte IP _at(0XFE09);"
Print #20, "_sfrbyte SPL _at(0XFE0A);"
Print #20, "_sfrbyte SPH _at(0XFE0B);"
Do While Not EOF(10)
DoEvents
K = 5030
cx = SFR(K)
cx = SFR(65030)
'CX = SFR(K - 1)
If cx <> "PSW_REG" Then
XX = 1
End If
If LNCON = 0 Then
Line Input #10, ln1
End If
ILN = ILN + 1
If ILN = 5 Then
ILN = 5
End If
J = Len(ln1)
jln1 = J
If LNCON = 0 Then
I = 1
lnxyz = 0
lnnxt = 1
Do While I < J
If Asc(Mid(ln1, I, 1)) = 10 Then
lnxyz = lnxyz + 1
ln11(lnxyz) = Mid(ln1, lnnxt, I - lnnxt)
lnnxt = I + 1
' ln11(lnxyz) = ln11(lnxyz) + Chr(13)
End If
I = I + 1
Loop
If lnnxt < I And lnxyz > 0 Then
lnxyz = lnxyz + 1
ln11(lnxyz) = Mid(ln1, lnnxt, I - lnnxt)
LNCON = 1
Else
LNCON = 0
End If
End If
If LNCON > 0 Then
ln1 = ln11(LNCON)
LNCON = LNCON + 1
J = Len(ln1)
jln1 = J
If lnxyz < LNCON Then
LNCON = 0
End If
End If
If J >= 23 Then
char20 = Asc(Mid(ln1, 20, 1))
char21 = Mid(ln1, 21, 1)
char22 = Mid(ln1, 22, 1)
If char20 < 58 And char20 > 47 Then
If char21 = " " Then
If char22 = ";" Then
Print #20, "//" + Right$(ln1, J - 20)
ElseIf char22 <> " " Then
endj = InStr(ln1, ";")
If endj = 0 Then
endj = jln1 + 1
End If
J = 0
For I = 22 To endj
ln2 = Mid(ln1, I, endj - I)
lspc = InStr(ln2, " ")
iln2 = 1
J = J + 1
If lspc <> 0 Then
strx(J) = Mid(ln2, iln2, lspc - iln2)
Else
strx(J) = ln2
lspc = Len(ln2)
End If
I = I + lspc
Do While I < endj
midln2 = Mid(ln1, I, 1)
If midln2 <> " " Then
I = I - 1
Exit Do
End If
I = I + 1
Loop
Next
If J > 1 Then
If J > 2 Then
c1up = toupcase(strx(1))
c2up = toupcase(strx(2))
If c1up = "DEFINE" Then
'10 define TR 'R8' ;TR-->R8
I = Len(strx(3))
' 11 TRL EQU 0010H ;R8壓埵
If (Asc(Left(strx(3), 1)) > 47 And Asc(Left(strx(3), 1)) < 58) And (Right(strx(3), 1) = "H" Or Right(strx(3), 1) = "h") Then
strx(3) = "0x" + Left(strx(3), I - 1)
End If
' 156 CP0INI equ 00010001B ;撪晹踢俦⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -