Что нового

IE, как сохранить содержимое открытой страницы в формате doc

Suppir

Продвинутый
Сообщения
967
Репутация
62
Добрый день!

Допустим, у меня уже открыта в IE страница
http://www.krd.ru/norma/21FCEE9E672B128FC325792D001EDB2E.htm

Как сохранить содержимое текущей страницы (та, которая уже открыта в браузере) в формате DOC?





Добавлено:
Сообщение автоматически объединено:

Если точнее, мне нужно сохранить в DOC весь текст, начиная от слова "Постановление", заканчивая фразой "Ссылки на другие документы". Возможно ли это?
 

Arei

Скриптер
Сообщения
938
Репутация
115
Код:
Iereadbytext
и потом с помощью функций string получить нужное.p.s пишу с телефона.
 

Garrett

Модератор
Локальный модератор
Сообщения
3,999
Репутация
967
Используйте IE.au3 ( _IEBodyReadText() ), далее с помощью Word.au3 сохраняйте в DOC.
 
Автор
S

Suppir

Продвинутый
Сообщения
967
Репутация
62
Проблема в том, что чтобы использовать _IEBodyReadText(), нужно сначала создать объект IE. А мне нужно использовать браузер и страницу, которые уже открыты.
 
Автор
S

Suppir

Продвинутый
Сообщения
967
Репутация
62
Да, в IE, в активной вкладке. Нужно получить доступ к объекту уже запущенного IE.
 

Garrett

Модератор
Локальный модератор
Сообщения
3,999
Репутация
967
Suppir [?]
Код:
Dim $sURL = 'http://www.yousite.ru/'

If WinExists("[CLASS:IEFrame]") Then
	WinActivate("[CLASS:IEFrame]")
	$hWin = WinGetHandle("[CLASS:IEFrame]")
	$oIE = _IEAttach($hWin, "HWND")
Else
	$oIE = _IECreate($sURL)
EndIf

$sText = _IEBodyReadText($oIE)
ConsoleWrite("Body Text: " & @CRLF & $sText)

Далее как описано выше.
 
Автор
S

Suppir

Продвинутый
Сообщения
967
Репутация
62
Спасибо.

Я попробовал вот так:
Код:
local $http = StringRegExpReplace(WinGetText(""), "(?s).+?(http:.+?)[\r\n].+", "\1")


т.е. получить адрес из видимого текста, а потом открыть его в невидимом IE, но ваш вариант мне больше нравится.
 

madmasles

Модератор
Глобальный модератор
Сообщения
7,790
Репутация
2,322
Suppir,
Можно еще так попробовать с уже открытым окном IE.
Код:
#include <IE.au3>
#include <Word.au3>

;'http://www.krd.ru/norma/21FCEE9E672B128FC325792D001EDB2E.htm'
$sText = ''
$hWin = ''
$aListIE = WinList('[CLASS:IEFrame]')

If Not $aListIE[0][0] Then
	MsgBox(16, 'Error', 'Нет окон IE')
	Exit
EndIf
For $i = 1 To $aListIE[0][0]
	If StringInStr(WinGetText($aListIE[$i][1]), 'www.krd.ru/norma/') Then
		$hWin = $aListIE[$i][1]
		ExitLoop
	EndIf
Next

If Not $hWin Then
	MsgBox(16, 'Error', 'Нет окна (:')
	Exit
EndIf
$oIE = _IEAttach($hWin, 'HWND')
If @error Then
	MsgBox(16, 'Error', '_IEAttach')
	Exit
EndIf
For $i = 1 To 1
	$sUrl = _IEPropertyGet($oIE, 'locationurl')
	If @error Then ExitLoop
	$oTags = _IETagNameGetCollection($oIE, 'div')
	If @error Or Not @extended Then ExitLoop
	For $oTag In $oTags
		If $oTag.classname == 'doc' Then
			$sText = $oTag.innertext
			ExitLoop
		EndIf
	Next
Next
If @error Or Not $sText Then
	MsgBox(16, 'Error', 'Error')
