Thema: Delphi EInvalidPointer in dll

Einzelnen Beitrag anzeigen

Capa

Registriert seit: 26. Okt 2003
102 Beiträge
 
RAD-Studio 2010 Arc
 
#13

Re: EInvalidPointer in dll

  Alt 30. Mär 2010, 00:18
Hätte da auch mal eine frage zum Thema EInvalidPointer und DLL Dateien
habe folgenden Code

DLL:
Delphi-Quellcode:
library Drucker;


uses
  ShareMem,
  SysUtils,
  Classes,
  Printers,
  Windows,
  Messages,
  WinSpool;

{$R *.res}

// *******************************************************
// ************* GetPrinterStrFromIndex ******************
// *******************************************************
function GetPrinterStrFromIndex(index : integer) : string; stdcall;
var
  pri : integer;
  hDeviceMode : THandle;
  Device,Driver,Port : array[0..255] of char;
  s,ResStr : array[0..255] of char;
begin
  pri:=Printer.PrinterIndex;
  Printer.PrinterIndex:=index;
  Printer.GetPrinter(Device,Driver,Port,hDeviceMode);
  // Arbeitet nicht richtig, deswegen korrekten String aus WIN.INI abfragen
  GetProfileString('Devices',Device,'',ResStr,255);
  StrCopy (s, Device);
  StrCat (s, ',');
  StrCat (s, ResStr);
  Result:=string(s);
  Printer.PrinterIndex:=pri;
end;
// *******************************************************
// ************* GetPrinterStrFromIndex ******************
// *******************************************************

// *******************************************************
// **************** Drucker löschen **********************
// *******************************************************
function Druckerloeschen(drucker: string):Boolean; stdcall;
var
hPrinter : Cardinal;
PrinterDef: PRINTER_DEFAULTS;
pPrinterName: PAnsichar;
begin
  pPrinterName := PChar(drucker);
  Result := FALSE;

   FillChar(PrinterDef, sizeof(PrinterDef), #0);
   PrinterDef.DesiredAccess := PRINTER_ALL_ACCESS;

   if OpenPrinter(pPrinterName, hPrinter, @PrinterDef) then
   begin
    if DeletePrinter(hPrinter) then Result := TRUE;
    ClosePrinter(hPrinter);
   end;
end;

function Druckerdelwahl(druckernr: integer):Boolean; stdcall;
begin
  Druckerloeschen(GetPrinterStrFromIndex(druckernr));
  Result := True;
end;
// *******************************************************
// **************** Drucker löschen **********************
// *******************************************************

// *******************************************************
// **************** Testseite drucken ********************
// *******************************************************
function Drucktest():Boolean; stdcall;
begin
  Printer.BeginDoc;
  Printer.Canvas.Font.Name := 'Courier new';
  Printer.Canvas.Font.Size := 20;
  Printer.Canvas.TextOut(20,100,'Testseite');
  Printer.Canvas.TextOut(20,250,'Testseite');
  Printer.Canvas.TextOut(20,400,'Testseite');
  Printer.EndDoc;
  result:=true;
end;
// *******************************************************
// **************** Testseite drucken ********************
// *******************************************************

// *******************************************************
// **************** Drucker setzen ***********************
// *******************************************************
function Druckersetzen(drucker: string):Boolean; stdcall;
  var ResStr : array[0..255] of char;
begin
  StrPCopy(ResStr,drucker);
  WriteProfileString ('windows', 'device', ResStr);
  StrCopy (ResStr, 'windows');
  SendMessage (HWND_BROADCAST, WM_WININICHANGE, 0, LongInt(@ResStr));
  Result := True;
end;

function Druckersetwahl(druckernr: integer):Boolean; stdcall;
begin
  Druckersetzen(GetPrinterStrFromIndex(druckernr));
  Result := True;
end;
// *******************************************************
// **************** Drucker setzen ***********************
// *******************************************************

// *******************************************************
// **************** Drucker auslesen *********************
// *******************************************************
function Druckerauslesen():Pchar; stdcall;
  var printerlist: tstringlist;
          ResStr : array[0..255] of char;
        mainprint: PChar;
begin
  GetProfileString('Windows','device','',ResStr,255);

  printerlist := TStringlist.Create;
  printerlist.AddStrings(printer.printers);
  mainprint := PChar(StrPas(ResStr));
  printerlist.Add('');
  printerlist.Add(Copy(mainprint,0,pos(',',mainprint)-1));

  result:=printerlist.GetText;
  printerlist.free;
end;
// *******************************************************
// **************** Drucker auslesen *********************
// *******************************************************

exports
  Druckerdelwahl,
  Druckersetwahl,
  Druckerauslesen,
  Drucktest;

begin
end.
Programm:
Delphi-Quellcode:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

 function Druckerauslesen():String; stdcall; external 'drucker.dll';

implementation


{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(StrPas(Druckerauslesen));
end;

end.
Sobald ich nun die ShowMessage ausgeben lasse bekomm ich NACH der korrekt angezeigten ShowMessage einen EInvalidPointer Fehler.
Kann mir da vielleicht einer weiter helfen is das erstemal das ich mit dlls arbeiten will/muss
Wenn ich Drucktest(); versuche bekomme ich keinen Fehler angezeigt.

EDIT: Hab mal den kompletten DLL-Source gepostet falls sich der fehler woanderst versteckt

EDIT: Wenn ich Sharemem auch bei dem Programm an erster stelle einfüge bekomm ich den Fehler beim beenden der Datei und nicht mehr nach dem ShowMessage;

EDIT: Ein Abändern von "function Druckerauslesen():ShortString; stdcall;" auf "function Druckerauslesen()Char; stdcall;" hat leider auch
keinen erfolg gebracht immernoch der selbe fehler.

EDIT: Kompletter Source updated auf aktuellen stand!
  Mit Zitat antworten Zitat