WRFan
Gold Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
написал contextmenu extension для ИЕ для сохранения страницы в mhtml (mht) формат. для использования нужна эта библиотека:
http://www.chilkatsoft.com/mht-activex.asp
в скрипт уже вставлен trial reset. т.к. библиотека не бесплатная, она добавляет ключи в реестр, через которые она контролирует, истекло ли демочное время. а так демо - полнофункциональна. trial reset сабрутина используется в виде wrapper-а, другими словами, trial ключи убираются автоматически из реестра перед и после каждого использования скрипта, можно пользоваться годами
если будете переписывать скрипт, с этой частью скрипта играться не советую, а то по незнанию ещё весь реестр удалите
да, я знаю, что эта функция странно написана, но это из за того, что производитель закодировал ключи в реестре и до них трудновато добраться, если точный путь указывать, vbscript путается
Код:
<SCRIPT LANGUAGE="VBSCRIPT">
sub trialreset()
'ON ERROR RESUME NEXT
Const HKEY_LOCAL_MACHINE = &H80000002
strComputer = "."
Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\default:StdRegProv")
strKeyPath = "SOFTWARE\Chilkat Software, Inc."
oReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys
For Each subkey In arrSubKeys
strKeyPath2 = strKeyPath + "\" + subkey
strValueName = "Key30"
oReg.DeleteValue HKEY_LOCAL_MACHINE,strKeyPath2,strValueName
Next
secondpath = "SOFTWARE\Classes\WMZebra\CLSID"
oReg.EnumKey HKEY_LOCAL_MACHINE, secondpath, arrSubKeys2
For Each subkey2 In arrSubKeys2
secondpath2 = secondpath + "\" + subkey2
strValueName2 = "7832"
oReg.DeleteValue HKEY_LOCAL_MACHINE,secondpath2,strValueName2
Next
end sub
trialreset()
set mht = CreateObject("ChilkatMht.ChilkatMht")
mht.UnlockComponent "AnythingWorksFor30DayTrial"
'external.menuArguments.window.prompt mht.isunlocked
mht.proxy = "127.0.0.1:89" 'Set Proxy
mht.EmbedImages = 1
myURL=external.menuArguments.location.href
pagetitle = external.menuArguments.document.title
Dim fso, half
Set fso = CreateObject("Scripting.FileSystemObject")
half = fso.GetFileName(external.menuArguments.location.href)
'p=instrrev(myURL,"/")
'half = right(myURL,len(myURL)-p)
if InStr(half,".") then
s=InStr(half,".") -1
filename = Left(half, s)
filename = Replace(filename, "%20", "_")
Else filename = ""
End If
Dim WshShell
Set WshShell = CreateObject("WScript.Shell")
Set objWshSpecialFolders = WshShell.SpecialFolders
Mydocs1=WshShell.RegRead("HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\Personal")
Mydocs2 = objWshSpecialFolders("MyDocuments")
if pagetitle > "" then
pagetitle = Replace(pagetitle, " ", "_")
pagetitle = Replace(pagetitle, "/", "_")
pagetitle = Replace(pagetitle, "\", "_")
pagetitle = Replace(pagetitle, ":", "_")
pagetitle = Replace(pagetitle, "|", "_")
pagetitle = Replace(pagetitle, "?", "_")
pagetitle = Replace(pagetitle, Chr(34), "_")
returntext = external.menuArguments.window.prompt ("Please provide the title" & vbCrLf & "(Empty Input or Cancel stop operation)",pagetitle)
Else returntext = external.menuArguments.window.prompt ("Please provide the title" & vbCrLf & "(Empty Input or Cancel stop operation)",filename)
End If
if returntext > "" then
mht.GetAndSaveMHT myURL, Mydocs2 + "\" + returntext + ".mht"
set mht = nothing
trialreset()
end if
</SCRIPT>
|
Код:
Windows Registry Editor Version 5.00
[HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\MenuExt\Save2MHT]
"contexts"=hex:01
@="E:\\WINDOWS\\Web\\ChilkatMHT.html"
|
|
Всего записей: 5275 | Зарегистр. 25-11-2002 | Отправлено: 05:19 20-11-2006 | Исправлено: WRFan, 18:28 22-11-2006 |
|
При том и места на винте отжирает раза в 3+ больше огнелиса. 