E-Mail(クリップボード利用のメッセージ作成)          <TOP>


Outlook Express の「メッセージの作成」本文入力部にクリップボードを利用してデータ(TEXT)を送ってみます。

FindWindow クラス名またはキャプションを与えてウィンドウのハンドルを取得
FindWindowEx クラス名 、または キャプションを与えてウィンドウのハンドルを取得
ShellExecute 拡張子に関連付けられたプログラムを実行
SendMessage ウィンドウにメッセージを送信
SetWindowPos ウィンドウのサイズ、位置、および Z オーダーを設定
keybd_event
特殊キーの状態を設定
 

1.本文を用意(範囲選択しクリップボードにコピー)
2.「メッセージの作成」ウィンドウを起動(ここでは「宛先」にFocusが当たっている)
3.本文入力部のハンドルを取得
4.上記ハンドルにマウスボタンクリック状態を送る
5.クリップボード内容を貼り付ける

 

'================================================================
'= E-Mail(クリップボード利用のメッセージ作成)
'=    (FindWindow2.bas)
'================================================================
#include "Windows.bi"
#include "File.bi"

' クラス名またはキャプションを与えてウィンドウのハンドルを取得
Declare Function Api_FindWindow& Lib "user32" Alias "FindWindowA" (ByVal lpClassName$, ByVal lpWindowName$)

' クラス名 、または キャプションを与えてウィンドウのハンドルを取得
Declare Function Api_FindWindowEx& Lib "user32" Alias "FindWindowExA" (ByVal hWnd&, ByVal hChildAfter&, ByVal lpszClass$, ByVal lpszWindow$)

' 拡張子に関連付けられたプログラムを実行
Declare Function Api_ShellExecute& Lib "shell32" Alias "ShellExecuteA" (ByVal hWnd&, ByVal lpOperation$, ByVal lpFile$, ByVal lpParameters$, ByVal lpDirectory$, ByVal nShowCmd&)

' ウィンドウにメッセージを送信。この関数は、指定したウィンドウのウィンドウプロシージャが処理を終了するまで制御を返さない
Declare Function Api_SendMessage& Lib "user32" Alias "SendMessageA" (ByVal hWnd&, ByVal wMsg&, ByVal wParam&, ByVal lParam&)

' ウィンドウのサイズ、位置、および Z オーダーを設定
Declare Function Api_SetWindowPos& Lib "user32" Alias "SetWindowPos" (ByVal hWnd&, ByVal hWndInsertAfter&, ByVal X&, ByVal Y&, ByVal CX&, ByVal CY&, ByVal uFlags&)

' 特殊キーの状態を設定
Declare Sub Api_keybd_event Lib "user32" Alias "keybd_event" (ByVal bVk As byte, ByVal bScan As byte, ByVal dwFlags&, ByVal dwExtraInfo&)

#define HWND_TOPMOST (-1)               'ウィンドウを常に最前面に配置
#define SWP_SHOWWINDOW &H40             'ウィンドウを表示する
#define SWP_NOMOVE &H2                  'ウィンドウの現在位置を保持する
#define SWP_NOSIZE &H1                  'ウィンドウの現在のサイズを保持する

#define VK_CONTROL &H11                 '[Ctrl]
#define VK_TAB &H9                      '[TAB]
#define VK_V &H56                       '(86)Vキー
#define KEYEVENTF_KEYUP &H2             'キーを放す

#define WM_LBUTTONDOWN &H201            '左のマウスボタンを押した
#define WM_LBUTTONUP &H202              '左のマウスボタンが解放された

Var Shared Text1 As Object
Var Shared Text2 As Object
Var Shared Edit1 As Object
Var Shared Button(3) As Object

Text1.Attach GetDlgItem("Text1") : Text1.SetFontSize 14
Text2.Attach GetDlgItem("Text2") : Text2.SetFontSize 14
Edit1.Attach GetDlgItem("Edit1") : Edit1.SetFontSize 14

For i = 0 To 3
    Button(i).Attach GetDlgItem("Button" & Trim$(Str$(i + 1)))
    Button(i).SetFontSize 14
Next

Var Shared hParent As Long
Var Shared hIEServer As Long
Var Shared EMail As String

