[fpc-pascal]Missing Win32 Function
Full_Name
memsom at post.interalpha.co.uk
Thu Aug 8 15:51:01 CEST 2002
Jim,
compiling this in Delphi, I found that some stuff was a bit wrong. I didn't get
any valid results, but then I'm on a network without a local printer.
Try the following. Straight from the Delphi unit, so may need tweaking for your
needs. I can supply the Win32 C API version if it helps.
This is from the delphi Printers Unit, so will need de-Delphifying for FPC:
function TPrinter.GetPrinters: TStrings;
var
LineCur, Port: PChar;
Buffer, PrinterInfo: PChar;
Flags, Count, NumInfo: DWORD;
I: Integer;
Level: Byte;
begin
if FPrinters = nil then
begin
FPrinters := TStringList.Create;
Result := FPrinters;
try
if Win32Platform = VER_PLATFORM_WIN32_NT then
begin
Flags := PRINTER_ENUM_CONNECTIONS or PRINTER_ENUM_LOCAL;
Level := 4;
end
else
begin
Flags := PRINTER_ENUM_LOCAL;
Level := 5;
end;
Count := 0;
EnumPrinters(Flags, nil, Level, nil, 0, Count, NumInfo);
if Count = 0 then Exit;
GetMem(Buffer, Count);
try
if not EnumPrinters(Flags, nil, Level, PByte(Buffer), Count, Count,
NumInfo) then
Exit;
PrinterInfo := Buffer;
for I := 0 to NumInfo - 1 do
begin
if Level = 4 then
with PPrinterInfo4(PrinterInfo)^ do
begin
FPrinters.AddObject(pPrinterName,
TPrinterDevice.Create(nil, pPrinterName, nil));
Inc(PrinterInfo, sizeof(TPrinterInfo4));
end
else
with PPrinterInfo5(PrinterInfo)^ do
begin
LineCur := pPortName;
Port := FetchStr(LineCur);
while Port^ <> #0 do
begin
FPrinters.AddObject(Format(SDeviceOnPort, [pPrinterName, Port]),
TPrinterDevice.Create(nil, pPrinterName, Port));
Port := FetchStr(LineCur);
end;
Inc(PrinterInfo, sizeof(TPrinterInfo5));
end;
end;
finally
FreeMem(Buffer, Count);
end;
except
FPrinters.Free;
FPrinters := nil;
raise;
end;
end;
Result := FPrinters;
end;
Hope that helps,
Matt
--
"Computer games don't affect kids; I mean if Pac-Man affected us as kids,
we'd all be running around in darkened rooms, munching magic pills and
listening to repetitive electronic music."
Kristian Wilson,
Nintendo, Inc, 1989
-----BEGIN GEEK CODE BLOCK-----
Version: 3.12
GCS d? s+++:+ a- C++ UL+ P L++ E---- W- N+ o+ K- w
O- M V PS PE-- Y PGP- t- 5-- X- R- tv+ b+ DI++ D+
G e++ h--- r+++ y+++
------END GEEK CODE BLOCK------
More information about the fpc-pascal
mailing list