[文本处理] 如何通过批处理修改桌面url快捷方式的图标？

url文件是个文本文件，可以用记事本打开并编辑

文件中，与快捷键和图标相关的行：
IconFile  表示图标文件
IconIndex 如果图标文含有多个图标，IconIndex表示图标的序号，第一个图标的序号为0
复制代码

rem 另存为 ANSI 编码 bat
' & cls & cscript.exe /nologo /e:vbscript "%~f0" & pause & exit

file = "百度.url"
icon = "%USERPROFILE%\Pictures\baidu.ico"

Call write_ini(file, , "InternetShortcut", "IconFile", icon)
Call write_ini(file, , "InternetShortcut", "IconIndex", "0")
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oWshShell = CreateObject("WScript.Shell")
Set oWshUrlShortcut = oWshShell.CreateShortcut(file)
s = oWshUrlShortcut.TargetPath
oWshUrlShortcut.TargetPath = s
oWshUrlShortcut.Save()

Function write_ini(ByVal file, ByVal charset, ByVal section, ByVal key, ByRef value)
    Dim oFSO, oStream, oRegExp, oMatches, sINI, s, i, m, b, t, LineSeparator
    Set oFSO          = CreateObject("Scripting.FileSystemObject")
    Set oStream       = CreateObject("ADODB.Stream")
    oStream.Type      = 2    'adTypeText
    oStream.Mode      = 3    'adModeReadWrite
    Set oRegExp       = New RegExp
    oRegExp.Global    = True
    oRegExp.MultiLine = True
    If VarType(charset) = vbError Then charset = "GB2312"    '缺省参数
    On Error Resume Next

    If (VarType(file)    <> vbString)                                Or _
       (VarType(section) <> vbString)                                Or _
       (VarType(key)     <> vbString And VarType(key)   <> vbNull)   Or _
       (VarType(value)   <> vbString And VarType(value) <> vbNull) Then _
       write_ini = "至少有一个参数的类型错误" : Exit Function
    If Left(section, 1)  <> "[" Then section = "[" & section
    If Right(section, 1) <> "]" Then section = section & "]"    'section参数带不带[]都可以
    Err.Clear()
    oStream.Charset = charset
    If Err.Number <> 0 Then write_ini = Err.Description : Exit Function
    If Not oFSO.FileExists(file) Then    '文件不存在
        oStream.Open()
        oStream.WriteText section
        Err.Clear()
        oStream.SaveToFile file    '新建文件
        If Err.Number <> 0 Then write_ini = "新建文件失败" : Exit Function
        oStream.Close()
    End If
    oStream.Open()
    Err.Clear()
    oStream.LoadFromFile file
    If Err.Number <> 0 Then write_ini = "读取文件失败" : Exit Function
    sINI = oStream.ReadText()    '读取文件内容
    oStream.Close()

    LineSeparator = vbNewLine    '兼容各种分行符
    If InStr(sINI, vbLf) > 0 Then LineSeparator = vbLf
    If InStr(sINI, vbCr) > 0 Then LineSeparator = vbCr
    If InStr(sINI, vbCrLf) > 0 Then LineSeparator = vbCrLf
    sINI = sINI & LineSeparator    '添加分行符，防止最后一行不匹配正则表达式
    oRegExp.Pattern = "^(.+)\r"
    If LineSeparator = vbLf Then oRegExp.Pattern = "^(.+)\n"

    m = -1    '用于标志小节名是否存在
    Set oMatches = oRegExp.Execute(sINI)  '兼容小节名含有特殊字符的情况，兼容其它行含小节名的情况
    For i = 0 To oMatches.Count - 1
        If LCase(oMatches.Item(i).SubMatches.Item(0)) = LCase(section) Then m = i : Exit For
    Next
    If m = -1 Then sINI = sINI & section & LineSeparator    '小节名不存在，在文末添加小节名

    '目标小节已存在，开始处理键名键值
    b = False    'False非目标小节，True是目标小节
    s = 0        '0未处理目标小节，1已处理目标小节未处理目标键名，2已处理目标小节和目标键名
    t = ""       '新的sINI文本
    Set oMatches = oRegExp.Execute(sINI)
    For i = 0 To oMatches.Count - 1
        m = oMatches.Item(i).SubMatches.Item(0)
        If LCase(m) = LCase(section) Then    '目标小节
            b = True
            s = 1
            If VarType(key) <> vbNull Then t = t & m & LineSeparator
        ElseIf Left(m, 1) = "[" And Right(m, 1) = "]" Then    '其它小节
            b = False
            If s = 1 Then
                If VarType(value) <> vbNull And VarType(key) <> vbNull Then
                    t = t & key & "=" & value & LineSeparator & m & LineSeparator
                Else
                    t = t & m & LineSeparator
                End If
                s = 2
            Else
                t = t & m & LineSeparator
            End If
        Else                     '键名键值行、注释行
            If b = False Then    '非目标小节
                t = t & m & LineSeparator
            Else                 '目标小节
                If VarType(key) = vbNull Then                      '删除目标小节
                    s = 2
                ElseIf LCase(Split(m ,"=")(0)) = LCase(key) Then   '目标键名
                    If VarType(value) = vbNull Then                '删除目标键名
                    Else
                        t = t & key & "=" & value & LineSeparator  '修改键值
                    End If
                    s = 2
                Else                                               '非目标键名
                    t = t & m & LineSeparator
                End If
            End If
        End If
    Next
    If s = 1 And VarType(value) <> vbNull And VarType(key) <> vbNull Then    '新建目标键名
        t = t & key & "=" & value & LineSeparator
    End If

    t = RePlace(t, LineSeparator & "[", LineSeparator & LineSeparator & "[")
    oStream.Open()
    oStream.WriteText t
    Err.Clear()
    oStream.SaveToFile file, 2    'adSaveCreateOverWrite 覆盖写入文件
    If Err.Number <> 0 Then write_ini = "写入文件失败" : Exit Function
    oStream.Close()
    write_ini = "写入成功" & Len(t) & "字符" & LineSeparator & t
End Function
复制代码