📄 form1.frm
字号:
Caption = "屏幕更新速度"
Height = 255
Left = 4680
TabIndex = 17
Top = 3000
Width = 1695
End
Begin VB.Line Line4
X1 = 300
X2 = 9540
Y1 = 4680
Y2 = 4680
End
Begin VB.Line Line3
BorderWidth = 2
X1 = 120
X2 = 9720
Y1 = 4560
Y2 = 4560
End
Begin VB.Line Line2
BorderWidth = 2
X1 = 4440
X2 = 4440
Y1 = 0
Y2 = 4500
End
Begin VB.Label Label2
Caption = "理财产品代码编辑"
BeginProperty Font
Name = "黑体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 1200
TabIndex = 0
Top = 60
Width = 2055
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim ExcelName As String
Dim DbCon As Boolean
Dim DbRs As Boolean
Dim Insertflag As Integer
Dim DateUpflag As Integer
Sub UpDate(VestKind As Integer)
Dim LedRs As ADODB.Recordset
Dim FundRs As ADODB.Recordset
Dim VestRs As ADODB.Recordset
Dim ScreenInt, ScreenID, ScreenNum As Integer
Dim TermIp As String
Dim VestIDtmp, VestNametmp As String
Dim tmp1, tmp2 As String
Dim cmp1, cmp2, cmp3, cmp4 As String
Dim ScreenSpeed As Integer
Dim ChangeRate As Double
Dim int1, int2 As Integer
Dim VestKindtmp As Integer
Dim ShuMaString As String
Dim CurrencyHead As String
Dim ColorString As String
Dim ShuMaMark As String
Dim CurrencyMask As String
Dim SQLSTRING As String
Dim I, j As Integer
ShuMaMark = " "
CurrencyMask = " "
ColorString = "11111111111111111111111111111111111111111111111111111111111111111111111111111111"
Set FundRs = New ADODB.Recordset
Set VestRs = New ADODB.Recordset
Set LedRs = cnNew.Execute("select * from terminfo")
TermIp = LedRs.Fields("TermIp")
LedRs.Close
ScreenSpeed = CInt(Trim$(GetINI("设置项目", "速度", App.Path & "\setting.ini")))
'0 基金 1 货币 2 稳得利 3 黄金
Select Case VestKind
Case 0
Set VestRs = cnNew.Execute("select * from vestname where FundKind=" & VestKind)
ScreenInt = 0: ScreenID = 0: ScreenNum = 1
' cmp1 = "开放式基金 净值 累计净值 日涨跌% 基金代码"
cmp1 = "开放式基金 净值 累净值 涨跌额 涨跌幅 代码"
While Not VestRs.EOF
VestIDtmp = VestRs.Fields(1)
VestNametmp = Trim$(VestRs.Fields(0))
cmp4 = VestNametmp & Left(CurrencyMask, 16 - MixLen(VestNametmp))
cmp2 = cmp4 & cmp2
cmp4 = ""
' cmp2 = VestNametmp & Left$(CurrencyMask, lstrlen(VestNametmp)) & cmp2
VestKindtmp = VestRs.Fields(2)
Set FundRs = cnNew.Execute("select * from Fund where [FundID]='" & VestIDtmp & "'")
If FundRs.BOF = False Then
If FundRs.Fields("FundVal") = Null Then tmp1 = 0 Else: tmp1 = CStr(FundRs.Fields("FundVal"))
Else
tmp1 = 0
End If
tmp1 = Format(tmp1, "0.0000")
tmp1 = Left$(ShuMaMark, 8 - Len(tmp1)) & tmp1
tmp2 = tmp2 & tmp1: tmp1 = ""
If FundRs.BOF = False Then
If FundRs.Fields("FundAllVal") = Null Then tmp1 = 0 Else tmp1 = CStr(FundRs.Fields("FundAllVal"))
Else
tmp1 = 0
End If
tmp1 = Format(tmp1, "0.0000")
tmp1 = Left$(ShuMaMark, 8 - Len(tmp1)) & tmp1
tmp2 = tmp2 & tmp1: tmp1 = ""
If FundRs.BOF = False Then
If FundRs.Fields("FundChange") = Null Then tmp1 = 0 Else tmp1 = CStr(FundRs.Fields("FundChange"))
Else
tmp1 = 0
End If
tmp1 = Format(tmp1, "0.000")
tmp1 = Left$(ShuMaMark, 8 - Len(tmp1)) & tmp1
tmp2 = tmp2 & tmp1: tmp1 = ""
If FundRs.BOF = False Then
If FundRs.Fields("ChangeRate") = Null Then tmp1 = 0 Else tmp1 = CStr(FundRs.Fields("ChangeRate") * 100)
Else
tmp1 = 0
End If
tmp1 = Format(tmp1, "0.00")
tmp1 = Left$(ShuMaMark, 8 - Len(tmp1)) & tmp1
tmp2 = tmp2 & tmp1: tmp1 = ""
tmp1 = CStr(VestIDtmp)
tmp1 = Left$(ShuMaMark, 8 - Len(tmp1)) & tmp1
tmp2 = tmp2 & tmp1: tmp1 = ""
tmp2 = tmp2 & ShuMaMark & ShuMaMark & ShuMaMark
VestRs.MoveNext
If ScreenInt = 9 Then
cmp2 = cmp2 & cmp1
'
'ScreenID 数据名称，ScreenNum 屏幕顺序，Screenint 单屏幕行计数
' Debug.Print cmp2
Set LedRs = cnNew.Execute("select max([Screen]) as maxvalue from data")
ScreenNum = LedRs.Fields(0)
LedRs.Close
ScreenNum = ScreenNum + 1
SQLSTRING = "insert [Data]([Name],[TermIp],[Area],[Screen],[ShowTime],[Hang],[Lie],[ShuMa],[Color],[Title],[CurrencyHead],[Remark],[CreateTime],[ModifyTime],[Flag]) values" & _
"('1" & Format(CStr(ScreenNum), "0#") & ".dat','" & TermIp & "','1'," & ScreenNum & "," & ScreenSpeed & ",0,0,'" & tmp2 & "','" & ColorString & "','开放式基金','" & cmp2 & "',NULL,'" & Now() & "','" & Now() & "',1)"
' Debug.Print SQLSTRING
cnNew.Execute SQLSTRING
ScreenID = ScreenID + 1
tmp1 = "": tmp2 = "": cmp2 = ""
End If
If VestRs.EOF = True And ScreenInt < 9 Then
Set LedRs = cnNew.Execute("select max([Screen]) as maxvalue from data")
ScreenNum = LedRs.Fields(0)
LedRs.Close
ScreenNum = ScreenNum + 1
For I = 9 - ScreenInt To 0 Step -1
For j = 1 To 6
tmp2 = tmp2 & ShuMaMark
Next j
Next I
For I = 9 - ScreenInt To 1 Step -1
cmp2 = CurrencyMask & cmp2
Next I
cmp2 = cmp2 & cmp1
SQLSTRING = "insert [Data]([Name],[TermIp],[Area],[Screen],[ShowTime],[Hang],[Lie],[ShuMa],[Color],[Title],[CurrencyHead],[Remark],[CreateTime],[ModifyTime],[Flag]) values" & _
"('1" & Format(CStr(ScreenNum), "0#") & ".dat','" & TermIp & "','1'," & ScreenNum & "," & ScreenSpeed & ",0,0,'" & tmp2 & "','" & ColorString & "','开放式基金','" & cmp2 & "',NULL,'" & Now() & "','" & Now() & "',1)"
cnNew.Execute SQLSTRING
ScreenID = ScreenID + 1
tmp1 = "": tmp2 = "": cmp2 = ""
End If
ScreenInt = ScreenInt + 1
If ScreenInt > 9 Then ScreenInt = 0
Wend
Case 1
Set VestRs = cnNew.Execute("select * from vestname where FundKind=" & VestKind)
ScreenInt = 0: ScreenID = 1
cmp1 = "货币基金 万份值 年收益 代码 "
While Not VestRs.EOF
VestIDtmp = VestRs.Fields(1)
VestNametmp = Trim$(VestRs.Fields(0))
cmp2 = VestNametmp & Left$(CurrencyMask, lstrlen(VestNametmp + Chr(0))) & cmp2
VestKindtmp = VestRs.Fields(2)
Set FundRs = cnNew.Execute("select * from Fund where [FundID]='" & VestIDtmp & "'")
If FundRs.BOF = False Then
If FundRs.Fields("FundVal") = Null Then tmp1 = 0 Else tmp1 = CStr(FundRs.Fields("FundVal"))
Else
tmp1 = 0
End If
tmp1 = Format(tmp1, "0.0000")
tmp1 = Left$(ShuMaMark, 8 - Len(tmp1)) & tmp1
tmp2 = tmp2 & tmp1: tmp1 = ""
If FundRs.BOF = False Then
If FundRs.Fields("ChangeRate") = Null Then tmp1 = 0 Else tmp1 = CStr(FundRs.Fields("ChangeRate") * 100)
Else
tmp1 = 0
End If
tmp1 = Format(tmp1, "0.000")
tmp1 = Left$(ShuMaMark, 8 - Len(tmp1)) & tmp1
tmp2 = tmp2 & tmp1: tmp1 = ""
tmp1 = CStr(VestIDtmp)
'Debug.Print tmp1 & VestNametmp
tmp1 = Left$(ShuMaMark, 8 - Len(tmp1)) & tmp1
tmp2 = tmp2 & tmp1: tmp1 = ""
tmp2 = tmp2 & ShuMaMark & ShuMaMark & ShuMaMark & ShuMaMark & ShuMaMark
VestRs.MoveNext
If ScreenInt = 9 Then
cmp2 = cmp2 & cmp1
' Debug.Print cmp2
Set LedRs = cnNew.Execute("select max([Screen]) as maxvalue from data")
ScreenNum = LedRs.Fields(0)
LedRs.Close
ScreenNum = ScreenNum + 1
'ScreenID 数据名称，ScreenNum 屏幕顺序，Screenint 单屏幕行计数
SQLSTRING = "insert [Data]([Name],[TermIp],[Area],[Screen],[ShowTime],[Hang],[Lie],[ShuMa],[Color],[Title],[CurrencyHead],[Remark],[CreateTime],[ModifyTime],[Flag]) values" & _
"('1" & Format(CStr(ScreenNum), "0#") & ".dat','" & TermIp & "','1'," & ScreenNum & "," & ScreenSpeed & ",0,0,'" & tmp2 & "','" & ColorString & "','货币基金','" & cmp2 & "',NULL,'" & Now() & "','" & Now() & "',1)"
' Debug.Print SqlString
cnNew.Execute SQLSTRING
ScreenID = ScreenID + 1
tmp1 = "": tmp2 = "": cmp2 = ""
End If
If VestRs.EOF = True And ScreenInt < 9 Then
Set LedRs = cnNew.Execute("select max([Screen]) as maxvalue from data")
ScreenNum = LedRs.Fields(0)
LedRs.Close
ScreenNum = ScreenNum + 1
For I = 9 - ScreenInt To 0 Step -1
For j = 1 To 6
tmp2 = tmp2 & ShuMaMark
Next j
Next I
For I = 9 - ScreenInt To 1 Step -1
cmp2 = CurrencyMask & cmp2
Next I
cmp2 = cmp2 & cmp1
SQLSTRING = "insert [Data]([Name],[TermIp],[Area],[Screen],[ShowTime],[Hang],[Lie],[ShuMa],[Color],[Title],[CurrencyHead],[Remark],[CreateTime],[ModifyTime],[Flag]) values" & _
"('1" & Format(CStr(ScreenNum), "0#") & ".dat','" & TermIp & "','1'," & ScreenNum & "," & ScreenSpeed & ",0,0,'" & tmp2 & "','" & ColorString & "','货币基金','" & cmp2 & "',NULL,'" & Now() & "','" & Now() & "',1)"
cnNew.Execute SQLSTRING
ScreenID = ScreenID + 1
tmp1 = "": tmp2 = "": cmp2 = ""
End If
ScreenInt = ScreenInt + 1
If ScreenInt > 9 Then ScreenInt = 0
Wend
End Select
MsgBox "数据生成成功", vbInformation, "提示"
End Sub
Private Sub Combo3_Click()
If Combo3.Text = "基金" Then
DateUpflag = 0
Command3.Caption = "导入" & Combo3.Text & "数据"
Command3.Enabled = True
ElseIf Combo3.Text = "货币" Then
Command3.Caption = "导入" & Combo3.Text & "数据"
Command3.Enabled = True
DateUpflag = 1
Else
MsgBox "数据无效", vbCritical, "提示"
End If
End Sub
Private Sub Command1_Click()
Call UpDate(CInt(Left(Combo2.Text, 1)))
'UpDate (1)
End Sub
Private Sub Command10_Click()
ShellExecute Me.hWnd, "open", App.Path & "\setting.ini", "", "", 4
End Sub
Private Sub Command11_Click()
On Error GoTo Err_Spot
Dim ExePath As String
ExePath = Trim$(GetINI("设置项目", "程序路径", App.Path & "\setting.ini"))
ShellExecute Me.hWnd, "open", ExePath, "", "", 4
Exit Sub
Err_Spot: MsgBox Err.Description, vbCritical
End Sub
Private Sub Command12_Click()
Dim XML_NodeList As IXMLDOMNodeList
Dim XML_Doc As DOMDocument
Dim XML_Node As IXMLDOMNode
Dim XML_Element As IXMLDOMElement
Dim XML_Root As IXMLDOMElement
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -