[问题求助] [已解决] VBS中创建带有unicode字符的快捷方式应如何改？

adan1

由于脚本带有unciode字符，VBS文件必须保存为unicode编码，跟目标程序于同一目录下，这个目录也是带有unicode字符的。
就这样运行的话，第6行就报错了。

rootPath=createobject("Scripting.FileSystemObject").GetFolder(".").Path
currentPath=rootPath & "\"
set WshShell=WScript.CreateObject("WScript.Shell")

set oShellLink=WshShell.CreateShortcut(currentPath & "イブニクル・ランス版.lnk")
oShellLink.TargetPath=currentPath & "EvenicleRance.exe"
oShellLink.Arguments=""
oShellLink.WorkingDirectory=currentPath
'oShellLink.Hotkey=""
oShellLink.WindowStyle=1
oShellLink.Description=""
oShellLink.Save
复制代码

adan1

回复 14# yu2n

不错

adan1

今天又是带有unicode的，而且是多个，顺应修改下复用。

set objShell = CreateObject("shell.application")
set fso = CreateObject("Scripting.FileSystemObject")
Function createLink(path, linkName)
    set objFolder = objShell.NameSpace(path)
    set objFolderItem = objFolder.ParseName(linkName)
    if objFolderItem Is Nothing then
        fso.CreateTextFile path & linkName, true
        set objFolderItem = objFolder.ParseName(linkName)
    end if
    set createLink = objFolderItem.GetLink
End Function

rootPath = fso.GetFolder(".").Path
Function currentPath(path)
    if isNull(path) then
        currentPath = rootPath
    elseif path = "" then
        currentPath = rootPath & "\"
    elseif path = "\" then               '特殊
        currentPath = rootPath
    elseif left(path, 1) = "\" then      '特殊
        currentPath = rootPath & path
    elseif right(path, 1) = "\" then
        currentPath = rootPath & "\" & path
    else
        currentPath = rootPath & "\" & path & "\"
    end if
End Function


