Hi!

I'm having serious troubles compiling a DLL for 64bit Windows.
I'm using FPC svn 14444 (Ver 2.5.1) on all machines. I tried on WinXP 32bit (works), Vista 64bit (doesn't work), Win7 32Bit (works) and Win7 64bit (doesn't work).

The DLL works as a print-monitor, providing a virtual printer port.

For the definitions I used the windows-Unit whereever it would work, the missing ones (mainly the Monitor-Structure i ported from MSDN.
(http://msdn.microsoft.com/en-us/library/aa506794.aspx)

To see the problem copy the resulting dll in your \windows\system32 folder. Then add a registry folder HKLM\SYSTEM\CurrentControlSet\Control\Print\Monitors\PMon64Test Inside this folder add a string named "Driver" with a value of "PMon64.dll" (which has to be the name of the dll in the System32 Folder.
Restart the Spooler-Service and try to add a Printer to your system.

On Win64 the Spooler Service will produce an Error with the ErrorCode 0x000006be, on win32 the normal AddPrinter Dialog will appear.

The source attached provides a basic dll, wich will do nothing but write some information to C:\TMP\DEBUG.TXT if that file is existant (so please create it first!)

The Source is:

------------Start

library PMon64;

{$mode Delphi}
{$H+}

uses Windows, Sysutils;

type
  pMonitor=^rMonitor;

  TEnumPortsFunc=function(pName:LPWSTR;dwLevel:DWORD;pPorts:LPBYTE;
                          cbBuf:DWORD;pdwNeeded:LPDWORD;
                          pdwReturned:LPDWORD):BOOL;stdcall;
  TOpenPortFunc=function(pName:LPWSTR;H:PHANDLE):BOOL;stdcall;
  TOpenPortExFunc=function(pName,pPrinterName:LPWSTR;H:PHANDLE;
                           _Monitor:pMonitor):BOOL;stdcall;
  TStartDocPortFunc=function(hPort:HANDLE;pPrinterName:LPWSTR;
                             JobID,Level:DWORD;
                             pDocInfo:LPBYTE):BOOL;stdcall;
  TWritePortFunc=function(hPort:HANDLE;pBuffer:LPBYTE;
                          cbBuf:DWORD;pcbWritten:LPDWORD):BOOL;stdcall;
  TReadPortFunc=function(hPort:HANDLE;pBuffer:LPBYTE;cbBuf:DWORD;
                         pcbRead:LPDWORD):BOOL;stdcall;
  TEndDocPortFunc=function(hPort:HANDLE):BOOL;stdcall;
  TClosePortFunc=function(hPort:HANDLE):BOOL;stdcall;
  TAddPortFunc=function(pName:LPWSTR;h:HWND;
                        pMonitorName:LPWSTR):BOOL;stdcall;
  TAddPortExFunc=function(pName:LPWSTR;Level:DWORD;pBuffer:LPBYTE;
                          pMonitorName:LPWSTR):BOOL;stdcall;
  TConfigurePortFunc=function(pName:LPWSTR;h:HWND;
                              pMonitorName:LPWSTR):BOOL;stdcall;
  TDeletePortFunc=function(pName:LPWSTR;h:HWND;
                           pMonitorName:LPWSTR):BOOL;stdcall;
  TGetPrinterDataFromPortFunc=function(hPort:HANDLE;ControlID:DWORD;
                                     pValueName,lpInBuffer:LPWSTR;
                                     cbInBuffer:DWORD;
                                     lpOutBuffer:LPWSTR;
                                     cbOutBuffer:DWORD;
                                     lpcbReturned:LPDWORD):BOOL;stdcall;
  TSetPortTimeOutsFunc=function(hPort:HANDLE;lpTCO:pCommTimeouts;
                                reserved:DWORD):BOOL;stdcall;
  TXcvOpenPortFunc=function(pszObject:LPCWSTR;GrantedAccess:ACCESS_MASK;
                            phXcv:PHANDLE):BOOL;stdcall;
  TXcvDataPortFunc=function(hXcv:HANDLE;pszDataName:LPCWSTR;
                            pInputData:PBYTE;cbInputData:DWORD;
                            pOutputData:PBYTE;cbOutputData:DWORD;
                            pcbOutputNeeded:PDWORD):DWORD;stdcall;
  TXcvClosePortFunc=function(hXcv:HANDLE):BOOL;stdcall;

  rMonitor=packed record
    pfnEnumPorts: TEnumPortsFunc;
    pfnOpenPort: TOpenPortFunc;
    pfnOpenPortEx: TOpenPortExFunc;
    pfnStartDocPort: TStartDocPortFunc;
    pfnWritePort: TWritePortFunc;
    pfnReadPort: TReadPortFunc;
    pfnEndDocPort: TEndDocPortFunc;
    pfnClosePort: TClosePortFunc;
    pfnAddPort: TAddPortFunc;
    pfnAddPortEx: TAddPortExFunc;
    pfnConfigurePort: TConfigurePortFunc;
    pfnDeletePort: TDeletePortFunc;
    pfnGetPrinterDataFromPort: TGetPrinterDataFromPortFunc;
    pfnSetPortTimeOuts: TSetPortTimeOutsFunc;
    pfnXcvOpenPort: TXcvOpenPortFunc;
    pfnXcvDataPort: TXcvDataPortFunc;
    pfnXcvClosePort: TXcvClosePortFunc;
  end;
  rMonitorEx=packed record
    dwMonitorSize:DWORD;
    Monitor:rMonitor;
  end;
  pMonitorEx=^rMonitorEx;

var
  Mon:rMonitorEx;

procedure DbgSend(Text:String);
var f:Textfile;
begin
  if FileExists('C:\TMP\DEBUG.TXT') then begin
    AssignFile(f,'C:\TMP\DEBUG.TXT');
    Append(f);
    Writeln(f,FormatDateTime('HH:MM:SS',now())+': '+Trim(Text));
    CloseFile(f);
  end;
end;

function EnumPorts(pName:LPWSTR;dwLevel:DWORD;pPorts:LPBYTE;
                   cbBuf:DWORD;pdwNeeded:LPDWORD;
                   pdwReturned:LPDWORD):BOOL;stdcall;
begin
  DbgSend('EnumPorts');
end;

function OpenPort(pName:LPWSTR;H:PHANDLE):BOOL;stdcall;
begin
  DbgSend('OpenPort');
end;

function StartDocPort(hPort:HANDLE;pPrinterName:LPWSTR;
                      JobID,Level:DWORD;pDocInfo:LPBYTE):BOOL;stdcall;
begin
  DbgSend('StartDocPort');
end;

function WritePort(hPort:HANDLE;pBuffer:LPBYTE;cbBuf:DWORD;
                   pcbWritten:LPDWORD):BOOL;stdcall;
begin
  DbgSend('WritePort');
end;

function ReadPort(hPort:HANDLE;pBuffer:LPBYTE;cbBuf:DWORD;
                  pcbRead:LPDWORD):BOOL;stdcall;
begin
  DbgSend('ReadPort');
end;

function EndDocPort(hPort:HANDLE):BOOL;stdcall;
begin
  DbgSend('EndDocPort');
end;

function ClosePort(hPort:HANDLE):BOOL;stdcall;
begin
  DbgSend('ClosePort');
end;

function AddPort(pName:LPWSTR;h:HWND;pMonitorName:LPWSTR):BOOL;stdcall;
begin
  DbgSend('AddPort');
end;

function AddPortEx(pName:LPWSTR;Level:DWORD;pBuffer:LPBYTE;
                   pMonitorName:LPWSTR):BOOL;stdcall;
begin
  DbgSend('AddPortEx');
end;

function ConfigurePort(pName:LPWSTR;h:HWND;
                       pMonitorName:LPWSTR):BOOL;stdcall;
begin
  DbgSend('ConfigurePort');
end;

function DeletePort(pName:LPWSTR;h:HWND;
                    pMonitorName:LPWSTR):BOOL;stdcall;
begin
  DbgSend('DeletePort');
end;

function InitializePrintMonitor(pRegRoot:LPWSTR):pMonitorEx;stdcall;export;
begin
  DbgSend('InitializePrintMonitor start');
  Result:=...@mon;
  DbgSend('InitializePrintMonitor end');
end;

exports InitializePrintMonitor;

begin
  DbgSend('MainSection start');

  Mon.dwMonitorSize:=SizeOf(rMonitor);
  Mon.Monitor.pfnEnumPorts:=EnumPorts;
  Mon.Monitor.pfnOpenPort:=OpenPort;
  Mon.Monitor.pfnOpenPortEx:=nil;
  Mon.Monitor.pfnStartDocPort:=StartDocPort;
  Mon.Monitor.pfnWritePort:=WritePort;
  Mon.Monitor.pfnReadPort:=ReadPort;
  Mon.Monitor.pfnEndDocPort:=EndDocPort;
  Mon.Monitor.pfnClosePort:=ClosePort;
  Mon.Monitor.pfnAddPort:=AddPort;
  Mon.Monitor.pfnAddPortEx:=AddPortEx;
  Mon.Monitor.pfnConfigurePort:=ConfigurePort;
  Mon.Monitor.pfnDeletePort:=DeletePort;
  Mon.Monitor.pfnGetPrinterDataFromPort:=nil;
  Mon.Monitor.pfnSetPortTimeOuts:=nil;
  Mon.Monitor.pfnXcvOpenPort:=nil;
  Mon.Monitor.pfnXcvDataPort:=nil;
  Mon.Monitor.pfnXcvClosePort:=nil;

  DbgSend('MainSection end');
end.

------------End

I compiled it by the command
32Bit:
fpc -WB0 -MDelphi -B -O- -Os -CX -g- -XDs -Pi386 -TWin32 -vewi PMon64.lpr

and 64Bit.
fpc -WB0 -MDelphi -B -O- -Os -CX -g- -XDs -Px86_64 -TWin64 -vewi PMon64.lpr


The debug.txt on 32 Bit reads:
20:11:37: MainSection start
20:11:37: MainSection end
20:11:37: InitializePrintMonitor start
20:11:37: InitializePrintMonitor end
20:11:37: EnumPorts

The debug.txt on 64 Bit reads:
20:11:37: MainSection start
20:11:37: MainSection end
20:11:37: InitializePrintMonitor start
20:11:37: InitializePrintMonitor end
--> The EnumPorts-Entry is missing here!

so the crash is before or on calling the EnumPorts-Function.

So, anyone an Idea what I might have missed? Or is ther a bug in FPC for Win64?

Any help would be appreciated.

Regards
Lukas



--

--------------------------
software security networks
Lukas Gradl <fpc#ssn.at>
Eduard-Bodem-Gasse 5
A - 6020 Innsbruck
Tel: +43-512-214040-0
Fax: +43-512-214040-21
--------------------------
_______________________________________________
fpc-pascal maillist  -  fpc-pascal@lists.freepascal.org
http://lists.freepascal.org/mailman/listinfo/fpc-pascal

Reply via email to