Else
	If Not FileExists(@ScriptDir & '\Документы') Then DirCreate(@ScriptDir & '\Документы')
	$sName = StringRegExpReplace(StringRegExpReplace($sUrl, '^.*/', ''), '\..*$', '') & '.doc'
	If FileExists(@ScriptDir & '\Документы\' & $sName) Then
		MsgBox(64, 'Info', 'Этот документ уже сохранен')
		Exit
	Else
		$sText = StringRegExpReplace($sText, '[\r\n]{6}.*$', '')
		$oWordApp = _WordCreate('', 0, 0)
		$oDoc = _WordDocAdd($oWordApp)
		$oDoc.Range.Text = $sText
		_WordDocSaveAs($oDoc, @ScriptDir & '\Документы\' & $sName)
		_WordQuit($oWordApp)
		MsgBox(64, 'Info', 'OK')
	EndIf
EndIf
 
Автор
S

Suppir

Продвинутый
Сообщения
967
Репутация
62
madmasles
Отлично работает, спасибо!

Только в начале на IE 8 почему-то несколько раз писал "нет такого окна", но потом заработало.

А можно еще сделать так:
1) чтобы ваш скрипт определял номер документа (в данном случае № 7699), создавал папку с таким номером и в эту папку сохранял 7699.doc
2) чтобы в эту же папку сохранялись все doc-овские приложения к документу (в данном случае файл 7699 прил.)
 

madmasles

Модератор
Глобальный модератор
Сообщения
7,790
Репутация
2,322
Suppir [?]
А можно еще сделать так:
Протестируйте, у меня работает.
Код:
#include <IE.au3>
#include <Encoding.au3>;http://autoit-script.ru/index.php/topic,510.0.html
#include <WinAPIEx.au3>;Yashied, http://autoit-script.ru/index.php/topic,47.0.html

Opt('MustDeclareVars', 1)
Opt('TrayMenuMode', 1)

Global $sTitle = 'Сохранение документов www.krd.ru'

If WinExists('{[/@$@\]}' & $sTitle) Then Exit
AutoItWinSetTitle('{[/@$@\]}' & $sTitle)

HotKeySet('^{F8}', '_Get_Info_IE');Ctrl+F8
HotKeySet('+{Esc}', '_Exit');Shift+Esc
TraySetToolTip('Shift + Esc - выход' & @LF & 'Ctrl + F8 - сохранить документы')
_WinAPI_EmptyWorkingSet()
While 1
	Sleep(50)
WEnd

