コミュニティでの活動の履歴として、自身(Orator/魔界の仮面弁士)が掲示板・Mailing List・Newsgroup等へ発言した内容の中で、再利用できそうな物を拾い出して、掲載しています。

セキュリティ情報検索 / 2010年09月29日(水)
http://www.microsoft.com/japan/technet/security/current.aspx
上記ページの中段に、「サポート技術情報 (KB) から検索」という項目がありますが、数字6桁で無いとエラーになります。


しかし実際には、KB2418042KB2416473 のように非6桁な項目も存在しているため、このままでは一部のKBを検索することができません。

この場合、IE のアドレスバーに以下の呪文を打ち込むことで、7桁コードな 「2418042」や「2416473」も調べられるようになります。
javascript:alert(searchControl_RegExKBQNumber.validationexpression="^\\s*[qQ]?(\\d{5,7})\\s*$")

検索後に赤文字警告は表示されますが、検索結果には該当データの一覧が表示されます。
そのうち修正される事を期待していますが…現状は上記の方法で凌ぐことができそうです。
 
 続きを読む...  
Posted at 10:24 / 雑記 / この記事のURL
コメント(0)
[.NET]イベント付きCOMオブジェクトの解放 / 2009年07月28日(火)

VB.NET から イベント付き COM オブジェクトを扱う場合の注意点として覚書。

KB317109KB306682 などでは、使用した COM オブジェクトの後始末として、Marshal.ReleaseComObject( object ) の呼び出しと、Nothing の代入コードが紹介されています。

それ自体は間違いでは無いのですが、その変数がイベントを受け取るコードであった場合には要注意です。

たとえば下記を実行すると、フォーム終了時の Nothing 代入の時点で、[TargetInvocationException]が発生します。


Imports Excel = Microsoft.Office.Interop.Excel
Imports System.Runtime.InteropServices
Public Class Form1
  Private WithEvents xlApp As Excel.Application

  Private Sub Form1_FormClosing(sender As Object, e As FormClosingEventArgs) Handles Me.FormClosing
    If xlApp IsNot Nothing Then
      'xlApp.Quit()
      If Marshal.IsComObject(xlApp) Then
        Marshal.ReleaseComObject(xlApp)
      End If
      xlApp = Nothing    '★
    End If
  End Sub

  Private Sub Form1_Load(sender As Object, e As EventArgs) Handles Me.Load
    xlApp = New Excel.ApplicationClass()
    xlApp.Visible = True
  End Sub

  Private Sub xlApp_NewWorkbook(Wb As Excel.Workbook) Handles xlApp.NewWorkbook
    MsgBox("新しいブック")
  End Sub
End Class

このエラーは、Handles xlApp.NewWorkbok の部分が原因で引き起こされています。COM オブジェクトに対する Handles 句を削ってしまえば、Nothing を代入してもエラーは発生しません。

Private Sub xlApp_NewWorkbook(Wb As Excel.Workbook)  'Handles xlApp.NewWorkbook
  MsgBox("新しいブック")
End Sub

しかし、そのままだとイベントが使えません。そのため、AddHandler を使う方法に切り替えます。

このようにしておけば、Marshal.ReleaseComObject 後の Nothing 代入がエラーになる事もありません。

'Private WithEvents xlApp As Excel.Application
Private xlApp As Excel.Application
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles Me.Load
    xlApp = New Excel.ApplicationClass()
    AddHandler xlApp.NewWorkbook, AddressOf xlApp_NewWorkbook    
    xlApp.Visible = True
End Sub
 
   
Posted at 00:42 / .NET / この記事のURL
コメント(0)
[VB6]漢数字ゼロをクリアできない…? / 2009年01月30日(金)
Private Sub Form_Load()
    Label1.Caption = "〇"
End Sub

Private Sub Command1_Click()
    Label1.Caption = ""
    MsgBox Label1.Caption    ’本来は空文字になるはず…。
End Sub
VB6/SP6 にて上記のコードを実行したところ、ラベルがクリアされないという不具合が発生する可能性があります。原因不明。
この現象は、漢数字ゼロ「〇」の時には再現しますが、一度、別の文字列を割り当ててからクリアする分には正常動作します。google で探すと、同様の現象を確認している人が他にもいるようなので、当方だけの問題では無さそうです。
手元の環境で確認したところ、以下のような状況でした。OS 依存なのかどうかはまだ分かりませんけれども。

《ラベルがクリアされず、〇が表示される環境》
  • Windows XP Professional(x86) Service Pack 3
《正常にラベルがクリアされる環境》
  • Windows Vista Business (x64) Service Pack 1
 
   
Posted at 03:42 / Visual Basic / この記事のURL
コメント(0)
[VB6]IE7の履歴を削除 / 2009年01月09日(金)

インターネット キャッシュを削除します。IE7以降が対象です。


Option Explicit

Private Enum TargetHistory
    CLEAR_ALL = &HFF&
    CLEAR_ALL_WITH_ADDONS = &H10FF&
    CLEAR_HISTORY = &H1&
    CLEAR_COOKIES = &H2&
    CLEAR_TEMPORARY_INTERNET_FILES = &H8&
    CLEAR_FORM_DATA = &H10&
    CLEAR_PASSWORDS = &H20&
End Enum

Private Declare Function ClearMyTracksByProcessW Lib "InetCpl.cpl" _
   (ByVal hwnd As OLE_HANDLE, _
    ByVal hinst As OLE_HANDLE, _
    ByRef lpszCmdLine As Byte, _
    ByVal nCmdShow As VbAppWinStyle) As Long

Private Sub Command1_Click()
    Dim b() As Byte
    Dim o As OptionButton
    For Each o In Option1
        If o.Value Then
            b = o.Tag
            ClearMyTracksByProcessW Me.hwnd, App.hInstance, b(0), vbNormalFocus
            Exit For
        End If
    Next
End Sub

Private Sub Form_Load()
    Command1.Caption = "削除"

    Option1(0).Caption = "インターネット一時ファイル"
    Option1(0).Tag = CStr(CLEAR_TEMPORARY_INTERNET_FILES)

    Option1(1).Caption = "Cookie"
    Option1(1).Tag = CStr(CLEAR_COOKIES)

    Option1(2).Caption = "履歴"
    Option1(2).Tag = CStr(CLEAR_HISTORY)

    Option1(3).Caption = "フォーム データ"
    Option1(3).Tag = CStr(CLEAR_HISTORY)

    Option1(4).Caption = "パスワード"
    Option1(4).Tag = CStr(CLEAR_PASSWORDS)

    Option1(5).Caption = "すべて削除"
    Option1(5).Tag = CStr(CLEAR_ALL)

    Option1(2).Value = True
End Sub
 
   
Posted at 02:22 / Visual Basic / この記事のURL
コメント(0)
[WHS]AutoExit のインストール / 2008年10月24日(金)
Windows Home Server 用のアドイン、[AutoExit 2008 R2]をインストールしようとしてハマったので、そのときの手順を記載しておきます。


最初に、ダウンロードしたアドイン(aeshs2008r2.msi)を、『\\homeserver\ソフトウェア\Add-Ins\』フォルダに放り込みます。


次に、Home Server コンソールに移動して、「設定」画面から[アドイン]タブを開き、画面右側の「使用可能」のタブからAutoExit を選んでインストールします。
(下記はインストール後に撮影したもの)


コンソールの再起動が行われ、AutoExit のアイコンが登録されます。


通常は、これだけで利用開始できるようなのですが…当方では期待動作しませんでした。

実際に利用するため、AutoExit の右クリックメニューから、コンピュータの[Sleep]や[Send message]を呼び出してみましたが、何も起きません。


どうやら追加で、クライアント側にもソフトのインストールが必要になるようです。
日本語版のHome Server だと、クライアントソフトがうまく展開されない(?)らしく、手動で展開が必要なのだとか。

そこで先ほどの msi ファイルから、クライアントソフトを取り出します。
まずは適当なローカルフォルダに、先ほどの aewhs2008r2.msi をコピーしておきます。
(例: C:\work\ )


次に、[Win]+[R]キーにて「ファイル名を指定して実行」画面を開き、以下のコマンドを指定。

『 msiexec /a "C:\work\aewhs2008r2.msi" targetdir="C:\work\files\" /qn 』

すると、msi の中にあるファイルが、targetdir で指定したフォルダに展開されます。


その中の Shares_Logiciel フォルダに、autoexitclient.exe というファイルが展開されます。
なお他のフォルダにも同名のファイルが展開されますが、これらは同じバイナリのようです。
(MD5 ハッシュ = 3BFD215D7803DBF0FB1450F7E707FD8A )


取り出したautoexitclient.exe をクライアントPC 上でインストールすると、タスクトレイに AutoExit WHS Client というアイコンが現れます。


これでようやくクライアント側も準備完了。
Home Server コンソールから、このPC を [Shutdown] や [Sleep] させられるようになります。
 
   
Posted at 03:07 / Home Server / この記事のURL
コメント(0)
[VB2005]WebBrowser上のスクリプト ダイアログを制御する / 2008年10月05日(日)

HTMLページ上に表示される、メッセージボックスを制御するサンプルです。

JavaScript 等から alert、confirm、prompt を呼び出していたり、あるいは VBScript で MsgBox を呼び出しているサイト等が対象となります。


[10/05/2008]VBレスキュー(VB.NET用掲示板)

ソースは、下記からダウンロードして下さい。

http://www.vb-user.net/junk/replySamples/2008.10.05.13.35/8274.zip


メッセージの表示をカスタマイズするには、WebBrowser コントロールのホストが、IDocHostShowUI::ShowMessageを実装してやる必要があります。

そして今回のサンプルでは、IDocHostShowUI インターフェイスを実装した独自クラス WebBrowserController を作成しています。

これは、メッセージが表示されるタイミングで ShowMessage というイベントが発生するよう実装させてあり、下記のようにして利用することができます。

Private Sub WebBrowerCtrl_ShowMessage(ByVal sender As Object, ByVal e As WebBrowserController.ShowMessageEventArgs) Handles WebBrowerCtrl.ShowMessage
	' 任意のメッセージに差し替えたり、メッセージそのものを非表示にしても OK。
	Dim ret As MsgBoxResult = MsgBox(e.Text, e.Type, e.Caption)

	' メッセージボックスで押されたボタンを返す。
	e.Result = ret

	' 標準のダイアログを表示させないなら True、表示させるなら False
	e.Handled = True
End Sub
 
   
Posted at 18:05 / .NET / この記事のURL
コメント(0)
Access2007 へのバージョンアップ作業 / 2008年09月18日(木)

MDB ファイルを操作する VB6 製プログラムを、Access 2007 の accdb 形式に対応させたいという質問があったので、その時にまとめた資料です。

各原典へのリンクも貼りたかったのですが、Access の開発者向けヘルプには記述があっても、Web 上には記載されているところが見当たらなかったので、リンクを断念…。


[09/18/2008]Programming Library(VB掲示板)

  • 《Access の UI を併用する場合》

    1. データベース ウィンドウが無くなりました。代わりに、ナビゲーション ウィンドウが採用されています。操作感が異なるので、ユーザー向けにマニュアル等を作成していた場合、その内容を見直す必要があるかと思います。
    2. ご存知の通り、Office のツールバー(CommandBar)が、リボンに変更されました。CommandBar とはバーのサイズが異なるため、Access 側のフォーム等を用いていた場合、利用可能な画面領域に差が生じるため、画面デザインの見直しが必要になる可能性があります。
    3. メニュー項目が変更されているため、SendKeys によるメニュー制御は見直しが必要です。
    4. DoCmd.DoMenuItem メソッドへの変更はありません。従来の acMenuVer70 等のコードはそのまま利用できます。ただし、2007 のメニューを DoMenuItem で操作する事はできません。
  • 《DAO の場合》

    1. 参照設定するライブラリが、DAO360.DLL から ACEDAO.DLL に変更になります。
    2. 新機能サポートのため、ComplexType/Field2/Recordset2 という型が追加されました。
    3. ODBCDirect ワークスペースがサポートされなくなりました。この機能を用いたコードは、RDO 2.0 や ADO を用いたコードに置き換える必要があります。
    4. Jet ワークスペースからの ODBC 接続や ODBC パススルーは、引き続き利用可能です。
  • 《ADO の場合》

    1. ADO は、2.5 以上のバージョンを参照してください。
    2. 使用するOLE DB Provider の名前は、"Microsoft.JET.OLEDB.4.0" ではなく、"Microsoft.ACE.OLEDB.12.0" となります。
    3. 今のところ、JET 4.0 用 JetOLEDBConstants に替わる ACE 12 対応版の定数定義は見当たりませんが、MDAC 2.5 SDK / Windows DAC 6.0 SDK で定義される定数群は、accdb でも引き続き利用可能なようです。(なお、"Jet OLEDB:Engine Type" プロパティは *.accdb では「6」を返します)
  • 《文書化されていない開発者向け機能について》

    1. DAO の ISAMStats メソッドや、ADO の"Jet OLEDB:Reset ISAM Stats" プロパティは、引き続き利用可能です。
    2. ShowPlan の設定箇所が変更になっているようです。従来、JETSHOWPLAN=ON の設定箇所は HKLM\SOFTWARE\Microsoft\Jet\4.0\Engines\Debug のレジストリキーでしたが、2007 では HKLM\SOFTWARE\Microsoft\Office\12.0\Access\Access Connectivity Engine\Debug であるとの情報を海外サイトで幾つか発見できます。(ただし当方環境では、この設定を行っても、Access 2007 では showplan.out が出力されませんでした)
  • 《その他の変更点》

    1. 外部データのインポート機能として、Microsoft SharePoint がサポートされました。
    2. エクスポートできる形式が増えています。Excel/Access/Word の 2007 形式はもちろんのこと、PDF、XPS への出力も可能となっています。SharePoint への発行も可能です。
    3. エンジン設定の既定値を格納する場所が変更になっています。従来のバージョンでは、HKLM\SOFTWARE\Microsoft\Jet\4.0\Engines のレジストリキーでしたが、2007 では HKLM\SOFTWARE\Microsoft\Office\12.0\Access\Access Connectivity Engine にて設定されることになります。
 
   
Posted at 18:51 / Jet/Access / この記事のURL
コメント(0)
[.NET]AxMSHFlexGridでMouseWheelイベントを実装 / 2008年02月18日(月)

「AxMshFlexGridでホイールが効かない」という質問を受けて作ったものです。VB2005を前提としたコードになっています。


[02/18/2008]VBレスキュー(VB.NET掲示板)

Partial Public Class Form1
	Public Class SampleGrid
		Inherits AxMSHierarchicalFlexGridLib.AxMSHFlexGrid
		Public Shadows Event MouseWheel As MouseEventHandler
		Protected Overrides Sub OnMouseWheel(ByVal e As MouseEventArgs)
			RaiseEvent MouseWheel(Me, e)
			MyBase.OnMouseWheel(e)
		End Sub
	End Class

	Private WithEvents AxMSHFlexGrid1 As SampleGrid
	Private Sub Form1_Load(ByVal sender As System.Object, _
	  ByVal e As System.EventArgs) Handles MyBase.Load
		AxMSHFlexGrid1 = New SampleGrid()
		AxMSHFlexGrid1.Dock = DockStyle.Fill
		Controls.Add(AxMSHFlexGrid1)

		FillSampleData(AxMSHFlexGrid1)
	End Sub

	Private Sub AxMSHFlexGrid1_MouseWheel(ByVal sender As Object, _
	  ByVal e As MouseEventArgs) Handles AxMSHFlexGrid1.MouseWheel
		Dim row As Integer = AxMSHFlexGrid1.TopRow - _
			(e.Delta \ SystemInformation.MouseWheelScrollDelta)
		If row < AxMSHFlexGrid1.FixedRows Then
			row = AxMSHFlexGrid1.FixedRows
		ElseIf row > AxMSHFlexGrid1.Rows - 1 Then
			row = AxMSHFlexGrid1.Rows - 1
		End If
		AxMSHFlexGrid1.TopRow = row
	End Sub

	Private Shared Sub FillSampleData( _
	  ByVal grid As AxMSHierarchicalFlexGridLib.AxMSHFlexGrid)
		With grid
			.Rows = 200
			'.Cols = 20
			.set_Cols(20)
			Dim Cells As New System.Text.StringBuilder()
			For row As Integer = 0 To 199
				For col As Integer = 0 To 19
					Cells.Append(String.Format("{0,3}-{1,3}", row, col))
					Cells.Append(vbTab)
				Next
				Cells.AppendLine()
			Next
			.Row = 0
			.Col = 0
			.RowSel = 199
			.ColSel = 19
			.Clip = Cells.ToString()
			.RowSel = 0
			.ColSel = 0
		End With
	End Sub
End Class
 
   
Posted at 22:02 / .NET / この記事のURL
コメント(0)
[VB6]列番号をExcelの列名形式に変更 / 2008年02月16日(土)

自然数を、Excel の(A1方式の)列名に変更するサンプルです。


幾つかのサイトで同様の物を見つけたのですが、「702列目(ZZ)」までは正常なのに、「703列目(AAA)」以上になると、正しい結果を返さない物が目立っていたので、作ってみました。

Public Function GetColumnName(ByVal ColIndex As Long) As String
	Const KEY As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
	Dim length As Long
	length = Len(KEY)

	Dim num As Long, keta As Long, n As Long
	num = ColIndex
	n = 1
	Do Until num < n
		num = num - n
		n = n * length
		keta = keta + 1
	Loop

	Dim i As Long
	For i = 1 To keta
		n = n \ length
		GetColumnName = GetColumnName & Mid(KEY, (num \ n) + 1, 1)
		num = num Mod n
	Next
End Function
 
 続きを読む...  
Posted at 18:15 / Visual Basic / この記事のURL
コメント(1)
[VB6]USBメモリ等が接続されたことを知る方法 / 2008年02月12日(火)

USBメモリが接続されたことを知る方法が無いか、という質問を受けたので、作ってみました。

正確には USB メモリだけでなく、リムーバブルディスク全般の挿入/取り外しの通知が取得されます。


フォームに、ListBoxコントロール(List1)とシステム情報コントロール(SysInfo1)を貼っておいてください。

Option Explicit

Private Enum DriveType
	Unknown = 0   '不明
	Removable = 1 'リムーバブル ディスク
	Fixed = 2     'ハード ディスク
	Remote = 3    'ネットワーク ドライブ
	CDROM = 4     '光学ドライブ
	RAMDisk = 5   'RAMディスク
End Enum

Private Const DBT_DEVTYP_VOLUME As Long = &H2&
Private Const DBTF_MEDIA As Long = &H1&
	
Private Sub SysInfo1_DeviceArrival(ByVal DeviceType As Long, ByVal DeviceID As Long, ByVal DeviceName As String, ByVal DeviceData As Long)
	Dim drives() As String
	drives = GetChangedDrives(DeviceType, DeviceID, DeviceData)

	If LBound(drives) <= UBound(drives) Then
		Dim msg As String
		msg = Format(Time, "hh:mm:ss") & vbTab
		msg = msg & Join(drives, ",") & " が追加されました。"
		List1.AddItem msg
		List1.ListIndex = List1.NewIndex
	End If
End Sub

Private Sub SysInfo1_DeviceRemoveComplete(ByVal DeviceType As Long, ByVal DeviceID As Long, ByVal DeviceName As String, ByVal DeviceData As Long)
	Dim drives() As String
	drives = GetChangedDrives(DeviceType, DeviceID, DeviceData, False)

	If LBound(drives) <= UBound(drives) Then
		Dim msg As String
		msg = Format(Time, "hh:mm:ss") & vbTab
		msg = msg & Join(drives, ",") & " が削除されました。"
		List1.AddItem msg
		List1.ListIndex = List1.NewIndex
	End If
End Sub

Private Function GetChangedDrives(ByVal DeviceType As Long, ByVal DeviceID As Long, ByVal DeviceData As Long, Optional RemovableOnly As Boolean = True) As String()
	GetChangedDrives = Split("")
	
	'デバイス種類が論理ボリュームか調べる
	If DeviceType <> DBT_DEVTYP_VOLUME Then
		Exit Function
	End If
	
	Dim dbcv_unitmask As Long
	dbcv_unitmask = DeviceID
	Dim dbcv_flags As Long
	dbcv_flags = DeviceData
		
	' メディアフラグを調べる
	If dbcv_flags = DBTF_MEDIA Then
		Exit Function   'CD-ROM挿入
	End If

	Dim list As Object
	Set list = CreateObject("Scripting.Dictionary")

	' 得られたドライブを調べる
	Dim drv As Variant
	For Each drv In GetDrivesFromMask(dbcv_unitmask)
		If RemovableOnly = False Then
			list(drv) = drv
		ElseIf IsRemovableDrive(drv) Then
			list(drv) = drv
		End If
	Next
	
	If list.Count > 0 Then
		Dim sDrives() As String
		Dim vDrives() As Variant
		vDrives = list.Keys()
		ReDim sDrives(0 To list.Count - 1)
		Dim d As Integer
		For d = 0 To list.Count - 1
			sDrives(d) = CStr(vDrives(d))
		Next
		GetChangedDrives = sDrives
	End If
End Function

Private Function GetDrivesFromMask(ByVal unitmask As Long) As Variant()
	Dim list As Object
	Set list = CreateObject("Scripting.Dictionary")
	
	Dim mask As Long
	mask = unitmask
	
	Dim i As Integer
	For i = 0 To 25
		If (mask And 1) = 1 Then
			list(Chr(i + Asc("A")) & ":") = True
		End If
		mask = (mask \ 2)
	Next
	
	GetDrivesFromMask = list.Keys()
End Function

Private Function IsRemovableDrive(ByVal drive As String) As Boolean
	IsRemovableDrive = False

	Dim fso As Object
	Set fso = CreateObject("Scripting.FileSystemObject")
	If fso.DriveExists(drive) Then
		Dim d As Object
		Set d = fso.GetDrive(drive)
		If d.DriveType = DriveType.Removable Then
			IsRemovableDrive = True
		End If
	End If
End Function
 
 続きを読む...  
Posted at 15:14 / Visual Basic / この記事のURL
コメント(1)
P R

Microsoft Most Valuable Professional, Visual Developer - Visual BasicMSMVP for Visual Basic

  | 次へ  
 
Global Media Online INC.