'================================================================
'= Mail起動
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var Ret As Long

    EMail = ""
    EMail = EMail & "mailto:hogehoge@hoge.ne.jp"
    EMail = EMail & "?Subject=TEST"
    EMail = EMail & "&body="
    
    hParent = Api_FindWindow("ATH_Note", ByVal 0)

    If hParent = 0 Then
        Ret = Api_ShellExecute(GethWnd, "Open", EMail, ByVal 0, ByVal 0, SW_NORMAL)
        Wait 5
        hParent = Api_FindWindow("ATH_Note", ByVal 0)
    End If

    'ハンドル確認
    Text1.SetWindowText "hParent:" & "&&H" & Hex$(hParent)
    Text2.SetWindowText "hIEServer:" & "&&H" & Hex$(hIEServer)
End Sub

'================================================================
'= クリップボードへコピー
'================================================================
Declare Sub Button2_on edecl ()
Sub Button2_on()
    SetMapMode 0
    CLEARCB
    SETCBFORMAT "CF_TEXT"

    Edit1.SetSelText 0, -1
    Edit1.Copy
    Edit1.SetSelText -1, -1
End Sub

'================================================================
'=「Internet Explorer_Server」のハンドル取得
'= AH_Note
'=   └ ME_DocHost
'=        └ ##MimeEdit_Server
'=             └ Internet Explorer_Server 
'================================================================
Declare Sub Button3_on edecl ()
Sub Button3_on()
    Var hChild As Long
    Var MyStr As String
    Var Ret As Long

    'メッセージの作成(Parent)
    hParent = Api_FindWindow("ATH_Note", ByVal 0)

    'Child1
    hChild = Api_FindWindowEx(hParent, 0, "ME_DocHost", ByVal 0)

    'Child2
    hChild = Api_FindWindowEx(hChild, 0, "##MimeEdit_Server", ByVal 0)

    'Child3(本文入力部)
    hIEServer = Api_FindWindowEx(hChild, 0, "Internet Explorer_Server", ByVal 0)

    'ハンドル確認
    Text1.SetWindowText "hParent:" & "&&H" & Hex$(hParent)
    Text2.SetWindowText "hIEServer:" & "&&H" & Hex$(hIEServer)
End Sub

'================================================================
'= 本文貼り付け
'================================================================
Declare Sub Button4_on edecl ()
Sub Button4_on()
    Var Ret As Long

    '「メッセージの作成」をアクティブに
    Ret = Api_SetWindowPos(hParent, HWND_TOPMOST, 0, 0, 0, 0, SWP_SHOWWINDOW Or SWP_NOMOVE Or SWP_NOSIZE)

    '本文入力部にフォーカスセット
    Ret = Api_SendMessage(hIEServer, WM_LBUTTONDOWN, 0, 0)
    Ret = Api_SendMessage(hIEServer, WM_LBUTTONUP, 0, 0)

    'Clipboardデータを貼り付け(Ctrl+Vをシミュレート)
    Api_keybd_event VK_CONTROL, 0, 0, 0
    Api_keybd_event VK_V, 0, 0, 0
    Api_keybd_event VK_V, 0, KEYEVENTF_KEYUP, 0
    Api_keybd_event VK_CONTROL, 0, KEYEVENTF_KEYUP, 0
End Sub

'================================================================
'= シェルドロップされたファイル名を取得
'================================================================
Declare Sub Edit1_DropFiles edecl (ByVal DF As Long)
Sub Edit1_DropFiles(ByVal DF As Long)
    Var FileName As String
    Var CN As Long
    Var hFile As Byte
    Var Temp As String
    Var Buffer As String
    Var Ret As long

    CN = GetDropFileCount(DF)
    FileName = GetDropFileName(DF, 0)

    On Error GoTo *ErTrap

    hFile = FreeFile

    Open FileName For BinInp As hFile
        Buffer = Space$(Lof(hFile))
        fRead hFile, Buffer
        Buffer = jconv$(Buffer, 0, 2)
        Edit1.SetWindowText Buffer
    Close hFile
    Exit Sub

*ErTrap
    Close hFile
    Edit1.SetWindowText ""
    Resume *ErReturn

*ErReturn
    On Error GoTo 0
End Sub

'================================================================
'=
'================================================================
While 1
    WaitEvent
Wend
Stop
End