Func _Get_Info_IE()
	Local $a_ListIE, $h_Win, $o_IE, $o_Tags, $o_Links, $s_Text_Doc, $s_Control_Url = 'www.krd.ru', _
			$a_Links, $i_Count_Links, $s_Name, $s_Text_Doc_Temp, $s_Root_Folder = @ScriptDir & '\Документы', _
			$s_Ext = 'doc', $i_Error = 1

	HotKeySet('^{F8}')
	HotKeySet('+{Esc}')
	$a_ListIE = WinList('[CLASS:IEFrame]')
	If Not $a_ListIE[0][0] Then
		TrayTip($sTitle, 'Отсутствуют окна Internet Explorer', 5, 3)
		AdlibRegister('_Kill_TrayTip', 5000)
		HotKeySet('^{F8}', '_Get_Info_IE')
		HotKeySet('+{Esc}', '_Exit')
		_WinAPI_EmptyWorkingSet()
		Return
	EndIf
	For $i = 1 To $a_ListIE[0][0]
		If StringInStr(WinGetText($a_ListIE[$i][1]), $s_Control_Url) Then
			$h_Win = $a_ListIE[$i][1]
			ExitLoop
		EndIf
	Next
	If Not $h_Win Then
		TrayTip($sTitle, 'Отсутствует окно Internet Explorer' & @LF & _
				'с адресом, содержащим <' & $s_Control_Url & '>', 5, 3)
		AdlibRegister('_Kill_TrayTip', 5000)
		HotKeySet('^{F8}', '_Get_Info_IE')
		HotKeySet('+{Esc}', '_Exit')
		_WinAPI_EmptyWorkingSet()
		Return
	EndIf
	$o_IE = _IEAttach($h_Win, 'HWND')
	If @error Then
		TrayTip($sTitle, 'Ошибка присоединения к окну Internet Explorer' & @LF & _
				'Попробуйте еще раз', 5, 3)
		AdlibRegister('_Kill_TrayTip', 5000)
		HotKeySet('^{F8}', '_Get_Info_IE')
		HotKeySet('+{Esc}', '_Exit')
		_WinAPI_EmptyWorkingSet()
		Return
	EndIf
	For $i = 1 To 1
		$o_Tags = _IETagNameGetCollection($o_IE, 'div')
		If @error Or Not @extended Then ExitLoop
		For $o_Tag In $o_Tags
			If $o_Tag.classname == 'doc' Then
				$s_Text_Doc = $o_Tag.innertext
				$o_Links = _IETagNameGetCollection($o_Tag, 'a')
				If @error Or Not @extended Then ExitLoop
				Dim $a_Links[@extended + 1][2]
				For $o_Link In $o_Links
					If $o_Link.href Then
						$i_Count_Links += 1
						$a_Links[$i_Count_Links][0] = _Encoding_HexToURL($o_Link.href)
						$a_Links[$i_Count_Links][1] = StringRegExpReplace($a_Links[$i_Count_Links][0], '^.*/', '')
						If @extended <> 1 Then _
								$a_Links[$i_Count_Links][1] = 'Прил_' & @MDAY & '_' & @MON & '_' & @HOUR & '_' & @MIN & '_' & @SEC
					EndIf
				Next
				If $i_Count_Links Then ReDim $a_Links[$i_Count_Links + 1][2]
				ExitLoop
			EndIf
		Next
		$i_Error = 0
	Next
	If $i_Error Or Not $s_Text_Doc Then
		TrayTip($sTitle, 'Ошибка получения текста документа.' & @LF & _
				'Попробуйте еще раз', 5, 3)
		AdlibRegister('_Kill_TrayTip', 5000)
		HotKeySet('^{F8}', '_Get_Info_IE')
		HotKeySet('+{Esc}', '_Exit')
		_WinAPI_EmptyWorkingSet()
		Return
	EndIf
	$s_Text_Doc_Temp = StringRegExpReplace($s_Text_Doc, '[\r\n]{6}.*$', '')
	If @extended = 1 Then $s_Text_Doc = $s_Text_Doc_Temp
	$s_Name = StringRegExpReplace($s_Text_Doc, '(?s).*\d{1,2}\.\d{1,2}\.\d{2,4}.*(№\s?\d+)\r\n.*', '$1')
	If @extended <> 1 Then $s_Name = @MDAY & '_' & @MON & '_' & @HOUR & '_' & @MIN & '_' & @SEC
	_Save_Word($s_Text_Doc, $s_Name, $s_Root_Folder, $s_Ext)
	If @error Then
		TrayTip($sTitle, 'Ошибка сохранения файла.' & @LF & _
				'Попробуйте еще раз', 5, 3)
		AdlibRegister('_Kill_TrayTip', 5000)
		HotKeySet('^{F8}', '_Get_Info_IE')
		HotKeySet('+{Esc}', '_Exit')
		_WinAPI_EmptyWorkingSet()
		Return
	EndIf
	If $i_Count_Links Then
		For $i = 1 To $i_Count_Links
			_Inet_Get_Doc($a_Links[$i][0], $s_Root_Folder & '\' & $s_Name, $a_Links[$i][1])
			If @error Then
				TrayTip($sTitle, 'Ошибка закачки файла.' & @LF & _
						'Попробуйте еще раз', 5, 3)
				AdlibRegister('_Kill_TrayTip', 5000)
				HotKeySet('^{F8}', '_Get_Info_IE')
				HotKeySet('+{Esc}', '_Exit')
				_WinAPI_EmptyWorkingSet()
				Return
			EndIf
		Next
	EndIf
	TrayTip($sTitle, 'Все операции успешно выполнены.', 5, 1)
	AdlibRegister('_Kill_TrayTip', 5000)
	HotKeySet('^{F8}', '_Get_Info_IE')
	HotKeySet('+{Esc}', '_Exit')
	_WinAPI_EmptyWorkingSet()
	Return
EndFunc   ;==>_Get_Info_IE

Func _Save_Word($s_Text_To_Word, $s_Name_Dir_File, $s_Root_Folder_Save, $s_Ext_Word)
	Local $o_WordApp, $o_Doc, $i_Error = 1, $o_Error, $f_Copy

	If Not FileExists($s_Root_Folder_Save & '\' & $s_Name_Dir_File) _
			Or Not StringInStr(FileGetAttrib($s_Root_Folder_Save & '\' & $s_Name_Dir_File), 'D') Then
		If Not DirCreate($s_Root_Folder_Save & '\' & $s_Name_Dir_File) Then Return SetError(1)
	EndIf
	If FileExists($s_Root_Folder_Save & '\' & $s_Name_Dir_File & '\' & $s_Name_Dir_File & '.' & $s_Ext_Word) Then
		If MsgBox(36, $sTitle, 'Файл <' & $s_Root_Folder_Save & '\' & $s_Name_Dir_File & '\' & _
				$s_Name_Dir_File & '.' & $s_Ext_Word & '>' & @LF & 'уже есть. Перезаписать его?') = 7 Then
			Return
		Else
			If FileCopy($s_Root_Folder_Save & '\' & $s_Name_Dir_File & '\' & $s_Name_Dir_File & '.' & $s_Ext_Word, _
					$s_Root_Folder_Save & '\' & $s_Name_Dir_File & '\' & $s_Name_Dir_File & '.' & $s_Ext_Word & '.bak', 1) _
					Then $f_Copy = True
			FileDelete($s_Root_Folder_Save & '\' & $s_Name_Dir_File & '\' & $s_Name_Dir_File & '.' & $s_Ext_Word)
		EndIf
	EndIf
	$o_Error = ObjEvent('AutoIt.Error', '_Save_Word')
	$o_WordApp = ObjCreate('Word.Application')
	If Not IsObj($o_WordApp) Then Return SetError(1)
	$o_WordApp.Visible = False
	For $i = 1 To 1
		$o_Doc = $o_WordApp.Documents.Add
		If $o_Error.number Then ExitLoop
		$o_Doc.Range.Text = $s_Text_To_Word
		If $o_Error.number Then ExitLoop
		$o_Doc.SaveAs($s_Root_Folder_Save & '\' & $s_Name_Dir_File & '\' & $s_Name_Dir_File & '.' & $s_Ext_Word)
		If $o_Error.number Then ExitLoop
		$i_Error = 0
	Next
	If $i_Error Then
		If $f_Copy Then
			FileCopy($s_Root_Folder_Save & '\' & $s_Name_Dir_File & '\' & $s_Name_Dir_File & '.' & $s_Ext_Word & '.bak', _
					$s_Root_Folder_Save & '\' & $s_Name_Dir_File & '\' & $s_Name_Dir_File & '.' & $s_Ext_Word, 1)
		EndIf
	Else
		If $f_Copy Then
			FileDelete($s_Root_Folder_Save & '\' & $s_Name_Dir_File & '\' & $s_Name_Dir_File & '.' & $s_Ext_Word & '.bak')
		EndIf
	EndIf
	$o_WordApp.Quit
	If $o_Error.number Then $i_Error = 1
	Return SetError($i_Error)
EndFunc   ;==>_Save_Word

Func _Inet_Get_Doc($s_Url, $s_Folder, $s_File_Name)
	Local $h_Download, $i_Error, $f_Copy

	If FileExists($s_Folder & '\' & $s_File_Name) Then
		If MsgBox(36, $sTitle, 'Файл <' & $s_Folder & '\' & $s_File_Name & '>' & @LF & _
				'уже закачен. Перезаписать его?') = 7 Then
			Return
		Else
			If FileCopy($s_Folder & '\' & $s_File_Name, $s_Folder & '\' & $s_File_Name & '.bak', 1) _
					Then $f_Copy = True
			FileDelete($s_Folder & '\' & $s_File_Name)
		EndIf
	EndIf
	$h_Download = InetGet($s_Url, $s_Folder & '\' & $s_File_Name, 1, 1)
	Do
		Sleep(10)
	Until InetGetInfo($h_Download, 2)
	If InetGetInfo($h_Download, 4) Then $i_Error = 1
	InetClose($h_Download)
	If $i_Error Then
		If $f_Copy Then
			FileCopy($s_Folder & '\' & $s_File_Name & '.bak', $s_Folder & '\' & $s_File_Name, 1)
		EndIf
	Else
		If $f_Copy Then
			FileDelete($s_Folder & '\' & $s_File_Name & '.bak')
		EndIf
	EndIf
	Return SetError($i_Error)
EndFunc   ;==>_Inet_Get_Doc

Func _Kill_TrayTip()
	AdlibUnRegister('_Kill_TrayTip')
	TrayTip('', '', 0)
EndFunc   ;==>_Kill_TrayTip

Func _Exit()
	Exit
EndFunc   ;==>_Exit
 
Автор
S

Suppir

Продвинутый
Сообщения
967
Репутация
62
madmasles

Вроде, работает. Но есть проблемы:

1) не скачивает приложения (doc-овские файлы на этой же странице). Вот, например:
http://www.krd.ru/norma/568D1A9146BB3AB9C325792F0025899F.htm

2) если открыто несколько вкладок внутри IE 8, то скрипт анализирует не открытую в данный момент вкладку, а первую из них.
Т.е. у меня открыто несколько вкладок и нужно, чтобы скрипт скачивал документ из открытой. Если это возможно.
 

madmasles

Модератор
Глобальный модератор
Сообщения
7,790
Репутация
2,322
Suppir [?]
1) не скачивает приложения (doc-овские файлы на этой же странице). Вот, например:
http://www.krd.ru/norma/568D1A9146BB3AB9C325792F0025899F.htm
Проверил, у меня скачивает без проблем.
2) если открыто несколько вкладок внутри IE 8, то скрипт анализирует не открытую в данный момент вкладку, а первую из них.
Т.е. у меня открыто несколько вкладок и нужно, чтобы скрипт скачивал документ из открытой. Если это возможно.
У меня WinList('[CLASS:IEFrame]') захватывает только открытую в данный момент вкладку, не знаю, почему у Вас не так.
 
Автор
S

Suppir

Продвинутый
Сообщения
967
Репутация
62
Наверное, потому что у меня IE 9 ?

Попробуйте мой вариант (упрощенный):


Код:
#include <IE.au3>
#include <Array.au3>
#include <Word.au3> 

HotKeySet("^{INS}", "Savedoc")
HotKeySet("^{ESC}", "_Exit")

While 1 
	sleep(50)
WEnd	

Func Savedoc()
	
	ToolTip("")
	
	local $hWin = WinGetHandle("[CLASS:IEFrame]")
	$oIE = _IEAttach($hWin, "HWND")
	local $html = _IEBodyReadHTML ($oIE)
	
	if Not StringRegExp($html, "(?s).+?(<p><b>.+?)Ссылки на другие документы
.+") Then 
		ToolTip("Не вижу документа!", 0, 0)
		Sleep(500)
		Return
	EndIf
		
	local $text = StringRegExpReplace($html, "(?s).+?(<p><b>.+?)Ссылки на другие документы
.+", "\1")
	local $number = StringRegExpReplace($text, "(?s).+?г\. № (.+?)<.+", "\1")
	
	Global $downloadDir = @ScriptDir & "\" & $number
	
	FileDelete("temp.html")
	Filewrite("temp.html", $text)

	ToolTip("Сохраняю в doc")	
	local $size =  DirGetSize ($downloadDir)
	if @error = 1 Then 
		DirCreate($downloadDir)
		$oWordApp = _WordCreate (@ScriptDir & "\temp.html", 0, 0, 1)
		$oDoc = _WordDocGetCollection ($oWordApp, 0)
		_WordDocSaveAs ($oDoc, @ScriptDir & "\" & $number & "\" & $number & ".doc")
		_WordQuit ($oWordApp)

		$links = StringRegExp($html,'href="([^>]+\.doc)"',3)
		if @error = 0 Then 
			For $i = 0 To UBound($links)-1
				$filename = _Encoding_HexToURL(StringRegExpReplace($links[$i],"(.+)/([^/]+)","\2"))&".doc"
				ToolTip("Скачиваю " & $filename)
				$iInetGet = InetGet($links[$i], $downloadDir & "\" & $filename, 1, 1)
			Next
		EndIf
		ToolTip("Готово!")
		Sleep(500)
	Else
		ToolTip("Директория с номером " & $number & " уже есть!")
		Sleep(1000)
	EndIf
	ToolTip("")
EndFunc



Func _Encoding_HexToURL($sURLHex)
    Local $aURLHexSplit = StringSplit($sURLHex, "")
    Local $sRetString = "", $iDec, $iUbound = UBound($aURLHexSplit)

    For $i = 1 To $iUbound - 1
        If $aURLHexSplit[$i] = "%" And $i + 2 <= $iUbound - 1 Then
            $i += 2
            $iDec = Dec($aURLHexSplit[$i - 1] & $aURLHexSplit[$i])

            If Not @error Then
                $sRetString &= Chr($iDec)
            Else
                $sRetString &= $aURLHexSplit[$i - 2]
            EndIf
        Else
            $sRetString &= $aURLHexSplit[$i]
        EndIf
    Next

    Return _Encoding_UTF8ToANSI($sRetString)
EndFunc


Func _Encoding_UTF8ToANSI($sString)
    Return BinaryToString(StringToBinary($sString), 4)
EndFunc
 
Верх