伪指纹浏览器-多开Chrome

1
' ============================================================
2
' 脚本名称：Chrome 多独立环境一键生成工具
3
' 脚本说明：用于批量创建带有独立 user-data-dir 参数的 Chrome 快捷方式
4
' ============================================================
5

6
Option Explicit ' 强制要求声明变量，防止拼写错误
7

8
' ------------------ 1. 配置区域 (根据需要修改这里) ------------------
9

10
' 每一个 Chrome 分身保存数据（插件、账号、历史记录）的主文件夹
11
Dim UserDataPath: UserDataPath = "D:\ChromeMore\Chrome_UserData"
12

13
' 生成的快捷方式图标存放的位置
14
Dim FilePath:     FilePath     = "D:\ChromeMore\Chrome_ShortCuts"
15

16
' Chrome 程序的实际安装路径 (TargetPath)
17
Dim TargetPath:   TargetPath   = "C:\Program Files\Google\Chrome\Application\chrome.exe"
18

19
' Chrome 运行时的起始位置
20
Dim WorkDir:      WorkDir      = "C:\Program Files\Google\Chrome\Application"
21

22
' 设置生成的起始编号和结束编号（1-10 就是生成 10 个）
23
Dim StartNum:     StartNum     = 1
24
Dim EndNum:       EndNum       = 10
25

26
' ------------------ 2. 系统组件初始化 ------------------
27

28
Dim fso:   Set fso   = CreateObject("Scripting.FileSystemObject") ' 文件系统对象：用于建文件夹
29
Dim shell: Set shell = CreateObject("WScript.Shell")           ' 系统外壳对象：用于建快捷方式
30

31
' ------------------ 3. 自动创建文件夹逻辑 ------------------
32

33
' 如果文件夹不存在，则自动创建（支持多级目录）
34
Sub CreateFolderRecursive(path)
35
    If Not fso.FolderExists(path) Then
36
        Dim parent: parent = fso.GetParentFolderName(path)
37
        If Not fso.FolderExists(parent) Then CreateFolderRecursive(parent)
38
        fso.CreateFolder(path)
39
    End If
40
End Sub
41

42
' 运行创建命令
43
CreateFolderRecursive UserDataPath
44
CreateFolderRecursive FilePath
45

46
' ------------------ 4. 循环生成快捷方式 ------------------
47

48
Dim i, lnk, shortcutFile
49
For i = StartNum To EndNum
50
    ' 定义快捷方式的完整路径（例如 D:\...\Chrome_1.lnk）
51
    shortcutFile = FilePath & "\Chrome_" & i & ".lnk"
52

53
    ' 创建快捷方式对象
54
    Set lnk = shell.CreateShortcut(shortcutFile)
55

56
    ' 设置快捷方式指向的程序路径
57
    lnk.TargetPath = TargetPath
58

59
    ' 设置核心启动参数：--user-data-dir="数据存放路径"
60
    ' 三个引号的作用是在最终生成的参数里保留一对双引号，防止路径中有空格导致失效
61
    lnk.Arguments = "--user-data-dir=""" & UserDataPath & "\" & i & """"
62

63
    ' 设置起始位置
64
    lnk.WorkingDirectory = WorkDir
65

66
    ' 设置快捷方式的鼠标悬停说明
67
    lnk.Description = "Chrome 独立环境分身 " & i
68

69
    ' 保存并关闭该快捷方式文件
70
    lnk.Save
71
Next
72

73
' ------------------ 5. 完成提示 ------------------
74

75
' 弹出成功提示框
76
MsgBox "分身已成功生成！" & vbCrLf & _
77
       "生成的个数：" & (EndNum - StartNum + 1) & " 个" & vbCrLf & _
78
       "存放路径：" & FilePath, _
79
       64, "任务完成" ' 64 代表显示“信息”图标
80

81
' 自动打开存放快捷方式的文件夹，方便直接使用
82
shell.Run "explorer.exe " & FilePath
83

84
' 释放对象内存
85
Set fso = Nothing
86
Set shell = Nothing

1
' ============================================================
2
' 脚本名称：Chrome 多独立环境一键清除工具
3
' 脚本说明：用于彻底删除脚本生成的快捷方式和用户数据文件夹
4
' ============================================================
5

6
Option Explicit
7

8
' ------------------ 1. 配置区域 (必须与生成脚本的路径一致) ------------------
9

10
' 用户数据主文件夹路径
11
Dim UserDataPath: UserDataPath = "D:\ChromeMore\Chrome_UserData"
12

13
' 快捷方式图标存放的文件夹路径
14
Dim FilePath:     FilePath     = "D:\ChromeMore\Chrome_ShortCuts"
15

16
' ------------------ 2. 安全确认 ------------------
17

18
Dim confirm
19
confirm = MsgBox("确定要清除所有 Chrome 分身吗？" & vbCrLf & vbCrLf & _
20
                 "这将删除：" & vbCrLf & _
21
                 "1. " & FilePath & " 下的所有快捷方式" & vbCrLf & _
22
                 "2. " & UserDataPath & " 下的所有用户数据（账号记录将丢失）", _
23
                 33, "危险操作确认")
24

25
' 33 代表“确定”和“取消”按钮，并带有警告图标。如果点击“取消”则退出脚本。
26
If confirm <> 1 Then WScript.Quit
27

28
' ------------------ 3. 系统组件初始化 ------------------
29

30
Dim fso: Set fso = CreateObject("Scripting.FileSystemObject")
31

32
' ------------------ 4. 执行删除逻辑 ------------------
33

34
On Error Resume Next ' 开启错误忽略，防止某些文件夹被占用导致脚本崩溃
35

36
' 删除快捷方式文件夹及其所有内容
37
If fso.FolderExists(FilePath) Then
38
    fso.DeleteFolder FilePath, True
39
    If Err.Number = 0 Then
40
        WScript.Echo "已成功清除快捷方式文件夹。"
41
    Else
42
        WScript.Echo "警告：无法删除快捷方式文件夹，可能某些文件正在被使用。"
43
        Err.Clear
44
    End If
45
End If
46

47
' 删除用户数据主文件夹及其所有内容
48
If fso.FolderExists(UserDataPath) Then
49
    fso.DeleteFolder UserDataPath, True
50
    If Err.Number = 0 Then
51
        WScript.Echo "已成功清除用户数据文件夹（磁盘空间已释放）。"
52
    Else
53
        WScript.Echo "警告：无法删除用户数据文件夹，请先关闭所有运行中的 Chrome 浏览器。"
54
        Err.Clear
55
    End If
56
End If
57

58
' ------------------ 5. 完成提示 ------------------
59

60
MsgBox "清理任务执行完毕！", 64, "清理成功"
61

62
Set fso = Nothing