Registriert seit: 26. Okt 2003
102 Beiträge
RAD-Studio 2010 Arc
|
Re: EInvalidPointer in dll
30. Mär 2010, 01: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!
|