set objShellLink = createLink(currentPath(""), "手垢塗れの天使.lnk")
objShellLink.Path = currentPath("") & "angel.exe"
objShellLink.Arguments = ""
objShellLink.WorkingDirectory = currentPath("\")
objShellLink.Hotkey = 0
objShellLink.ShowCommand = 1
objShellLink.Description = ""
objShellLink.SetIconLocation currentPath("") & "angel.exe", 0
objShellLink.Save()

set objShellLink = createLink(currentPath(""), "手垢塗れの天使の詳細設定.lnk")
objShellLink.Path = currentPath("") & "angel.exe"
objShellLink.Arguments = "-userconf"
objShellLink.WorkingDirectory = currentPath("\")
objShellLink.Hotkey = 0
objShellLink.ShowCommand = 1
objShellLink.Description = ""
'objShellLink.SetIconLocation currentPath("") & ".exe.ico.dll", 0
objShellLink.Save()

set objShellLink = createLink(currentPath(""), "手垢塗れの天使のファイル破損チェック.lnk")
objShellLink.Path = currentPath("data") & "ファイル破損チェックツール.exe"
objShellLink.Arguments = ""
objShellLink.WorkingDirectory = currentPath("\")
objShellLink.Hotkey = 0
objShellLink.ShowCommand = 1
objShellLink.Description = ""
'objShellLink.SetIconLocation currentPath("") & ".exe.ico.dll", 0
objShellLink.Save()
复制代码

yu2n

回复 9# adan1


    已测试 INF 无法创建带这些字符的快捷方式。

yu2n

Mark. 墙内资料不好找。

'VBS 使用 Shell.Application 创建快捷方式
Option Explicit 

Main
'================================================================================
Sub Main()
'================================================================================
	Dim exePath, lnkPath
	'在当前目录创建
	exePath = "Evenicle・Rance.exe" 
	lnkPath = "イブニクル・ランス版.lnk"
	If CreateLink(exePath, lnkPath) Then
		Msgbox lnkPath & " 创建成功！", vbInformation, WScript.ScriptName
	Else
		Msgbox lnkPath & " 创建失败！", vbCritical, WScript.ScriptName
	End If

	'在当前用户桌面创建
	exePath = "Evenicle・Rance.exe" 
	lnkPath = CreateObject("Wscript.Shell").SpecialFolders("Desktop") & "\イブニクル・ランス版.lnk"
	If CreateLink(exePath, lnkPath) Then
		Msgbox lnkPath & " 创建成功！", vbInformation, WScript.ScriptName
	Else
		Msgbox lnkPath & " 创建失败！", vbCritical, WScript.ScriptName
	End If
End Sub


'================================================================================
'使用 Shell.Application 创建快捷方式
'================================================================================
Function CreateLink(ByVal exePath, ByVal lnkPath)
	Dim exeDir, exeName, lnkDir, lnkName
	Dim objFS, objShell, objFolder, objFolderItem, objShellLink
	Set objFS = CreateObject("Scripting.FileSystemObject")
	Set objShell = CreateObject("Shell.Application")
	CreateLink = False
	exeName = Split(exePath,"\")(UBound(Split(exePath,"\")))	'设置路径
	exeDir = Left(exePath, Len(exePath) - Len(exeName))
	lnkName = Split(lnkPath,"\")(UBound(Split(lnkPath,"\")))
	lnkDir = Left(lnkPath, Len(lnkPath) - Len(lnkName))
	If exeDir = "" Then exeDir = objFS.GetFolder(".").Path & "\"
	If lnkDir = "" Then lnkDir = exeDir
	Set objFolder = objShell.NameSpace(lnkDir)					'获取快捷方式对象
	If objFolder Is Nothing Then Exit Function
	Set objFolderItem = objFolder.ParseName(lnkName)
	If objFolderItem Is Nothing Then
		objFS.CreateTextFile lnkPath, true
		Set objFolderItem = objFolder.ParseName(lnkName)
		If objFolderItem Is Nothing Then
			objFS.DeleteFile lnkPath
			Exit Function
		End If
	End If
	Set objShellLink = objFolderItem.GetLink					'设置快捷方式属性
	objShellLink.Path = exePath
	objShellLink.Arguments = ""
	objShellLink.WorkingDirectory = exeDir
	objShellLink.Hotkey = 0
	objShellLink.ShowCommand = 1
	objShellLink.Description = ""
	objShellLink.SetIconLocation exePath, 0
	objShellLink.Save()
	CreateLink = True
End Function
复制代码

CommandBatCmd

回复 12# adan1


Windows Shell自己搞的东西还需自己收拾。
付出总有回报，问题总是没有办法多。
前进！前进！前进进！

adan1

我google了几篇国外求助贴，算是搞起来了。一开始是用VBS去执行powershell的，后来才想起可以直接VBS。。。

set fso = CreateObject("Scripting.FileSystemObject")
rootPath = fso.GetFolder(".").Path
set objShell = CreateObject("shell.application")

currentPath = rootPath & "\"
set objFolder = objShell.NameSpace(currentPath)

lnkname = "イブニクル・ランス版.lnk"
set objFolderItem = objFolder.ParseName(lnkname)
if objFolderItem Is Nothing then
    fso.CreateTextFile currentPath & lnkname, true
    set objFolderItem = objFolder.ParseName(lnkname)
end if

set objShellLink = objFolderItem.GetLink
objShellLink.Path = currentPath & "Evenicle・Rance.exe"
objShellLink.Arguments = ""
objShellLink.WorkingDirectory = currentPath
objShellLink.Hotkey = 0
objShellLink.ShowCommand = 1
objShellLink.Description = ""
objShellLink.SetIconLocation currentPath & "Evenicle・Rance.exe", 0
objShellLink.Save()
复制代码

暂时先这样，看看还有没需要改正的。

adan1

回复 8# 老刘1号

。。。压缩包的方式算是写死了吧，而且还要求自带解压程序，这曲线想想都麻烦

adan1

回复 7# CommandBatCmd


嗯，很同意历史遗留的编码问题，以前相对封闭的空间使用区域性编码，而现在全世界互联造成各种冲突。Windows上至今升级到WIN10好像仍用这样的编码方式，写个批处理换别的语言平台就显示乱码了。
你提出的只使用系统默认编码之内的字符，做法是正确的，不过我觉得这应该是真正软件开发者所要考虑的，而我只是事后为其做些小事情，在不破坏原有程序的前提下。前几次我遇到过带unicode字符的快捷方式，那时是使用形状相近的非unicode字符替换 临时解决掉，而现在连目录也带有unicode字符，现有的脚本无法可施。

adan1

回复 6# yu2n

没怎么弄过INF，常见于驱动那边，看上去会给系统绑定些什么的。。。

老刘1号

这还不简单？VBS不能处理Unicode那就不处理呗
贯穿曲线救国思想，步骤如下：
1、把快捷方式整好
2、连带Unicode字符的目录与文件一起压缩为压缩包
3、需要时使用VBS解压压缩包即可
如果实在想要单文件，可以考虑文件转Hex嵌入到VBS里面。

CommandBatCmd

在1楼的代码中，没有什么逻辑错误，是由不同字符集和编码，以及程序和系统之间交互编码不统一造成的，和老生常谈的“乱码”问题没有什么本质的区别。

在1楼第5行的“CreateShortcut()”函数在保存处理结果之前，肯定进行了从来源字符串编码（unicode编码）到操作系统默认编码（ANSI编码）的转换，
windows的简体中文版的默认ANSI编码为：GB2312或GBK或GB18030，把unicode编码字符 ・ 转换到ANSI编码会变为半角问号 ?
所以函数“CreateShortcut()”保存的结果与输入的原始字符串不一致，这样会造成路径改变的错误，而半角问号又会造成无法保存的错误。

到现在为止，字符集和编码遗留下来的多足鼎立的现象还没有得到很好的根治，
加之操作系统、应用程序、储存的文件，它们之间没有强制性的、统一的、唯一的“中转”字符集和编码，
编写应用程序稍有考虑不周，产生错误则不可避免，如很多杀毒软件对unicode编码字符“☀☁☂☃☄☎☏☐☑☒”文件夹下的病毒无可奈何。
盼望计算机世界的字符集和编码大统一早日到来！！！

2楼的曲线救国，6楼的inf，实际中都存在字符集和编码的问题，退就其次的解决办法就是（权宜之计）：
把存储体中超出系统默认编码的路径、文件名中的字符替换成系统默认编码之内的字符，
或者不读取包含超出系统默认编码字符的路径、文件名，
或者直接使用系统功能手动创建快捷方式。

以上个人拙见，与坛友共勉。

yu2n

回复 5# adan1


    原来目录也是日文，没看清。
看来此路不通，换inf调用试试吧。

参考：
inf 创建 快捷方式
inf文件如何使用命令安装

adan1

回复 4# yu2n

测试平台 Win7x86
1. 目标文件所在目录带有unicode字符，比如：・
    使用2L代码，执行后提示错误：

2. 目标文件名带有unicode字符，比如：・
    目录没有带unicode字符，使用2L代码并修改targetPath指向带有unicode字符名的文件，执行后提示错误：

yu2n

回复 3# adan1

    测试环境：Win10x64。
    我这里测试自己的代码没有报错。
    我这里测试你的代码是第 12 行错误，没有第 6 行报错。第 6 行报错可能是没有写权限，第 12 行报错可能是字符集问题。

    说到底，你报错的提示是什么？