Something like this (but as I said not tested)
#define JOB_CONTROL_PAUSE 1
#define JOB_CONTROL_RESUME 2
#define JOB_CONTROL_CANCEL 3
#define JOB_CONTROL_RESTART 4
#define JOB_CONTROL_DELETE 5
PUBLIC oform1
oform1=NEWOBJECT("form1")
oform1.Show
READ EVENTS
RETURN
DEFINE CLASS form1 AS form
Top = 0
Left = 0
Height = 412
Width = 504
DoCreate = .T.
Caption = "Form1"
Name = "Form1"
DIMENSION editarray[1,3]
ADD OBJECT list1 AS listbox WITH ;
ColumnCount = 3, ;
ColumnWidths = "30,200", ;
RowSourceType = 5, ;
RowSource = "thisform.editarray", ;
Value = 0, ;
ControlSource = "", ;
Height = 323, ;
Left = 5, ;
Top = 51, ;
Width = 492, ;
Name = "List1"
ADD OBJECT command1 AS commandbutton WITH ;
Top = 10, ;
Left = 20, ;
Height = 27, ;
Width = 84, ;
Caption = "Refresh", ;
Name = "Command1"
ADD OBJECT command2 AS commandbutton WITH ;
Top = 381, ;
Left = 12, ;
Height = 27, ;
Width = 84, ;
Caption = "Delete", ;
Name = "Command2"
ADD OBJECT command3 AS commandbutton WITH ;
Top = 381, ;
Left = 97, ;
Height = 27, ;
Width = 84, ;
Caption = "Pause", ;
Name = "Command3"
ADD OBJECT command4 AS commandbutton WITH ;
Top = 381, ;
Left = 184, ;
Height = 27, ;
Width = 84, ;
Caption = "Resume", ;
Name = "Command4"
ADD OBJECT command5 AS commandbutton WITH ;
Top = 381, ;
Left = 273, ;
Height = 27, ;
Width = 84, ;
Caption = "Cancel", ;
Name = "Command5"
ADD OBJECT command6 AS commandbutton WITH ;
Top = 381, ;
Left = 359, ;
Height = 27, ;
Width = 84, ;
Caption = "Restart", ;
Name = "Command6"
PROCEDURE setjob
LPARAMETERS what_to_do
LOCAL nJob
DECLARE INTEGER SetJob IN winspool.drv;
INTEGER hPrinter,;
INTEGER JobId,;
INTEGER Level,;
STRING @ pJob,;
INTEGER Command
DECLARE INTEGER OpenPrinter IN winspool.drv;
STRING pPrinterName,;
INTEGER @phPrinter,;
INTEGER pDefault
nJob = thisform.List1.Value
lhPrinter = 0
IF OpenPrinter(thisform.editarray[nJob,2], @lhPrinter, 0) = 0
MESSAGEBOX("Unable to get printer handle for '" ;
+ thisform.editarray[nJob,2] + ".")
RETURN .F.
ENDIF
MESSAGEBOX(SetJob(lhPrinter,;
thisform.editarray[nJob,1],;
0,;
"",;
what_to_do))
ENDPROC
PROCEDURE Load
STORE "" TO thisform.editarray
ENDPROC
PROCEDURE command1.Click
ooo = NEWOBJECT("EnumJobs")
IF NOT ooo.GetJobList()
MESSAGEBOX("ERROR "+ooo.cErrorMessage+" "+ooo.cApiErrorMessage)
RETURN
ENDIF
FOR i=1 TO ooo.oJobList.Count
loOneJob = ooo.oJobList.Item(i)
DIMENSION thisform.editarray[i, 3]
thisform.editarray[i, 1] = loOneJob.JobId
thisform.editarray[i, 2] = loOneJob.LocalPrinterName
thisform.editarray[i, 3] = loOneJob.Document
ENDFOR
thisform.List1.Requery()
ooo = Null
ENDPROC
PROCEDURE command2.Click
thisform.SetJob(JOB_CONTROL_DELETE)
ENDPROC
PROCEDURE command3.Click
thisform.SetJob(JOB_CONTROL_PAUSE)
ENDPROC
PROCEDURE command4.Click
thisform.SetJob(JOB_CONTROL_RESUME)
ENDPROC
PROCEDURE command5.Click
thisform.SetJob(JOB_CONTROL_CANCEL)
ENDPROC
PROCEDURE command6.Click
thisform.SetJob(JOB_CONTROL_RESTART)
ENDPROC
PROCEDURE Destroy
CLEAR EVENTS
ENDPROC
ENDDEFINE
DEFINE CLASS EnumJobs AS Custom
HIDDEN hHeap
cPrinterName = ""
nApiErrorCode = 0
cApiErrorMessage = ""
cErrorMessage = ""
hHeap = 0
oJobList = Null
PROCEDURE Init()
This.oJobList = CREATEOBJECT("Collection")
This.LoadApiDlls()
This.hHeap = HeapCreate(0, 4096, 0)
This.cPrinterName = GETPRINTER()
ENDPROC
PROCEDURE Destroy
IF This.hHeap <> 0
HeapDestroy(This.hHeap)
ENDIF
ENDPROC
PROCEDURE GetJobList(tcPrinterName)
LOCAL lhPrinter, llSuccess, lnNeeded, lnNumberOfJobs, lnBuffer, i
IF PCOUNT() > 0
This.cPrinterName = tcPrinterName
ENDIF
This.ClearErrors()
lhPrinter = 0
IF OpenPrinter(This.cPrinterName, @lhPrinter, 0) = 0
This.cErrorMessage = "Unable to get printer handle for '" ;
+ This.cPrinterName + "."
This.nApiErrorCode = GetLastError()
This.cApiErrorMessage = This.ApiErrorText(This.nApiErrorCode)
RETURN .F.
ENDIF
lnNeeded = 0
lnNumberOfJobs = 0
IF EnumJobs(lhPrinter, 0, 127, 1, 0, 0, ;
@lnNeeded, @lnNumberOfJobs ) = 0
IF GetLastError() <> 122
This.cErrorMessage = "Unable to Enumerate Jobs."
This.nApiErrorCode = GetLastError()
This.cApiErrorMessage = This.ApiErrorText(This.nApiErrorCode)
RETURN .F.
ENDIF
ENDIF
lnBuffer = HeapAlloc(This.hHeap, 0, lnNeeded)
llSuccess = .T.
IF EnumJobs(lhPrinter, 0, 127, 1, lnBuffer, @lnNeeded, ;
@lnNeeded, @lnNumberOfJobs ) = 0
This.cErrorMessage = "Unable to Enumerate Jobs."
This.nApiErrorCode = GetLastError()
This.cApiErrorMessage = This.ApiErrorText(This.nApiErrorCode)
llSuccess = .F.
ENDIF
IF llSuccess
FOR i=1 TO lnNumberOfJobs
loOneJob = This.OneJobObj()
WITH loOneJob
lnPointer = lnBuffer + (i-1) * 64
.JobId = This.Long2NumFromBuffer(lnPointer)
.PrinterName = This.StrZFromBuffer(lnPointer+4)
.MachineName = This.StrZFromBuffer(lnPointer+8)
.UserName = This.StrZFromBuffer(lnPointer+12)
.Document = This.StrZFromBuffer(lnPointer+16)
.Datatype = This.StrZFromBuffer(lnPointer+20)
.StatusText = This.StrZFromBuffer(lnPointer+24)
.Status = This.Long2NumFromBuffer(lnPointer+28)
.Priority = This.Long2NumFromBuffer(lnPointer+32)
.Position = This.Long2NumFromBuffer(lnPointer+36)
.TotalPages = This.Long2NumFromBuffer(lnPointer+40)
.PagesPrinted = This.Long2NumFromBuffer(lnPointer+44)
.LocalPrintername = This.cPrinterName
ENDWITH
This.oJobList.Add(loOneJob, TRANSFORM(loOneJob.JobId))
ENDFOR
ENDIF
= HeapFree(This.hHeap, 0, lnBuffer )
= ClosePrinter(lhPrinter)
RETURN llSuccess
PROCEDURE StrZFromBuffer(tnPointer)
LOCAL lcStr, lnStrPointer
lcStr = SPACE(256)
lnStrPointer = 0
= RtlCopy(@lnStrPointer, tnPointer, 4)
lstrcpy(@lcStr, lnStrPointer)
RETURN LEFT(lcStr, AT(CHR(0),lcStr)-1)
ENDPROC
PROCEDURE Long2NumFromBuffer(tnPointer)
LOCAL lnNum
lnNum = 0
= RtlCopy(@lnNum, tnPointer, 4)
RETURN lnNum
ENDPROC
PROCEDURE OneJobObj
LOCAL loOneJob
loOneJob = NEWOBJECT("Empty")
ADDPROPERTY(loOneJob, "JobId", 0)
ADDPROPERTY(loOneJob, "PrinterName", "")
ADDPROPERTY(loOneJob, "MachineName", "")
ADDPROPERTY(loOneJob, "UserName", "")
ADDPROPERTY(loOneJob, "Document", "")
ADDPROPERTY(loOneJob, "Datatype", "")
ADDPROPERTY(loOneJob, "StatusText", "")
ADDPROPERTY(loOneJob, "Status", 0)
ADDPROPERTY(loOneJob, "Priority", 0)
ADDPROPERTY(loOneJob, "Position", 0)
ADDPROPERTY(loOneJob, "TotalPages", 0)
ADDPROPERTY(loOneJob, "PagesPrinted", 0)
ADDPROPERTY(loOneJob, "LocalPrinterName","")
RETURN loOneJob
ENDPROC
PROCEDURE ClearErrors
This.cErrorMessage = ""
This.nApiErrorCode = 0
This.cApiErrorMessage = ""
ENDPROC
FUNCTION Num2LOng(tnNum)
DECLARE RtlMoveMemory IN WIN32API AS RtlCopyLong ;
STRING @Dest, Long @Source, Long Length
LOCAL lcString
lcString = SPACE(4)
=RtlCopyLong(@lcString, BITOR(tnNum,0), 4)
RETURN lcString
ENDFUNC
FUNCTION Long2Num(tcLong)
DECLARE RtlMoveMemory IN WIN32API AS RtlCopyNum ;
Long @Dest, String @Source, Long Length
LOCAL lnNum
lnNum = 0
= RtlCopyNum(@lnNum, tcLong, 4)
RETURN lnNum
ENDFUNC
HIDDEN PROCEDURE ApiErrorText
LPARAMETERS tnErrorCode
Local lcErrBuffer
lcErrBuffer = REPL(CHR(0),1024)
= FormatMessage(0x1000 ,.NULL., tnErrorCode, 0, @lcErrBuffer, 1024,0)
RETURN LEFT(lcErrBuffer, AT(CHR(0),lcErrBuffer)- 1 )
ENDPROC
HIDDEN PROCEDURE LoadApiDlls
DECLARE INTEGER OpenPrinter IN winspool.drv;
STRING pPrinterName,;
INTEGER @phPrinter,;
INTEGER pDefault
DECLARE INTEGER ClosePrinter IN winspool.drv;
INTEGER hPrinter
Declare Integer EnumJobs in WinSpool.Drv ;
Integer hPrinter, ;
Integer FirstJob, ;
Integer NoJobs, ;
Integer Level, ;
Integer pJob, ;
Integer cbBuf, ;
Integer @pcbNeeded, ;
Integer @pcReturned
DECLARE INTEGER HeapCreate IN Win32API;
INTEGER dwOptions, INTEGER dwInitialSize,;
INTEGER dwMaxSize
DECLARE INTEGER HeapAlloc IN Win32API;
INTEGER hHeap, INTEGER dwFlags, INTEGER dwBytes
DECLARE lstrcpy IN Win32API;
STRING @lpstring1, INTEGER lpstring2
DECLARE INTEGER HeapFree IN Win32API;
INTEGER hHeap, INTEGER dwFlags, INTEGER lpMem
DECLARE HeapDestroy IN Win32API;
INTEGER hHeap
DECLARE RtlMoveMemory IN WIN32API AS RtlCopy ;
Long @Dest, Long Source, Long Length
DECLARE lstrcpy IN Win32API;
STRING @lpstring1, INTEGER lpstring2
DECLARE INTEGER GetLastError IN kernel32
Declare Integer FormatMessage In kernel32.dll ;
Integer dwFlags, String @lpSource, ;
Integer dwMessageId, Integer dwLanguageId, ;
String @lpBuffer, Integer nSize, Integer Arguments
ENDPROC
ENDDEFINE
Against Stupidity the Gods themselves Contend in Vain - Johann Christoph Friedrich von Schiller
The only thing normal about database guys is their tables.
