DATABANK üzerinde otomatik Oki ML 521 Elite (IBM)
hp deskjet 845c series

function GetPrinterPort(PrinterName : String) : shortstring;
var
dwNeeded : DWORD;
hGlobal : cardinal;
bFlag : BOOLEAN;
hPrinter : THandle;
pd : _PRINTER_DEFAULTS;
pi2 : ^_PRINTER_INFO_2;
pPrinterName : Pchar;
level : integer;

begin
level := 2;
result := '';
bFlag := true;
pi2 := nil;
pPrinterName := '';
hGlobal := 0;
try
GetMem(pPrinterName,length(PrinterName)+1);
StrPCopy(pPrinterName,PrinterName);
// find printer handle og åben printer
zeromemory(@pd,sizeof(pd));
pd.DesiredAccess := PRINTER_ACCESS_USE;
bFlag := OpenPrinter(pPrinterName, hPrinter, @pd);
if ((not bFlag) or (hPrinter = 0)) then exit;

// først finder vi størrelse på buffer
GetPrinter(hPrinter, Level, nil, 0, @dwNeeded);
if (dwNeeded = 0) then exit;

// allocate memory til buffer
hGlobal := GlobalAlloc(GHND, dwneeded);
pi2 := GlobalLock(hGlobal);
if (pi2 = nil) then exit;

// nu henter vi data fra printer
bFlag := GetPrinter(hPrinter, Level, pi2, dwNeeded, @dwNeeded);
if (not bFlag) then exit;

result := StrPas(pi2.pPortName);
finally
if (pi2 <> nil) then GlobalUnlock(hGlobal);
if (hGlobal <> 0) then GlobalFree(hGlobal);
if (pPrinterName <> nil) then freeMem(pPrinterName);
if (hPrinter <> 0) then closeprinter(hPrinter);
//if (not bFlag) then GetLastSystemError('GetPrinterPort '+printername);
end;
end;

unit uPrinterStuff;

interface

uses
SysUtils, Windows, Messages, Classes, Graphics, comctrls, winspool,
dialogs;

procedure SetPrinterStatus(PrinterName: string; psStatus: dword);
procedure ModifyPrinterPort(PrinterName, PortName: string);
procedure GetAPIPortListToView(var PortLV: TListView);
procedure GetAPIPortListToList(var PortList: TStringList);
function PrinterExists(PrinterName: string): boolean;
function GetPrinterPort(PrinterName: string): shortstring;
procedure ListJobsForprinter(PrinterName: string; var JobLV: TListView);
function JobsInPrinterQueue(PrinterName: string): integer;
function GetHandleForPrinter(PrinterName: string): THandle;
procedure GetPrinterListToList(var PrinterList: TStringList);

implementation

function GetHandleForPrinter(PrinterName: string): THandle;
// find printer handle og åben printer
var
bFlag: BOOLEAN;
hPrinter: THandle;
pd: _PRINTER_DEFAULTS;

begin
bFlag := false;
hPrinter := 0;
result := 0;
try
if PrinterName = '' then exit;
zeromemory(@pd, sizeof(pd));
pd.DesiredAccess := PRINTER_WRITE;
bFlag := OpenPrinter(pChar(PrinterName), hPrinter, @pd);
if ((not bFlag) or (hPrinter = 0)) then exit;
result := hPrinter;
finally
end;
end;

function PrinterExists(PrinterName: string): boolean;
var
hPrinter: THandle;
begin
result := false;
hPrinter := 0;
try
hPrinter := GetHandleForPrinter(PrinterName);
if hPrinter = 0 then exit;
result := true;
finally
if (hPrinter <> 0) then closeprinter(hPrinter);
end;
end;

procedure SetPrinterStatus(PrinterName: string; psStatus: dword);
var
pd: _PRINTER_DEFAULTS;
hPrinter: THandle;
level: DWORD;
bFlag: BOOLEAN;
dwCommand: dword;
pPrinter: dword;

begin
level := 0;
hPrinter := 0;
bFlag := false;
dwCommand := 0;
pPrinter := 0;
try
zeromemory(@pd, sizeof(pd));
pd.DesiredAccess := PRINTER_ALL_ACCESS;
bFlag := OpenPrinter(PChar(PrinterName), hPrinter, @pd);
if ((not bFlag) or (hPrinter = 0)) then exit;
dwCommand := psStatus;
pPrinter := PRINTER_CONTROL_SET_STATUS;
bFlag := SetPrinter(hPrinter, Level, @pPrinter, dwCommand);
finally
//if (not bFlag) then GetLastSystemError('Setprinter '+printername);
if (hPrinter <> 0) then closeprinter(hPrinter);
end;
end;

