2024-4-29 修改
自己平时在用alist，没事的时候就写了个，我这是win11系统。
重新修改了，之前代码搞错了。
蓝奏 https://wwt.lanzout.com/izw9n1v9rhwd
密码:52pj
上面是之前的，下面是4月29日制作的
今天蓝奏打不开
换123盘链接，VB6工程文件和exe
https://www.123pan.com/s/klfbVv-HQCIh.html提取码:52pj
alist程序自行下载，放在同一文件内
win挂载需要修改注册表
开启webdav服务批处理文件，自解压文件，可直接运行或解压。
内容就是下面的注册表和重启WebClient的bat。
https://www.123pan.com/s/klfbVv-oQCIh.html
或复制下面内容保存成.reg添加
Windows Registry Editor Version 5.00
[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\WebClient\Parameters]
"AcceptOfficeAndTahoeServers"=dword:00000001
"BasicAuthLevel"=dword:00000002
"ClientDebug"=dword:00000000
"FileAttributesLimitInBytes"=dword:000f4240
"FileSizeLimitInBytes"=dword:ffffffff
"InternetServerTimeoutInSec"=dword:0000001e
"LocalServerTimeoutInSec"=dword:0000000f
"SendReceiveTimeoutInSec"=dword:0000003c
"ServerNotFoundCacheLifeTimeInSec"=dword:0000003c
"ServiceDebug"=dword:00000000
"ServiceDll"=hex(2):25,00,53,00,79,00,73,00,74,00,65,00,6d,00,52,00,6f,00,6f,\
00,74,00,25,00,5c,00,53,00,79,00,73,00,74,00,65,00,6d,00,33,00,32,00,5c,00,\
77,00,65,00,62,00,63,00,6c,00,6e,00,74,00,2e,00,64,00,6c,00,6c,00,00,00
"ServiceDllUnloadOnStop"=dword:00000001
"SupportLocking"=dword:00000001
启动或重启服务，开始菜单搜：服务
[Visual Basic] 纯文本查看 复制代码
Private MOUNT_POINT As String
Private MOUNT_POINT As String
Private SERVER_ADDRESS As String
Private USERNAME As String
Private PASSWORD As String
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Sub CheckAListStatus()
Dim objWMIService As Object
Dim colProcessList As Object
Dim objProcess As Object
' 获取 Windows 管理服务的实例
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
' 获取所有运行中的进程
Set colProcessList = objWMIService.ExecQuery("Select * from Win32_Process")
' 遍历所有进程，查找 alist.exe
For Each objProcess In colProcessList
If LCase(objProcess.Name) = "alist.exe" Then
' 如果找到 alist.exe，则在 Text4.Text 中显示“开”
Label4.Caption = "开"
Label4.BackColor = &HC0FFC0
Shape1.FillColor = Label4.BackColor
Exit Sub
End If
Next
' 如果没有找到 alist.exe，则在 Text4.Text 中显示“关”
Label4.Caption = "关"
Label4.BackColor = &H8080FF
Shape1.FillColor = Label4.BackColor
End Sub
' 假设这是你的Form_Load事件处理程序
Private Sub Form_Load()
CheckAListStatus
Dim fs As Object
Dim ts As Object
Dim line As String
Dim filePath As String
Dim i As Integer
Dim driveLetter As String
Dim fileSystemObject As Object
' 遍历所有盘符（从A到Z）
For i = 65 To 90 ' ASCII码从A(65)到Z(90)
driveLetter = Chr(i) ' 将ASCII码转换为字符
' 尝试创建一个文件系统对象来访问该盘符
On Error Resume Next ' 忽略错误
Set fileSystemObject = CreateObject("Scripting.FileSystemObject")
' 尝试获取盘符的根目录
fileSystemObject.GetFolder (driveLetter & ":")
' 检查是否发生了错误（即盘符不存在或不可用）
If Err.Number <> 0 Then
' 如果是错误，则添加盘符到ComboBox
Combo1.AddItem driveLetter & ":"
Err.Clear ' 清除错误
End If
On Error GoTo 0 ' 恢复正常的错误处理
If Not fileSystemObject Is Nothing Then
Set fileSystemObject = Nothing
End If
Next i
' 定义文件路径
filePath = "C:\Program Files\webdav\webdav.txt"
' 创建文件系统对象
Set fs = CreateObject("Scripting.FileSystemObject")
' 检查文件是否存在
If fs.fileExists(filePath) Then
Set ts = fs.OpenTextFile(filePath, 1)
Do While Not ts.AtEndOfStream
line = ts.ReadLine
If InStr(line, "Combo1 Value:") > 0 Then
Combo1.Text = Split(line, "Value: ")(1)
ElseIf InStr(line, "Text1 Value:") > 0 Then
Text1.Text = Split(line, "Value: ")(1)
ElseIf InStr(line, "Text2 Value:") > 0 Then
Text2.Text = Split(line, "Value: ")(1)
ElseIf InStr(line, "Text3 Value:") > 0 Then
Text3.Text = Split(line, "Value: ")(1)
End If
If InStr(1, line, "Check1: ", vbTextCompare) > 0 Then
Check1.Value = CInt(Split(line, ":")(1))
ElseIf InStr(1, line, "Check2: ", vbTextCompare) > 0 Then
Check2.Value = CInt(Split(line, ":")(1))
End If
If InStr(1, line, "Check1: ", vbTextCompare) > 0 Then
check1State = Trim(Split(line, ":")(1))
If check1State = "1" Then
' 如果 Check1 被勾选，则运行按钮8的点击事件
Command3_Click
End If
ElseIf InStr(1, line, "Check2: ", vbTextCompare) > 0 Then
check2State = Trim(Split(line, ":")(1))
If check2State = "1" Then
' 如果 Check2 被勾选，则运行按钮6的点击事件
Command1_Click
End If
End If
Loop
ts.Close
Set ts = Nothing
End If
Set fs = Nothing
' 清除错误状态
Err.Clear
End Sub
'----挂载----
Private Sub Command1_Click()
Dim command As String
Dim fs As Object
Dim ts As Object
' 设置你的值
MOUNT_POINT = Combo1.Text ' 挂载点
SERVER_ADDRESS = Text1.Text ' 服务器地址
USERNAME = Text2.Text ' 用户名
PASSWORD = Text3.Text ' 密码
command = "net use " & Combo1.Text & " " & Text3.Text & " /USER:" & Text2.Text & " " & Text1.Text
Call Sleep(2000)
Shell command, 0 ' 隐藏窗口执行
End Sub
'----保存设置
' 假设这是你的按钮2的点击事件处理程序
Private Sub Command2_Click()
Dim fs As Object
Dim folderPath As String
Dim filePath As String
Dim ts As Object
' 定义文件夹路径
folderPath = "C:\Program Files\webdav\"
filePath = folderPath & "webdav.txt"
' 创建文件系统对象
Set fs = CreateObject("Scripting.FileSystemObject")
' 如果文件夹不存在，则创建文件夹
If Not fs.FolderExists(folderPath) Then
fs.CreateFolder folderPath
End If
' 创建或打开文本文件以写入
Set ts = fs.CreateTextFile(filePath, True)
' 写入Text1, Text2, Text3和Combo1的内容
ts.WriteLine "Text1 Value: " & Text1.Text
ts.WriteLine "Text2 Value: " & Text2.Text
ts.WriteLine "Text3 Value: " & Text3.Text
ts.WriteLine "Combo1 Value: " & Combo1.Text
' 写入复选框的状态
ts.WriteLine "Check1: " & Check1.Value
ts.WriteLine "Check2: " & Check2.Value
' 关闭文件
ts.Close
Set ts = Nothing
Set fs = Nothing
' 可选：给出用户反馈
MsgBox "文件保存成功。", vbInformation, "保存"
' 清除错误状态
Err.Clear
End Sub
'----打开网页----
Private Sub Command8_Click()
' 定义要打开的URL
Dim url As String
url = "http://127.0.0.1:5244/"
' 使用Shell函数在CMD中打开默认浏览器并导航到网页
' start 命令会在新的窗口中打开URL
Shell "cmd.exe /c start " & url, 0
CheckAListStatus
End Sub
'----启动alist----
Private Sub Command3_Click()
' 定义要执行的外部程序和参数
Dim programPath As String
programPath = "alist.exe" ' alist.exe 的完整路径
' ' 使用 Shell 函数运行 alist.exe并传递start参数
Shell programPath & " start", 0
CheckAListStatus
End Sub
'----重启alist----
Private Sub Command4_Click()
' 定义要执行的外部程序和参数
Dim programPath As String
programPath = "alist.exe" ' alist.exe 的完整路径
' 使用 Shell 函数运行 alist.exe并传递start参数
Shell programPath & " restart", 0
Call Sleep(500)
CheckAListStatus
End Sub
'----停止alist----
Private Sub Command7_Click()
' 定义要执行的外部程序和参数
Dim programPath As String
programPath = "alist.exe" ' alist.exe 的完整路径
' 使用 Shell 函数运行 alist.exe并传递start参数
Shell programPath & " stop", 0
Call Sleep(500)
CheckAListStatus
End Sub
'----停止alist----
Private Sub Command5_Click()
' 定义要执行的外部程序和参数
Dim programPath As String
programPath = "alist.exe" ' alist.exe 的完整路径
' 使用 Shell 函数运行 alist.exe并传递start参数
Shell programPath & " admin set admin", 1
CheckAListStatus
End Sub
'----下载更新----
Private Sub Command6_Click()
' 定义要打开的URL
Dim url As String
url = "https://github.com/alist-org/alist/releases"
' 使用Shell函数在CMD中打开默认浏览器并导航到网页
' start 命令会在新的窗口中打开URL
Shell "cmd.exe /c start " & url, 0
CheckAListStatus
End Sub
Private Sub Label4_Click()
CheckAListStatus
End Sub
