Skip to content

Bug in Delphi 7 "ReportStatus" could be the cause of the hang (though project needs more work to utilize it correctly) #10

@SkybuckFlying

Description

@SkybuckFlying

(I'm working on a bug fix to try and keep SCM informed when long operations on CreateRam/DestroyRam/DetachRam etc)

Quick description of problem/fix, more on this later:
I guess my ramdisk is big enough that it might take more than 30 seconds to read/write to disk to complete the storing of files/destruction of ramdisk etc, this could lead to premature termination of ramservice, so a fix would be to inform it more properly to stay alive...

Gemini has stubbornly identified a bug in Delphi 7, not directly but it kept insisting it's solution was better, later Co-Pilot also identified the bug, as well as did I somewhat and another session with Gemini more or less confirmed it:

So this Delphi 7 bug could introduce potential extra issues into the code base/executable:

In short:

The issue is with:

Seems like a bug in delphi 7:

const
LastStatus: TCurrentStatus = csStartPending;

This should have been a member field of TService.

Gemini explains the problem as follows:

procedure TService.ReportStatus;

const

LastStatus: TCurrentStatus = csStartPending;

NTServiceStatus: array[TCurrentStatus] of Integer = (SERVICE_STOPPED,

SERVICE_START_PENDING, SERVICE_STOP_PENDING, SERVICE_RUNNING,

SERVICE_CONTINUE_PENDING, SERVICE_PAUSE_PENDING, SERVICE_PAUSED);

PendingStatus: set of TCurrentStatus = [csStartPending, csStopPending,

csContinuePending, csPausePending];

var

ServiceStatus: TServiceStatus;

begin

with ServiceStatus do

begin

dwWaitHint := FWaitHint;

dwServiceType := GetNTServiceType;

if FStatus = csStartPending then

  dwControlsAccepted := 0 else

  dwControlsAccepted := GetNTControlsAccepted;

if (FStatus in PendingStatus) and (FStatus = LastStatus) then

  Inc(dwCheckPoint) else

  dwCheckPoint := 0;

LastStatus := FStatus;

dwCurrentState := NTServiceStatus[FStatus];

dwWin32ExitCode := Win32ErrCode;

dwServiceSpecificExitCode := ErrCode;

if ErrCode <> 0 then

  dwWin32ExitCode := ERROR_SERVICE_SPECIFIC_ERROR;

if not SetServiceStatus(FStatusHandle, ServiceStatus) then

  LogMessage(SysErrorMessage(GetLastError));

end;

end;

Notice how LastStatus is a local variable instead of a class variable ?

So LastStatus would basically be lost on re-entry ?

You are correct. Based on the code snippet you've provided, the LastStatus variable is declared as a const within the ReportStatus procedure. This means it is a local constant initialized to csStartPending every time the ReportStatus procedure is called.

The logic if (FStatus in PendingStatus) and (FStatus = LastStatus) then Inc(dwCheckPoint) else dwCheckPoint := 0; followed by LastStatus := FStatus; is designed to track the previous status to correctly increment the dwCheckPoint when a service is in a pending state. However, because LastStatus is re-initialized on each call, this logic will not work as intended. The value assigned to LastStatus at the end of the procedure call will be lost when the procedure exits.

To fix this, LastStatus should be a member of the TService class (a class variable) or a global variable if it needs to be shared across the entire application, and it should be declared and initialized outside the ReportStatus procedure. This would allow its value to persist between calls to ReportStatus.

Here's an example of how you might declare it as a class member:
Code snippet

type
TService = class(TServiceComponent)
private
FStatus: TCurrentStatus;
LastStatus: TCurrentStatus; // Declare LastStatus here
// ... other private fields
public
procedure ReportStatus;
// ... other public methods
end;

// ...
procedure TService.ReportStatus;
const
// ... other constants
var
// ... local variables
begin
// ...
if (FStatus in PendingStatus) and (FStatus = LastStatus) then
Inc(dwCheckPoint)
else
dwCheckPoint := 0;
LastStatus := FStatus; // Assign to the class member
// ...
end;

This bug would cause the service's checkpoint to never increment correctly, which could lead to issues with the Service Control Manager (SCM) timing out on pending operations, as it relies on the checkpoint value to know that the service is still making progress.

Metadata

Metadata

Assignees

No one assigned

    Labels

    No labels
    No labels

    Projects

    No projects

    Milestone

    No milestone

    Relationships

    None yet

    Development

    No branches or pull requests

    Issue actions