1,502
社区成员
发帖
与我相关
我的任务
分享
Private Sub Command1_Click()
List1.Clear
List7.Clear
If Text1.Text <> "" Then
Dim Str As String, Szfg, i As Integer, Qishu As Integer, haoma As String, ge As String, shi As String, bai As String, qian As String, wan As String
Dim zuixin As String
Dim gew, shiw, baiw, qianw, wanw, shua
Set Http = New WinHttpRequest
Http.Option(6) = False
Http.Option(4) = 13056
Str = GetPage("http://chart.cp.360.cn/zst/getchartdata2?lotId=255401&chartType=x5&spanType=0&span=" & Text1.Text)
Szfg = Split(Str, "class='tdbg_1' >1")
For i = 0 To UBound(Szfg)
If InStr(1, Szfg(i), "num") > 0 Then
haoma = Mid(Szfg(i), InStr(1, Szfg(i), "num") + 5, 5)
End If
If Mid(Szfg(i), 1, 1) = "7" Then
List1.AddItem "1" & Mid(Szfg(i), 1, 9) & "--" & haoma
ge = ge & Mid(haoma, 5, 1)
shi = shi & Mid(haoma, 4, 1)
bai = bai & Mid(haoma, 3, 1)
qian = qian & Mid(haoma, 2, 1)
wan = wan & Mid(haoma, 1, 1)
End If
Next
zuixin = Right(ge, 2)
Dim AAA, u, BBB, pp, CCC, DDD, EEE, FFF, III, GGG, KKK, LL, YY, IO, OI, KOI, ij
KKK = Array(ge, shi, bai, qian, wan)
For u = 1 To Len(ge)
AAA = Mid(ge, u, 2)
CCC = Mid(shi, u, 2)
DDD = Mid(bai, u, 2)
EEE = Mid(qian, u, 2)
FFF = Mid(wan, u, 2)
GGG = Array(AAA, CCC, DDD, EEE, FFF)
For III = 0 To UBound(GGG)
If GGG(III) = zuixin Then
YY = Mid(KKK(III), u - 2, 1)
For LL = u - 2 To u - 7
BBB = BBB & Mid(KKK(III), LL, 1)
Next
BBB = ""
For pp = u + 2 To u + 7
BBB = BBB & Mid(KKK(III), pp, 1)
Next
List7.AddItem BBB
BBB = ""
End If
Next
Next
End If
End Sub
Dim H As String, A As String
Dim strHeader As String, strTailer As String, strTemp As String
Dim p As Integer, i As Integer
H = "45"
A = "4812334567889"
p = InStr(A, H)
If p Then
strHeader = ""
strTemp = Left(A, p - 1)
For i = Len(strTemp) To 1 Step -1
If InStr(strHeader, Mid(strTemp, i, 1)) = 0 Then strHeader = strHeader & Mid(strTemp, i, 1)
If Len(strHeader) = 5 Then Exit For
Next i
Debug.Print strHeader
strTailer = ""
strTemp = Mid(A, p + Len(H))
For i = 1 To Len(strTemp)
If InStr(strTailer, Mid(strTemp, i, 1)) = 0 Then strTailer = strTailer & Mid(strTemp, i, 1)
If Len(strTailer) = 5 Then Exit For
Next i
Debug.Print strTailer
End If
Function RegExpN(ptn, txt, n) As String
'Debug.Print "[" + RegExpN("[012]{8}", "mno_if22220101_and11000011_or00111100_xor10101010.txt", 1) + "]"
'[22220101]
'Debug.Print "[" + RegExpN("[012]{8}", "mno_if22220101_and11000011_or00111100_xor10101010.txt", 2) + "]"
'[11000011]
'Debug.Print "[" + RegExpN("[012]{8}", "mno_if22220101_and11000011_or00111100_xor10101010.txt", 3) + "]"
'[00111100]
'Debug.Print "[" + RegExpN("[012]{8}", "mno_if22220101_and11000011_or00111100_xor10101010.txt", 4) + "]"
'[10101010]
'Debug.Print "[" + RegExpN("[012]{8}", "mno_if22220101_and11000011_or00111100_xor10101010.txt", 5) + "]"
'[]
'Debug.Print "[" + RegExpN("[a-z]+(\d+)[_.]", "mno_if22220101_and11000011_or00111100_xor10101010.txt", 4) + "]"
'[xor10101010.]
'Debug.Print "[" + RegExpN("[a-z]+(\d+)[_.]", "mno_if22220101_and11000011_or00111100_xor10101010.txt", 4.1) + "]"
'[10101010]
'Debug.Print "[" + RegExpN("<abc>(.*)</abc>", "<html><ab>AB</ab><abc>ABC汉字</abc></html>", 1) + "]"
'[<abc>ABC汉字</abc>]
'Debug.Print "[" + RegExpN("<abc>(.*)</abc>", "<html><ab>AB</ab><abc>ABC汉字</abc></html>", 1.1) + "]"
'[ABC汉字]
Dim rtnstr As String
Dim codestr As String
rtnstr = ""
With ScriptControl1
' Set script language (VBScript is the default).
.Language = "VBScript"
' Set UI interaction (TRUE is the default).
.AllowUI = True
' Copy the script to the control.
'--------------------------------------------------------
codestr = ""
codestr = codestr + "Function RegExpTest(patrn, strng, ns) " + vbCrLf
codestr = codestr + " Dim regEx, Match, Matches, RetStr, ii " + vbCrLf
codestr = codestr + " Dim nn,ss " + vbCrLf
codestr = codestr + " nn=fix(ns) " + vbCrLf
codestr = codestr + " if nn=ns then " + vbCrLf
codestr = codestr + " ss=-1 " + vbCrLf
codestr = codestr + " else " + vbCrLf
codestr = codestr + " ss=(ns-nn)*10-1 " + vbCrLf
codestr = codestr + " end if " + vbCrLf
codestr = codestr + " Set regEx = New RegExp " + vbCrLf
codestr = codestr + " regEx.Pattern = patrn " + vbCrLf
codestr = codestr + " regEx.IgnoreCase = True " + vbCrLf
codestr = codestr + " regEx.Global = True " + vbCrLf
codestr = codestr + " Set Matches = regEx.Execute(strng) " + vbCrLf
codestr = codestr + " ii=0 " + vbCrLf
codestr = codestr + " For Each Match in Matches " + vbCrLf
codestr = codestr + " ii=ii+1 " + vbCrLf
codestr = codestr + " if ii=nn then " + vbCrLf
codestr = codestr + " if ss=-1 then " + vbCrLf
codestr = codestr + " RetStr=Match.Value " + vbCrLf
codestr = codestr + " else " + vbCrLf
codestr = codestr + " RetStr=Match.SubMatches(ss)" + vbCrLf
codestr = codestr + " end if " + vbCrLf
codestr = codestr + " exit for " + vbCrLf
codestr = codestr + " end if " + vbCrLf
codestr = codestr + " Next " + vbCrLf
codestr = codestr + " RegExpTest = RetStr " + vbCrLf
codestr = codestr + " Set regEx = Nothing " + vbCrLf
codestr = codestr + "End Function " + vbCrLf
'--------------------------------------------------------
.AddCode codestr
Dim oMod As Object
Set oMod = .Modules(GlobalModule)
rtnstr = oMod.Run("RegExpTest", ptn, txt, n)
Set oMod = Nothing
End With
RegExpN = rtnstr
End Function
Private Sub Command2_Click()
Dim strSpec As String
Dim strText As String
Dim strChar As String
Dim sA$, sE As String
Dim i&, k&, w As Long
strText = "4812334567889"
strSpec = "45"
k = InStr(1&, strText, strSpec)
sA = "": w = 0&
For i = k - 1& To 1& Step -1&
strChar = Mid$(strText, i, 1&)
If (0& = InStr(1&, sA, strChar)) Then
sA = sA & strChar
w = 1& + w
If (5& = w) Then Exit For
End If
Next
sE = "": w = 0&
For i = 2& + k To Len(strText)
strChar = Mid$(strText, i, 1&)
If (0& = InStr(1&, sE, strChar)) Then
sE = sE & strChar
w = 1& + w
If (5& = w) Then Exit For
End If
Next
MsgBox "向前截取的字符串:" & sA & vbLf & _
"向后截取的字符串:" & sE, 64&, "截取结果"
End Sub
' 向前截取的字符串:32184
' 向后截取的字符串:6789