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