procedure ModifyPrinterPort(PrinterName, PortName: string);
var
pd: _PRINTER_DEFAULTS;
pi2: ^_PRINTER_INFO_2;
hGlobal: cardinal;
hPrinter: THandle;
level: DWORD;
dwNeeded: DWORD;
bFlag: BOOLEAN;

begin
level := 2;
hPrinter := 0;
pi2 := nil;
hGlobal := 0;
dwneeded := 0;
bFlag := false;
zeromemory(@pd, sizeof(pd));
try
pd.DesiredAccess := PRINTER_ALL_ACCESS;
bFlag := OpenPrinter(Pchar(PrinterName), hPrinter, @pd);
if ((not bFlag) or (hPrinter = 0)) then exit;

// først finder vi størrelse på buffer
GetPrinter(hPrinter, Level, nil, 0, @dwNeeded);
if (dwNeeded = 0) then exit;

// allocate memory til buffer
hGlobal := GlobalAlloc(GHND, dwneeded);
pi2 := GlobalLock(hGlobal);
if (pi2 = nil) then exit;

// nu henter vi data fra printer
bFlag := GetPrinter(hPrinter, Level, pi2, dwNeeded, @dwNeeded);
if (not bFlag) then exit;

// sæt ny port og skriv det ned
pi2.pPortName := PChar(PortName);
pi2.pComment := PChar(PrinterName + ' Rutes ' + PortName);
bFlag := SetPrinter(hPrinter, Level, pi2, 0);
if (not bFlag) then exit;

// notificer andre applikationer om ændringen
sendmessage(HWND_BROADCAST, WM_DEVMODECHANGE, 0,
longint(@pi2.pPrinterName));

finally
if (pi2 <> nil) then GlobalUnlock(hGlobal);
if (hPrinter <> 0) then closeprinter(hPrinter);
if (hGlobal <> 0) then GlobalFree(hGlobal);
//if (not bFlag) then GetLastSystemError('ModifyPrinterPort');
end;
end;

procedure GetAPIPortListToList(var PortList: TStringList);
type
TPortInfos = array[0..0] of _PORT_INFO_2; //TPortInfo - Typecasting
var
p: pointer;
pi2: _PORT_INFO_2;
hGlobal: cardinal;
level: DWORD;
dwNeeded, dwReturned: DWORD;
bFlag: BOOLEAN;
i: dword;

begin
level := 2;
bFlag := true;
p := nil;
hGlobal := 0;

try
// først finder vi mindste størrelse på buffer
EnumPorts(nil, level, p, 0, dwNeeded, dwReturned);
if (dwNeeded = 0) then exit;

// allocate memory til buffer
hGlobal := GlobalAlloc(GHND, dwneeded);
p := GlobalLock(hGlobal);
if (p = nil) then exit;

// her henter jeg så de ægte data
bFlag := EnumPorts(nil, level, p, dwNeeded, dwNeeded, dwReturned);
if (not bFlag) then exit;

// Loop igennem alle portene og hent data.
PortList.Clear;
{$R-}
with PortList do
for i := 0 to dwReturned - 1 do
begin
Pi2 := TPortInfos(p^)[i];
Add(strpas(Pi2.pPortName));
end;
{$R+}

finally
if (p <> nil) then GlobalUnlock(hGlobal);
if (hGlobal <> 0) then GlobalFree(hGlobal);
//if (not bFlag) then GetLastSystemError('GetAPIPortListToList');
end;
end;

procedure GetPrinterListToList(var PrinterList: TStringList);
type
TPrinterInfos = array[0..0] of _PRINTER_INFO_2; //TPrinterInfo -Typecasting
var
p: pointer;
pi: _PRINTER_INFO_2;
hGlobal: cardinal;
level: DWORD;
dwNeeded, dwReturned: DWORD;
bFlag: BOOLEAN;
i: dword;

begin
level := 2;
bFlag := true;
p := nil;
hGlobal := 0;
try
try
// først finder vi mindste størrelse på buffer
EnumPrinters(PRINTER_ENUM_LOCAL, nil, level, p, 0, dwNeeded,
dwReturned);
if (dwNeeded = 0) then exit;

// allocate memory til buffer
hGlobal := GlobalAlloc(GHND, dwneeded);
p := GlobalLock(hGlobal);
if (p = nil) then exit;

// her henter jeg så de ægte data
bFlag := EnumPrinters(PRINTER_ENUM_LOCAL, nil, level, p, dwneeded,
dwNeeded, dwReturned);
if (not bFlag) then exit;

