アクセスカウンタ

プロフィール

Author:croissant3

カテゴリー

最近の記事

月別アーカイブ(タブ)

最近のコメント

最近のトラックバック

月別アーカイブ

ブロとも申請フォーム

この人とブロともになる

月別アーカイブ

カレンダー

06 | 2007/07 | 08
1 2 3 4 5 6 7
8 9 10 11 12 13 14
15 16 17 18 19 20 21
22 23 24 25 26 27 28
29 30 31 - - - -

小さな天気予報


-天気予報コム- -FC2-

全ての記事を表示する

全ての記事を表示する

PCノンセクションの10♪
PCに関することを色々と。っつうか最近VBネタばっかorz
スポンサーサイト

上記の広告は1ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。
↑参考になったら拍手よろろ
VBでmht保存(おまけ)

ちなみにクラムメディアの問題集はマウスでコピペが出来ないよう
JavaScriptで細工しています。

mht保存したファイルに記載されているJavaScriptの一部、
実際には1行をコメントアウトするだけで
コピペガードは外せます。

私はコピペガードを外した上で
OutLookにHTML形式でペタペタ貼り付けて
自分だけの問題集を作りました。
↑参考になったら拍手よろろ
スポンサーサイト

テーマ:プログラミング - ジャンル:コンピュータ

VBでmht保存(その2)

とりあえずこんな感じで作ってみました。

CRAM



WebBrowserでWebを表示、保存ボタンを押すと
「Webページを保存」画面で
ファイル名、保存形式を自動入力し
mht保存を行います。

もうちょい時間があれば1問1問自分でWEBを巡回して
勝手にmht保存する形にしたかったのですが
そこまで作っている時間がなかった。orz


今回もmht保存する関数のソースを載せてみます。


Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Const LB_SETTOPINDEX = &H197
Private Const GW_HWNDNEXT = 2
Private Const GW_CHILD = 5
Private Const WM_ACTIVATE = &H6
Private Const WM_CLOSE = &H10
Private Const WM_COMMAND = &H111
Private Const WM_COPY = &H301
Private Const WM_GETTEXT = &HD
Private Const WM_GETTEXTLENGTH = &HE
Private Const WM_PASTE = &H302
Private Const WM_QUIT = &H12
Private Const WM_SETTEXT = &HC
Private Const WM_CLEAR = &H303
Private Const EM_SETSEL = &HB1
Private Const EM_REPLACESEL = &HC2
Private Const BN_CLICKED = 0
Private Const BM_CLICK = &HF5
Private Const CB_SETCURSEL = &H14E



Public Sub SaveAs_Input()

'名前を付けて保存ダイアログを検索、
'ファイル名を入力し、mht形式をSendKeysで選択、
'保存ボタンを押すだけ


Const WINDOW_NAME As String = "Web ページの保存"
Const BUTTON_NAME As String = "保存(&S)"

Dim hwnd As Long    '親   Dialog
Dim hChild As Long   '子供  ComboBoxEx32
Dim hhChild As Long   '孫   ComboBox
Dim hhhChild As Long  'ひ孫  Edit


'名前を付けて保存ウィンドウの検索
hwnd = FindWindow(vbNullString, WINDOW_NAME)


'ファイル名入力用のエディットボックスの検索
'ダイアログ-->ComboBoxEx32-->ComboBox-->Editの
'3段になっていることに注意。


If hwnd = 0 Then
  MsgBox "WEBページの保存画面が見つかりません"
  Exit Sub
End If

'エディットボックスの検索
hChild = SearchHandle(hwnd, "ComboBoxEx32")
If hChild = 0 Then
  MsgBox "WEBページの保存:ComboBoxEx32 が見つかりません"
  Exit Sub
End If

hhChild = SearchHandle(hChild, "ComboBox")
If hhChild = 0 Then
  MsgBox "WEBページの保存:ComboBox が見つかりません"
  Exit Sub
End If

hhhChild = SearchHandle(hhChild, "Edit")
If hhhChild = 0 Then
  MsgBox "WEBページの保存:Edit が見つかりません"
  Exit Sub
End If


'---- 保存ファイル名の入力 ----
'見つかったEditボックス(hhhChild)に SendMessage

Call SetForegroundWindow(hwnd)
SendMessage hwnd, WM_ACTIVATE, 1, ByVal 0&
SendMessage hhhChild, WM_ACTIVATE, 1, ByVal 0&
SendMessage hhhChild, WM_CLEAR, 0, ByVal 0&
SendMessage hhhChild, WM_SETTEXT, 0, ByVal "C: emp est.mht"


