1.「安卓按键精灵」几种字符串提取的方法（源码）
2.用vb获取任一网页源代码,要完整的!!!,可以用webbrowser控件
3.vb问题：希望可以给代码

「安卓按键精灵」几种字符串提取的方法（源码）

       截取法提取两个字符串之间的内容

       TracePrint GetStrAB("如果想要写成一行代码，那么就可以用冒号连接","想要","代码")

       Function GetStrAB(str,StrA,StrB)

       If UTF8.InStr(1, str, StrA)>0 and utf8.instr(1,str,StrB) > 0 Then

       Dim m=utf8.instr(1,Str,StrA)

       Dim n=utf8.instr(m,Str,StrB)

       GetStrAB=utf8.mid(str,m+utf8.len(StrA),n-m-utf8.len(StrA))

       End If

       End Function

       分割法提取字符串

       TracePrint SplitStrAB("如果想要写成一行代码，那么就可以用冒号连接",出售直播软件源码"想要","代码")

       Function SplitStrAB(str, StrA, StrB)

       If UTF8.InStr(1, str, StrA) > 0 and UTF8.InStr(1, str, StrB) > 0 Then

       Dim arr_A=split(str,StrA)

       Dim arr_B=split(arr_A(1),StrB)

       SplitStrAB=arr_B(0)

       end if

       End Function

       取多组两个字符串之间的内容

       Dim arr=GetStrArr("如果(公众号3分钟学堂)写成一行(代码)，那么就(可以)用冒号连接","(",")")

       For Each k In arr

       TracePrint k

       Next

       Function GetStrArr(str, StrA, StrB)

       If UTF8.InStr(1, str, StrA) > 0 and UTF8.InStr(1, str, StrB) > 0 Then

       Dim str_arr=array()

       Dim n=0

       Dim arr_A=split(str,StrA)

       Dim arr_B

       For i = 1 To UBOUND(arr_A)

       If InStr(1,arr_A(i),StrB) > 0 Then

       arr_B = Split(arr_A(i), StrB)

       str_arr(n) = arr_B(0)

       n=n+1

       End If

       Next

       GetStrArr=str_arr

       end if

       End Function

       提取数字

       TracePrint GetNum("如果_ba@d1b都是a2aaf%b连接")

       Function GetNum(str)

       Dim Num

       For i = 1 To UTF8.Len(str)

       If IsNumeric(utf8.StrGetAt(str,i)) Then

       Num=Num&utf8.StrGetAt(str,i)

       End If

       Next

       GetNum=Num

       End Function

       提取字母

       TracePrint GetZm("如果_ba@d1b都是a2aaf%b连接")

       Function GetZm(str)

       Dim zm

       For i = 1 To UTF8.Len(str)

       If < CInt(Asc(utf8.StrGetAt(str, i))) < or < CInt(Asc(utf8.StrGetAt(str, i))) < Then

       zm=zm&utf8.StrGetAt(str,i)

       End If

       Next

       GetZm=zm

       End Function

       提取汉字

       TracePrint GetCN("如果_ba@d1b都是a2aaf%b连接")

       Function GetCN(str)

       Dim CN

       For i = 1 To UTF8.Len(str)

       If Len(utf8.StrGetAt(str, i)) = 3 Then

       CN=CN&utf8.StrGetAt(str, i)

       End If

       Next

       GetCN=CN

       End Function

       正则提取数字

       import"shanhai.lua"

       Dim str="如果_ba@d1b都是a2aaf%b连接"

       dim arr= shanhai.RegexFind(str,"%d+")

       TracePrint join(arr,"")

       正则提取字母

       import"shanhai.lua"

       Dim str="如果_ba@d1D都是a2aaf%b连接"

       dim arr= shanhai.RegexFind(str,"%a+")

       TracePrint join(arr,"")

       正则提取汉字

       import"shanhai.lua"

       Dim str="如果_ba@d1D都是a2aaf%b连接"

       dim arr= shanhai.RegexFind(str,"[\-\]+")

       TracePrint join(arr,"")

       本期文章是源码分享的形式，感兴趣的nt4源码剖析朋友可以复制源码在按键中运行一下，自己照着去写写就可以学会。淘宝宝贝分裂源码

