仮想プリンタの並列化

Class1.vb

''' 仮想プリンタ名称を取得する
Public Function GfnGetPdfPrinterName() As String
    Dim LobjPrinter As Object
    Dim LstrCommand As String
    
    Set LobjPrinter = CreateObject("Bullzip.PDFPrinterSettings")
    
    LobjPrinter.SetPrinterName "Bullzip PDF Printer2"
    
    GfnGetPdfPrinterName = LobjPrinter.GetPrinterName
    
    Set LobjPrinter = Nothing
End Function

'------------------------------------------------------------------------------
'GfnGetPrinters
'- プリンタ名を列挙
'
'PstrPrinters()
'- 取得したプリンタを格納する配列
'
'Returns
'- 取得件数
'- PstrPrintersに取得したプリンタ名をセット
'------------------------------------------------------------------------------
Public Function GfnGetPrinters(ByRef PstrPrinters() As String) As Long
    Dim LlngCount As Long
    Dim LobjPrinter As Printer
    
    LlngCount = 0
    
    For Each LobjPrinter In Printers
        ReDim Preserve PstrPrinters(0 To LlngCount)
        PstrPrinters(LlngCount) = LobjPrinter.DeviceName
        LlngCount = LlngCount + 1
    Next

    GfnGetPrinters = LlngCount - 1

    Set LobjPrinter = Nothing
End Function

'------------------------------------------------------------------------------
'GsbEnumWindowText
'- Window Textを列挙する
'
'PstrWindowText()
'- 取得したWindowTextを格納する配列
'
'PstrCaptionPrefix
'- 取得対象とするWindowText (前方一致)
'
'Returns
'- 取得件数
'- PstrWindowTextに取得結果をセット
'------------------------------------------------------------------------------
Public Function GfnEnumWindowText(ByRef PstrWindowText() As String, _
                                  ByVal PstrCaptionPrefix As String) As Long
    Static LlngHandles() As Long
    Static LstrTitles() As String
    Static LlngProcessId() As Long
    Dim LlngResult As Long
    Dim LlngIndex As Long
    Dim LlngCount As Long
    
    ' すべてのWindowから指定された文字列を含むWindowを取得
    LlngResult = FindWindowLike(LlngHandles, LstrTitles, LlngProcessId, 0, PstrCaptionPrefix & "*")
    
    LlngCount = 0
    For LlngIndex = 0 To UBound(LlngHandles)
        If LlngHandles(LlngIndex) <> 0 Then
            ReDim Preserve PstrWindowText(0 To LlngCount)
            PstrWindowText(LlngCount) = LstrTitles(LlngIndex)
            LlngCount = LlngCount + 1
        End If
    Next
    
    GfnEnumWindowText = LlngCount - 1
End Function

'------------------------------------------------------------------------------
'GfnWindowText
'- 自分自身のWindowTextを取得する
'------------------------------------------------------------------------------
Public Function GfnWindowText() As String
    GfnWindowText = GetWindowTitle()
End Function

Form1.vb

' フォーム名の接頭語
Const CAPTION_PREFIX = "Form1"
' 区切り文字
Const CAPTION_SEPARATOR = ":"

Private Sub Form_Load()
    Label1.Caption = CAPTION_PREFIX & CAPTION_SEPARATOR
End Sub

' フォームのキャプション設定
Private Sub Command2_Click()
    Me.Caption = CAPTION_PREFIX & CAPTION_SEPARATOR & Text1.Text
End Sub

' プリンタ情報、Windowの列挙
Private Sub Command1_Click()
    Dim LobjPrinter As Class1
    Dim LstrPrinters() As String
    Dim LstrTitles() As String
    Dim LlngResult As Long
    Dim LstrTemp As String
    Dim LstrLines As String
    Dim LlngIndex As Long
    
    Set LobjPrinter = New Class1
    
    ' プリンタを列挙する
    LlngResult = LobjPrinter.GfnGetPrinters(LstrPrinters)
    
    LstrLines = "プリンター:"
    For LlngIndex = 0 To UBound(LstrPrinters)
        If LstrPrinters(LlngIndex) <> "" Then
            LstrLines = LstrLines & vbCrLf & "    " & LstrPrinters(LlngIndex)
        End If
    Next
    
    ' WindowTextを列挙
    LlngResult = LobjPrinter.GfnEnumWindowText(LstrTitles, CAPTION_PREFIX)
    
    LstrLines = LstrLines & vbCrLf & "WindowText:"
    For LlngIndex = 0 To UBound(LstrTitles)
        If LstrTitles(LlngIndex) <> "" Then
            LstrLines = LstrLines & vbCrLf & "    " & LstrTitles(LlngIndex)
        End If
    Next
    
    ' 自分のWindow Textを取得
    LstrTemp = LobjPrinter.GfnWindowText()
    LstrLines = LstrLines & vbCrLf & "MyCaption: " & LstrTemp
    
    Text2.Text = LstrLines
End Sub

Module1.vb

Option Explicit

Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Declare Function GetDesktopWindow Lib "user32" () As Long
Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long
Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
Declare Function GetWindowLW Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwprocessid As Long) As Long
Declare Function SetFocusAPI Lib "user32" Alias "SetForegroundWindow" (ByVal hWnd As Long) As Long

Declare Function GetCurrentProcessId Lib "kernel32" () As Long

Public Const GWL_ID = (-12)
Public Const GW_HWNDNEXT = 2
Public Const GW_CHILD = 5

'----------------------------------------------------------------------
'[How To Get a Window Handle Without Specifying an Exact Title](http://support.microsoft.com/kb/147659/ja)
'
'FindWindowLike
' - Finds the window handles of the windows matching the specified parameters
'
'PlngWindowHandles()
' - An integer array used to return the window handles
'
'PlngProcessIDs()
' - process id of the window
'
'PlngHandleStart
' - The handle of the window to search under.
' - The routine searches through all of this window's children and their
'   children recursively.
' - If PlngHandleStart = 0 then the routine searches through all windows.
'
'PstrWindowText
' - The pattern used with the Like operator to compare window's text.
'
'Returns
' - The number of windows that matched the parameters.
' - Also returns the window handles in PlngWindowHandles()
'   and the window text in PstrWindowTexts()
'   and the process id in PlngProcessIDs()
'
'----------------------------------------------------------------------
Function FindWindowLike(ByRef PlngWindowHandles() As Long, _
                        ByRef PstrWindowTexts() As String, _
                        ByRef PlngProcessIDs() As Long, _
                        ByVal PlngHandleStart As Long, _
                        ByVal PstrWindowText As String) As Long
                        
    Dim LlngWindowHandle As Long
    Dim LlngResult As Long
    ' Hold the level of recursion:
    Static LlngLevel As Long
    ' Hold the number of matching windows:
    Static LlngFound As Long
    Dim LstrWindowText As String
    Dim LlngProcessId As Long
    
    ' Initialize if necessary:
    If PlngHandleStart = 0 Then
        LlngLevel = 0
        ReDim PlngWindowHandles(0 To 0)
        ReDim PstrWindowTexts(0 To 0)
        ReDim PlngProcessIDs(0 To 0)
        If PlngHandleStart = 0 Then
            PlngHandleStart = GetDesktopWindow()
        End If
    End If
    
    ' Increase recursion counter:
    LlngLevel = LlngLevel + 1
    ' Get first child window:
    LlngWindowHandle = GetWindow(PlngHandleStart, GW_CHILD)
    
    Do Until LlngWindowHandle = 0
        ' Search children by recursion:
        LlngResult = FindWindowLike(PlngWindowHandles, _
                                    PstrWindowTexts, _
                                    PlngProcessIDs, _
                                    LlngWindowHandle, _
                                    PstrWindowText)
        
        ' Get the window text:
        LstrWindowText = Space(255)
        LlngResult = GetWindowText(LlngWindowHandle, LstrWindowText, 255)
        LstrWindowText = Left(LstrWindowText, LlngResult)
        
        ' Get ProcessID
        LlngProcessId = ProcIDFromWnd(LlngWindowHandle)
        
        ' Check that window matches the search parameters:
        If LstrWindowText Like PstrWindowText Then
            LlngLevel = LlngLevel + 1
            ReDim Preserve PlngWindowHandles(0 To LlngLevel)
            ReDim Preserve PstrWindowTexts(0 To LlngLevel)
            ReDim Preserve PlngProcessIDs(0 To LlngLevel)
            PlngWindowHandles(LlngLevel) = LlngWindowHandle
            PstrWindowTexts(LlngLevel) = LstrWindowText
            PlngProcessIDs(LlngLevel) = LlngProcessId
            
            'Debug.Print "Window Found: "
            'Debug.Print "  Window Text  : " & LstrWindowText
            'Debug.Print "  Window Handle: " & CStr(LlngWindowHandle)
            'Debug.Print "  Process ID: " & CStr(LlngProcessID)
        End If
        ' Get next child window:
        LlngWindowHandle = GetWindow(LlngWindowHandle, GW_HWNDNEXT)
    Loop
    ' Decrement recursion counter:
    LlngLevel = LlngLevel - 1
    ' Return the number of windows found:
    FindWindowLike = LlngLevel
End Function

'-------------------------------------------------------------------------------
'[How To Find a Window Handle from an Instance Handle](http://support.microsoft.com/kb/242308/ja)
'ProcIDFromWnd
'- Get Process ID from window handle
'-------------------------------------------------------------------------------
Private Function ProcIDFromWnd(ByVal hWnd As Long) As Long
    Dim idProc As Long

    ' Get PID for this HWnd
    GetWindowThreadProcessId hWnd, idProc

    ' Return PID
    ProcIDFromWnd = idProc
End Function


'-------------------------------------------------------------------------------
'GetWindowTitle
'- 自分自身が実行されているWindowのWindowTextを取得
'-------------------------------------------------------------------------------
Function GetWindowTitle() As String
    Dim LlngMyProcessId As Long
    Dim LlngWndHandls() As Long
    Dim LstrWndTexts() As String
    Dim LlngPrcIDs() As Long
    Dim LlngResult As Long
    Dim LlngIndex As Long
    
    ' ProcessIDを取得
    LlngMyProcessId = GetCurrentProcessId()
    
    ' Windowをすべて取得
    LlngResult = FindWindowLike(LlngWndHandls, LstrWndTexts, LlngPrcIDs, 0, "F*")
    
    ' ProcessIDが一致するWindowTextを取得
    For LlngIndex = 0 To LlngResult
        If LlngPrcIDs(LlngIndex) = LlngMyProcessId Then
            GetWindowTitle = LstrWndTexts(LlngIndex)
            Exit For
        End If
    Next
    
End Function

ToDo.md

課題

• 指定されたフォルダを監視し、ファイルが追加されたらそのファイルを読み取り、PDFに変換するVB6アプリがある。
  • PDF変換には仮想プリンタを使用している。
• 1ファイルあたりの処理時間が長いため、変換処理がいつまでも終わらない。

やりたいこと

• ひとつのPCに複数の仮想プリンタをインストールし、処理を分散することにより、変換処理の短縮を図る。

改修方針

1. そのPCにインストールされている仮想プリンタを列挙する。

• プリンタ名が 'Bullzip PDF Printer' から始まるものを取得

2. そのPCで起動中の全てのWindow Textを列挙する。

• FormのCaptionは 'Form1' から始まるようにする。
  例)「Form1:Bullzip PDF Printer」

3. 2.から使用中の仮想プリンタ名を全て取得する。
4. 1.と3.より未使用の仮想プリンタを1つ選択する。

• 未使用の仮想プリンタが存在しない場合はメッセージを表示してプログラムを終了する。

5. 4.で取得した仮想プリンタ名をFormのCaptionに設定する。

• 「Form1:Bullzip PDF Printer2」

6. WindowText (FormのCaption) に設定された仮想プリンタを使用してPDFを作成する。