Is it possible to identify which open programs the BDE uses for connection? How do I do?

3

I need to know from a list of open programs which are using BDE for database access, so I want to know if it's possible and how I do it.

Att

Luiz

    
asked by anonymous 24.08.2015 / 01:33

1 answer

3

One way to do this is to list the dll 's that the process is using, but if the process has not yet loaded the dll you are looking for, this process will not appear in the list, presence of dll 's in processes.

uses TlHelp32;

TCardinalArray = array of Cardinal;
ECanContinue = class(Exception);

function EnumerateProcessesThatHasLoadedAModule(const AModuleName: String; IncludeCurrentProcess: Boolean = False): TCardinalArray; forward;
  • The function expects the module name as the first argument.
  • The second parameter specifies whether you want to include the process itself in the list of processes to be scanned, by default the value is false, that is, the current process will not be considered.
  • The function returns a list of the PIDs that have the module you passed in the first argument.
function EnumerateProcessesThatHasLoadedAModule(
  const AModuleName: String;
  IncludeCurrentProcess: Boolean = False): TCardinalArray;
var
  ProcessList: array [0..1023] of DWORD;
  I, ProcessCount: Integer;
  BytesReturnedInProcessList: DWORD;
  CurrentProcessID: Cardinal;
  UpperModule: String;
  IsModulePresent: Boolean;

  function IsModuleDetected(const TargetModuleName: String; PID: DWORD): Boolean;
  var
    ModuleEntry32: TModuleEntry32;
    RetVal, ErrorCode: Cardinal;
    HasModule: Boolean;
    StrModuleName: String;
  begin
    Result:= False;
    repeat
      RetVal:= CreateToolhelp32Snapshot(TH32CS_SNAPMODULE, PID);

      ErrorCode := ERROR_SUCCESS;
      if RetVal = INVALID_HANDLE_VALUE then
      begin
        ErrorCode:= GetLastError;
        if ErrorCode <> ERROR_BAD_LENGTH then
        begin
          if (ErrorCode = ERROR_ACCESS_DENIED) or (ErrorCode = ERROR_PARTIAL_COPY) then
            raise ECanContinue.Create(SysErrorMessage(ErrorCode))
          else
            RaiseLastOSError;
        end;
      end;
    until ErrorCode <> ERROR_BAD_LENGTH;

    try
      ModuleEntry32.dwSize := SizeOf(ModuleEntry32);
      HasModule:= Integer(Module32First(RetVal, ModuleEntry32)) <> 0;

      while HasModule do
      begin
        StrModuleName := ModuleEntry32.szModule;
        Result:= UpperCase(StrModuleName) = TargetModuleName;

        if Result  then
          Break
        else
          HasModule:= Integer(Module32Next(RetVal, ModuleEntry32)) <> 0;
      end;
    finally
      CloseHandle(RetVal);
    end;
  end;

begin
  SetLength(Result, 0);
  CurrentProcessID:= GetCurrentProcessId;
  UpperModule:= UpperCase(AModuleName);
  if EnumProcesses(@ProcessList, 1024, BytesReturnedInProcessList) then
  begin
    ProcessCount:= BytesReturnedInProcessList div SizeOf(DWORD);
    for I:= 0 to ProcessCount-1 do
    begin
      if (ConsiderCurrentProcess or (CurrentProcessID <> ProcessList[I])) and  
         //Ignore Idle 'Fake' Process...
         (ProcessList[I] <> 0 )  then
      begin
        try
          IsModulePresent:= IsModuleDetected(UpperModule, ProcessList[I]);

          //FROM MSDN:
          (*
             If the specified process is the Idle process or one of the CSRSS processes,
             this function fails and the last error code is ERROR_ACCESS_DENIED because their access restrictions
             prevent user-level code from opening them.
          *)
        except
          on E: ECanContinue do
            IsModulePresent := False;
          else
            raise;
        end;

        if IsModulePresent then
        begin
          SetLength(Result, Length(Result) + 1);
          Result[Length(Result) -1] := ProcessList[I];
        end;
      end;
    end;
  end
  else
    RaiseLastOSError;
end;

The function call would look like this:

var PIDs: TCardinalArray;
begin
  PIDs:= EnumerateProcessesThatHasLoadedAModule('IDAPI32.DLL');
    
25.08.2015 / 14:49