VB.NETで非アクティブなウィンドウをスムーズに移動できた

VB.NETで非アクティブなウィンドウをスムーズに移動したいのコードを下記に変更した。これなら再フォーカスの問題は発生しない。

Public Class Form1

    :

    Private Structure RECT
        Public Left As Integer
        Public Top As Integer
        Public Right As Integer
        Public Bottom As Integer
    End Structure

    Private Const WM_MOVING As Integer = &H216

    Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
        Select Case m.Msg
            Case WM_MOVING
                Dim rect As RECT = Marshal.PtrToStructure(m.LParam, GetType(RECT))
                SetWindowPos(Me.Handle, HWND_TOPMOST, rect.Left, rect.Top, 0, 0, _
                             SWP_SHOWWINDOW Or SWP_NOSIZE)
            Case Else
        End Select
        MyBase.WndProc(m)
    End Sub

VB.NETで非アクティブなウィンドウをスムーズに移動したい

VB.NETで非アクティブで常に手前に表示したいで作ったウィンドウを非アクティブな状態で移動すると、移動が終わってからしか描画されないっぽい。アクティブじゃないから？とりあえず移動時だけアクティブにしてあげてみる。

Public Class Form1

    :

    Declare Function GetForegroundWindow Lib "user32" () As IntPtr
    Declare Function SetForegroundWindow Lib "user32" (hWnd As IntPtr) As Boolean

    Private Const WM_NCLBUTTONDOWN As Integer = &HA1
    Private Const WM_NCLBUTTONUP As Integer = &HA0

    Private m_hForegroundWnd As IntPtr = IntPtr.Zero

    Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
        Select Case m.Msg
            Case WM_NCLBUTTONDOWN
                If m_hForegroundWnd = IntPtr.Zero Then
                    m_hForegroundWnd = GetForegroundWindow
                    SetForegroundWindow(Me.Handle)
                End If
            Case WM_NCLBUTTONUP
                If m_hForegroundWnd <> IntPtr.Zero Then
                    SetForegroundWindow(m_hForegroundWnd)
                    m_hForegroundWnd = IntPtr.Zero
                End If
        End Select
        MyBase.WndProc(m)
    End Sub

けどこれだと、前面にいたウィンドウが再フォーカスされることになるからどうかなぁ。例えばIE9のURL部分は一度フォーカス外して再フォーカスすると全選択になるし。

VB.NETで非アクティブで常に手前に表示したい

スクリーンキーボード作りたいから

Windows アプリケーションの作成を参考にしてたけどそのままだとPInvoke～とか言われる。SetWindowPosとかのhWndとかの型が違うので直したげると動いた。

Imports System.Runtime.InteropServices
Public Class Form1

    Public Const HWND_TOPMOST = (-1)
    Public Const SWP_SHOWWINDOW = &H40&
    Public Const SWP_NOSIZE = &H1&
    Public Const SWP_NOMOVE = &H2&

    Public Const WS_EX_NOACTIVATE = &H8000000
    Public Const GWL_EXSTYLE As Long = (-20)

    <DllImport("user32.dll", SetLastError:=True)> _
    Private Shared Function SetWindowPos(ByVal hWnd As IntPtr, _
        ByVal hWndInsertAfter As IntPtr, _
        ByVal X As Integer, _
        ByVal Y As Integer, _
        ByVal cx As Integer, _
        ByVal cy As Integer, _
        ByVal uFlags As UInteger) As Boolean
    End Function

    <DllImport("user32.dll")> _
    Private Shared Function SetWindowLong(hWnd As IntPtr, _
        <MarshalAs(UnmanagedType.I4)> nIndex As Integer, _
        dwNewLong As IntPtr) As Integer
    End Function

    <DllImport("user32.dll", SetLastError:=True)> _
    Private Shared Function GetWindowLong(hWnd As IntPtr, _
        <MarshalAs(UnmanagedType.I4)> nIndex As Integer) As Integer
    End Function

    Protected Overrides ReadOnly Property CreateParams() As CreateParams
        Get
            Dim p As CreateParams = MyBase.CreateParams
            If Not MyBase.DesignMode Then
                p.ExStyle = p.ExStyle Or (WS_EX_NOACTIVATE)
            End If
            Return p
        End Get
    End Property

    Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
        Dim lngRet As Long = SetWindowPos(Me.Handle, HWND_TOPMOST, 0, 0, 0, 0, _
            SWP_SHOWWINDOW Or SWP_NOMOVE Or SWP_NOSIZE)
        Call SetWindowLong(Me.Handle, GWL_EXSTYLE, GetWindowLong(Me.Handle, GWL_EXSTYLE) Or WS_EX_NOACTIVATE)
    End Sub

    Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles ButtonEx1.Click
        SendKey(Keys.A)
    End Sub

