1. ホーム
  2. スクリプト・コラム
  3. vbs

vbs と wget を組み合わせて Web サイトの画像をダウンロードする。

2022-02-09 11:20:12

vbs関数プロシージャ。
1. wgetを呼び出す:サイトのすべてのページをこのスクリプトディレクトリにダウンロードする ......
2. このスクリプトディレクトリのすべてのファイルをスキャンする .......
3. このスクリプトディレクトリ内のすべてのページを読み、画像のURLアドレスに一致する .......
4. すべての画像のURLアドレスをurl-img.txtファイルに保存する...............................4
5. wgetを呼び出す。url-img.txtで指定された画像をこのスクリプトのimgディレクトリにダウンロードする .........................。

class ECGDataSegment:
    """
    Minute-by-minute ECG segment.
    """

    def __init__(self):
		self.data = None # ECG segment data
		self.label = None # ECG segment label
		self.database = "apnea-ecg" # Database name
		self.filename = None # Which file does it belong to?
		self.local_id = None # The ID in file
		self.global_id = None # global ID in database

Webファイルの文字列検索コード(findstr_html.vbs)を使用します。

' findstr_html.vbs
Call Main()
Sub Main()

 ' CMD mode
 If Not (LCase(Right(WScript.FullName,11)) = LCase("CScript.exe")) Then
  CreateObject("WScript.Shell").Run "cscript.exe //nologo """ & WScript.ScriptFullName & "" "", 1, False
  WScript.Quit(1)
 End If

 Dim strMeDir
 strMeDir = Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName,"\")-1)
 Dim regEx, strHTML, strURL
 
 ' Scan the folder
 Dim arr() : ReDim Preserve arr(0)
 Call ScanFolder(arr, strMeDir & "\720.hao2046.net")
 If UBound(arr) = 0 Then
  WScript.Echo strMeDir & "\720.hao2046.net" & ", Not Found!"
  Exit Sub
 End If

 ' Create regular expressions.
 Set regEx = CreateObject("VBScript.RegExp") ' Create regular expression.
 regEx.IgnoreCase = True ' Set whether to be case-sensitive or not.
 regEx.Global = True ' Set global substitution.
 regEx.MultiLine = True ' Set multi-line matching mode
 
 
 Do
  strPattern = InputBox("Please enter the regular expression to match: ","Find all web files","123456")
  strInfo = strPattern & vbCrLf & "Not Found!"
  For i = 0 To UBound(arr)
   If LCase(Right(arr(i),5)) = ".html" Or LCase(Right(arr(i),4)) = ".htm" Then
    'WScript.Echo arr(i)
    strHTML = ReadPfile(arr(i), "gb2312")
    If InStr(strHTML, strPattern)>0 Then
     strInfo = strPattern & vbCrLf & arr(i) & vbCrLf
     Exit For
    Else
     'regEx.Pattern = "src=['""]http://\S+\.jpg['""]"
     regEx.Pattern = strPattern
     Set Matches = regEx.Execute(strHTML) ' Execute the search.
     For Each Match in Matches ' Iterate through the set of matches.
      If Not Match.Value = "" Then
       ' regEx.Pattern = "(src=['""])*(['""])*"
       'strURL = strURL & regEx.Replace(Match.Value, "") & vbCrLf
       strInfo = strPattern & vbCrLf & arr(i) & vbCrLf
       Exit For
      End If
     Next
    End If
   End If
  Next
  WScript.Echo strInfo
  Loop
End Sub


'===========================================================================================
'Read txt file content by code
Function ReadPfile(ByVal FileName, ByVal FileCode)
  Dim objStream
  Set objStream = CreateObject("ADODB.Stream")
  '
  With objStream
    .Type = 2
    .Mode = 3
    .open
    .Charset = FileCode 'Change different encoding,Chinese (Simplified) (GB2312),Chinese GBK,Traditional Chinese Big5,Japanese EUC-JP,Korean EUC-KR,charset=UTF-8(internationalized encoding),ANSI,Unicode,unicode big endian
    LoadFromFile FileName
     ReadPfile = .ReadText
    .Close
  End With
  Set objStream = Nothing
End Function

' Dim arr() : ReDim Preserve arr(0)
' Call ScanFolder(arr, "V:\")
Sub ScanFolder(ByRef arr, ByVal strFolderspec)
  On Error Resume Next
  Dim fso, objFolder
  Set fso = Createobject("Scripting.FileSystemObject")
  Set objFolder = fso.getfolder(strFolderspec)
  ReDim Preserve arr(UBound(arr)+1)
  arr(UBound(arr)) = strFolderspec & "\"
  For Each subFile In objFolder.files
    ReDim Preserve arr(UBound(arr)+1)
    arr(UBound(arr)) = subFile.path
  Next
  For Each subFolder In objFolder.subfolders
    ScanFolder arr, subFolder.path
  Next
  Set fso = NoThing
  Set objFolder = NoThing
End Sub


ヒント 
1. 警告 コードを直接実行しないでください。ここのサンプルURLはアクセスできないか、セキュリティに欠けている可能性がありますので、他のURLに変更してから使用してください。
2. wget.exeをスクリプトと同じディレクトリに置いて、実行してください。ファイル構成は以下の通りです。
  ... \♪♪~
  ... \♪♪~
  ... \♪♪~