20090416_006_005

「20090416_006_005」の編集履歴（バックアップ）一覧はこちら

「20090416_006_005」(2009/04/16 (木) 20:19:18) の最新版変更点

追加された行は緑色になります。

削除された行は赤色になります。

<p><br />
===<br /><br />
===</p>

<p><br />
===<br /><br />
txt_File01 = "file001.txt"<br />
txt_File02 = "file002.txt"<br />
txt_File03 = "file003.txt"</p>
<p>s_txt001 = "ttp://www.yourfilehost.com/"<br />
s_txt002 = "http://"</p>
<p>s_len_txt001 = len(s_txt001)<br />
s_len_txt002 = len(s_txt002)</p>
<p>'WScript.Echo s_len_txt001 &amp; vbCrLf<br />
'WScript.Echo s_len_txt002 &amp; vbCrLf</p>
<p><br />
Set objFso01 = CreateObject("Scripting.FileSystemObject")<br />
'Set objFile01 = objFso01.OpenTextFile("C:\Documents and Settings\parao\My
Documents\w\a.txt", 1, False)</p>
<p>Set objFile01 = objFso01.OpenTextFile("C:\Documents and Settings\user\My
Documents\w\" &amp; txt_File01, 1, False)</p>
<p>If Err.Number &gt; 0 Then<br />
    WScript.Echo "Open Error"<br />
Else<br />
    Do Until objFile01.AtEndOfStream<br />
        'WScript.Echo objFile01.ReadLine &amp; vbCrLf<br />
        txt01 = objFile01.ReadLine &amp; vbCrLf</p>
<p><br />
Set objFso02 = CreateObject("Scripting.FileSystemObject")</p>
<p>'Set objFile02 = objFso02.OpenTextFile("C:\Documents and Settings\user\My
Documents\w\" &amp; txt_File02, 1, False)</p>
<p>Set objFile02 = objFso02.OpenTextFile("C:\Documents and Settings\user\My
Documents\w\" &amp; txt_File02, 2, True)</p>
<p><br />
Dim s</p>
<p>url_Val01 = "ttp://www.yourfilehostdb.com/"<br />
url_Val02 =
"ttp://www.yourfilehost.com/media.php?cat=video&amp;file=nagasawasentai_part002.wmv"</p>
<p>url_Val02 = txt01</p>
<p>'対象画面を検索、なければ開く（必要に応じ使用してください）<br />
Set xShell = CreateObject("Shell.Application")<br />
win_s = False<br />
For Each Window In xShell.Windows '対象URLが表示されているか？<br />
 If TypeName(Window.Document) = "HTMLDocument" Then<br />
  if Window.Document.url=url_Val01 then<br />
     Set objIE0 = Window '対象URLが表示→その画面を使う<br />
     win_s=true<br />
     exit for<br />
  end if<br />
 end if<br />
next</p>
<p>if win_s=false then '対象URLが非表示→新しく画面を開く</p>
<p> Set objIE0 = CreateObject("InternetExplorer.Application")<br />
 objIE0.Visible = True<br />
 objIE0.Navigate url_Val01</p>
<p> Do While objIE0.busy = True<br />
    '空ループだと無駄にCPUを使うので250ミリ秒のインターバルを置く<br />
    WScript.sleep(250)<br />
 Loop</p>
<p> Do While objIE0.document.readyState &lt;&gt; "complete"<br />
 Loop<br />
end if<br />
'---header end---</p>
<p>'---以下操作コード、必要な部分をコピーしてください---<br />
'objIE0.document.all.q.value=url_Val02 ' text index=2<br />
'objIE0.document.all.Submit.click ' submit Submit ログイン or
tags("INPUT").item(4).Click</p>
<p>on error resume next<br />
objIE0.document.form1.yourfilehosturl.value=url_Val02 ' text index=2<br />
'objIE0.document.all.Submit.click ' submit Submit ログイン or
tags("INPUT").item(4).Click<br />
objIE0.document.form1.Submit.click ' submit Submit ログイン or
tags("INPUT").item(4).Click</p>
<p> Do While objIE0.busy = True<br />
    '空ループだと無駄にCPUを使うので250ミリ秒のインターバルを置く<br />
    WScript.sleep(250)<br />
 Loop</p>
<p> Do While objIE0.document.readyState &lt;&gt; "complete"<br />
 Loop</p>
<p>'①表示したページの&lt;BODY&gt;部のHTMLを取得し画面に表示<br />
strBody = objIE0.Document.Body.InnerHtml<br />
'WScript.echo strBody</p>
<p>'②表示したページの&lt;BODY&gt;部のテキストだけを取得し画面に表示<br />
strBody = objIE0.Document.Body.InnerText<br />
WScript.echo strBody</p>
<p><br />
objFile02.WriteLine "aaa " &amp; vbcrlf &amp;  vbcrlf &amp;
objIE0.Document.Body.InnerText</p>
<p>objFile02.Close<br />
Set objFile02 = Nothing<br />
Set objFso02 = Nothing</p>
<p>'オブジェクトの破棄<br />
Set objIE0 = Nothing</p>
<p><br />
Set objFso02 = CreateObject("Scripting.FileSystemObject")<br />
Set objFile02 = objFso02.OpenTextFile("C:\Documents and Settings\user\My
Documents\w\" &amp; txt_File02, 1, False)</p>
<p>Set objFso03 = CreateObject("Scripting.FileSystemObject")<br />
Set objFile03 = objFso03.OpenTextFile("C:\Documents and Settings\user\My
Documents\w\" &amp; txt_File03, 8, True)</p>
<p><br />
    flg_01 = "0"<br />
    'WScript.Echo "flg_01 = " &amp; flg_01 &amp; vbCrLf<br />
    'WScript.Echo flg_01 &amp; vbCrLf</p>
<p>    Do Until objFile02.AtEndOfStream</p>
<p>     s01 = objFile02.ReadLine</p>
<p>     'objFile03.WriteLine s01</p>
<p>'     if mid(s01,1,s_len_txt001 - 1) = s_txt001 then<br />
     if mid(s01,1,28) = s_txt001 then<br />
        flg_01 = "1"<br />
        objFile03.WriteLine s01<br />
        'WScript.Echo flg_01 &amp; vbCrLf<br />
     end if</p>
<p>     if flg_01 = "1" and mid(s01,1,7) = s_txt002 then<br />
        objFile03.WriteLine s01<br />
     end if</p>
<p>    Loop<br />
    flg_01 = "0"</p>
<p><br />
objFile02.Close<br />
Set objFile02 = Nothing<br />
Set objFso02 = Nothing</p>
<p>objFile03.Close<br />
Set objFile03 = Nothing<br />
Set objFso03 = Nothing</p>
<p>    Loop<br />
End If</p>
<p>objFile01.Close<br />
Set objFile01 = Nothing<br />
Set objFso01 = Nothing</p>
<p><br />
 <br /><br /><br />
===</p>