// Loop igennem alle portene og hent data.
Printerlist.Clear;
{$R-}
with Printerlist do
for i := 0 to dwReturned - 1 do
begin
Pi := TPrinterInfos(p^)[i];
add(pi.pPrinterName);
end;
{$R+}
except

end;
finally
if (p <> nil) then GlobalUnlock(hGlobal);
if (hGlobal <> 0) then GlobalFree(hGlobal);
//if (not bFlag) then GetLastSystemError('GetPrinterListToList');
end;
end;

procedure GetAPIPortListToView(var PortLV: TListView);
type
TPortInfos = array[0..0] of _PORT_INFO_2; //TPortInfo - Typecasting
var
p: pointer;
pi2: _PORT_INFO_2;
hGlobal: cardinal;
level: DWORD;
dwNeeded, dwReturned: DWORD;
bFlag: BOOLEAN;
i: dword;
ListItem: TListItem;

begin
level := 2;
bFlag := true;
p := nil;
hGlobal := 0;
try
// først finder vi mindste størrelse på buffer
EnumPorts(nil, level, p, 0, dwNeeded, dwReturned);
if (dwNeeded = 0) then exit;

// allocate memory til buffer
hGlobal := GlobalAlloc(GHND, dwneeded);
p := GlobalLock(hGlobal);
if (p = nil) then exit;

// her henter jeg så de ægte data
bFlag := EnumPorts(nil, level, p, dwNeeded, dwNeeded, dwReturned);
if (not bFlag) then exit;

// Loop igennem alle portene og hent data.
PortLV.Items.Clear;
{$R-}
with PortLV do
for i := 0 to dwReturned - 1 do
begin
Pi2 := TPortInfos(p^)[i];
ListItem := Items.add;
ListItem.Caption := strpas(Pi2.pPortName);
ListItem.subitems.add(strpas(Pi2.pMonitorName));
ListItem.subitems.add(strpas(Pi2.pDescription));
case Pi2.fPortType of
PORT_TYPE_WRITE:
ListItem.subitems.add(strpas('PORT_TYPE_WRITE'));
PORT_TYPE_READ: ListItem.subitems.add(strpas('PORT_TYPE_READ'));
PORT_TYPE_REDIRECTED:
ListItem.subitems.add(strpas('PORT_TYPE_REDIRECTED'));
PORT_TYPE_NET_ATTACHED:
ListItem.subitems.add(strpas('PORT_TYPE_NET_ATTACHED'));
else
ListItem.subitems.add(strpas('PORT_TYPE_UKENDT'));
end;
end;
{$R+}
finally
if (p <> nil) then GlobalUnlock(hGlobal);
if (hGlobal <> 0) then GlobalFree(hGlobal);
//if (not bFlag) then GetLastSystemError('GetAPIPortListToView');
end;
end;

function JobsInPrinterQueue(PrinterName: string): integer;
var
p: pointer;
level: DWORD;
dwNeeded1, dwNeeded2, dwReturned: DWORD;
bFlag: BOOLEAN;
hPrinter: THandle;

begin
result := 0;
p := nil;
level := 1;
bFlag := true;
hPrinter := 0;
try
hPrinter := GetHandleForPrinter(PrinterName);
if hPrinter = 0 then exit;

// først finder vi størrelsen på bufferen
dwneeded1 := 0;
dwneeded2 := 0;
dwreturned := 0;
EnumJobs(hPrinter, 0, $FFFFFFFF, level, nil, 0, dwNeeded1, dwReturned);
if (dwNeeded1 = 0) then exit; // dwneeded = 0 ~ måske ingen jobs fundet

getmem(p, dwneeded1);
if (p = nil) then exit;

// her henter jeg så de ægte data
bFlag := EnumJobs(hPrinter, 0, $FFFFFFFF, level, p, dwNeeded1,
dwNeeded2, dwReturned);
if dwneeded1 <> dwneeded2 then
begin
bFlag := true;
SetLastError(0);
exit;
end;
if (not bFlag) then exit;

result := dwreturned;
finally
if (p <> nil) then freemem(p, dwneeded1);
if (hPrinter <> 0) then closeprinter(hPrinter);
//if (not bFlag) then GetLastSystemError('JobsInPrinterQueue'+printername);
end;
end;

procedure ListJobsForprinter(PrinterName: string; var JobLV: TListView);
type
TJobInfo = array[0..0] of _JOB_INFO_2; // bruges til typecasting