End Class

Grails + CAS、CASクライアント編

Acegiプラグインを使ってCASでSSOします。

まず、Grails + CAS、CASサーバ編で作成したユーザ管理アプリをCASクライアントにしてみる。

ユーザ管理アプリのgrails-app/conf/SecurityConfig.groovyに以下の内容を追加する。

// CAS
useCAS = true // false
cas.casServer = 'localhost'
cas.casServerPort = '8080' // '443'
cas.casServerSecure = false // true
cas.localhostSecure = false // true
cas.failureURL = '/index.gsp' // '/denied.jsp'
cas.defaultTargetURL = '/'
cas.fullLoginURL = 'http://localhost:8080/cas/login' // 'https://localhost:443/cas/login'
cas.fullServiceURL = 'http://localhost:8080/cas' // 'https://localhost:443/cas'
cas.authenticationProviderKey = 'cas_key_changeme'
cas.userDetailsService = 'userDetailsService'
cas.sendRenew = false
cas.proxyReceptorUrl = '/' // '/secure/receptor'
cas.filterProcessesUrl = '/j_spring_cas_security_check'

コメントアウトはDefaultSecurityConfig.groovyの設定。
cas.failureURLはdenied.jspを用意するのが面倒なので。
cas.proxyReceptorUrlはCASサーバがリクエストしてくるので'/'に変更。'/secure/receptor'のままだとCASサーバ側でエラーが発生してしまい、Single Sign OutができなくなったSpring SourceのCASサンプルが'/secure/receptor'に設定してるから？

あとはweb.xmlにSingleSignOutフィルタを書く。

grails install-templates

<filter>
   <filter-name>CAS Single Sign Out Filter</filter-name>
   <filter-class>org.jasig.cas.client.session.SingleSignOutFilter</filter-class>
</filter>

<filter-mapping>
   <filter-name>CAS Single Sign Out Filter</filter-name>
   <url-pattern>/j_spring_cas_security_check</url-pattern>
</filter-mapping>

<listener>
   <listener-class>org.jasig.cas.client.session.SingleSignOutHttpSessionListener</listener-class>
</listener>

これでOK。
認証が必要なページに遷移するとCASのログイン画面が表示される。ログインすると、Spring Security的にもログインする。ログアウトはCASのログアウトリクエストを送る必要がある。そうしないと、Cookieに情報が残ったままになるので

CASの仕組みについてはcas-server-coreの処理を読めばだいたい分かるのでそちらを見てください。ちなみによく見たクラスは以下。

• CentralAuthenticationServiceImpl
• TicketGrantingTicketImpl
• ServiceTicketImpl

そろそろサンプルをどこかにおきたい。次回はCASサーバが接続するデータベースとCASクライアントのアプリが接続するデータベースが異なる場合についてまとめる。

VB.NETでスクリーンロックしてスクリーンセーバー起動

Imports System.Runtime.InteropServices

