Dim desc
desc=""
ref=""
addr=""
if WScript.Arguments.Count>1 then
desc=WScript.Arguments(1)
end if
if WScript.Arguments.Count>2 then
ref=WScript.Arguments(2)
end if
addr = WScript.Arguments(0)
If Left(addr,5) = "href=" Then addr = Right(addr,Len(addr)-5)
if Left(addr,1) = "(" Then addr = Right(addr,Len(addr)-1)
if Left(addr,1) = Chr(34) Then addr = Right(addr,Len(addr)-1)
if Left(addr,1) = "<" Then addr = Right(addr,Len(addr)-1)
if Left(addr,1) = "_" Then addr = Right(addr,Len(addr)-1)
if Left(addr,1) = "-" Then addr = Right(addr,Len(addr)-1)
If Right(addr,1) = "." Then addr = Left(addr,Len(addr)-1)
If Right(addr,1) = "," Then addr = Left(addr,Len(addr)-1)
If Right(addr,1) = "?" Then addr = Left(addr,Len(addr)-1)
If Right(addr,1) = "!" Then addr = Left(addr,Len(addr)-1)
If Right(addr,1) = ":" Then addr = Left(addr,Len(addr)-1)
If Right(addr,1) = ";" Then addr = Left(addr,Len(addr)-1)
If Right(addr,1) = Chr(34) Then addr = Left(addr,Len(addr)-1)
If Right(addr,1) = ")" Then addr = Left(addr,Len(addr)-1)
If Right(addr,1) = "(" Then addr = Left(addr,Len(addr)-1)
If Right(addr,1) = ">" Then addr = Left(addr,Len(addr)-1)
addr = Replace(addr,"hxxp://", "http://")
addr = Replace(addr,"hххp://", "http://")
addr = Replace(addr,"HXXP://", "http://")
addr = Replace(addr,"hXXp://", "http://")
addr = Replace(addr,"HxxP://", "http://")
addr = Replace(addr,"хттп://", "http://")
addr = Replace(addr,"ХТТП://", "http://")
addr = Replace(addr,"h__p://", "http://")
addr = Replace(addr,"H__P://", "http://")
addr = Replace(addr,"h**p://", "http://")
addr = Replace(addr,"H**P://", "http://")
addr = Replace(addr,"fxp://", "ftp://")
addr = Replace(addr,"fхp://", "ftp://")
addr = Replace(addr,"FXP://", "ftp://")
addr = Replace(addr,"f*p://", "ftp://")
addr = Replace(addr,"F*P://", "ftp://")
addr = Replace(addr,"f_p://", "ftp://")
addr = Replace(addr,"F_P://", "ftp://")
addr = Replace(addr,"ФТТП://", "ftp://")
addr = Replace(addr,"фттп://", "ftp://")
addr = Replace(addr,"hxxps://", "https://")
addr = Replace(addr,"HTTP://", "http://")
addr = Replace(addr,"HTTPS://", "https://")
addr = Replace(addr,"FTP://", "ftp://")
addr = Replace(addr,"MMS://", "mms://")
addr = Replace(addr,"RTSP://", "rtsp://")
if Left(addr,4) = "ftp." then
addr = "ftp://" + addr
elseif Left(addr,7) <> "http://" and Left(addr,6) <> "ftp://" and Left(addr,8) <> "https://" and Left(addr,6) <> "mms://" and Left(addr,7) <> "rtsp://" then
addr = "http://" + addr
end if
AddLink addr, desc, ref
Sub AddLink(ByVal Url, ByVal Info, ByVal Refer)
set JetCarCatch=CreateObject("JetCar.Netscape")
JetCarCatch.AddUrl Url, Info, Refer
end sub
|
править меню , кладите ADDLINK.VBS в корень системного диска, тогда путь можно вообще не прописявать.