var
p: pointer;
ji2: _JOB_INFO_2;
level: DWORD;
dwNeeded, dwReturned: DWORD;
bFlag: BOOLEAN;
i: dword;
ListItem: TListItem;
hPrinter: THandle;
pd: _PRINTER_DEFAULTS;

begin
p := nil;
level := 2;
bFlag := true;
try
JobLV.Items.Clear; // slet tidligere items fra liste
// find printer handle og åben printer
zeromemory(@pd, sizeof(pd));
pd.DesiredAccess := PRINTER_ACCESS_USE;
bFlag := OpenPrinter(PChar(PrinterName), hPrinter, @pd);
if ((not bFlag) or (hPrinter = 0)) then exit;

// først finder vi størrelsen på bufferen
dwneeded := 0;
dwreturned := 0;
EnumJobs(hPrinter, 0, $FFFFFFFF, level, nil, 0, dwNeeded, dwReturned);
if (dwNeeded = 0) then exit; // dwneeded = 0 ~ måske ingen jobs fundet

getmem(p, dwneeded);
if (p = nil) then exit;

// her henter jeg så de ægte data
bFlag := EnumJobs(hPrinter, 0, $FFFFFFFF, level, p, dwNeeded, dwNeeded,
dwReturned);
if (not bFlag) then exit;

// Loop igennem alle jobs og hent data.
{$R-}
with JobLV do
for i := 0 to dwReturned - 1 do
begin
Ji2 := TJobInfo(p^)[i];
ListItem := Items.add;
ListItem.Caption := inttostr(Ji2.JobID);
ListItem.subitems.add(strpas(Ji2.pDocument));
ListItem.subitems.add(strpas(Ji2.pUserName));
if ji2.pStatus <> nil then ListItem.subitems.add(strpas(Ji2.pStatus))
else
case Ji2.Status of
JOB_STATUS_PAUSED: ListItem.subitems.add(strpas('PAUSED'));
JOB_STATUS_ERROR: ListItem.subitems.add(strpas('ERROR'));
JOB_STATUS_DELETING: ListItem.subitems.add(strpas('DELETING'));
JOB_STATUS_SPOOLING: ListItem.subitems.add(strpas('SPOOLING'));
JOB_STATUS_PRINTING: ListItem.subitems.add(strpas('PRINTING'));
JOB_STATUS_OFFLINE: ListItem.subitems.add(strpas('OFFLINE'));
JOB_STATUS_PAPEROUT: ListItem.subitems.add(strpas('PAPEROUT'));
JOB_STATUS_PRINTED: ListItem.subitems.add(strpas('PRINTED'));
end;
end;
{$R+}

finally
if (p <> nil) then freemem(p, dwneeded);
if (hPrinter <> 0) then closeprinter(hPrinter);
//if (not bFlag) then GetLastSystemError('ListJobsForprinter'+printername);
end;
end;

function GetPrinterPort(PrinterName: string): shortstring;
var
dwNeeded: DWORD;
hGlobal: cardinal;
bFlag: BOOLEAN;
hPrinter: THandle;
pd: _PRINTER_DEFAULTS;
pi2: ^_PRINTER_INFO_2;
pPrinterName: Pchar;
level: integer;

begin
level := 2;
result := '';
bFlag := true;
pi2 := nil;
pPrinterName := '';
hGlobal := 0;
try
GetMem(pPrinterName, length(PrinterName) + 1);
StrPCopy(pPrinterName, PrinterName);
// find printer handle og åben printer
zeromemory(@pd, sizeof(pd));
pd.DesiredAccess := PRINTER_ACCESS_USE;
bFlag := OpenPrinter(pPrinterName, hPrinter, @pd);
if ((not bFlag) or (hPrinter = 0)) then exit;

// først finder vi størrelse på buffer
GetPrinter(hPrinter, Level, nil, 0, @dwNeeded);
if (dwNeeded = 0) then exit;

// allocate memory til buffer
hGlobal := GlobalAlloc(GHND, dwneeded);
pi2 := GlobalLock(hGlobal);
if (pi2 = nil) then exit;

// nu henter vi data fra printer
bFlag := GetPrinter(hPrinter, Level, pi2, dwNeeded, @dwNeeded);
if (not bFlag) then exit;

result := StrPas(pi2.pPortName);
finally
if (pi2 <> nil) then GlobalUnlock(hGlobal);
if (hGlobal <> 0) then GlobalFree(hGlobal);
if (pPrinterName <> nil) then freeMem(pPrinterName);
if (hPrinter <> 0) then closeprinter(hPrinter);
//if (not bFlag) then GetLastSystemError('GetPrinterPort ' + printername);
end;
end;

end.