systam
شنبه 28 تیر 1393, 16:37 عصر
سلام
یک قطه کد در نت پیدا کردم توی برنامه چند جاش خطا میگیره
از عنوان پست هم مشخصه میخوام اطلاعات صف چاپه ، پرینت اشتراک شده رو بدست بیارم
ممنون میشم دوستان راهنمایی کنند
Private Declare Function OpenPrinter Lib "winspool.drv" Alias "OpenPrinterA" (ByVal pPrinterName As String, ByVal phPrn As Long, ByVal pDefault As any) As Long Private Declare Function StartDocPrinter Lib "winspool.drv" Alias "StartDocPrinterA" (ByVal hPrn As Long, ByVal Level As Long, ByVal pDocInfo As DOC_INFO_1) As Long
Private Declare Function StartPagePrinter Lib "winspool.drv" (ByVal hPrn As Long) As Long
Private Declare Function WritePrinter Lib "winspool.drv" (ByVal hPrn As Long, ByVal pBuf As Any, ByVal cdBuf As Long, ByVal pcWritten As Long) As Long
Private Declare Function EndPagePrinter Lib "winspool.drv" (ByVal hPrn As Long) As Long
Private Declare Function EndDocPrinter Lib "winspool.drv" (ByVal hPrn As Long) As Long
Private Declare Function ClosePrinter Lib "winspool.drv" (ByVal hPrn As Long) As Long
Private Structure DOC_INFO_1
Dim pDocName As String
Dim pOutputFile As String
Dim pDatatype As String
End Structure
Public Sub SpoolFile(ByVal sFile As String, ByVal PrnName As String, Optional ByVal AppName As String = "")
Dim hPrn As Long
Dim Buffer() As Byte
Dim hFile As Integer
Dim Written As Long
Dim di As DOC_INFO_1
Dim i As Long
Const BufSize As Long = &H4000
' Extract filename from passed spec, and build job
' name. Fill remainder of DOC_INFO_1 structure.
If InStr(sFile, "\") Then
For i = Len(sFile) To 1 Step -1
If Mid(sFile, i, 1) = "\" Then Exit For
di.pDocName = Mid(sFile, i, 1) & di.pDocName
Next i
Else
di.pDocName = sFile
End If
If Len(AppName) Then
di.pDocName = AppName & ": " & di.pDocName
End If
di.pOutputFile = vbNullString
di.pDatatype = "RAW"
' Open printer for output to obtain handle.
' Set it up to begin recieving raw data.
Call OpenPrinter(PrnName, hPrn, vbNullString)
Call StartDocPrinter(hPrn, 1, di)
Call StartPagePrinter(hPrn)
' Open file and pump it to the printer.
hFile = FreeFile()
'Open sFile For Binary Access Read As hFile
' Read in 16K buffers and spool.
ReDim Buffer(1 To BufSize) As Byte
For i = 1 To LOF(hFile) \ BufSize
Get hFile, , Buffer
Call WritePrinter(hPrn, Buffer(1), _
BufSize, Written)
Next i
' Get last chunk of file if it doesn't
' fit evenly into a 16K buffer.
If LOF(hFile) Mod BufSize Then
ReDim Buffer(1 To (LOF(hFile) Mod BufSize)) As Byte
Get #hFile, , Buffer
Call WritePrinter(hPrn, Buffer(1), _
UBound(Buffer), Written)
End If
Close #hFile
' Shut down spooling process.
Call EndPagePrinter(hPrn)
Call EndDocPrinter(hPrn)
Call ClosePrinter(hPrn)
End Sub
فایل مقاله اش هم ضمیمه شد
یک قطه کد در نت پیدا کردم توی برنامه چند جاش خطا میگیره
از عنوان پست هم مشخصه میخوام اطلاعات صف چاپه ، پرینت اشتراک شده رو بدست بیارم
ممنون میشم دوستان راهنمایی کنند
Private Declare Function OpenPrinter Lib "winspool.drv" Alias "OpenPrinterA" (ByVal pPrinterName As String, ByVal phPrn As Long, ByVal pDefault As any) As Long Private Declare Function StartDocPrinter Lib "winspool.drv" Alias "StartDocPrinterA" (ByVal hPrn As Long, ByVal Level As Long, ByVal pDocInfo As DOC_INFO_1) As Long
Private Declare Function StartPagePrinter Lib "winspool.drv" (ByVal hPrn As Long) As Long
Private Declare Function WritePrinter Lib "winspool.drv" (ByVal hPrn As Long, ByVal pBuf As Any, ByVal cdBuf As Long, ByVal pcWritten As Long) As Long
Private Declare Function EndPagePrinter Lib "winspool.drv" (ByVal hPrn As Long) As Long
Private Declare Function EndDocPrinter Lib "winspool.drv" (ByVal hPrn As Long) As Long
Private Declare Function ClosePrinter Lib "winspool.drv" (ByVal hPrn As Long) As Long
Private Structure DOC_INFO_1
Dim pDocName As String
Dim pOutputFile As String
Dim pDatatype As String
End Structure
Public Sub SpoolFile(ByVal sFile As String, ByVal PrnName As String, Optional ByVal AppName As String = "")
Dim hPrn As Long
Dim Buffer() As Byte
Dim hFile As Integer
Dim Written As Long
Dim di As DOC_INFO_1
Dim i As Long
Const BufSize As Long = &H4000
' Extract filename from passed spec, and build job
' name. Fill remainder of DOC_INFO_1 structure.
If InStr(sFile, "\") Then
For i = Len(sFile) To 1 Step -1
If Mid(sFile, i, 1) = "\" Then Exit For
di.pDocName = Mid(sFile, i, 1) & di.pDocName
Next i
Else
di.pDocName = sFile
End If
If Len(AppName) Then
di.pDocName = AppName & ": " & di.pDocName
End If
di.pOutputFile = vbNullString
di.pDatatype = "RAW"
' Open printer for output to obtain handle.
' Set it up to begin recieving raw data.
Call OpenPrinter(PrnName, hPrn, vbNullString)
Call StartDocPrinter(hPrn, 1, di)
Call StartPagePrinter(hPrn)
' Open file and pump it to the printer.
hFile = FreeFile()
'Open sFile For Binary Access Read As hFile
' Read in 16K buffers and spool.
ReDim Buffer(1 To BufSize) As Byte
For i = 1 To LOF(hFile) \ BufSize
Get hFile, , Buffer
Call WritePrinter(hPrn, Buffer(1), _
BufSize, Written)
Next i
' Get last chunk of file if it doesn't
' fit evenly into a 16K buffer.
If LOF(hFile) Mod BufSize Then
ReDim Buffer(1 To (LOF(hFile) Mod BufSize)) As Byte
Get #hFile, , Buffer
Call WritePrinter(hPrn, Buffer(1), _
UBound(Buffer), Written)
End If
Close #hFile
' Shut down spooling process.
Call EndPagePrinter(hPrn)
Call EndDocPrinter(hPrn)
Call ClosePrinter(hPrn)
End Sub
فایل مقاله اش هم ضمیمه شد