フレーム分割のソース表示プログラムについて

このQ&Aのポイント
  • フレーム分割のソース表示プログラムについてアドバイスをお願いします。
  • URLを入力するとブラウザのソースを表示するプログラムを作成しましたが、フレームによって分割されたページのソースは表示されません。分割されたページのソースも表示させるためにはどうすれば良いでしょうか?
  • 新たにコマンドを作成して分割されたページのソースも表示できるようにしたいです。アドバイスをお願いします。
回答を見る
  • ベストアンサー

フレーム分割のソース表示プログラムについて

以前次のようなプログラムを作ったのですが、これはURLを入力するとブラウザのソースを表示するものなので、フレームによって分割されたページのソースはすべて表示させることができません。このプログラムに何か追加して分割されていてもソースが表示できるようにしたいのですが。新たにコマンドを作ってやるしかないのでしょうか?何かアドバイスお願いします。 Private Sub Command1_Click() Dim strUrl As String Dim strBuf As String Command1.Enabled = False strUrl = InputBox("URLを入力して下さい.") If (Len(strUrl) = 0) Then Exit Sub End If Command1.Enabled = True strBuf = Inet1.OpenURL(strUrl) Form2.Show Form2.Text1.Text = strBuf End Sub Function Getsource() As String Dim strBuf As String Dim strUrl As String Dim strUrl2 As String strBuf = Inet1.OpenURL(strUrl) 'ファイル内容を取得 strUrl2 = InStr(strBuf, "frame src=") If strUrl2 > 0 Then strUrl3 = Mid(strBuf, strUrl2, 100) strUrl4 = Mid(strUrl3, 1, l) Getsource = strBuf End Function

  • mos21
  • お礼率46% (128/273)

質問者が選んだベストアンサー

  • ベストアンサー
  • TAGOSAKU7
  • ベストアンサー率65% (276/422)
回答No.1

