Beep 関数

Wed, 23 Jan 2008 22:25:00 GMT

えーと、、超不定期ですが、今日は Beep 関数です。
「ペッ」って鳴らすあれです。
単純に MessageBeep を呼ぶだけかと想像していたのですが、違うみたいですね。
アクセス許可絡みをうじゃうじゃやっているようです。

Option Strict On


Imports System.Security.Permissions
Imports System.Runtime.InteropServices
Imports System.ComponentModel


Public NotInheritable Class Functions


#Region " AppActivate "

AppActivate 関数参照

#End Region


#Region " GetResourceString "

AppActivate 関数参照

#End Region


#Region " Asc "

Asc 関数参照

#End Region


#Region " Beep "
    <DllImport("user32", CharSet:=CharSet.Unicode)> _
    Friend Shared Function MessageBeep(ByVal uType As Integer) As Integer
    End Function


    Public Shared Sub Beep()
        Try
            Dim perm As UIPermission = New UIPermission(UIPermissionWindow.SafeSubWindows)
            perm.Demand()
        Catch exception As System.Security.SecurityException
            Try
                Dim perm As UIPermission = New UIPermission(UIPermissionWindow.SafeSubWindows)
                perm.Demand()
            Catch exception2 As System.Security.SecurityException
                Return
            End Try
        End Try
        MessageBeep(0)
    End Sub
#End Region
End Class

Asc 関数

Thu, 17 Jan 2008 18:36:00 GMT

今日は Asc 関数です。
msdn には「文字に対応する文字コードを表す整数型 (Integer) の値を返します。」とあります。
VB6 で使っていた AscB 関数は VB.NET のコード体系が Unicode になったのでサポートされなくなったらしいです。
いずれにしても、あまり使う機会がなかったなぁ。

Option Strict On


Imports System.Security.Permissions
Imports System.Runtime.InteropServices
Imports System.ComponentModel


Public NotInheritable Class Functions


#Region " AppActivate "

AppActivate 関数参照

#End Region


#Region " GetResourceString "

AppActivate 関数参照

#End Region


#Region " Asc "
    Public Shared Function Asc(ByVal [String] As String) As Integer
        If (([String] Is Nothing) OrElse ([String].Length = 0)) Then
            Throw New ArgumentException(GetResourceString("Argument_LengthGTZero1", New String() {"String"}))
        End If
        Dim ch As Char = [String].Chars(0)
        Dim num As Integer
        Dim num2 As Integer = Convert.ToInt32(ch)
        If (num2 < &H80) Then
            Return num2
        End If


        Dim buffer As Byte()
        Dim fileIOEncoding As System.Text.Encoding = System.Text.Encoding.Default


        Dim chars As Char() = New Char() {ch}
        If fileIOEncoding.IsSingleByte Then
            buffer = New Byte(1 - 1) {}
            Dim num3 As Integer = fileIOEncoding.GetBytes(chars, 0, 1, buffer, 0)
            Return buffer(0)
        End If
        buffer = New Byte(2 - 1) {}
        If (fileIOEncoding.GetBytes(chars, 0, 1, buffer, 0) = 1) Then
            Return buffer(0)
        End If
        If BitConverter.IsLittleEndian Then
            Dim num4 As Byte = buffer(0)
            buffer(0) = buffer(1)
            buffer(1) = num4
        End If
        num = BitConverter.ToInt16(buffer, 0)
        Return num
    End Function
#End Region
End Class

AppActivate 関数

Wed, 16 Jan 2008 12:31:00 GMT

ひさびさのぶろぐ投稿です。
皆様、お元気でしょうか。ワタシはまた入院していましたｗ

VB.NET には過去との互換性の目的も含めて（たぶん）言語固有の関数があります。
それらを VB 関数ではなく、.NET で実装してみようという試みです。
（ほとんど Reflector のお世話になりっぱだと思いますがｗ）
VB 関数が嫌いじゃ～でも VB 関数の機能は使いたいんじゃ～といういるかいないか解らない人向けです。
変換ツールとか使えば、 C# でも VB 名前空間を Import しなくても、VB 関数みたいな事ができる、、、はず、、、

最初は
AppActivate 関数です。
いきなりこけてますけども、ProcessID を引数にするやつがワタシの環境ではこけてしまいます。
どうも GetWindowThreadProcessId がうまくいっていないっぽい。

# 追記：ぎゃあー修正すればするほどソースがでかくなるー

