#include <Excel.au3>
;#include <Array.au3>
Opt('MustDeclareVars', 1)
Opt('TrayMenuMode', 1)
Global $sFileExcel_Links = @ScriptDir & '\adresa_test.xls', $aUrl, $aInfo, _
$sFileSave = @ScriptDir & '\Save.xls'
$aUrl = _Get_UrlExcel($sFileExcel_Links)
Switch @error
Case -1
MsgBox(16, 'Error', 'Отсутствует файл' & @LF & $sFileExcel_Links)
Exit
Case 1
MsgBox(16, 'Error', '_Get_UrlExcel')
Exit
EndSwitch
;_ArrayDisplay($aUrl)
For $i = 1 To $aUrl[0]
$aInfo = _Get_InfoArray($aUrl[$i])
If @error Then ContinueLoop
;_ArrayDisplay($aInfo, $i & ' (' & $aUrl[0] & ')')
_SaveExcel($sFileSave, $aInfo)
If @error Then
MsgBox(16, 'Error', '_SaveExcel')
EndIf
Next
MsgBox(64, 'Info', 'OK :)')
Func _Get_UrlExcel($s_FileExcel, $s_Sheet = 'Ссылки')
Local $o_Excel, $a_TempArray, $a_Return_Array, $i_Count, $i_Error = 1, _
$s_ControlUrl = 'http://www.photosight.ru/users/'
If Not FileExists($s_FileExcel) Then Return SetError(-1)
$o_Excel = _ExcelBookOpen($s_FileExcel, 0)
If @error Then Return SetError(1)
For $i = 1 To 1
_ExcelSheetActivate($o_Excel, $s_Sheet)
If @error Then ExitLoop
$a_TempArray = _ExcelReadSheetToArray($o_Excel)
If @error Then ExitLoop
$i_Error = 0
Next
_ExcelBookClose($o_Excel)
If $i_Error Then Return SetError(1)
Dim $a_Return_Array[$a_TempArray[0][0] + 1]
For $i = 1 To $a_TempArray[0][0]
For $j = 1 To $a_TempArray[0][1]
If StringRegExp($a_TempArray[$i][$j], '^' & $s_ControlUrl) Then
$i_Count += 1
$a_Return_Array[$i_Count] = $a_TempArray[$i][$j]
EndIf
Next
Next
If Not $i_Count Then Return SetError(1)
ReDim $a_Return_Array[$i_Count + 1]
$a_Return_Array[0] = $i_Count
Return $a_Return_Array
EndFunc ;==>_Get_UrlExcel
Func _Get_InfoArray($s_Url)
Local $s_Sourse, $i_Flag = 1, $a_TempArray, $a_Return_Array, $i_Count, $s_Url_big, _
$s_Url_small, $s_Alt, $s_Nick
$s_Sourse = InetRead($s_Url, 17)
If @error Then Return SetError(1)
If StringInStr($s_Sourse, Hex(StringToBinary(StringLower('UTF-8')))) Then $i_Flag = 4
$s_Sourse = BinaryToString($s_Sourse, $i_Flag)
$a_TempArray = StringRegExp($s_Sourse, '(?s)<a\s+id="photo_(.*?)</a>', 3)
If @error Then Return SetError(1)
Dim $a_Return_Array[UBound($a_TempArray) + 1][3]
For $i = 0 To UBound($a_TempArray) - 1
$s_Url_big = StringRegExpReplace($a_TempArray[$i], '(?s).*href="(.*?)"><.*', 'http://www.photosight.ru$1')
If @extended <> 1 Then ContinueLoop
$s_Url_small = StringRegExpReplace($a_TempArray[$i], '(?s).*src="(.*?)"\s+alt.*', '$1')
If @extended <> 1 Then ContinueLoop
$s_Alt = StringRegExpReplace($a_TempArray[$i], '(?s).*alt="(.*?)"\s+/>.*', '$1')
If @extended <> 1 Then ContinueLoop
$i_Count += 1
$a_Return_Array[$i_Count][0] = $s_Url_big
$a_Return_Array[$i_Count][1] = $s_Url_small
$a_Return_Array[$i_Count][2] = $s_Alt
Next
If Not $i_Count Then Return SetError(1)
ReDim $a_Return_Array[$i_Count + 1][3]
$a_Return_Array[0][0] = $i_Count
$s_Nick = StringRegExpReplace($s_Sourse, '(?s).*<title>.*?пользователя\s+(.*?)\s+-\sPhoto.*', '$1')
If @extended = 1 Then
$a_Return_Array[0][1] = $s_Nick
Else
$a_Return_Array[0][1] = StringRegExpReplace($s_Url, '.*users/(\d+)/.*', '$1')
EndIf
Return $a_Return_Array
EndFunc ;==>_Get_InfoArray
Func _SaveExcel($s_FileSave, $a_Array)
Local $o_Excel, $f_Exist, $s_Name_Sheet, $aSheet, $i_RowPlus, $f_SheetExist
$s_Name_Sheet = StringRegExpReplace($a_Array[0][1], '[^а-яА-ЯёЁ\w\s-()]', '')
If FileExists($s_FileSave) Then
$f_Exist = True
$o_Excel = _ExcelBookOpen($s_FileSave, 0)
Else
$o_Excel = _ExcelBookNew(0);(0)
EndIf
If @error Then Return SetError(1)
For $i = 1 To 1
If $f_Exist Then
$aSheet = _ExcelSheetList($o_Excel)
If @error Then ExitLoop
For $j = 1 To $aSheet[0]
If $aSheet[$j] == $s_Name_Sheet Then
_ExcelSheetActivate($o_Excel, $s_Name_Sheet)
If @error Then ExitLoop 2
$i_RowPlus = $o_Excel.Application.ActiveCell.Row
$f_SheetExist = True
ExitLoop
EndIf
Next
If Not $f_SheetExist Then
_ExcelSheetAddNew($o_Excel, $s_Name_Sheet)
If @error Then ExitLoop
_ExcelSheetMove($o_Excel, $s_Name_Sheet, $aSheet[0] + 1, False)
If @error Then ExitLoop
_ExcelSheetActivate($o_Excel, $s_Name_Sheet)
If @error Then ExitLoop
EndIf
Else
_ExcelBookSaveAs($o_Excel, $s_FileSave)
If @error Then ExitLoop
$aSheet = _ExcelSheetList($o_Excel)
If @error Then ExitLoop
If $aSheet[0] > 1 Then
For $j = 2 To $aSheet[0]
_ExcelSheetDelete($o_Excel, $aSheet[$j])
If @error Then ExitLoop 2
Next
_ExcelSheetNameSet($o_Excel, $s_Name_Sheet)
If @error Then ExitLoop
EndIf
EndIf
For $j = 1 To $a_Array[0][0]
_ExcelWriteCell($o_Excel, $j + $i_RowPlus & '.', $j + $i_RowPlus, 1)
_ExcelHyperlinkInsert($o_Excel, $a_Array[$j][1], $a_Array[$j][1], $a_Array[$j][2], $j + $i_RowPlus, 2)
If @error Then ExitLoop
_ExcelHyperlinkInsert($o_Excel, $a_Array[$j][0], $a_Array[$j][0], $a_Array[$j][2], $j + $i_RowPlus, 3)
If @error Then ExitLoop
Next
Next
If Not @error Then
$o_Excel.Columns('A:C' ).EntireColumn.AutoFit
_ExcelBookClose($o_Excel)
EndIf
Return SetError(@error)
EndFunc ;==>_SaveExcel