ループもしくは、再帰呼び出しを使用しましょう。 1.ソースをget パラメータは[http://www.hoge.hoge]などのアドレスを文字列で受けて、ソースを文字列で返す) 2.ソースにフレームが含まれているかを判断 3-1.含まれているなら、フレーム内のアドレスを1の関数に与える 3-2.含まれていないなら、終了

mos21
質問者

お礼

ありがとうございました。これはstrUrl3とstrUrl4が生かされてないですよね。frame srcがあったらその次に書かれてあるURLを参考にそのページを表示させたいのですが。

関連するQ&A

  • 保存の仕方

    こんにちは、次のようなアドレスを入力するとそのソースを表示するプログラムを作ったのですがこれで表示されるソースに名前を付けて保存することってできますか?お願いします。 Private Sub Command1_Click() Dim strUrl As String Dim strBuf As String Command1.Enabled = False strUrl = InputBox("URLを入力して下さい.") If (Len(strUrl) = 0) Then Exit Sub End If Command1.Enabled = True strBuf = Inet1.OpenURL(strUrl) Form2.Show Form2.Text1.Text = strBuf End Sub Function Getsource() As String Dim strBuf As String Dim strUrl As String strBuf = Inet1.OpenURL(strUrl) 'ファイル内容を取得 Getsource = strBuf End Function

  • ソース内の文字検索について

    下にHPのソースを表示させるプログラムがあります。 これで表示されたソースの中からある文字を検索したいのですが、それってできますか?どうしたらいいんでしょうか、お願いします。 Private Sub Command1_Click() Command1.Enabled = False Text1.Text = GetSource() Command1.Enabled = True End Sub Function GetSource() As String Dim strBuf As String Dim strURL As String strURL = "http://www.microsoft.com/japan/ms.htm" strBuf = Inet1.OpenURL(strURL) GetSource = strBuf End Function

  • プログラムについて

    今このようなプログラムを作っているのですが、わからなくて困っています。 Private Sub Command1_Click() Command1.Enabled = False 'タイマー無効 Text1.Text = GetSource() Command1.Enabled = True 'タイマー有効 Msg = "アドレスを入力して下さい" Title = "URL入力" Ret = InputBox(Msg, Title, "") End Sub Function GetSource() As String Dim strBuf As String Dim strURL As String strURL = "http://www.microsoft.com/japan/ms.htm" strBuf = Inet1.OpenURL(strURL) 'ファイル内容を取得 GetSource = strBuf End Function InputBoxにアドレスを書いてOKを押すと別ウィンドウでソースが表示されるプログラムを作りたいんです。お願いします。

  • VB6でテレビ番組表HTMLの保存

    VB6の以下のプログラムで下記URLのテレビ番組表を保存しようとしたのですが、うまくできませんでした。ソースを開いてみるとEUC-JPとなっていまして、これが原因かと思うのですが、保存するにはどうしたら良いでしょうか? よろしくお願いします。 ■URL http://tv.nikkansports.com/tv.php?site=007&mode=06&category=g&area=025&template=time&sdate=20081226&lhour=24&shour=5&arg=05 ■プログラム Private Sub Command1_Click() Dim strURL As String ' 取得URL Dim strFileName As String ' ファイル名 ' URLとファイル名を代入する strURL = Text1.Text strFileName = Text2.Text ' 指定されたURLのドキュメントをファイルに出力する Open strFileName For Output As #1 Print #1, Inet1.OpenURL(strURL) Close #1 MsgBox strURL & "を" & strFileName & "に出力しました" End Sub

  • FTPサーバからダウンロードするには?

    windowsXP,VB6,SP5で開発しています。 下のコードはヘルプからなんですが、 これをURLとファイル名を変更してやってみても、全然できません。 Private Sub Form_DblClick() Inet1.AccessType = icUseDefault Dim b() As Byte Dim strURL As String ' この URL は有効な URL であると仮定します。 strURL = "ftp://ftp.microsoft.com/" & _ "developr/drg/Win32/Autorun.zip" ' ファイルをバイト配列として取得します。 b() = Inet1.OpenURL(strURL, icByteArray) Open "C:\Temp\Autorun.zip" For Binary Access Write As #1 Put #1, , b() Close #1 MsgBox "完了しました。" End Sub ここの部分でタイムアウトになってしまいます。 b() = Inet1.OpenURL(strURL, icByteArray) FTPサーバのアドレスとかちゃんとあってます。 どなたか、解決方法をご教授くださいませm(_ _)m

  • 下記のマクロをもっと早くするには?

    下記のマクロは、 A列にあるURLがSSL化(https)されているかを調べるものです。 このマクロを動かすと、大体3秒に1つのURLを調べるくらいの早さです。 もっと早く調べられるようにするには、どのような記述にすればできるでしょうか? また、エクセルの他の設定で、マクロを早くできたりしますか? よろしくお願いいたします。 Sub SSL() Dim objHttp As Object Dim nURL As String Dim strURL As String Dim i As Long, f As String, l As String Dim Lastrow As Long, getLine As Long Set objHttp = CreateObject("WinHttp.WinHttpRequest.5.1") On Error GoTo ErrHandler 'A1から getLine = Cells(Rows.Count, 2).End(xlUp).Row Lastrow = Cells(Rows.Count, 1).End(xlUp).Row If getLine = Lastrow Then MsgBox "既に終わっているか、データがないです。", vbExclamation: Exit Sub If getLine < Lastrow And Cells(1, 2).Value <> "" Then getLine = getLine + 1 Else getLine = 1 '最初の行が1行目からの場合 End If For i = getLine To Lastrow strURL = LCase(Trim(Cells(i, 1).Value)) 'A列の登録URL strURL = Replace(strURL, "https:", "http:") If strURL Like "http*" Then objHttp.Open "GET", strURL, False objHttp.send DoEvents 'ESC割り込み可能にする With objHttp If .Status = 200 Then nURL = .Option(1) 'WinHttpRequestOption_URL f = Mid(strURL, 1, InStr(strURL, "://")) l = Mid(nURL, 1, InStr(nURL, "://")) If nURL = "" Then Cells(i, 2).Value = "no URL" ElseIf nURL <> "" Then If LCase(f) = LCase(l) Then Cells(i, 2).Value = "non SSL" Else Cells(i, 2).Value = "https" End If End If Else Cells(i, 2).Value = "Err:" & .Status End If End With End If Endline: nURL = "" strURL = "" Next i MsgBox "Finished" Exit Sub ErrHandler: If Err() <> 0 Then Cells(i, 2).Value = Err.Number 'マイナスになるのは外部エラー GoTo Endline End If End Sub

  • 画像のランダム表示

    初心者なのですがVisual Studio6.0でもぐらたたきゲームを利用した作品を現在制作しています。内容は決まった画像がランダムでImageコントロールに表示され、それをクリックできると画像が変わり得点加算、クリックできないと画像が変わり減点というゲームです。現在Imageコントロールに決まった画像を呼び出す処理が完成しました。そして追加機能としてクリックできたらボーナスポイントの画像をImageコントロールに何分の何かの確率で表示させたいのですがわからない状態です。ちなみに画像は私のパソコンのDドライブから呼び出して表示させています。 どういった命令文を打ったら良いのかわかる方教えて下さい。宜しくお願いします。 こちらがプログラムです。 Option Explicit Const MinImgAry = 0 Const MaxImgAry = 15 Const GameTime = 15 Dim HitFlg As Integer Dim TEN As Integer Dim HoleNum As Integer Dim IconAry(2) As String Private Sub Command1_Click() Command1.Enabled = False Option1.Enabled = False Option2.Enabled = False Option3.Enabled = False HitFlg = 0 TEN = 0 Text1.Text = Str(TEN) Timer1.Enabled = True Timer2.Enabled = True End Sub Private Sub Command2_Click() Form1.Show End Sub Private Sub Form_Load() Dim StrPath As String StrPath = App.Path If Right(StrPath, 1) <> "\" Then StrPath = StrPath + "\" End If IconAry(0) = "D:制作\5\画像1.bmp" IconAry(1) = "D:制作\5\画像2.bmp" IconAry(2) = "D:制作\5\画像3.bmp" End Sub Private Sub Image1_Click(Index As Integer) Image1(Index).Enabled = False HitFlg = -1 End Sub Private Sub Option1_Click() Timer1.Interval = 1000 End Sub Private Sub Option2_Click() Timer1.Interval = 800 End Sub Private Sub Option3_Click() Timer1.Interval = 500 End Sub Private Sub Timer1_Timer() Static CtlFlg As Integer Select Case CtlFlg Case 0 Image1(HoleNum).Enabled = False Image1(HoleNum).Visible = False HoleNum = Int((MaxImgAry - _ MinImgAry + 1) * Rnd + MinImgAry) Image1(HoleNum).Picture = _ LoadPicture(IconAry(0)) CtlFlg = 1 Image1(HoleNum).Visible = True Image1(HoleNum).Enabled = True Exit Sub Case 1 Image1(HoleNum).Enabled = False If HitFlg Then HitFlg = 0 Image1(HoleNum).Picture = _ LoadPicture(IconAry(2)) TEN = TEN + 1 Text1.Text = Str(TEN) Else Image1(HoleNum).Picture = _ LoadPicture(IconAry(1)) TEN = TEN - 1 Text1.Text = Str(TEN) End If CtlFlg = 0 Exit Sub End Select End Sub Private Sub Timer2_Timer() Static TimeCnt As Long TimeCnt = TimeCnt + 1 If TimeCnt <> GameTime Then Exit Sub End If Timer1.Enabled = False Timer2.Enabled = False MsgBox "おしまい" TimeCnt = 0 Command1.Enabled = True Image1(HoleNum).Enabled = False Image1(HoleNum).Visible = False Option1.Enabled = True Option2.Enabled = True Option3.Enabled = True End Sub

  • VBAでソースから全てのURLを取得したい

    VBAでソースに書いてある全てのURLを取得したいのですが、現状では一部しか取得できません。 文字数制限にでも引っかかっているのでしょうか? どうすれば全てのURLを取得できるのか・・添削して頂けると or ヒントを教えて頂けると助かります。 よろしくお願いします。 (Excel2003を使用) Sub test() Dim objIE As Object Dim objTAG As Object Dim source As String Dim url As String Dim url_start As String Dim url_end As String Dim y As Long url_end = 1 y = 1 Set objIE = CreateObject("InternetExplorer.application") objIE.Visible = False objIE.Navigate "http://dir.yahoo.co.jp/" Do While objIE.Busy = True DoEvents Loop Application.Wait Time:=Now + TimeValue("00:00:03") source = objIE.Document.All(1).Innerhtml Do While y < 10000 url_start = InStr(url_end, source, "<a href=", vbTextCompare) If url_start = 0 Then y = 10000 Else url_end = InStr(url_start, source, ">", vbTextCompare) url = Mid(source, url_start + 9, url_end - url_start - 10) Cells(y, 1).Value = url y = y + 1 End If Loop End Sub

  • 1つのPCで同じマクロを複数動かす

    下記のマクロは、 A列にあるURLがSSL化(https)されているかを調べるものです。 このマクロで、いろんなURLを調べる作業があります。 その作業を早く完了させるために、下記のマクロを同時に動かそうと思っています。 しかし、エクセルを使えるPCが1つしかありません。 エクセルを2つ起動して、調べるURLを分けて、 2つのエクセルでマクロを同時に動かす。 これをやろうと思いましたが、かなりPCが重くなるし、 エクセルが度々フリーズしたみたいになります。 どうにか、1つのPCで下記のマクロを複数動かして、 いろんなURLを調べる作業を、早くに完了する方法はありますでしょうか? エクセル2016です。 よろしくお願いいたします。 Sub SSL() Dim objHttp As Object Dim nURL As String Dim strURL As String Dim i As Long, f As String, l As String Dim Lastrow As Long, getLine As Long Set objHttp = CreateObject("WinHttp.WinHttpRequest.5.1") On Error GoTo ErrHandler 'A1から getLine = Cells(Rows.Count, 2).End(xlUp).Row Lastrow = Cells(Rows.Count, 1).End(xlUp).Row If getLine = Lastrow Then MsgBox "既に終わっているか、データがないです。", vbExclamation: Exit Sub If getLine < Lastrow And Cells(1, 2).Value <> "" Then getLine = getLine + 1 Else getLine = 1 '最初の行が1行目からの場合 End If For i = getLine To Lastrow strURL = LCase(Trim(Cells(i, 1).Value)) 'A列の登録URL strURL = Replace(strURL, "https:", "http:") If strURL Like "http*" Then objHttp.Open "GET", strURL, False objHttp.send DoEvents 'ESC割り込み可能にする With objHttp If .Status = 200 Then nURL = .Option(1) 'WinHttpRequestOption_URL f = Mid(strURL, 1, InStr(strURL, "://")) l = Mid(nURL, 1, InStr(nURL, "://")) If nURL = "" Then Cells(i, 2).Value = "no URL" ElseIf nURL <> "" Then If LCase(f) = LCase(l) Then Cells(i, 2).Value = "non SSL" Else Cells(i, 2).Value = "https" End If End If Else Cells(i, 2).Value = "Err:" & .Status End If End With End If Endline: nURL = "" strURL = "" Next i MsgBox "Finished" Exit Sub ErrHandler: If Err() <> 0 Then Cells(i, 2).Value = Err.Number 'マイナスになるのは外部エラー GoTo Endline End If End Sub

  • プログラムの意味を教えてください

    ここで繰り返しについてのプログラムについて質問させていただいたものです。 いろんな方にプログラムについて教えていただきありがとうございました。コピーして貼り付けしてプログラムは完成したのですが、内容もわからないままとかいやなので下記に貼り付けしてあるプログラムを簡単にでもかまいませんので説明してほしいのです。内容を理解したうえで先に進みたいので是非わかる方よろしくお願いします。 Private Sub Command1_Click()   Label1.Caption = NumKanji(Text1.Text) End Sub Private Function NumKanji(ByVal Arg As String) As String   Dim Idx As Long   For Idx = 1& To 10&     Arg = Replace$(Arg, _       Mid$("1234567890", Idx, 1&), _       Mid$("一二三四五六七八九〇", Idx, 1&) _     )   Next   NumKanji = Arg End Function

専門家に質問してみよう