Get-Rapidshare

нам надо сделать файл со списком адресов и передать его программе. для передачи я просто перетащил файл списка на значёк проги в папке.

vbs-скрипт:
Code:


DIM Wsh
Set Wsh = WScript.CreateObject("WScript.Shell")
'check if Notepad is running
Set locator = CreateObject("WbemScripting.SWbemLocator")
Set service = locator.ConnectServer()
Set props = service.ExecQuery("select name from Win32_Process where name = 'notepad.exe'")
num = props.Count
'if not, launch a new one
If num = 0 Then
Wsh.Run "C:\WINNT\NOTEPAD.EXE", 1
End If
'focus window
Do Until Wsh.AppActivate("Безымянный - Блокнот")
Loop
'paste info
Wsh.SendKeys "^{V}"
Wsh.SendKeys "{enter}"
'quit
Set Wsh = nothing
WScript.Quit

код пункта меню:
Code:


Item, "послать ссылку в блокнот"=Copy link & Execute program, "C:\export.vbs"

прописать его в разделах link popup menu и image link popup menu.

при клике по пункту ссылка копируется, запускается скрипт.

скрипт проверяет, не запущен ли блокнот с определённым дефолтным заголовком. если нет, то блокнот запускается. в положение курсора (т.е. в начало документа) вставляется содержимое буфера обмена, имитируется нажатие ентера для перехода на следующую строку.
при следующем клике опять же происходит копирование, проверяется наличие запущенного блокнота с дефолтным заголовком. а такой уже запущен, поэтому в положение курсора вставляется содержимое буфера и нажимается ентер.
т.о. я перед сном полазил по варезным сайтам, накопал в такой блокнотовский документ несколько ссылок. закрыл документ с сохранением и перетащил его на значёк программы.

в настройках флешгета лучше всего поставить:
настройки - слежение - буфер обмена, подтверждение убрать.
если последнего не сделать, то. я взял штук пять ссылок, кинул их программе. она взяла ссылку на скачивание первого файла в буфер обмена, флеш поймал её и выдал окно с подтверждением. ну в первый раз я могу нажать на ентер для начала закачки, но на второй раз я уже сплю и получится, что окно так и будет висеть, пока я его не сниму.

зы. а я сейчас зачем-то качаю с аваксхома учебники по китайскому языку. делать мне нечего.

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,"http*://", "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