【fileinfo源码】【kok1源码】【des算法源码下载】function andthen源码
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("如果想要写成一行代码，那么就可以用冒号连接",fileinfo源码"想要","代码")
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,"")
本期文章是源码分享的形式，感兴趣的kok1源码朋友可以复制源码在按键中运行一下，自己照着去写写就可以学会。des算法源码下载
用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的顶底乾坤源码标题关键字是：我的家"
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号: