AD(ActiveDirectory)サーバにユーザ確認

AD(ActiveDirectory)サーバ上のユーザを利用したユーザ認証
（単にユーザ・パスワードが有効なのかチェックするだけw）をVB.NETでって案件。

ADサーバをLDAPサーバ扱いすれば可能なようなので。

----------------------------------------------------------------------------
        Dim aName As String
        Dim aSn As String
        Dim aGivenName As String
        Dim aDescription As String

        Try
            Dim searcher As New System.DirectoryServices.DirectorySearcher()
            'サーバーが結果を返すまでのクライアント待機時間
            searcher.ClientTimeout = New TimeSpan(500)
            'サーバーが検索するための制限時間
            searcher.ServerTimeLimit = New TimeSpan(500)
            'サーバーが結果のページを検索するための時間
            searcher.ServerPageTimeLimit = New TimeSpan(500)
            '検索を開始する Active Directory 階層のノード
            searcher.SearchRoot = New System.DirectoryServices.DirectoryEntry(%サーバ名%, _
                                                        %ユーザ名% & "@" & %ドメイン名%, %パスワード%)
            searcher.Filter = "(sAMAccountName=" & %ユーザ名%  & ")"
            searcher.SearchScope = System.DirectoryServices.SearchScope.Subtree
            searcher.PageSize = 512
            '姓(漢字姓),名(漢字名),部署名(説明),ユーザID
            searcher.PropertiesToLoad.AddRange(New String() {"name", _
                                                        "sn", _
                                                        "givenName", _
                                                        "description", _
                                                        "sAMAccountName"})
            Dim results As System.DirectoryServices.SearchResult = searcher.FindOne
            'name
            If results.Properties("name").Count > 0 Then
                aName = results.Properties("name").Item(0).ToString
            End If
            'sn
            If results.Properties("sn").Count > 0 Then
                aSn = results.Properties("sn").Item(0).ToString
            End If
            'GivenName
            If results.Properties("givenName").Count > 0 Then
                aGivenName = results.Properties("givenName").Item(0).ToString
            End If
            'Description
            If results.Properties("description").Count > 0 Then
                aDescription = results.Properties("description").Item(0).ToString
            End If
        Catch ex As System.DirectoryServices.DirectoryServicesCOMException
            MsgBox(ex.Message)
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try

ACCESSとVB.NETの色指定

以前、ACCESS(2003)とVB2008を使用したシステム構築の案件があったんだけど
当然、ACCESS側とVB.NETでのインターフェイス（見た目w）を統一したいと。
フォーム上の色はINIファイルから設定したいと。

で、ACCESSの色(RGB)とVB2008(ARGB)の色は形式が異なる訳で変換が必要。
例)
ACCESS-----------------------------
   me.詳細.BackColor = %指定色%

VB2008------------------------------
  Dim cl As New Color
  cl = ColorTranslator.FromWin32(%指定色%)
  me.BackColor = cl

案件がぁ

１１月中旬から予定していた案件が潰れたぁ。

また、案件を探さないと。
受注先を増やさんと駄目かな・・・・

ほとんどサラリーマン時代の繋がりだからなぁ

VB.NETからCD-Rにデータ書込み

先日、PGのリプレースを依頼された。
PGは単純なんだけど、現状FDに出力するファイルをCD-Rに出力して欲しいと。

結構めんどくさいw
単純にCD-RドライブにCOPYって訳にもいかないようだし。

で、定番 ググってみた。
IMAPI2 なるAPIがあるようだ。（対象がWin7でVB2010だったから)

ただほとんどの情報は英語。まあ仕方ない。
無い頭を無理やり使って意訳w

で、出来たのが次のソース。
かなり簡略化してコメントもアバウト。
エラー処理などほぼ無視w
--------------------------------------------------------
参照  COM
  IMAPI2
  IMAPI2FS
--------------------------------------------------------
'CD-R書込み関連参照設定
Imports IMAPI2
Imports IMAPI2FS
Imports System.Runtime.InteropServices
Module modX
    Public Function fncBURNdata() As Boolean
        Dim bRet As Boolean = False
        Dim sRecorderId As String = String.Empty            'RecorderID
        Dim objDiscMaster As IMAPI2.MsftDiscMaster2 = Nothing   'DiscMaster2 Object connects
        Dim objRecorder As IMAPI2.MsftDiscRecorder2 = Nothing   'Recorder for BURNing device
        Dim DataWriter As IMAPI2.MsftDiscFormat2Data = Nothing  '
        Dim BurnRet As IMAPI2FS.FileSystemImageResult = Nothing '
        Dim Image As IMAPI2FS.MsftFileSystemImage = Nothing     '
        Dim ImageStreem As IMAPI2.IStream = Nothing             '
        'CD-R書込み
        Try
            'デバイス検索
            objDiscMaster = New IMAPI2.MsftDiscMaster2
            sRecorderId = ""
            For Each sDev As String In objDiscMaster
                Dim objDev As New IMAPI2.MsftDiscRecorder2
                Try
                    objDev.InitializeDiscRecorder(sDev)
                    If Trim(objDev.ProductId) = %デバイス名% Then
                        sRecorderId = sDev
                        Exit For
                    End If
                Catch ex As Exception
                    Throw ex
                Finally
                    MarshalObject(objDev)
                End Try
            Next
            'デバイス決定
            objRecorder = New IMAPI2.MsftDiscRecorder2
            objRecorder.InitializeDiscRecorder(sRecorderId)
            'メディア初期化
            Dim bRetErase As Boolean = fncEraseDisc(objRecorder)
            'ISOイメージ種別指定(Longファイル名使用可能)
            Image = New IMAPI2FS.MsftFileSystemImage
            Image.FileSystemsToCreate = (FsiFileSystems.FsiFileSystemISO9660 Or
                                          FsiFileSystems.FsiFileSystemJoliet)
            'CD-Rボリューム名設定
            Image.VolumeName = %ボリューム名%
            'ISO作成元フォルダ指定
            Image.Root.AddTree(%作成元フォルダパス%, False)
            'ISOイメージ作成
            DataWriter = New IMAPI2.MsftDiscFormat2Data
            DataWriter.Recorder = objRecorder
            DataWriter.ClientName = %本PG名%
            DataWriter.ForceMediaToBeClosed = True
            BurnRet = Image.CreateResultImage()
            'ISOイメージ書込み
            ImageStreem = DirectCast(BurnRet.ImageStream, IMAPI2.IStream)
            DataWriter.Write(ImageStreem)
            'メディア取り出し
            objRecorder.EjectMedia()
        Catch ex As System.Runtime.InteropServices.COMException
            '書込みエラー
            MsgBox(ex.Message ,
                   MsgBoxStyle.OkOnly Or MsgBoxStyle.Exclamation,
                   "エラー")
            bRet = False
        Catch ex As Exception
            '書込みエラー
            MsgBox(ex.Message ,
                   MsgBoxStyle.OkOnly Or MsgBoxStyle.Exclamation,
                   "エラー")
            bRet = False
        Finally
            '各ＣＯＭオブジェクト開放
            MarshalObject(ImageStreem)
            MarshalObject(BurnRet)
            MarshalObject(DataWriter)
            MarshalObject(Image)
            MarshalObject(objRecorder)
            MarshalObject(objDiscMaster)
        End Try
        Return bRet
    End Function
    Private Sub MarshalObject(ByVal obj As Object)
        Try
            If (Not obj Is Nothing) AndAlso (Marshal.IsComObject(obj)) Then
                Marshal.ReleaseComObject(obj)
            End If
        Catch ex As Exception
        Finally
            obj = Nothing
        End Try
    End Sub

    Public Function fncEraseDisc(ByVal Recorder As IMAPI2.MsftDiscRecorder2) As Boolean
        Dim Format As New IMAPI2.MsftDiscFormat2Erase
        Try
            Format.Recorder = Recorder
            If Not Format.IsCurrentMediaSupported(Recorder) Then
                Return False
            End If
            Format.ClientName = %本PG名%
            Format.EraseMedia()
        Catch ex As Exception
            'ここでのエラーはひとまず無視
        Finally
            'ＣＯＭオブジェクト開放
            MarshalObject(Format)
        End Try
        Return True
    End Function
End Module
--------------------------------------------------------
そうそうXP等で動かす時はIMAPI2をインストールする必要がある。
Win7は何も必要ないけど
XPだとIMAPI2をMSからダウンロードしてインストールしてね。
%～%は各環境に合わせれば良いと思います^^;

SqlServer2005 インストール時チェックエラー

以前、SqlServer2005で開発環境作成時にシステム構成チェッカーで再起動しろとのメッセージ。
何度再起動掛けてもエラー…

で、SqlServer2000で同様の記事をMSで発見(アドレスは忘れたw)
どうやらレジストリにゴミが残っていて、再起動後実行ファイル?の指定が削除不可能の状態らしい。

解決策は
 レジストリエディタで
  HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Session Manager
    PendingFileRenameOperations
 を削除すれば良いらしい。
 (必要ならばControlSet001,ControlSet002も同様に確認)

 けっこう情報が無くて半日は悩んだ記憶が・・・・

技術情報を思いつくまま書き込みw

基本的には自分のメモ代わりなんで… USO800 はごめん。