想对递归有更深刻的了解

qiu5208 2008-03-08 03:46:42
想对递归有更深刻的了解
那位高手有比较典型的例子,有代码最好,或好的材料欢迎发上来.
代码最好是vb代码.

...全文
159 17 打赏 收藏 转发到动态 举报
写回复
用AI写文章
17 条回复
切换为时间正序
请发表友善的回复…
发表回复
qiu5208 2008-03-13
  • 打赏
  • 举报
回复
阶乘,和快速排序法的列子已经熟悉,谢谢你们

结帖吧。
qiu5208 2008-03-12
  • 打赏
  • 举报
回复
谢谢大家

理清了cbm666朋友的代码,受益匪浅

Private Sub Command1_Click()
Dim aay() As String
Call SeachFile(aay, "e:\vbAPI\", "*.txt,*.gif")
Dim i As Integer
For i = 1 To UBound(aay)
Debug.Print aay(i)

Next

End Sub
'==================================================
'搜索文件子过程
Sub SeachFile(Ay() As String, ByVal Path As String, _
Optional ByVal strSc As String = "")
'Ay():返回所有符合搜索条件的文件,Ay(0)不是,从Ay(1)开始
'path:搜索路径
'strSc:搜索条件,用逗号分开,比如 "*.txt,win*.*"
'====================================================
Static scType() As String '搜索条件字串
Dim i As Long

DoEvents
On Error Resume Next

'初始化
If strSc <> "" Then
scType = Split(Trim(strSc), ",")
ReDim Preserve Ay(0)
End If
If Right(Path, 1) <> "\" Then Path = Path & "\"


'对当前的目录进行文件搜索
For i = 0 To UBound(scType)
Ay(0) = Dir(Path & scType(i), vbNormal Or vbReadOnly Or vbHidden)
Do While Ay(0) <> ""
ReDim Preserve Ay(1 + UBound(Ay))
Ay(UBound(Ay)) = Path & Ay(0)
Ay(0) = Dir
Loop
Next

'列举出所有子目录
Dim subPath() As String '存放子目录数组
ReDim subPath(0)
subPath(0) = Dir(Path, vbDirectory)
Do While subPath(0) <> ""

'去掉当前目录,和上级目录
If subPath(0) <> "." And subPath(0) <> ".." Then

'判断是否是目录
If (GetAttr(Path & subPath(0)) And vbDirectory) = vbDirectory Then
ReDim Preserve subPath(1 + UBound(subPath))
subPath(UBound(subPath)) = Path & subPath(0)
End If

End If
subPath(0) = Dir
Loop

'如果有子目录的话,进行递归
If UBound(subPath) > 0 Then
For i = 1 To UBound(subPath)
Call SeachFile(Ay, subPath(i))
Next
End If

End Sub
z_wenqian 2008-03-12
  • 打赏
  • 举报
回复
Public Sub sort快速递归排序(ByRef dataArray As Variant)
r_Quick dataArray, 0, UBound(dataArray)
End Sub

Private Sub r_Quick(ByRef dataArray As Variant, ByVal low As Long, ByVal high As Long)
Dim i As Long, j As Long, t As Long
If low < high Then
i = low: j = high: t = dataArray(low)
While i < j
While i < j And dataArray(j) > t
j = j - 1
Wend
If i < j Then
dataArray(i) = dataArray(j)
i = i + 1
End If
While i < j And dataArray(i) <= t
i = i + 1
Wend
If i < j Then
dataArray(j) = dataArray(i)
j = j - 1
End If
Wend
dataArray(i) = t
r_Quick dataArray, low, i - 1
r_Quick dataArray, i + 1, high
End If
End Sub
qiu5208 2008-03-11
  • 打赏
  • 举报
回复
不好意思,错了一行,
一定要改,不然有发病毒的嫌疑


'删除空目录
ElseIf fsoFolder.Files.Count = 0 Then
fsoFolder.Delete
End If


qiu5208 2008-03-11
  • 打赏
  • 举报
回复
理通了7楼的代码,剩下慢慢看.



Sub DeleteEmptyFolders(ByVal recentlyPath As String)
'''''''''''''''''''''''''''''''''''''''''''''''
'删除指定目录下的所有目录.
'recentlyPath参数:指定目录
'''''''''''''''''''''''''''''''''''''''''''''''
Dim fsoFolder As Folder '一个由recentlyPath指定的目录对象
Dim fsoI As Folder
Dim Fso As FileSystemObject '文件系统对象
Set Fso = New FileSystemObject

'交出控制权,及除错
DoEvents
On Error Resume Next

'如果目录不存在的话,退出子过程
If Not Fso.FolderExists(recentlyPath) Then Exit Sub
Set fsoFolder = Fso.GetFolder(recentlyPath) '创建一个folder

'对所有的子目录递归
If fsoFolder.SubFolders.Count > 0 Then
For Each fsoI In fsoFolder.SubFolders
DeleteEmptyFolders fsoI.Path '递归
Next

'删除空目录
ElseIf fsoFolder.SubFolders.Count = 0 Then
fsoFolder.Delete
End If

End Sub

tmd007 2008-03-10
  • 打赏
  • 举报
回复
写个简单的例子,所谓阶乘的递归

Private Sub Command1_Click()
Debug.Print dg(7)
End Sub

Function dg(n)
If n = 0 Then
dg = 1
Else
dg = dg(n - 1) * n
End If
End Function
qiu5208 2008-03-10
  • 打赏
  • 举报
回复

Recursively delete any subkey

to VBAdvisor

这段程序的作用是什么?
siwolf1129 2008-03-10
  • 打赏
  • 举报
回复
他不想学,哈哈。。。。
VBAdvisor 2008-03-10
  • 打赏
  • 举报
回复
以上的2个例子是完整的。你一步一步的Debug吧,你不然怎么明白Recursive?
qiu5208 2008-03-09
  • 打赏
  • 举报
回复
呵呵,这样的天书可不好看啊。
VBAdvisor 2008-03-09
  • 打赏
  • 举报
回复
Recursively Delete Empty Folders


'References to
'Microsoft Scripting Runtime

Public Sub DeleteEmptyFolders(ByVal strFolderPath As String)
Dim fsoSubFolders As Folders
Dim fsoFolder As Folder
Dim fsoSubFolder As Folder

Dim strPaths()
Dim lngFolder As Long
Dim lngSubFolder As Long

DoEvents

Set m_fsoObject = New FileSystemObject
If Not m_fsoObject.FolderExists(strFolderPath) Then Exit Sub

Set fsoFolder = m_fsoObject.GetFolder(strFolderPath)

On Error Resume Next

'Has sub-folders
If fsoFolder.SubFolders.Count > 0 Then
lngFolder = 1
ReDim strPaths(1 To fsoFolder.SubFolders.Count)
'Get each sub-folders path and add to an array
For Each fsoSubFolder In fsoFolder.SubFolders
strPaths(lngFolder) = fsoSubFolder.Path
lngFolder = lngFolder + 1
Next fsoSubFolder

lngSubFolder = 1
'Recursively call the function for each sub-folder
Do While lngSubFolder < lngFolder
Call DeleteEmptyFolders(strPaths(lngSubFolder))
lngSubFolder = lngSubFolder + 1
Loop
End If

'No sub-folders or files
If fsoFolder.Files.Count = 0 And fsoFolder.SubFolders.Count = 0 Then
fsoFolder.Delete
End If
End Sub

VBAdvisor 2008-03-09
  • 打赏
  • 举报
回复
Recursively delete any subkey



Option Explicit

Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) As Long
Private Declare Function RegQueryValue Lib "advapi32.dll" Alias "RegQueryValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal lpValue As String, lpcbValue As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long

