Public Const strPrnDrvName As String = "Print Dummy"
 # このプリンタを直接出力専用
Public Const strPrnDocName As String = "Print Test(Escape/WritePrinter)"
 # このドキュメント名称はプリントマネージャに表示される
 # なんでも構まわない

Type DOC_INFO_1
        pDocName As String
        pOutputFile As String
        pDatatype As String
End Type

Declare Function StartDocPrinter Lib "winspool.drv"
        Alias "StartDocPrinterA" (ByVal hPrinter As Long, 
        ByVal Level As Long, pDocInfo As DOC_INFO_1) As Long
Declare Function EndDocPrinter Lib "winspool.drv"
        (ByVal hPrinter As Long) As Long
Declare Function OpenPrinter Lib "winspool.drv" Alias
        "OpenPrinterA" (ByVal pPrinterName As String, phPrinter As Long,
        pDefault As Any) As Long
Declare Function ClosePrinter Lib "winspool.drv" (ByVal hPrinter As Long)
                                                                  As Long
Declare Function WritePrinter Lib "winspool.drv" (ByVal hPrinter As Long, 
    ByVal pBuf As String, ByVal cdBuf As Long, pcWritten As Long) As Long

'========================================================
Public Function PrintWrite(strData As String) As Boolean
    On Error Resume Next

    Dim DocInfo1 As DOC_INFO_1
 # NTでは DOC_INFO_1 だが Win95では DOC_INFO_2 を用いる

    Dim intLen As Integer
    Dim hdlPrn As Long
    Dim lngWritten As Long, lngResult As Long
    Dim strPrint As String
    
    PrintWrite = True
    
    lngResult = OpenPrinter(strPrnDrvName, hdlPrn, ByVal 0&)
    If lngResult <> 0 Then
        With DocInfo1
            .pDocName = strPrnDocName
            .pOutputFile = "LPT1:"    # ← 実際に出力するポート名
            .pDatatype = vbNullString # ← Nullしか駄目
        End With
        lngResult = StartDocPrinter(hdlPrn, 1, DocInfo1)
 # Win95では StartDocPrinter(hdcPrn, 2, DocInfo2) のよう
 #  With DocInfo2
 #      .pDocName = strPrnDocName
 #      .pOutputFile = "LPT1:"      # ← 実際に出力するポート名
 #      .pDatatype = vbNullString   # ← Nullしか駄目だそうです
 #      .dwMode = DI_CHANNEL_WRITE  # ← この定数の正体が分かりません 
 #      .JobId = 0                  # ← 0 でＯＫとのことです
 #  End With

        If lngResult <> 0 Then
            strPrint = strData
            intLen = Len(strPrint)
 # VB4の32Bit版では文字列が UniCode なので LenBでなく Len を使用

            lngResult = WritePrinter(hdlPrn, strPrint, intLen, lngWritten)
            If lngResult = 0 Then PrintWrite = False
            lngResult = EndDocPrinter(hdlPrn)
            If lngResult = 0 Then PrintWrite = False
        Else
            PrintWrite = False
        End If
        lngResult = ClosePrinter(hdlPrn)
        If lngResult = 0 Then PrintWrite = False
    Else
        PrintWrite = False
    End If
    
    If Err.Number <> 0 Then
        PrintWrite = False
        'Show Errors
        ShowPCRStatus "Error Source: " & Err.Source, 
              "Procedure: << PrintWrite >>", Err.Description
    End If
End Function