用vb获取任一网页源代码,要完整的!!!,可以用webbrowser控件

       '你把下面的代码保存为Form1.frm，然后双击打开该文件，运行后按提示即可看到结果。

       '呵呵，够详细了，再不会我也没办法了。

       '====文件Form1.frm====

       VERSION 5.

       Begin VB.Form Form1

        Caption = "Form1"

        ClientHeight =

        ClientLeft =

        ClientTop =

        ClientWidth =

        LinkTopic = "Form1"

        ScaleHeight =

        ScaleWidth =

        StartUpPosition = 3 '窗口缺省

        Begin VB.TextBox Text2

        Height =

        Left =

        MultiLine = -1 'True

        ScrollBars = 2 'Vertical

        TabIndex = 2

        Top =

        Width =

        End

        Begin VB.TextBox Text1

        Height =

        Left =

        TabIndex = 1

        Text = "我的网站在线获取源码家"

        Top =

        Width =

        End

        Begin VB.CommandButton Command1

        Caption = "获取HTML源码"

        Height =

        Left =

        TabIndex = 0

        Top =

        Width =

        End

        Begin VB.Label Label2

        Caption = "注意：获取源码之前必须先用IE打开网址，然后输入窗口标题关键字。如www..com的php文章源码 手机版标题关键字是：我的家"

        Height =

        Left =

        TabIndex = 4

        Top =

        Width =

        End

        Begin VB.Label Label1

        Caption = "请输入IE窗口标题："

        Height =

        Left =

        TabIndex = 3

        Top =

        Width =

        End

       End

       Attribute VB_Name = "Form1"

       Attribute VB_GlobalNameSpace = False

       Attribute VB_Creatable = False

       Attribute VB_PredeclaredId = True

       Attribute VB_Exposed = False

       Option Explicit

       Function GetIeHtml(IeTitle As String) As String

       Dim oShellApp: Set oShellApp = CreateObject("Shell.Application")

       Dim oShellAppWindows: Set oShellAppWindows = oShellApp.Windows

       Dim owin

       '获取弹出的IE窗口

       For Each owin In oShellAppWindows '获取弹出的IE窗口

       If LCase(TypeName(owin.Document)) = "htmldocument" And _

       InStr(1, owin.LocationName, IeTitle, vbTextCompare) > 0 Then '如果找到符合条件的IE窗口

       GetIeHtml = owin.Document.activeElement.Document.documentElement.innerHTML '此句可获得完整html代码

       GoTo Mend '退出

       End If

       Next

       Mend:

       Set oShellAppWindows = Nothing

       Set oShellApp = Nothing

       Set owin = Nothing

       End Function

       Private Sub Command1_Click()

       Dim S As String

       S = GetIeHtml(Text1.Text) '表示获得标题含有"我的家"的html代码

       Text2.Text = S

       End Sub

       Private Sub Form_Load()

       'Shell "explorer.exe ""/""", vbNormalNoFocus

       End Sub