Public Class ScreenLockForm
    <DllImport("user32.dll")> _
    Public Shared Function LockWorkStation() As Long
    End Function

    <DllImport("user32.dll")> _
    Public Shared Function SendMessage(ByVal hWnd As IntPtr, _
          ByVal uMsg As Int32, _
          ByVal wParam As Int32, _
          ByVal lParam As Int32) As Int32
    End Function

    Private Const WM_SYSCOMMAND As Int32 = &H112
    Private Const SC_SCREENSAVE As Int32 = &HF140

    Private Sub Lock_Button_Click(sender As System.Object, e As System.EventArgs) _
        Handles Lock_Button.Click
        LockWorkStation()
        SendMessage(Me.Handle, WM_SYSCOMMAND, SC_SCREENSAVE, 0)
        Close()
    End Sub
End Class

VB.NETでCSV読まないといけなくなった

どうやってやるのがいいの？

社員のモデル

Public Class Syain
    '社員コード
    Private mCode As String
    '社員氏名
    Private mName As String

    Public Property Code As String
        Get
            Code = mCode
        End Get
        Set(value As String)
            mCode = value
        End Set
    End Property

    Public Property Name As String
        Get
            Name = mName
        End Get
        Set(value As String)
            mName = value
        End Set
    End Property

    Public Overrides Function ToString() As String
        Return "code: " & mCode & ", name: " & mName
    End Function

End Class

社員のMapper

Public Class SyainMapper
    Inherits CsvMapper

    'カラム名とプロパティ名のマッピング
    Private Shared MAPPINGS As New SortedDictionary(Of String, String) From { _
            {"社員コード", "Code"}, _
            {"社員氏名", "Name"}}

    Protected Overrides Function GetMappings() As SortedDictionary(Of String, String)
        GetMappings = MAPPINGS
    End Function

    'モデルの名前とテーブル名は一致させること
    Protected Overrides Function GetModel() As Type
        GetModel = GetType(Syain)
    End Function

End Class

Mapperの共通部分

Imports System.Data.OleDb

Public Class CsvMapper

    '接続先(CSV用)
    Private Shared connectionString As String = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
              "Data Source=C:\tmp\;" & _
              "Extended Properties=""Text;HDR=YES;FMT=Delimited"""

    'SELECT文
    Private Function selectSQL() As String
        '個別のカラム情報を取得
        Dim columns As String() = (From i As String In GetMappings().Keys Select i).ToArray()
        'テーブル名、カラム名からSELECT文を構築
        selectSQL = "SELECT " & Join(columns, ",") & " FROM " & GetModel.Name() & ".csv"
    End Function

    'SELECT文を実行して一覧を返す
    Public Function List() As IList
        List = New ArrayList()
        Using connection As New OleDbConnection(connectionString)
            Dim command As New OleDbCommand(selectSQL, connection)
            connection.Open()
            Dim reader As OleDbDataReader = command.ExecuteReader()
            While reader.Read()
                List.Add(Transform(reader))
            End While
            reader.Close()
        End Using
    End Function

    'レコードをモデルに変換する
    Protected Overridable Function Transform(reader As OleDbDataReader) As Object

        'サブクラスからモデル情報を取得
        Dim modelType As Type = GetModel()
        If IsNothing(modelType) Then
            'モデル情報がなければHashtableに入れて返す
            Dim obj As New Hashtable
            Dim idx As Integer = 0
            For Each key As String In GetMappings.Values
                obj(key) = reader(idx)
                idx = idx + 1
            Next
            Transform = obj
        Else
            'モデル情報があればインスタンスを生成してプロパティを設定して返す
            Dim obj As Object = modelType.InvokeMember("New", Reflection.BindingFlags.CreateInstance, Nothing, Nothing, Nothing)
            Dim idx As Integer = 0
            For Each key As String In GetMappings.Values
                modelType.InvokeMember(key, Reflection.BindingFlags.SetProperty, Nothing, obj, New Object() {reader(idx)})
                idx = idx + 1
            Next
            Transform = obj
        End If
    End Function

    Protected Overridable Function GetModel() As Type
        GetModel = Nothing
    End Function

    Protected Overridable Function GetMappings() As SortedDictionary(Of String, String)
        Throw New NotImplementedException
    End Function

End Class

grails離れ

火消しを終えて本社戻ってきたらもうGrailsは使わない宣言された