'---- コンボボックスからmhtを指定する ----
Dim tmpStr As String
Dim tmpCls As String
Dim tmpl As Long
Dim combownd As Long
Dim buf As String * 1024

'とりあえずダイアログの中の子供を一つ取得
combownd = GetWindow(hwnd, GW_CHILD)

Do While combownd <> 0
  '子供のクラス名を取得
  tmpCls = String(255, Chr(0))
  tmpl = GetClassName(combownd, tmpCls, Len(tmpCls))
  tmpStr = Left(tmpCls, tmpl)

  'クラス名がComboBoxならコンボボックスの中の文字列を取得する
  If tmpStr = "ComboBox" Then
    buf = String(1024, Chr(0))
    SendMessage combownd, WM_GETTEXT, 1024, ByVal buf

    Dim a As String
    a = Left(buf, InStr(1, buf, Chr(0), vbTextCompare) - 1)

    Select Case a
      Case "Web ページ、完全 (*.htm;*.html)"
          '---- TAB,DOWN,DOWN,TAB ----
          Call SetForegroundWindow(hwnd)
          SendMessage combownd, WM_ACTIVATE, 1, ByVal 0&
          DoEvents

          Call SetForegroundWindow(hwnd)
          SendMessage combownd, WM_ACTIVATE, 1, ByVal 0&
          SendKeys "{TAB}", True
          DoEvents
          Sleep 300

          Call SetForegroundWindow(hwnd)
          SendMessage combownd, WM_ACTIVATE, 1, ByVal 0&
          SendKeys "{DOWN}", True
          DoEvents
          Sleep 300

          Call SetForegroundWindow(hwnd)
          SendMessage combownd, WM_ACTIVATE, 1, ByVal 0&
          SendKeys "{DOWN}", True
          DoEvents
          Sleep 300

          Call SetForegroundWindow(hwnd)
          SendMessage combownd, WM_ACTIVATE, 1, ByVal 0&
          SendKeys "{TAB}", True
          DoEvents
          Sleep 300

          Exit Do

      Case "Web アーカイブ、単一のファイル (*.mht)"
          '---- TAB,TAB ----
          Call SetForegroundWindow(hwnd)
          SendMessage combownd, WM_ACTIVATE, 1, ByVal 0&
          DoEvents

          Call SetForegroundWindow(hwnd)
          SendMessage combownd, WM_ACTIVATE, 1, ByVal 0&
          SendKeys "{TAB}", True
          DoEvents
          Sleep 300

          Call SetForegroundWindow(hwnd)
          SendMessage combownd, WM_ACTIVATE, 1, ByVal 0&
          SendKeys "{TAB}", True
          DoEvents
          Sleep 300

          Exit Do

      Case "Web ページ、HTML のみ (*.htm;*.html)"
          '---- TAB,DOWN,UP,TAB
          Call SetForegroundWindow(hwnd)
          SendMessage combownd, WM_ACTIVATE, 1, ByVal 0&
          DoEvents

          Call SetForegroundWindow(hwnd)
          SendMessage combownd, WM_ACTIVATE, 1, ByVal 0&
          SendKeys "{TAB}", True
          DoEvents
          Sleep 300

          Call SetForegroundWindow(hwnd)
          SendMessage combownd, WM_ACTIVATE, 1, ByVal 0&
          SendKeys "{DOWN}", True
          DoEvents
          Sleep 300

          Call SetForegroundWindow(hwnd)
          SendMessage combownd, WM_ACTIVATE, 1, ByVal 0&
          SendKeys "{UP}", True
          DoEvents
          Sleep 300

          Call SetForegroundWindow(hwnd)
          SendMessage combownd, WM_ACTIVATE, 1, ByVal 0&
          SendKeys "{TAB}", True
          DoEvents
          Sleep 300

          Exit Do

      Case "テキスト ファイル (*.txt)"
          '---- TAB DOWN,UP,UP,TAB
          'MsgBox "txt"
          Call SetForegroundWindow(hwnd)
          SendMessage combownd, WM_ACTIVATE, 1, ByVal 0&
          DoEvents

          Call SetForegroundWindow(hwnd)
          SendMessage combownd, WM_ACTIVATE, 1, ByVal 0&
          SendKeys "{TAB}", True
          DoEvents
          Sleep 300

          Call SetForegroundWindow(hwnd)
          SendMessage combownd, WM_ACTIVATE, 1, ByVal 0&
          SendKeys "{DOWN}", True
          DoEvents
          Sleep 300

          Call SetForegroundWindow(hwnd)
          SendMessage combownd, WM_ACTIVATE, 1, ByVal 0&
          SendKeys "{UP}", True
          DoEvents
          Sleep 300

          Call SetForegroundWindow(hwnd)
          SendMessage combownd, WM_ACTIVATE, 1, ByVal 0&
          SendKeys "{UP}", True
          DoEvents
          Sleep 300

          Call SetForegroundWindow(hwnd)
          SendMessage combownd, WM_ACTIVATE, 1, ByVal 0&
          SendKeys "{TAB}", True
          DoEvents
          Sleep 300

          Exit Do

    End Select
  End If
  combownd = GetWindow(combownd, GW_HWNDNEXT)
Loop

'---- 保存ボタンを検索してクリック
hChild = FindWindowEx(hwnd, 0, vbNullString, BUTTON_NAME)
If hChild = 0 Then
  MsgBox "WEBページの保存:保存ボタンが見つかりません"
  Exit Sub
End If
Call SetForegroundWindow(hwnd)
SendMessage hwnd, WM_ACTIVATE, 1, ByVal 0&
SendMessage hChild, WM_ACTIVATE, 1, ByVal 0&
SendMessage hChild, BM_CLICK, 0, ByVal 0&

End Sub





Public Function SearchHandle(hwnd As Long, ClsName As String) As Long
'hwndウィンドウから指定したクラスの部品を検索、
'ウィンドウハンドルを返すだけ


SearchHandle = 0

Dim hChild As Long

'とりあえずダイアログ画面の子供を1個取得
hChild = GetWindow(hwnd, GW_CHILD)

Dim tmpStr As String
Dim tmpCls As String
Dim tmpl As Long

Do While hChild <> 0
'クラス名を取得
  tmpCls = String(255, Chr(0))
  tmpl = GetClassName(hChild, tmpCls, Len(tmpCls))
  tmpStr = Left(tmpCls, tmpl)
  If tmpStr = ClsName Then
    'MsgBox ClsName & "見つけた!"
    SearchHandle = hChild
    Exit Function
  End If
  hChild = GetWindow(hChild, GW_HWNDNEXT)
Loop

'MsgBox ClsName & "みつからんかった"

End Function

↑参考になったら拍手よろろ

テーマ:プログラミング - ジャンル:コンピュータ

VBでmht保存(その1)

先日資格取得の為にクラムメディア(www.crammedia.com)の問題集を購入。
WEBで表示される問題と解答を保存したいと思い
ちまちまとローカルのHDDにmht形式で保存していたのだが、
結構めんどい。

フリーソフトの「Webよ止まれ ?EternalWeb?」というツールの使用もあるがファイル名の指定に困ってしまう。orz

仕方がないのでまたいつもの様に家内制手工業(自作)です。



とりあえずmht保存の方法を調べてみる

(1) CDO.Message オブジェクトで直接URLを指定して保存

  Set CDO=WScript.CreateObject("CDO.Message")
  Const adSaveCreateOverWrite = 2
  CDO.CreateMHTMLBody "http://www.yahoo.co.jp"
  CDO.GetStream.SaveToFile "C:\test.mht",adSaveCreateOverWrite

  この方法が一番簡単。
  CreateMHTLBodyの引数でユーザ、パスワードの指定は可能。
  しかしこの単純な認証作業で突破できないサイトは結構あるため
  クラムメディアでは試してないがおそらくこの方法は×。orz
  


(2) 「名前を付けて保存」を利用

  VBの画面にWebBrowserコントロールを貼り付けて、ページを表示して
  Me.WebBrowser.ExecWB を叩けば保存が出来る。

  Me.WebBrowserMain.ExecWB OLECMDID_SAVEAS, OLECMDEXECOPT_PROMPTUSER
  ※引数は適当に弄って下さい。

  しかしExecWBでは画像付きのhtmlファイルで保存することは出来たが
  mhtで保存出来ない様子。orz



(3) (2)を改良、ExecWBを利用して「名前を付けて保存」ダイアログを表示、
  入力部分はSendMessageなどで自動化。

  この方法だと
  保存ファイル名の入力はSendMessageでWM_SETTEXTを飛ばせばOK!

  コンボボックスでファイル形式にmhtを指定する事は
  SendMessageで出来たが・・mht形式で保存されず。orz
  コンボボックスを変更しただけではリストビューまで変更されないせいか?

  結局コンボボックスの変更を
  原始的にSendKeysを使ったところうまく出来ました。


保存方法についてはこれでOK。 ↑参考になったら拍手よろろ

テーマ:プログラミング - ジャンル:コンピュータ


ブログ内検索

RSSフィード

リンク

このブログをリンクに追加する

メールフォーム

名前:
メール:
件名:
本文:



上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。