Option Strict On
Imports System.Security.Permissions
Imports System.Runtime.InteropServices
Imports System.ComponentModel
Public NotInheritable Class Functions
#Region " AppActivate "
    <DllImport("user32", CharSet:=CharSet.Ansi, SetLastError:=True, ExactSpelling:=True)> _
    Friend Shared Function GetWindow(ByVal hwnd As IntPtr, ByVal wFlag As Integer) As IntPtr
    End Function
    <DllImport("user32", CharSet:=CharSet.Ansi, SetLastError:=True, ExactSpelling:=True)> _
    Friend Shared Function GetDesktopWindow() As IntPtr
    End Function
    <DllImport("user32", CharSet:=CharSet.Ansi, SetLastError:=True, ExactSpelling:=True)> _
    Friend Shared Function GetWindowThreadProcessId(ByVal hwnd As IntPtr, ByRef lpdwProcessId As Integer) As Integer
    End Function
    <DllImport("user32", CharSet:=CharSet.Ansi, SetLastError:=True, ExactSpelling:=True)> _
    Friend Shared Function IsWindowEnabled(ByVal hwnd As IntPtr) As <MarshalAs(UnmanagedType.Bool)> Boolean
    End Function
    <DllImport("user32", CharSet:=CharSet.Ansi, SetLastError:=True, ExactSpelling:=True)> _
    Friend Shared Function IsWindowVisible(ByVal hwnd As IntPtr) As <MarshalAs(UnmanagedType.Bool)> Boolean
    End Function
    <DllImport("user32", CharSet:=CharSet.Auto, SetLastError:=True)> _
    Friend Shared Function FindWindow(<MarshalAs(UnmanagedType.VBByRefStr)> ByRef lpClassName As String, <MarshalAs(UnmanagedType.VBByRefStr)> ByRef lpWindowName As String) As IntPtr
    End Function
    <DllImport("user32", CharSet:=CharSet.Auto, SetLastError:=True)> _
    Friend Shared Function GetWindowText(ByVal hWnd As IntPtr, <Out(), MarshalAs(UnmanagedType.LPTStr)> ByVal lpString As System.Text.StringBuilder, ByVal nMaxCount As Integer) As Integer
    End Function
    <DllImport("user32", CharSet:=CharSet.Ansi, SetLastError:=True, ExactSpelling:=True)> _
    Friend Shared Function AttachThreadInput(ByVal idAttach As Integer, ByVal idAttachTo As Integer, ByVal fAttach As Integer) As Integer
    End Function
    <DllImport("user32", CharSet:=CharSet.Ansi, SetLastError:=True, ExactSpelling:=True)> _
    Friend Shared Function SetForegroundWindow(ByVal hwnd As IntPtr) As <MarshalAs(UnmanagedType.Bool)> Boolean
    End Function
    <DllImport("user32", CharSet:=CharSet.Ansi, SetLastError:=True, ExactSpelling:=True)> _
    Friend Shared Function SetFocus(ByVal hwnd As IntPtr) As IntPtr
    End Function


    <SecurityPermission(SecurityAction.Demand, Flags:=SecurityPermissionFlag.UnmanagedCode)> _
     Public Shared Sub AppActivate(ByVal ProcessId As Integer)
        Dim num As Integer
        Dim window As IntPtr = GetWindow(GetDesktopWindow, 5)
        Do While (window <> IntPtr.Zero)
            GetWindowThreadProcessId(window, (num))
            If (((num = ProcessId) AndAlso IsWindowEnabled(window)) AndAlso IsWindowVisible(window)) Then
                Exit Do
            End If
            window = GetWindow(window, 2)
        Loop
        If (window = IntPtr.Zero) Then
            window = GetWindow(GetDesktopWindow, 5)
            Do While (window <> IntPtr.Zero)
                GetWindowThreadProcessId(window, (num))
                If (num = ProcessId) Then
                    Exit Do
                End If
                window = GetWindow(window, 2)
            Loop
        End If
        If (window = IntPtr.Zero) Then
            Throw New ArgumentException(GetResourceString("ProcessNotFound", New String() {Convert.ToString(ProcessId)}))
        End If
        AppActivateHelper(window)
    End Sub


    <SecurityPermission(SecurityAction.Demand, Flags:=SecurityPermissionFlag.UnmanagedCode)> _
    Public Shared Sub AppActivate(ByVal Title As String)
        Dim lpClassName As String = Nothing
        Dim hWnd As IntPtr = FindWindow((lpClassName), (Title))
        If (hWnd = IntPtr.Zero) Then
            Dim num As Integer
            Dim strA As String = String.Empty
            Dim lpString As New System.Text.StringBuilder(&H1FF)
            Dim length As Integer = Strings.Len(Title)
            hWnd = GetWindow(GetDesktopWindow, 5)
            Do While (hWnd <> IntPtr.Zero)
                num = GetWindowText(hWnd, lpString, lpString.Capacity)
                strA = lpString.ToString
                If ((num >= length) AndAlso (String.Compare(strA, 0, Title, 0, length, StringComparison.OrdinalIgnoreCase) = 0)) Then
                    Exit Do
                End If
                hWnd = GetWindow(hWnd, 2)
            Loop
            If (hWnd = IntPtr.Zero) Then
                hWnd = GetWindow(GetDesktopWindow, 5)
                Do While (hWnd <> IntPtr.Zero)
                    num = GetWindowText(hWnd, lpString, lpString.Capacity)
                    strA = lpString.ToString
                    If ((num >= length) AndAlso (String.Compare(Strings.Right(strA, length), 0, Title, 0, length, StringComparison.OrdinalIgnoreCase) = 0)) Then
                        Exit Do
                    End If
                    hWnd = GetWindow(hWnd, 2)
                Loop
            End If
        End If
        If (hWnd = IntPtr.Zero) Then
            Throw New ArgumentException(GetResourceString("ProcessNotFound", New String() {Title}))
        End If
        AppActivateHelper(hWnd)
    End Sub


    Private Shared Sub AppActivateHelper(ByVal hwndApp As IntPtr)
        Dim num As Integer
        Dim perm As UIPermission = New UIPermission(UIPermissionWindow.AllWindows)
        perm.Demand()
        If (Not IsWindowEnabled(hwndApp) OrElse Not IsWindowVisible(hwndApp)) Then
            Dim window As IntPtr = GetWindow(hwndApp, 0)
            Do While (window <> IntPtr.Zero)
                If (GetWindow(window, 4) = hwndApp) Then
                    If (IsWindowEnabled(window) AndAlso IsWindowVisible(window)) Then
                        Exit Do
                    End If
                    hwndApp = window
                    window = GetWindow(hwndApp, 0)
                End If
                window = GetWindow(window, 2)
            Loop
            If (window = IntPtr.Zero) Then
                Throw New ArgumentException(GetResourceString("ProcessNotFound"))
            End If
            hwndApp = window
        End If
        AttachThreadInput(0, GetWindowThreadProcessId(hwndApp, (num)), 1)
        SetForegroundWindow(hwndApp)
        SetFocus(hwndApp)
        AttachThreadInput(0, GetWindowThreadProcessId(hwndApp, (num)), 0)
    End Sub
#End Region


    Public Shared Function GetResourceString(ByVal ResourceKey As String, ByVal ParamArray Args As String()) As String
        Dim str As String = Nothing
        Dim format As String = Nothing
        Try
            format = GetResourceString(ResourceKey)
            str = String.Format(System.Threading.Thread.CurrentThread.CurrentUICulture, format, Args)
        Catch exception As StackOverflowException
            Throw exception
        Catch exception2 As OutOfMemoryException
            Throw exception2
        Catch exception3 As System.Threading.ThreadAbortException
            Throw exception3
        Catch exception4 As Exception
        End Try
        If (str <> "") Then
            Return str
        End If
        Return format
    End Function


    <EditorBrowsable(EditorBrowsableState.Never)> _
   Friend Shared Function GetResourceString(ByVal ResourceKey As String) As String
        Dim str2 As String
        If (VBAResourceManager Is Nothing) Then
            Return "Message text unavailable.  Resource file 'Microsoft.VisualBasic resources' not found."
        End If
        Try
            str2 = VBAResourceManager.GetString(ResourceKey, System.Threading.Thread.CurrentThread.CurrentCulture)
            If (str2 Is Nothing) Then
                str2 = VBAResourceManager.GetString("ID95")
            End If
        Catch exception As StackOverflowException
            Throw exception
        Catch exception2 As OutOfMemoryException
            Throw exception2
        Catch exception3 As System.Threading.ThreadAbortException
            Throw exception3
        Catch exception6 As Exception
            str2 = "Message text unavailable.  Resource file 'Microsoft.VisualBasic resources' not found."
        End Try
        Return str2
    End Function


    Private Shared m_VBAResourceManager As System.Resources.ResourceManager
    Private Shared m_TriedLoadingResourceManager As Boolean
    Private Shared ReadOnly ResourceManagerSyncObj As Object


    Friend Shared ReadOnly Property VBAResourceManager() As System.Resources.ResourceManager
        Get
            If (m_VBAResourceManager Is Nothing) Then
                Dim resourceManagerSyncObj As Object = resourceManagerSyncObj
                If ((Not resourceManagerSyncObj Is Nothing) AndAlso resourceManagerSyncObj.GetType.IsValueType) Then
                    Throw New ArgumentException(GetResourceString("SyncLockRequiresReferenceType1", New String() {VBFriendlyNameOfType(resourceManagerSyncObj.GetType, False)}))
                End If
                SyncLock resourceManagerSyncObj
                    If Not m_TriedLoadingResourceManager Then
                        Try
                            m_VBAResourceManager = New System.Resources.ResourceManager("Microsoft.VisualBasic", System.Reflection.Assembly.GetExecutingAssembly)
                        Catch exception As StackOverflowException
                            Throw exception
                        Catch exception2 As OutOfMemoryException
                            Throw exception2
                        Catch exception3 As System.Threading.ThreadAbortException
                            Throw exception3
                        Catch exception6 As Exception
                        End Try
                        m_TriedLoadingResourceManager = True
                    End If
                End SyncLock
            End If
            Return m_VBAResourceManager
        End Get
    End Property


    Friend Shared Function VBFriendlyNameOfType(ByVal typ As Type, Optional ByVal FullName As Boolean = False) As String
        Dim name As String
        Dim typeCode As TypeCode
        Dim arraySuffixAndElementType As String = GetArraySuffixAndElementType((typ))
        If typ.IsEnum Then
            typeCode = TypeCode.Object
        Else
            typeCode = Type.GetTypeCode(typ)
        End If
        Select Case typeCode
            Case TypeCode.DBNull
                name = "DBNull"
                Exit Select
            Case TypeCode.Boolean
                name = "Boolean"
                Exit Select
            Case TypeCode.Char
                name = "Char"
                Exit Select
            Case TypeCode.SByte
                name = "SByte"
                Exit Select
            Case TypeCode.Byte
                name = "Byte"
                Exit Select
            Case TypeCode.Int16
                name = "Short"
                Exit Select
            Case TypeCode.UInt16
                name = "UShort"
                Exit Select
            Case TypeCode.Int32
                name = "Integer"
                Exit Select
            Case TypeCode.UInt32
                name = "UInteger"
                Exit Select
            Case TypeCode.Int64
                name = "Long"
                Exit Select
            Case TypeCode.UInt64
                name = "ULong"
                Exit Select
            Case TypeCode.Single
                name = "Single"
                Exit Select
            Case TypeCode.Double
                name = "Double"
                Exit Select
            Case TypeCode.Decimal
                name = "Decimal"
                Exit Select
            Case TypeCode.DateTime
                name = "Date"
                Exit Select
            Case TypeCode.String
                name = "String"
                Exit Select
            Case Else
                If IsGenericParameter(typ) Then
                    name = typ.Name
                Else
                    Dim fullName1 As String
                    Dim str6 As String = Nothing
                    Dim genericArgsSuffix As String = GetGenericArgsSuffix(typ)
                    If fullName Then
                        If typ.IsNested Then
                            str6 = VBFriendlyNameOfType(typ.DeclaringType, True)
                            fullName1 = typ.Name
                        Else
                            fullName1 = typ.FullName
                        End If
                    Else
                        fullName1 = typ.Name
                    End If
                    If (Not genericArgsSuffix Is Nothing) Then
                        Dim length As Integer = fullName1.LastIndexOf("`"c)
                        If (length <> -1) Then
                            fullName1 = fullName1.Substring(0, length)
                        End If
                        name = (fullName1 & genericArgsSuffix)
                    Else
                        name = fullName1
                    End If
                    If (Not str6 Is Nothing) Then
                        name = (str6 & "." & name)
                    End If
                End If
                Exit Select
        End Select
        If (Not arraySuffixAndElementType Is Nothing) Then
            name = (name & arraySuffixAndElementType)
        End If
        Return name
    End Function
    Friend Shared Function IsGenericParameter(ByVal Type As Type) As Boolean
        Return Type.IsGenericParameter
    End Function
    Private Shared Function GetArraySuffixAndElementType(ByRef typ As Type) As String
        If Not typ.IsArray Then
            Return Nothing
        End If
        Dim builder As New System.Text.StringBuilder
        Do
            builder.Append("(")
            builder.Append(","c, (typ.GetArrayRank - 1))
            builder.Append(")")
            typ = typ.GetElementType
        Loop While typ.IsArray
        Return builder.ToString
    End Function
    Private Shared Function GetGenericArgsSuffix(ByVal typ As Type) As String
        If Not typ.IsGenericType Then
            Return Nothing
        End If
        Dim genericArguments As Type() = typ.GetGenericArguments
        Dim length As Integer = genericArguments.Length
        Dim num2 As Integer = length
        If (typ.IsNested AndAlso typ.DeclaringType.IsGenericType) Then
            num2 = (num2 - typ.DeclaringType.GetGenericArguments.Length)
        End If
        If (num2 = 0) Then
            Return Nothing
        End If
        Dim builder As New System.Text.StringBuilder
        builder.Append("(Of ")
        Dim num4 As Integer = (length - 1)
        Dim i As Integer = (length - num2)
        Do While (i <= num4)
            builder.Append(VBFriendlyNameOfType(genericArguments(i), False))
            If (i <> (length - 1)) Then
                builder.Append(","c)
            End If
            i += 1
        Loop
        builder.Append(")")
        Return builder.ToString
    End Function


End Class

VB関数を分解してみる試み

Beep 関数

Asc 関数

AppActivate 関数