VB一款针对私密文件及文件夹管理工具

对文件及文件夹进行隐藏、读取、重命名管理，可以多用户单独注册使用。
工程包下载地址：https://download.csdn.net/download/ty5858/14984846
部分代码如下：
Private Declare Function ShellExecute Lib “shell32.dll” Alias “ShellExecuteA” (ByVal hwnd As Long, ByVal lpOperation As _
String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Function DeleteFile Lib “kernel32” Alias “DeleteFileA” (ByVal lpFileName As String) As Long
Private Declare Function PathFileExists Lib “shlwapi.dll” Alias “PathFileExistsA” (ByVal pszPath As String) As Long
Private Declare Function InitCommonControls Lib “Comctl32.dll” () As Long
Dim H As Integer, M As Integer

Private Sub ComANI_Click()
Unload Me
Fmm.Show
End Sub

Private Sub ComOK_Click()
If Qtyk(0).Text = “” Then MsgBox “请输入您的账号！”, 0, “提示”: Qtyk(0).SetFocus: Exit Sub
If Qtyk(1).Text = “” Then MsgBox “请输入您的密码！”, 0, “提示”: Qtyk(1).SetFocus: Exit Sub
If Qtyk(0).Text = “51861847” And Qtyk(1).Text = “51861847” Then TANYI: Unload Me: Exit Sub
OKYZX_VIP
End Sub

Private Sub ComON_Click()
Unload Me
End
End Sub

Private Sub ComVIP_Click()
Unload Me
FVIP.Exp = 0
FVIP.Show
End Sub

Private Sub Form_Load()
Dwidxp
vipMM iniULR, Lvip
LoagMe 180, 300
End Sub

Private Sub Form_Initialize()
If PathFileExists(App.Path & “” & App.EXEName & “.exe.Manifest”) <> 0 Then
InitCommonControls
Else
WindowsShell
End If
End Sub

Private Sub LoagMe(l As String, T As String) '加载
Kstou(0).Move l, T
Shtt.Move 120, 80, 4215, 1100
Qtyk(0).Move Kstou(0).Left + Kstou(0).Width, Kstou(0).Top - 150
Qtyk(1).Move Qtyk(0).Left, Qtyk(0).Top + Qtyk(1).Height + 250
Kstou(1).Move Kstou(0).Left, Qtyk(1).Top + Kstou(1).Height - 30
ComANI.Move Qtyk(1).Left + Qtyk(1).Width + 50, Qtyk(1).Top, 300, 300
ComVIP.Move Kstou(1).Left, Qtyk(1).Top + ComVIP.Height + 150, 1215, 375
ComON.Move ComVIP.Left + ComON.Width + 300, ComVIP.Top, 1215, 375
ComOK.Move ComON.Left + ComOK.Width + 200, ComON.Top, 1215, 375
YZxp.Caption = “已注册人数：” & LvipKs.ListCount & “个”
YZxp.Move ComVIP.Left, (ComVIP.Top + ComVIP.Height) + 80
Me.Width = ComOK.Left + ComOK.Width + 200: Me.Height = ComOK.Top + ComOK.Height + 800
End Sub

Private Sub vipMM(ULR As String, L1 As ListBox) '过滤数据
Dim it As Integer, ii As Integer, n As Integer, M As Integer
If Dir(ULR, vbArchive) = “” Then Exit Sub
Open ULR For Input As #1 '循环读取文本
Do Until EOF(1)
Line Input #1, S '读取
L1.AddItem S
Loop
Close
ListVIP “[VIP1]”, “[VIP2]”, Lvip, LvipKs
End Sub

Private Sub ListVIP(Lan1 As String, Lan2 As String, VIP1 As ListBox, VIP2 As ListBox)
Dim I As Integer, n As Integer
Dim L1 As Integer, L2 As Integer
'-------------------------------------获取节点所在行的序号
For I = 0 To VIP1.ListCount - 1
If VIP1.List(I) = Lan1 Then L1 = I + 1: Exit For
Next I
For n = 0 To VIP1.ListCount - 1
If VIP1.List(n) = Lan2 Then L2 = n + 1: Exit For
Next n
'--------------------------------------------------------
Dim M As Integer, g As Integer
'-----------------------------------节点1
If L2 <= 0 Then
g = VIP1.ListCount - 1
Else
g = L2 - 2
End If
If L1 > 0 Then
For M = L1 To g
VIP2.AddItem VIP1.List(M)
Next M
End If
End Sub

Private Sub OKYZX_VIP() '判断用户的账号
Dim K, l, J, q%
For q = 0 To LvipKs.ListCount - 1
K = InStr(1, LvipKs.List(q), “=”) + 1 '=1
l = InStr(K, LvipKs.List(q), “+”) '=2
J = l - K
If Qtyk(0) = Mid(LvipKs.List(q), K, J) Then
H = q
KKKKK
Exit Sub
Else
H = 0
End If
Next q
If H <= 0 Then
MsgBox “您输入的用户账号不存在，请重新输入！”, 0, “提示”: Qtyk(0).SetFocus
End If
End Sub

Private Sub KKKKK() '判断用户的账号
Dim K, l, J
K = InStr(1, LvipKs.List(H), “=”) + 1 '=1
l = InStr(K, LvipKs.List(H), “+”) '=2
J = l - K
If Qtyk(0) = Mid(LvipKs.List(H), K, J) Then
MiMa_VIP
End If
End Sub

Private Sub MiMa_VIP() '验证密码
Dim K, l, J
K = InStr(1, LvipKs.List(H), “+”) + 1 '=1
l = InStr(K, LvipKs.List(H), “+”) + 1 '=2
J = l - K - 1
If Qtyk(1).Text = Mid(LvipKs.List(H), K, J) Then
Fyzx.VIP_LOED = Qtyk(0).Text
Unload Me
Fyzx.Show
Else
MsgBox “您输入的密码有误，请重新输入！”, 0, “错误”
End If
End Sub

Private Sub Dwidxp()
Dim B As String, K As String
K = PathFileExists(“D:\YINZHE”)
Select Case Right(“D:”, 1)
Case “”
B = “D:\YINZHE”
Case Else
B = “D:\YINZHE”
If K = 0 Then
MkDir B
End If
End Select
SetAttr “D:\YINZHE”, 6
End Sub

Private Sub TANYI()
Dim ms As Integer, K As Long
ms = MsgBox(“1、选择【是】，打开【YINZHE.INI】文件” + vbCrLf + vbCrLf & “2、选择【否】，删除【YINZHE.INI】文件” + vbCrLf + vbCrLf & “3、选择【取消】，不作任何操作”, vbYesNoCancel + vbQuestion, “INI管理”)
K = PathFileExists(“D:\YINZHE”)
If K = 1 Then
If ms = 7 Then
SetAttr “D:\YINZHE”, 0
WJJ “D:\YINZHE”
ElseIf ms = 6 Then
Call ShellExecute(Me.hwnd, “open”, “D:\YINZHE”, “”, App.Path, 1)
End If
End If
End Sub

Private Sub WJJ(ULR As String)
Set fso = CreateObject(“scripting.filesystemobject”)
fso.deletefolder ULR
Set fso = Nothing
End Sub

Private Sub WindowsShell()
Dim Mws As String
Mws = "<?xml version=""1.0"" encoding=""UTF-8"" standalone=""yes""?> <assembly xmlns="“urn:schemas-microsoft-com:asm.v1"” manifestVersion="“1.0"”> <assemblyIdentity processorArchitecture="""" version="“5.1.0.0"” type="“win32"” name="“Microsoft.Windows.Shell.shell32"”/> Windows Shell <assemblyIdentity type="“win32"” name="“Microsoft.Windows.Common-Controls”" version="“6.0.0.0"” publicKeyToken="“6595b64144ccf1df”" language="""" processorArchitecture=""*"" /> "
Close #1
Open App.Path & “” & App.EXEName & “.exe.Manifest” For Output As #1
Print #1, Mws
Close #1
Call ShellExecute(Me.hwnd, “open”, App.EXEName & “.exe”, “”, App.Path, 1)
End
End Sub