Private Const ERROR_SUCCESS = 0&

Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const HKEY_CURRENT_CONFIG = &H80000005
Private Const HKEY_CURRENT_USER = &H80000001
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const HKEY_USERS = &H80000003

Private Const STANDARD_RIGHTS_ALL = &H1F0000
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_SET_VALUE = &H2
Private Const KEY_CREATE_SUB_KEY = &H4
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const KEY_CREATE_LINK = &H20
Private Const SYNCHRONIZE = &H100000
Private Const KEY_ALL_ACCESS = _
((STANDARD_RIGHTS_ALL Or _
KEY_QUERY_VALUE Or _
KEY_SET_VALUE Or _
KEY_CREATE_SUB_KEY Or _
KEY_ENUMERATE_SUB_KEYS Or _
KEY_NOTIFY Or KEY_CREATE_LINK) And _
(Not SYNCHRONIZE))
Private Const ERROR_NO_MORE_ITEMS = 259&

Private m_SelectedSection As Long

Private Const REG_BINARY = 3
Private Const REG_DWORD = 4
Private Const REG_DWORD_BIG_ENDIAN = 5
Private Const REG_DWORD_LITTLE_ENDIAN = 4
Private Const REG_EXPAND_SZ = 2
Private Const REG_FULL_RESOURCE_DESCRIPTOR = 9
Private Const REG_LINK = 6
Private Const REG_MULTI_SZ = 7
Private Const REG_NONE = 0
Private Const REG_RESOURCE_LIST = 8
Private Const REG_RESOURCE_REQUIREMENTS_LIST = 10
Private Const REG_SZ = 1
' Delete all the key's subkeys.
Private Sub DeleteSubkeys(ByVal section As Long, ByVal key_name As String)
Dim hKey As Long
Dim subkeys As Collection
Dim subkey_num As Long
Dim length As Long
Dim subkey_name As String

' Open the key.
If RegOpenKeyEx(section, key_name, _
0&, KEY_ALL_ACCESS, hKey) <> ERROR_SUCCESS _
Then
MsgBox "Error opening key '" & key_name & "'"
Exit Sub
End If

' Enumerate the subkeys.
Set subkeys = New Collection
subkey_num = 0
Do
' Enumerate subkeys until we get an error.
length = 256
subkey_name = Space$(length)
If RegEnumKey(hKey, subkey_num, _
subkey_name, length) _
<> ERROR_SUCCESS Then Exit Do
subkey_num = subkey_num + 1

subkey_name = Left$(subkey_name, InStr(subkey_name, Chr$(0)) - 1)
subkeys.Add subkey_name
Loop

' Recursively delete the subkeys and their subkeys.
For subkey_num = 1 To subkeys.Count
' Delete the subkey's subkeys.
DeleteSubkeys section, key_name & "\" & subkeys(subkey_num)

' Delete the subkey.
RegDeleteKey hKey, subkeys(subkey_num)
Next subkey_num

' Close the key.
RegCloseKey hKey
End Sub
' Get the key information for this key and
' its subkeys.
Private Function GetKeyInfo(ByVal section As Long, ByVal key_name As String, ByVal indent As Integer) As String
Dim subkeys As Collection
Dim subkey_values As Collection
Dim subkey_num As Integer
Dim subkey_name As String
Dim subkey_value As String
Dim length As Long
Dim hKey As Long
Dim txt As String
Dim subkey_txt As String

Set subkeys = New Collection
Set subkey_values = New Collection

If Right$(key_name, 1) = "\" Then key_name = Left$(key_name, Len(key_name) - 1)

' Open the key.
If RegOpenKeyEx(section, _
key_name, _
0&, KEY_ALL_ACCESS, hKey) <> ERROR_SUCCESS _
Then
MsgBox "Error opening key."
Exit Function
End If

' Enumerate the subkeys.
subkey_num = 0
Do
' Enumerate subkeys until we get an error.
length = 256
subkey_name = Space$(length)
If RegEnumKey(hKey, subkey_num, _
subkey_name, length) _
<> ERROR_SUCCESS Then Exit Do
subkey_num = subkey_num + 1

subkey_name = Left$(subkey_name, InStr(subkey_name, Chr$(0)) - 1)
subkeys.Add subkey_name

' Get the subkey's value.
length = 256
subkey_value = Space$(length)
If RegQueryValue(hKey, subkey_name, _
subkey_value, length) _
<> ERROR_SUCCESS _
Then
subkey_values.Add "Error"
Else
' Remove the trailing null character.
subkey_value = Left$(subkey_value, length - 1)
subkey_values.Add subkey_value
End If
Loop

' Close the key.
If RegCloseKey(hKey) <> ERROR_SUCCESS Then
MsgBox "Error closing key."
End If

' Recursively get information on the keys.
For subkey_num = 1 To subkeys.Count
subkey_txt = GetKeyInfo(section, key_name & "\" & subkeys(subkey_num), indent + 2)
txt = txt & Space(indent) & _
subkeys(subkey_num) & _
": " & subkey_values(subkey_num) & vbCrLf & _
subkey_txt
Next subkey_num

GetKeyInfo = txt
End Function
' Delete this key.
Private Sub DeleteKey(ByVal section As Long, ByVal key_name As String)
Dim pos As Integer
Dim parent_key_name As String
Dim parent_hKey As Long

If Right$(key_name, 1) = "\" Then key_name = Left$(key_name, Len(key_name) - 1)

' Delete the key's subkeys.
DeleteSubkeys section, key_name

' Get the parent's name.
pos = InStrRev(key_name, "\")
If pos = 0 Then
' This is a top-level key.
' Delete it from the section.
RegDeleteKey section, key_name
Else
' This is not a top-level key.
' Find the parent key.
parent_key_name = Left$(key_name, pos - 1)
key_name = Mid$(key_name, pos + 1)

' Open the parent key.
If RegOpenKeyEx(section, _
parent_key_name, _
0&, KEY_ALL_ACCESS, parent_hKey) <> ERROR_SUCCESS _
Then
MsgBox "Error opening parent key"
Else
' Delete the key from its parent.
RegDeleteKey parent_hKey, key_name

' Close the parent key.
RegCloseKey parent_hKey
End If
End If
End Sub
Private Sub Command1_Click()
txtKeys.Text = GetKeyInfo( _
m_SelectedSection, Text1.Text, 0)
Command2.Enabled = True
End Sub

Private Sub Command2_Click()
' This can be very dangerous!
' Make the user confirm.
If MsgBox("Are you sure you want to delete these keys?", _
vbYesNo) <> vbYes Then Exit Sub

' Delete the keys.
DeleteKey m_SelectedSection, Text1.Text

Command2.Enabled = False
Text1.Text = ""
txtKeys.Text = ""
End Sub
Private Sub Form_Load()
Option1(2).Value = True
Text1.Text = "RemoteAccess\Profile"
End Sub

Private Sub Form_Resize()
Dim hgt As Single
Dim wid As Single

hgt = ScaleHeight - txtKeys.Top
If hgt < 120 Then hgt = 120
txtKeys.Move 0, txtKeys.Top, _
ScaleWidth, hgt

wid = ScaleWidth - Text1.Left
If wid < 120 Then wid = 120
Text1.Width = wid
End Sub


Private Sub Option1_Click(Index As Integer)
' Save the selected section number.
m_SelectedSection = CLng(Option1(Index).Tag)
End Sub


Private Sub Text1_Change()
Command2.Enabled = False
End Sub
用户 昵称 2008-03-08
  • 打赏
  • 举报
回复
写个递归显示硬盘文件结构的例子,就熟悉了
qiu5208 2008-03-08
  • 打赏
  • 举报
回复
一下看不明白,慢慢研究啊。
cbm6666 2008-03-08
  • 打赏
  • 举报
回复
'下面代码是从我写的 Dll 里面的 .cls 抽出来的, 因此,下面代码,除了Command1事件是本地代码, 其它另两个Sub与Function你可以活用, 摆在你的 .cls里面

'*************** 本代码是在指定的文件夹中中以递归方式搜索多媒体文件
*.mp3;*.mid;*.wav;*.wma;*.dat;*.rm;*.rmi;*.rmvb

'添加 Command1 List1

Option Explicit
Dim j%, aa$, subpattern$(), maxpattern%, tfiles&, subsch As Boolean, s
Private Sub Command1_Click()
MsgBox "共查找到: " & CStr(GetPathFiles(List1, "e:\music", "*.mp3;*.mid;*.wav;*.wma;*.dat;*.rm;*.rmi;*.rmvb", True)) & " 个文件"
End Sub

Public Function GetPathFiles(Llist As Object, pschdir$, pExtName$, Optional subyn As Boolean = False) As Long
tfiles = 0
subsch = subyn
s = Split(pExtName, ";")
For j = 0 To UBound(s)
ReDim Preserve subpattern$(j)
subpattern(j) = s(j)
Next j
maxpattern = UBound(s) + 1
Call DGsearch(Llist, pschdir)
GetPathFiles = tfiles
End Function

Private Sub DGsearch(Llist As Object, strpath$)
On Error Resume Next
Dim strFileDir$(), strFile$, dircount&, lDirCount&
If Right(strpath, 1) <> "\" Then strpath = strpath & "\"
strFile = Dir(strpath, vbDirectory Or vbHidden Or vbNormal Or vbReadOnly)
While strFile <> "" '搜索当前目录
DoEvents
If (GetAttr(strpath & strFile) And vbDirectory) = vbDirectory Then '如果找到的是目录
If strFile <> "." And strFile <> ".." Then '排除掉父目录(..)和当前目录(.)
lDirCount = lDirCount + 1 '将目录数增1
ReDim Preserve strFileDir(lDirCount) As String
strFileDir(lDirCount - 1) = strFile '用动态数组保存当前目录名
End If
Else
For j = 0 To maxpattern - 1
aa = subpattern(j)
If aa = "" Then
If UCase(Right(aa, 3)) = UCase(Right(Trim(strFile), 3)) Or subpattern(j) = "*.*" Then Llist.AddItem strpath & strFile: tfiles = tfiles + 1: Exit For
ElseIf UCase(Right(aa, 3)) = UCase(Right(Trim(strFile), 3)) Or subpattern(j) = "*.*" Then
Llist.AddItem strpath & strFile: tfiles = tfiles + 1: Exit For
End If
Next j
End If
strFile = Dir
Wend
If subsch Then
For dircount = 0 To lDirCount - 1
Call DGsearch(Llist, strpath & strFileDir(dircount)) '递归搜索子目录
Next dircount
ReDim strFileDir(0) '将动态数组清空
End If
End Sub

qiu5208 2008-03-08
  • 打赏
  • 举报
回复
怎么没人啊,
难道没人用vb写递归
难道非要把帖子贴到c语言版去不成。

问题补充:
最好谁有成功运用递归解决实际问题的例子。(vb代码)
当然如果网上复制的比较好的内容也可。
richen_99 2008-03-08
  • 打赏
  • 举报
回复
lisp

7,759

社区成员

发帖
与我相关
我的任务
社区描述
VB 基础类
社区管理员
  • VB基础类社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