۲۱-بهمن-۱۳۸۷, ۱۶:۰۶:۱۱
نمایش درختی کلیدهای رجیستری
کد:
#Compile Exe
#Option Version5
#Dim All
#Register All
#Include "win32api.inc"
#Include "commctrl.inc"
%max_computername_length = 15
'------------------------------------------------------------------------------
%id_reg_treeview = 100
'------------------------------------------------------------------------------
Global shivelist() As String ' hive path strings
Global lhivelistcount As Long ' array index counter
Global ltotalhivecount As Long ' can be removed
Global hregtreeview As Long ' treeview handle
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
Function tvgettext(ByVal hparent As Long, ByVal hcontrol As Long, ByVal htvitem As Long) As String
Local ztext As Asciiz * %max_dir
Local ltvitem As tv_item
ltvitem.hitem = htvitem
ltvitem.mask = %tvif_text
ltvitem.psztext = VarPtr(ztext)
ltvitem.cchtextmax = %max_dir
treeview_getitem(getdlgitem(hparent, hcontrol), ltvitem)
Function = ztext
End Function
'------------------------------------------------------------------------------
Function tvsettext(ByVal hparent As Long, ByVal hcontrol As Long, ByVal htvitem As Long, ByVal stxt As String) As Long
Local tvedititem As tv_item
tvedititem.mask = %tvif_handle Or %tvif_text
tvedititem.hitem = htvitem
tvedititem.cchtextmax = %max_dir
tvedititem.psztext = StrPtr(stxt)
Function = treeview_setitem(getdlgitem(hparent, hcontrol), tvedititem)
End Function
'------------------------------------------------------------------------------
Function tvgetfullpath(ByVal hparent As Long, ByVal hcontrol As Long, ByVal htvitem As Long) As String
Local strpath As String
Local hcurrent As Dword
hcurrent = htvitem
Do Until hcurrent = 0
strpath = tvgettext( hparent, hcontrol, hcurrent ) & "\" & strpath
hcurrent = treeview_getparent( getdlgitem(hparent, hcontrol) , hcurrent )
Loop
Function = RTrim$( strpath, "\" )
End Function
'------------------------------------------------------------------------------
Function tvselectitem(ByVal hparent As Long, ByVal hcontrol As Long, ByVal htvitem As Long) As Long
Function = treeview_select(getdlgitem(hparent, hcontrol), htvitem, %tvgn_caret)
End Function
'------------------------------------------------------------------------------
Function tvexpand(ByVal hparent As Long, ByVal hcontrol As Long, ByVal htvitem As Long) As Long
Function = treeview_expand(getdlgitem(hparent, hcontrol), htvitem, %tve_expand)
End Function
'------------------------------------------------------------------------------
Function tvinsertitem(ByVal htree As Long, ByVal hparent As Long, stxt As String) As Long
Local tv_insert As tv_insertstruct
Local tv_itm As tv_item
If hparent Then
tv_itm.mask = %tvif_children Or %tvif_handle
tv_itm.hitem = hparent
tv_itm.cchildren = 1
treeview_setitem(htree, tv_itm)
End If
tv_insert.hparent = hparent
tv_insert.item.item.mask = %tvif_state Or %tvif_text Or %tvif_image Or %tvif_selectedimage
tv_insert.item.item.psztext = StrPtr(stxt)
tv_insert.item.item.cchtextmax = Len(stxt)
Function = treeview_insertitem(htree, tv_insert)
End Function
'------------------------------------------------------------------------------
Function computername As String
Dim retcode As Long
Dim lpbuffer As Asciiz * %max_computername_length + 1
Dim nsize As Long
nsize = %max_computername_length + 1
retcode = getcomputername(lpbuffer,nsize)
Function = UCase$(Trim$(lpbuffer))
End Function
'------------------------------------------------------------------------------
Function enumregsubkeys(hivekey As Long, zstartsubkey As Asciiz) As Long
Local hkey As Long
Local dwindex As Long
Local lastwritetime As filetime
Local zname As Asciiz * %max_path
Local zclass As Asciiz * %max_path
If regopenkeyex(hivekey, zstartsubkey, 0, %key_enumerate_sub_keys Or %key_all_access, hkey) = %error_success Then
Do
Sleep(0)
'sizeof(zname) sizeof(zclass)
If regenumkeyex(hkey, dwindex, ByVal VarPtr(zname), %max_path, %null, zclass, %max_path, lastwritetime) = %error_success Then
If Trim$(zstartsubkey) = "" Then
ReDim Preserve shivelist(lhivelistcount)
shivelist(lhivelistcount) = zname
Incr lhivelistcount
' ** do a recursive search for more 'local' entries...
enumregsubkeys hivekey, zname
Else
ReDim Preserve shivelist(lhivelistcount)
shivelist(lhivelistcount) = zstartsubkey & "\" & zname
Incr lhivelistcount
' ** do a recursive search for more 'global' entries...
enumregsubkeys hivekey, zstartsubkey & "\" & zname
End If
' ** update index
Incr dwindex
Else
Exit Do
End If
Loop
regclosekey hkey
End If
End Function
'------------------------------------------------------------------------------
Sub getregpathstr(ByVal lreghivehandle As Long, ByVal hivekey As Long)
Local lcnt As Long
Local sregpathstr As String
Local lregpathlen As Long
' ** prepare counter and arrays for new data
lhivelistcount = 0
' ** setup the treeview handle array
Dim reghivehandlelist(0) As Long
reghivehandlelist(0) = lreghivehandle
' ** setup the registry path string array
Dim shivelist(0)
' ** get the subkeys for the hive
Call enumregsubkeys(hivekey, "")
' ** fill treeview with registry path data from shivelist array
For lcnt = 0 To UBound(shivelist)
' ** get registry path string
sregpathstr = shivelist(lcnt)
' ** get number of keys/nodes in the registry path
lregpathlen = ParseCount(sregpathstr,"\")
If lregpathlen < 1 Then lregpathlen = 1
' ** prepare array for the new treeview item handle
ReDim Preserve reghivehandlelist(lregpathlen)
' ** insert registry path item into treeview and update reghivehandlelist
reghivehandlelist(lregpathlen) = tvinsertitem(hregtreeview, reghivehandlelist(lregpathlen-1), Parse$(sregpathstr,"\",lregpathlen) )
Next
' ** release the arrays
Erase shivelist()
Erase reghivehandlelist()
ltotalhivecount = ltotalhivecount + lhivelistcount ' can be removed
End Sub
CallBack Function hdlgproc() As Long
Local trect As rect ' size dialog
Static hroot As Long
Static hhkcr As Long
Static hhkcu As Long
Static hhklm As Long
Static hhku As Long
Static hhkcc As Long
Local lptv As nm_treeview Ptr ' treeview
Local lpnmh As nmhdr Ptr ' treeview
Static htreeitem As Long ' treeview, the selected item
Static htime As Long ' can be removed
Local ltime1, ltime2 As Long ' can be removed
Select Case CbMsg
Case %wm_initdialog
hroot = tvinsertitem(hregtreeview, 0, computername)
hhkcr = tvinsertitem(hregtreeview, hroot, "hkey_classes_root")
hhkcu = tvinsertitem(hregtreeview, hroot, "hkey_current_user")
hhklm = tvinsertitem(hregtreeview, hroot, "hkey_local_machine")
hhku = tvinsertitem(hregtreeview, hroot, "hkey_users")
hhkcc = tvinsertitem(hregtreeview, hroot, "hkey_current_config")
htime = tvinsertitem(hregtreeview, 0, "load time: ")
tvexpand(CbHndl, %id_reg_treeview, hroot)
postmessage CbHndl, %wm_user + 1000, 0, 0
Case %wm_user + 1000
tvsettext(CbHndl, %id_reg_treeview, hroot, "reading registry... ")
ltime1 = Timer
tvselectitem(CbHndl, %id_reg_treeview, hhkcr)
Call getregpathstr(hhkcr, %hkey_classes_root)
tvselectitem(CbHndl, %id_reg_treeview, hhkcu)
Call getregpathstr(hhkcu, %hkey_current_user)
tvselectitem(CbHndl, %id_reg_treeview, hhklm)
Call getregpathstr(hhklm, %hkey_local_machine)
tvselectitem(CbHndl, %id_reg_treeview, hhku)
Call getregpathstr(hhku, %hkey_users)
tvselectitem(CbHndl, %id_reg_treeview, hhkcc)
Call getregpathstr(hhkcc, %hkey_current_config)
ltime2 = Timer
tvsettext(CbHndl, %id_reg_treeview, htime, "load time: " & Format$(ltotalhivecount) & _
" registry keys in " & Format$(ltime2-ltime1) & _
" seconds (" & Format$(ltotalhivecount \ (ltime2-ltime1)) & " keys/sec)" ) ' can be removed
tvsettext(CbHndl, %id_reg_treeview, hroot, computername)
tvselectitem(CbHndl, %id_reg_treeview, hroot)
Case %wm_notify
lpnmh = CbLParam
lptv = CbLParam
Select Case CbCtl
Case %id_reg_treeview
Select Case @lpnmh.code
Case %tvn_selchangingn
htreeitem = @lptv.itemnew.hitem
Dialog Set Text CbHndl, $Spc & tvgetfullpath(CbHndl, %id_reg_treeview, htreeitem)
Function = 0
Exit Function
Case %tvn_itemexpanded
htreeitem = @lptv.itemnew.hitem
tvselectitem(CbHndl, %id_reg_treeview, htreeitem)
Function = 0
Exit Function
End Select
End Select
Case %wm_command
Select Case CbCtl
Case %idcancel
If CbCtlMsg = %bn_clicked Then Dialog End CbHndl, 0
End Select
Case %wm_size
getclientrect CbHndl, trect
movewindow(hregtreeview, 1, 1, trect.nright-2, trect.nbottom-2, 1)
Case %wm_destroy
End Select
End Function
Function PBMain() As Long
Local hdlg As Long
Dialog New Pixels, 0, "registry to treeview",,, 400, 300, %ws_child Or %ws_sysmenu Or _
%ws_maximizebox Or %ws_minimizebox Or %ws_caption Or %ws_thickframe To hdlg
Control Add "systreeview32", hdlg, %id_reg_treeview, "", 0, 0, 0, 0, _
%ws_child Or %ws_visible Or %tvs_hasbuttons Or %tvs_haslines Or _
%tvs_linesatroot Or %tvs_showselalways, %ws_ex_clientedge
Control Handle hdlg, %id_reg_treeview To hregtreeview
Dialog Show Modal hdlg Call hdlgproc
End Function