vb问题：希望可以给代码

       先新建一个模块，里面添加API声明

       Option Explicit

       Declare Function MoveWindow Lib "user" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long

       Declare Function SendMessage Lib "user" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

       Public Const LB_INITSTORAGE = &H1A8

       Public Const LB_ADDSTRING = &H

       Public Const WM_SETREDRAW = &HB

       Public Const WM_VSCROLL = &H

       Public Const SB_BOTTOM = 7

       Declare Function GetLogicalDrives Lib "kernel" () As Long

       Declare Function FindFirstFile Lib "kernel" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN_FIND_DATA) As Long

       Public Const INVALID_HANDLE_VALUE = -1

       Declare Function FindNextFile Lib "kernel" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN_FIND_DATA) As Long

       Declare Function FindClose Lib "kernel" (ByVal hFindFile As Long) As Long

       Type FILETIME

       dwLowDateTime As Long

       dwHighDateTime As Long

       End Type

       Public Const MaxLFNPath =

       Type WIN_FIND_DATA

       dwFileAttributes As Long

       ftCreationTime As FILETIME

       ftLastAccessTime As FILETIME

       ftLastWriteTime As FILETIME

       nFileSizeHigh As Long

       nFileSizeLow As Long

       dwReserved0 As Long

       dwReserved1 As Long

       cFileName As String * MaxLFNPath

       cShortFileName As String *

       End Type

       然后在窗体上制作2个菜单，放置一个ListBox和一个PictureBox

       完整代码如下：

       Option Explicit

       Dim PicHeight%, hLB&, FileSpec$, UseFileSpec%

       Dim TotalDirs%, TotalFiles%, Running%

       Dim WFD As WIN_FIND_DATA, hItem&, hFile&

       Const vbBackslash = "\"

       Const vbAllFiles = "*.*"

       Const vbKeyDot =

       Private Sub Form_Load()

       ScaleMode = vbPixels

       PicHeight% = Picture1.Height

       hLB& = List1.hwnd

       SendMessage hLB&, LB_INITSTORAGE, &, ByVal & *

       Move (Screen.Width - Width) * 0.5, (Screen.Height - Height) * 0.5

       End Sub

       Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

       If KeyCode = vbKeyEscape And Running% Then Running% = False

       End Sub

       Private Sub Form_Resize()

       MoveWindow hLB&, 0, 0, ScaleWidth, ScaleHeight - PicHeight%, True

       End Sub

       Private Sub Form_Unload(Cancel As Integer)

       Set Form1 = Nothing

       End

       End Sub

       Private Sub mnuFindFiles_Click()

       If Running% Then: Running% = False: Exit Sub

       Dim drvbitmask&, maxpwr%, pwr%

       On Error Resume Next

       FileSpec$ = InputBox("Enter a file spec:" & vbCrLf & vbCrLf & "Searching will begin at drive A and continue " & "until no more drives are found. " & "Click Stop! at any time." & vbCrLf & "The * and ? wildcards can be used.", "Find File(s)", "*.exe")

       If Len(FileSpec$) = 0 Then Exit Sub

       MousePointer =

       Running% = True

       UseFileSpec% = True

       mnuFindFiles.Caption = "&Stop!"

       mnuFolderInfo.Enabled = False

       List1.Clear

       drvbitmask& = GetLogicalDrives()

       If drvbitmask& Then

       maxpwr% = Int(Log(drvbitmask&) / Log(2))

       For pwr% = 0 To maxpwr%

       If Running% And (2 ^ pwr% And drvbitmask&) Then _

       Call SearchDirs(Chr$(vbKeyA + pwr%) & ":\")

       Next

       End If

       Running% = False

       UseFileSpec% = False

       mnuFindFiles.Caption = "&Find File(s)..."

       mnuFolderInfo.Enabled = True

       MousePointer = 0

       Picture1.Cls

       Picture1.Print "Find File(s): " & List1.ListCount & " items found matching " & """" & FileSpec$ & """"

       Beep

       End Sub

       Private Sub mnuFolderInfo_Click()

       If Running% Then: Running% = False: Exit Sub

       Dim searchpath$

       On Error Resume Next

       searchpath$ = InputBox("输入要查找的目标路径", "文件夹信息", "C:\")

       If Len(searchpath$) < 2 Then Exit Sub

       If Mid$(searchpath$, 2, 1) <> ":" Then Exit Sub

       If Right$(searchpath$, 1) <> vbBackslash Then searchpath$ = searchpath$ & vbBackslash

       If FindClose(FindFirstFile(searchpath$ & vbAllFiles, WFD)) = False Then

       End If

       MousePointer =

       Running% = True

       mnuFolderInfo.Caption = "停止(&S)"

       mnuFindFiles.Enabled = False

       List1.Clear

       TotalDirs% = 0

       TotalFiles% = 0

       Call SearchDirs(searchpath$)

       Running% = False

       mnuFolderInfo.Caption = "文件夹信息(&F)"

       mnuFindFiles.Enabled = True

       Picture1.Cls

       MousePointer = 0

       MsgBox "Total folders: " & vbTab & TotalDirs% & vbCrLf & "Total files: " & vbTab & TotalFiles%, , "Folder Info for: " & searchpath$

       End Sub

       Private Sub SearchDirs(curpath$)

       Dim dirs%, dirbuf$(), i%

       Picture1.Cls

       Picture1.Print "Searching " & curpath$

       DoEvents

       If Not Running% Then Exit Sub

       hItem& = FindFirstFile(curpath$ & vbAllFiles, WFD)

       If hItem& <> INVALID_HANDLE_VALUE Then

       Do

       If (WFD.dwFileAttributes And vbDirectory) Then

       If Asc(WFD.cFileName) <> vbKeyDot Then

       TotalDirs% = TotalDirs% + 1

       If (dirs% Mod ) = 0 Then ReDim Preserve dirbuf$(dirs% + )

       dirs% = dirs% + 1

       dirbuf$(dirs%) = Left$(WFD.cFileName, InStr(WFD.cFileName, vbNullChar) - 1)

       End If

       ElseIf Not UseFileSpec% Then

       TotalFiles% = TotalFiles% + 1

       End If

       Loop While FindNextFile(hItem&, WFD)

       Call FindClose(hItem&)

       End If

       If UseFileSpec% Then

       SendMessage hLB&, WM_SETREDRAW, 0, 0

       Call SearchFileSpec(curpath$)

       SendMessage hLB&, WM_VSCROLL, SB_BOTTOM, 0

       SendMessage hLB&, WM_SETREDRAW, 1, 0

       End If

       For i% = 1 To dirs%: SearchDirs curpath$ & dirbuf$(i%) & vbBackslash: Next i%

       End Sub

       Private Sub SearchFileSpec(curpath$)

       hFile& = FindFirstFile(curpath$ & FileSpec$, WFD)

       If hFile& <> INVALID_HANDLE_VALUE Then

       Do

       DoEvents

       If Not Running% Then Exit Sub

       SendMessage hLB&, LB_ADDSTRING, 0, ByVal curpath$ & Left$(WFD.cFileName, InStr(WFD.cFileName, vbNullChar) - 1)

       Loop While FindNextFile(hFile&, WFD)

       Call FindClose(hFile&)

       End If

       End Sub

       程序运行时就能够通过输入文件名而进行模糊查找了

       如果还不明白，就加我QQ，我把我做好的程序发给你看

       QQ号: