[Delphi] error bij afsluiten programma

[Verwijderd]

Ik heb een klasse gemaakt. Maar zodra het programma gesloten worden, veroorzaakt het een foutmelding:



Het is misschien een beetje veel code om hier te plaatsen maar zo is het wel duidelijker.

Maar wat is de oorzaak? Ik zou niet weten wat ik fout doe?

code:

unit IOAccess;

interface

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

type
  TIOAccess = class(TComponent)
  private
    FWindowsNT: Boolean;
    FDriverName: AnsiString;
    FDriverDisplayName: AnsiString;
    FDriverGroupName: AnsiString;
    FDriverPath: AnsiString;
    FDriverFullPath: AnsiString;
    FDriverSourcePath: AnsiString;
    FIOPMAccess: Boolean;
    FDriverStarted: Boolean;
    FDriverInstalled: Boolean;
    FhndDeviceFile: THandle;

    function InstallDriver: Integer;
    function CopyDriver: Integer;
    function StartDriver: Integer;
    procedure SetIOPMAccess(OnFlag: Boolean);
    function OpenDeviceFile(var hndFile: THandle): Integer;
  protected
  public
    constructor Create(Owner : TComponent); override;
    destructor Destroy; override;

    procedure WritePortByte(Port: DWORD; Data: Byte);
    procedure WritePortWord(Port: DWORD; Data: Word);
    procedure WritePortDWord(Port: DWORD; Data: DWord);

    function ReadPortByte(Port: DWORD): Byte;
    function ReadPortWord(Port: DWORD): Word;
    function ReadPortDWord(Port: DWORD): DWORD;

    function StartDeviceDriver: Integer;
    function StopDriver: Integer;
    function InstallDeviceDriver: Integer;
    function UninstallDriver: Integer;

    property PortB[Port: DWORD]: Byte read ReadPortByte write WritePortByte;
    property PortW[Port: DWORD]: Word read ReadPortWord write WritePortWord;
    property PortDW[Port: DWORD]: DWORD read ReadPortDWord write WritePortDWord;
  published
    property IOPMAccess: Boolean read FIOPMAccess write SetIOPMAccess default False;
  end;

procedure Register;

implementation

function TIOAccess.InstallDriver: Integer;
var hSCMan, hService: SC_HANDLE;
begin
  Result := STATUS_SUCCESS;
  // Try to open the Service Control Manager
  hSCMan := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
  if hSCMan = 0 then
  begin
    Result := GetLastError;
    Exit;
  end;

  // Check if the driver is already in the Service Control Manager
  hService := OpenService(hSCMan, PChar(FDriverName), SERVICE_QUERY_STATUS);
  if hService <> 0 then
  begin
    // The driver is already in the Service Control Manager, so it don't have
    // to be installed
    CloseServiceHandle(hService);
    CloseServiceHandle(hSCMan);
    Exit;
  end;

  hService := CreateService(hSCMan, PChar(FDriverName),
                    PChar(FDriverDisplayName), SERVICE_ALL_ACCESS,
                    SERVICE_KERNEL_DRIVER, SERVICE_DEMAND_START,
                    SERVICE_ERROR_NORMAL, PChar(FDriverFullPath),
                    nil, nil, nil, nil, nil);
  if hService = 0 then
  begin
    Result := GetLastError;
    Exit;
  end
  else
  begin
    CloseServiceHandle(hService);
  end;

  CloseServiceHandle(hSCMan);
  Result := STATUS_SUCCESS;
end;



function TIOAccess.UninstallDriver: Integer;
var hSCMan, hService: SC_HANDLE;
    ServiceStatus: TServiceStatus;
begin
  hSCMan := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
  if hSCMan = 0 then
  begin
    Result := GetLastError;
    Exit;
  end;
  hService := OpenService(hSCMan, PChar(FDriverName), SERVICE_ALL_ACCESS);
  if hService = 0 then
    Result := GetLastError
  else
  begin
    if not Bool(DeleteService(hService)) then
    Result := GetLastError;

    CloseServiceHandle(hService);
  end;
  CloseServiceHandle(hSCMan);
end;


function TIOAccess.CopyDriver: Integer;
var FDriverPath, DeviceDriverPath: AnsiString;
begin
  Result := STATUS_SUCCESS;
  CreateDirectory(PChar(FDriverPath), nil);
  if not CopyFile(PChar(ExtractFileDir(Paramstr(0)) + '\IOAccess.sys'),
            StrCat(PChar(FDriverPath), PChar('\IOAccess.sys')), False) then
    Result := GetLastError;
end;



function TIOAccess.StartDriver: Integer;
var hService, hSCMan: SC_HANDLE;
    ServiceArgVectors: PChar;
begin
  Result := STATUS_SUCCESS;
  hSCMan := OpenSCManager(nil, nil, SC_MANAGER_CONNECT);
  if hSCMan = 0 then
  begin
    Result := GetLastError;
    Exit;
  end;

  hService := OpenService(hSCMan, PChar(FDriverName), SERVICE_START);
  if hService = 0 then
  begin
    Result := GetLastError;
  end
  else
  begin
    ServiceArgVectors := nil;
    if Integer(StartService(hService, 0, ServiceArgVectors)) = 0 then
    Result := GetLastError;
    CloseServiceHandle(hService);
  end;
  CloseServiceHandle(hSCMan);
end;

function TIOAccess.StopDriver: Integer;
var hService, hSCMan: SC_HANDLE;
    ServiceStatus: TServiceStatus;
begin
  Result := STATUS_SUCCESS;
  hSCMan := OpenSCManager(nil, nil, SC_MANAGER_CONNECT);
  if hSCMan = 0 then
  begin
    Result := GetLastError;
    Exit;
  end;

  hService := OpenService(hSCMan, PChar(FDriverName), SERVICE_STOP);
  if hService = 0 then
  begin
    Result := GetLastError;
  end
  else
  begin
    if not Bool(ControlService(hService, SERVICE_CONTROL_STOP, ServiceStatus)) then
    Result := GetLastError;
    CloseServiceHandle(hService);
  end;
  CloseServiceHandle(hSCMan);
end;


procedure TIOAccess.SetIOPMAccess(OnFlag: Boolean);
var IoctlCode: Cardinal;
    Status: Integer;
    Port32Struct: TIOAccessPortData;
    IoctlResult: Boolean;
    ReturnedLength: Cardinal;
begin
  if FWindowsNT then
  begin
    if OnFlag then
    IoctlCode := IOCTL_IOACCESS_IOPM_ON
    else
    IoctlCode := IOCTL_IOACCESS_IOPM_OFF;

    FIOPMAccess := OnFlag;

    Status := StartDeviceDriver;
    if Status <> STATUS_SUCCESS then
    Exit; // Driver is not installed or is not ready

    IoctlResult := DeviceIoControl(FhndDeviceFile, IoctlCode, @Port32Struct,
                 SizeOf(Port32Struct), nil, 0, ReturnedLength, nil);
  end;
end;

function TIOAccess.OpenDeviceFile(var hndFile: THandle): Integer;
begin
  Result := STATUS_SUCCESS;
  hndFile := CreateFile(PChar('\\.\' + FDriverName), GENERIC_READ or GENERIC_WRITE,
                FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING,
                0, 0);
  if hndFile = INVALID_HANDLE_VALUE then
    Result := GetLastError;
  if GetLastError = ERROR_ALREADY_EXISTS then
    Result := STATUS_SUCCESS;
end;

constructor TIOAccess.Create(Owner: TComponent);
var OS: TOSVersionInfo;
    Buffer: array[1..MAX_PATH] of char;
begin
  inherited Create(Owner);
  // Check if the Operation System is Windows NT/2000. If the OS is
  // Windows NT/2000 the driver have to be used.
  OS.dwPlatformId := 0;
  OS.dwOSVersionInfoSize := SizeOf(OSVERSIONINFO);
  GetVersionEx(OS);
  FWindowsNT := (OS.dwPlatformId=VER_PLATFORM_WIN32_NT);

  FDriverName := 'IOAccess';
  FDriverDisplayName := 'IOAccess Device Driver';
  FDriverGroupName := 'I/O Port Drivers';

  GetSystemDirectory(@Buffer, MAX_PATH);
  FDriverPath := StrCat(@Buffer, PChar('\DRIVERS'));

  FDriverFullPath := StrCat(PChar(FDriverPath), PChar('\' + FDriverName + '.sys'));
end;

destructor TIOAccess.Destroy;
begin
  if FDriverStarted then
  begin
    if FhndDeviceFile <> 0 then
    CloseHandle(FhndDeviceFile);
    StopDriver;
  end;
  inherited Destroy;
end;

procedure TIOAccess.WritePortByte(Port: DWORD; Data: Byte);
var Port32Struct: TIOAccessPortData;
    IoctlResult: Boolean;
    IoctlCode: Cardinal;
    DataLength: DWORD;
    ReturnedLength: Cardinal;
    Status: Integer;
begin
  // First check if the OS is Windows NT/2000 or the program has access to IO
  IoctlResult := False;

  if (not FWindowsNT) or IOPMAccess then
  begin
    ASM
    MOV EDX, Port;
    MOV AL, Data;
    OUT DX, AL;
    end;
    Exit;
  end;

  Status := StartDeviceDriver;
  if Status <> STATUS_SUCCESS then
    Exit; // Driver is not installed or is not ready

  Port32Struct.Port := Port;
  Port32Struct.Data := Data;
  Port32Struct.DataType := 1;
  IoctlCode := IOCTL_IOACCESS_WRITE_PORT_BYTE;

  IoctlResult := DeviceIoControl(FhndDeviceFile, IoctlCode, @Port32Struct,
                 SizeOf(Port32Struct), nil, 0, ReturnedLength, nil);
end;

procedure TIOAccess.WritePortWord(Port: DWORD; Data: Word);
var Port32Struct: TIOAccessPortData;
    IoctlResult: Boolean;
    IoctlCode: Cardinal;
    DataLength: DWORD;
    ReturnedLength: Cardinal;
    Status: Integer;
begin
  // First check if the OS is Windows NT/2000 or the program has access to IO
  if (not FWindowsNT) or FIOPMAccess then
  begin
    ASM
    MOV EDX, Port;
    MOV AX, Data;
    OUT DX, AX;
    end;
    Exit;
  end;

  Status := StartDeviceDriver;
  if Status <> STATUS_SUCCESS then
    Exit; // Driver is not installed or is not ready

  Port32Struct.Port := Port;
  Port32Struct.Data := Data;
  Port32Struct.DataType := 2;
  IoctlCode := IOCTL_IOACCESS_WRITE_PORT_WORD;

  IoctlResult := DeviceIoControl(FhndDeviceFile, IoctlCode, @Port32Struct,
                 SizeOf(TIOAccessPortData ), nil, 0, ReturnedLength, nil);
end;

procedure TIOAccess.WritePortDWord(Port: DWORD; Data: DWord);
var Port32Struct: TIOAccessPortData;
    IoctlResult: Boolean;
    IoctlCode: Cardinal;
    DataLength: DWORD;
    ReturnedLength: Cardinal;
    Status: Integer;
begin
  // First check if the OS is Windows NT/2000 or the program has access to IO
  if (not FWindowsNT) or FIOPMAccess then
  begin
    ASM
    MOV EDX, Port;
    MOV EAX, Data;
    OUT DX, EAX;
    end;
    Exit;
  end;

  Status := StartDeviceDriver;
  if Status <> STATUS_SUCCESS then
    Exit; // Driver is not installed or is not ready

  Port32Struct.Port := Port;
  Port32Struct.Data := Data;
  Port32Struct.DataType := 3;
  IoctlCode := IOCTL_IOACCESS_WRITE_PORT_DWORD;

  IoctlResult := DeviceIoControl(FhndDeviceFile, IoctlCode, @Port32Struct,
                 SizeOf(TIOAccessPortData ), nil, 0, ReturnedLength, nil);
end;


function TIOAccess.ReadPortByte(Port: DWORD): Byte;
var IoctlResult: Boolean;
    IoctlCode: Cardinal;
    DataLength: DWORD;
    ReturnedLength: Cardinal;
    Status: Integer;
    PortNumber: DWORD;
    DataBuffer: TIOAccessPortData;
    BytesReturned, test: DWORD;
begin
  // First check if the OS is Windows NT/2000 or the program has access to IO
  if (not FWindowsNT) or IOPMAccess then
  begin
    ASM
    MOV EDX, Port;
    XOR EAX, EAX;
    IN  AL, DX;
    MOV @Result, AL;
    end;
    Exit;
  end;

  Status := StartDeviceDriver;
  if Status <> STATUS_SUCCESS then
    Exit; // Driver is not installed or is not ready

  DataBuffer.Port := Port;
  DataBuffer.DataType := 1;
  IoctlCode := IOCTL_IOACCESS_READ_PORT_BYTE;

  IoctlResult := DeviceIoControl(FhndDeviceFile, IoctlCode, @DataBuffer,
                 sizeof(DataBuffer), @DataBuffer, sizeof(DataBuffer),
                 BytesReturned, nil);

  if IoctlResult then
    Result := Byte(DataBuffer.Data)
  else
    Result := 0;
end;

function TIOAccess.ReadPortWord(Port: DWORD): Word;
var IoctlResult: Boolean;
    IoctlCode: Cardinal;
    DataLength: DWORD;
    ReturnedLength: Cardinal;
    Status: Integer;
    PortNumber: DWORD;
    DataBuffer: TIOAccessPortData;
    BytesReturned: DWORD;
begin
  // First check if the OS is Windows NT/2000 or the program has access to IO
  if (not FWindowsNT) or FIOPMAccess then
  begin
    ASM
    MOV EDX, Port;
    XOR EAX, EAX;
    IN  AX, DX;
    MOV Result, AX;
    end;
    Exit;
  end;

  Status := StartDeviceDriver;
  if Status <> STATUS_SUCCESS then
    Exit; // Driver is not installed or is not ready

  DataBuffer.Port := Port;
  DataBuffer.DataType := 2;
  IoctlCode := IOCTL_IOACCESS_READ_PORT_WORD;

  IoctlResult := DeviceIoControl(FhndDeviceFile, IoctlCode, @DataBuffer,
                 sizeof(TIOAccessPortData), @Databuffer, sizeof(TIOAccessPortData),
                 BytesReturned, nil);
  if IoctlResult then
    Result := Word(DataBuffer.Data)
  else
    Result := 0;

end;

function TIOAccess.ReadPortDWord(Port: DWORD): DWORD;
var IoctlResult: Boolean;
    IoctlCode: Cardinal;
    DataLength: DWORD;
    ReturnedLength: Cardinal;
    Status: Integer;
    PortNumber: DWORD;
    DataBuffer: TIOAccessPortData;
    BytesReturned: DWORD;
begin
  // First check if the OS is Windows NT/2000 or the program has access to IO
  if (not FWindowsNT) or FIOPMAccess then
  begin
    ASM
    MOV EDX, Port;
    XOR EAX, EAX;
    IN  EAX, DX;
    MOV Result, EAX;
    end;
    Exit;
  end;

  Status := StartDeviceDriver;
  if Status <> STATUS_SUCCESS then
    Exit; // Driver is not installed or is not ready

  DataBuffer.Port := Port;
  DataBuffer.DataType := 3;
  IoctlCode := IOCTL_IOACCESS_READ_PORT_DWORD;

  IoctlResult := DeviceIoControl(FhndDeviceFile, IoctlCode, @DataBuffer,
                 sizeof(TIOAccessPortData), @Databuffer, sizeof(TIOAccessPortData),
                 BytesReturned, nil);
  if IoctlResult then
    Result := DataBuffer.Data
  else
    Result := 0;
end;

function TIOAccess.StartDeviceDriver:Integer;
var Status: Integer;
begin
  Result := STATUS_SUCCESS;
  if FWindowsNT then
  begin
    if not FDriverStarted then
    begin
    Result := StartDriver;
    if Result <> STATUS_SUCCESS then
    begin
      //MessageBox(Application.Handle, PChar('Driver kan niet worden gestart'), PChar('Bericht'), MB_OK);
      Exit; // The driver can't be started
    end
    else
    begin
      //MessageBox(Application.Handle, PChar('Driver is gestart'), PChar('Bericht'), MB_OK)
    end;
    Status := OpenDeviceFile(FhndDeviceFile);
//  if Status = STATUS_SUCCESS then
      //MessageBox(Application.Handle, PChar('Device file is geopend'), PChar('Bericht'), MB_OK)
 //     else
      //MessageBox(Application.Handle, PChar('Device file is NIET GEOPEND'), PChar('Bericht'), MB_OK);
    FDriverStarted := (Status = STATUS_SUCCESS);
    end;
  end;
end;

function TIOAccess.InstallDeviceDriver: Integer;
begin
  Result := STATUS_SUCCESS;
  if FWindowsNT then
  begin
    if (not FileExists(FDriverFullPath)) then
    begin
    Result := CopyDriver;
    if Result <> STATUS_SUCCESS then // Some error occured by copying the
      Exit;               // driver to the system
    end;

    Result := InstallDriver; // You need Administrator access rights
    if Result <> STATUS_SUCCESS then
    begin
    //MessageBox(Application.Handle, PChar('Driver kan niet worden geinstalleerd'), PChar('Bericht'), MB_OK);
    Exit; // The driver can't be installed
    end
    else
    begin
    //MessageBox(Application.Handle, PChar('Driver is geinstalleerd'), PChar('Bericht'), MB_OK);
    end;
  end;
end;

procedure Register;
begin
  RegisterComponents('IOAccess', [TIOAccess]);
end;

end.

[Verwijderd]

Je denkt toch niet dat ik dat allemaalga doorspitten he?

basic rules:
• Variabelen leegmaken
• objecten 'free'-en.

dan moet het wel werken.

[Verwijderd]

Op maandag 06 augustus 2001 22:47 schreef Razor_Blade het volgende:
Je denkt toch niet dat ik dat allemaalga doorspitten he?

Uh nee het gaat eigenlijk alleen om Create en Destroy (en de rest heb ik er voor de volledigheid maar bij gelaten)

Maar ik zie niks verkeerds

[jopiek]

Het zal inderdaad wel zo zijn dat je iets niet goed opruimt... Het zou daarnaast wel even zo vriendelijk van je geweest zijn om ff te vertellen dat dit een componentje in je programma was!!!

Gebeurt deze Access Violation ook als je het componentje delete?
Het ligt waarschijnlijk aan je destructor...

Een goede manier om een component te debuggen is het componentje gewoon op je form te smijten, er iets in te wijzigen (!!!) - al is het maar een spatie - en dan breakpoints te zetten, vooral in je destructor en de stopdriver functie in dit geval

[Johannes]

Op maandag 06 augustus 2001 22:04 schreef tokkie het volgende:
Het is misschien een beetje veel code om hier te plaatsen maar zo is het wel duidelijker.

Ehm, dat zou ik niet willen zeggen, niemand leest zoveel code door. Je kunt beter alleen de stukken plaatsen waar het om gaat, en bijv. een linkje naar de complete code zodat die ook bekeken kan worden.

[jopiek]

Op maandag 06 augustus 2001 22:51 schreef tokkie het volgende:

[..]

Uh nee het gaat eigenlijk alleen om Create en Destroy (en de rest heb ik er voor de volledigheid maar bij gelaten)

Maar ik zie niks verkeerds

Ik weet niet hoeveel ervaring je met Delphi hebt, maar een Access Violation gebeurt op het moment dat je een object probeert te benaderen dat er niet is (object is nil oftewel de pointer naar het object wijst ins blauen hinein)

[jopiek]

Op maandag 06 augustus 2001 22:57 schreef Taradino het volgende:

[..]

Ehm, dat zou ik niet willen zeggen, niemand leest zoveel code door. Je kunt beter alleen de stukken plaatsen waar het om gaat, en bijv. een linkje naar de complete code zodat die ook bekeken kan worden.

Was duidelijk waarom het ging, het was idd wel handig als ie ff een toelichting op zijn projectje had gegeven... Hij zij wel dat het bij het afsluiten gebeurde en omdat er een destructr is was het niet moeilijk te concluderen dat het dus daar fout gaat

[Verwijderd]

Het zou daarnaast wel even zo vriendelijk van je geweest zijn om ff te vertellen dat dit een componentje in je programma was!!!

Uh ja dat klopt

Gebeurt deze Access Violation ook als je het componentje delete?
Het ligt waarschijnlijk aan je destructor...

Als ik een kaal project heb en ik gooi dit componentje er op en ik haal hem weer weg krijg ik geen foutmelding.

Een goede manier om een component te debuggen is het componentje gewoon op je form te smijten, er iets in te wijzigen (!!!) - al is het maar een spatie - en dan breakpoints te zetten, vooral in je destructor en de stopdriver functie in dit geval

Heb ik ook gedaan, maar de destructor voert die gewoon goed uit.

Als ik de deconstructor weg haal, krijg ik nog deze error.

[jopiek]

Op maandag 06 augustus 2001 23:00 schreef tokkie het volgende:

[..]

Uh ja dat klopt
[..]

Als ik een kaal project heb en ik gooi dit componentje er op en ik haal hem weer weg krijg ik geen foutmelding.

Kijk daar hebben we wat aan, zo moet je puzzelen tot je alle stukjes op z'n plaats hebt

[..]

Heb ik ook gedaan, maar de destructor voert die gewoon goed uit.

Als ik de deconstructor weg haal, krijg ik nog deze error.

Als je me ff de IOCTLCodes.pas file zou kunnen sturen (of de dcu maar dan wel voor D6), ik probeer 'm ff maar hij wil die ook graag hebben... ([e-mail])

[Verwijderd]

hij is verstuurd

[Verwijderd]

Het blijkt dat de laatste regel van de constructor de fout veroorzaakt:

code:

  FDriverFullPath := StrCat(PChar(FDriverPath), PChar('\' + FDriverName + '.sys'));

Als ik deze regel verwijder krijg ik geen error.

Wie weet er wat er mis met deze regel is?

[jopiek]

Gewoon debuggen! Breakpoint erop en met F7 er door stappen...
Suc6

[joepP]

Wat gebeurt er als je een project maakt, dit componentje erop zet, compiled, en dan runt en weer afsluit? Dus eigenlijk zonder dat je 1 regel code hebt geschreven..

Gaat het dan ook fout?

[joepP]

code:

FDriverFullPath := StrCat(PChar(bla), PChar('\' + bla2 + '.sys'));

Waarom gebruik je hier StrCat en PChar? Een AnsiString is in Delphi (bij standaard compiler instelling) gewoon een normale string, de volgende code doet precies hetzelfde:

code:

FDriverFullPath := FDriverPath + '\' + FDriverName + '.sys';

Nu hoeft ie intern ook niet allerlei verschillende string-typecasts te doen. Ik denk dat dit ook de oorzaak van de foutmelding is.

Suc6!

[Verwijderd]

Thnx!!

Inderdaad nu werkt die wel gewoon goed.

Maar kan je precies uitleggen wat er dan verkeerd was aan datgene wat ik had?

[joepP]

Het standaard String-type van Delphi is de AnsiString. Dit is een totaal ander type string dan windows gebruikt, de PChar. Een PChar is #0 terminated, en een AnsiString niet.

Wat jij doet is eerst alle AnsiStrings omzetten naar PChars, ze dan met StrCat aan elkaar plakken, en het resultaat (een PChar) weer aan een AnsiString toekennen. Blijkbaar gaat de compiler daar de fout in met geheugentoewijzing ofzo, en daarom krijg je errors. Je code lijkt me niet fout, hooguit omslachtig

Nog iets, ik zie dat je al je Strings als 'AnsiString' hebt aangegeven. Dit is niet gebruikelijk in Delphi, je kan beter 'String' gebruiken zoals iedereen. Intern is dit toch hetzelfde.

Kijk eens in de help bij 'String types', daar staat ook nog eea.