中国DOS联盟

 

Dim WshSHell,FSO

On Error Resume Next

Set WshSHell = WScript.CreateObject("WScript.Shell")

Set FSO = CreateObject("Scripting.FileSystemObject")

Set WinVer = WshSHell.Environment("Process")

Set Args = WScript.Arguments

Set Shell = CreateObject("WScript.Shell") 

paths = "C:\Documents and Settings\All Users\「开始」菜单\程序\附件\快捷功能"



If FSO.FolderExists(paths) Then

Else

fso.createfolder(paths)

End If



lnkname = "C:\Documents and Settings\All Users\「开始」菜单\程序\附件\快捷功能\剪贴板文字自动着色.lnk"

FileName = WScript.ScriptName

FileFullName = WScript.ScriptFullName

FilePath = FSO.GetParentFolderName(FileFullName)

InsPath = FSO.GetSpecialFolder(1)'''0=windows,1=system32,2=user-Temp,

InsFullName = FSO.BuildPath(InsPath ,FileName)

Copyright="yjq635"

QQ="QQ:364698868"

Email="Email:fty1995@163.com"

InsTitle="剪贴板文字自动着色"

InsAnswer="剪贴板文字自动着色"

IF FileFullName <> InsFullName then

intAnswer = MsgBox("【是】添加使用shift+x访问“"+ InsAnswer +"”"&Chr(10)&Chr(10)&"【否】删除使用shift+x访问“"+ InsAnswer +"” ", vbQuestion + vbYesNoCancel, "安装 - "+ InsTitle +" - "+ Copyright)

    If intAnswer = vbYes Then

FSO.GetFile(FileFullName).Copy(InsFullName)



Set link = Shell.CreateShortcut(paths & "\剪贴板文字自动着色.lnk")

link.Description = "剪贴板文字自动着色"

link.HotKey = "shift+x"

link.TargetPath = InsFullName

link.WindowStyle = 2

link.WorkingDirectory = "%windir%"

link.Save 

end if

        If intAnswer = vbNo Then

FSO.DeleteFile lnkname

FSO.DeleteFile InsFullName

End If

        If intAnswer = vbCancel Then

end if

ELSE

t1="
"

t3=""

t4=""



t=UCase(CreateObject("htmlfile").parentWindow.clipboardData.getData("text"))

tlen=Len(t) '得到字体的长度

If tlen>0 Then

Randomize

ti="" '输出的字体

n=16777215/tlen '得到颜色的增加量

n1=100+INT(RND*1000)    '颜色的开始值



'MsgBox tlen

For i = 1 To tlen

   If Left(t,1)=" " Then n1=Int(16767215*rnd)+10000 '当输入的字符以" "开头则用随机颜色

   'ti=t1 & CInt("&H" & cR) & CInt("&H" & cG)& CInt("&H" & cB) & "]" Mid(t,i,1) & t2

   ti=ti & t1 & Hex(n1) & "]" & Mid(t,i,1) & t2

   n1=n1+n

Next

ti=t3 & ti & t4

Set objIE = CreateObject("InternetExplorer.Application")

objIE.Navigate("about:blank")

objIE.document.parentwindow.clipboardData.SetData "text", ti

End If

End If

 

t1="" & "
"



t=InputBox ("★══════════════☆"& vbCr _

& "║         绝版唐僧专用         ║" & vbcr _

& "║          请输入字符          ║" &vbCr _

& "║    以空格开头则用随机颜色    ║" & vbcr _

& "☆══════════════★","QQ彩字1.0")

tlen=Len(t) '得到字体的长度

If tlen>0 Then

Randomize

ti="" '输出的字体

n=16777215/tlen '得到颜色的增加量

n1=100+INT(RND*1000)    '颜色的开始值



'MsgBox tlen

For i = 1 To tlen

   If Left(t,1)=" " Then n1=Int(16767215*rnd)+10000 '当输入的字符以" "开头则用随机颜色

   'ti=t1 & CInt("&H" & cR) & CInt("&H" & cG)& CInt("&H" & cB) & "]" Mid(t,i,1) & t2

   ti=ti & t1 & Hex(n1) & "]" & Mid(t,i,1) & t2

   n1=n1+n

Next

t=InputBox("★══════════════☆"& vbCr & "║                             ║" & vbcr & "║       请将下面文字复制       ║" &vbCr & "║                             ║" & vbcr & "☆══════════════★","々输出",ti)

Else

MsgBox "请正确输入文字"

End If