ひさびさのぶろぐ投稿です。
皆様、お元気でしょうか。ワタシはまた入院していましたw
VB.NET には過去との互換性の目的も含めて(たぶん)言語固有の関数があります。
それらを VB 関数ではなく、.NET で実装してみようという試みです。
(ほとんど Reflector のお世話になりっぱだと思いますがw)
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