Need help please..

[Ian Branch 128]

Win 11, D12.2 P1.  32 bit App.

I asked ChatGPT to write a unit that would scan a given drive/directory for all instances of a .exe file starting with 'DBi', and return the name of the file(s) that were currently in use and the name of the User(s).

ChatGPT gave me this:

uses
  System.SysUtils, System.Classes, Windows, TlHelp32, PsAPI, JclSysInfo;

function IsFileOpen(const FileName: string): Boolean;
var
  HFile: THandle;
begin
  HFile := CreateFile(PChar(FileName), GENERIC_READ or GENERIC_WRITE,
    0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
  Result := (HFile = INVALID_HANDLE_VALUE);
  if not Result then
    CloseHandle(HFile);
end;

function GetUserNameForProcess(ProcessID: DWORD): string;
var
  hProcess: THandle;
  TokenHandle: THandle;
  TokenUser: PTOKEN_USER;
  ReturnLength: DWORD;
  Name: array[0..255] of Char;
  NameLength: DWORD;
  Domain: array[0..255] of Char;
  DomainLength: DWORD;
  Use: SID_NAME_USE;
begin
  Result := 'Unknown';
  hProcess := OpenProcess(PROCESS_QUERY_INFORMATION, False, ProcessID);
  if hProcess <> 0 then
  begin
    if OpenProcessToken(hProcess, TOKEN_QUERY, TokenHandle) then
    try
      GetTokenInformation(TokenHandle, TokenUser, nil, 0, ReturnLength);
      TokenUser := AllocMem(ReturnLength);
      try
        if GetTokenInformation(TokenHandle, TokenUser, ReturnLength, ReturnLength) then
        begin
          NameLength := SizeOf(Name);
          DomainLength := SizeOf(Domain);
          if LookupAccountSid(nil, TokenUser.User.Sid, Name, NameLength, Domain, DomainLength, Use) then
            Result := Format('%s\%s', [Domain, Name]);
        end;
      finally
        FreeMem(TokenUser);
      end;
    finally
      CloseHandle(TokenHandle);
    end;
    CloseHandle(hProcess);
  end;
end;

procedure ScanForDBiFiles(const Directory: string; var Results: TStringList);
var
  SearchRec: TSearchRec;
  ProcessEntry: TProcessEntry32;
  Snapshot: THandle;
  FileName: string;
begin
  Results.Clear;
  
  if FindFirst(IncludeTrailingPathDelimiter(Directory) + 'DBi*.exe', faAnyFile, SearchRec) = 0 then
  begin
    try
      repeat
        FileName := IncludeTrailingPathDelimiter(Directory) + SearchRec.Name;

        // Check if the file is open
        if IsFileOpen(FileName) then
        begin
          // Enumerate processes to find the one using this file
          Snapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
          if Snapshot <> INVALID_HANDLE_VALUE then
          begin
            ProcessEntry.dwSize := SizeOf(TProcessEntry32);
            if Process32First(Snapshot, ProcessEntry) then
            begin
              repeat
                // Check if the process has the same file name as the one we're looking for
                if SameText(ExtractFileName(ProcessEntry.szExeFile), SearchRec.Name) then
                begin
                  Results.Add(Format('File: %s, User: %s', [FileName, GetUserNameForProcess(ProcessEntry.th32ProcessID)]));
                  Break;
                end;
              until not Process32Next(Snapshot, ProcessEntry);
            end;
            CloseHandle(Snapshot);
          end;
        end;
      until FindNext(SearchRec) <> 0;
    finally
      FindClose(SearchRec);
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Results: TStringList;
begin
  Results := TStringList.Create;
  try
    ScanForDBiFiles('C:\YourDirectory', Results);
    ShowMessage(Results.Text);
  finally
    Results.Free;
  end;
end;

Whilst most of it is OK, Delphi balks immediately at "TokenUser: PTOKEN_USER;".  😞

Seems it doesn't know about PTOKEN_USER.  ??

I think it is part of Windows but I can't pin it down.

I would really appreciate any and all help in getting this going.

Regards & TIA,

Ian

[Lajos Juhász 295]

A quick search returned instead of PToken_User it is definied as PTokenUser in Winapi,Windows.

[Ian Branch 128]

Tks Lajos.  Appreciated.

That solved that issue but unfortunately I don't understand enough about using Windows stuff to understand why

       GetTokenInformation(TokenHandle, TokenUser, nil, 0, ReturnLength);

and

        if GetTokenInformation(TokenHandle, TokenUser, ReturnLength, ReturnLength) then

are not hapy in this context.  😞

I perceive it is probably to do with the use of TokenUser.

Edited October 24 by Ian Branch

[Remy Lebeau 1436]

2 hours ago, Ian Branch said:

I asked ChatGPT to write a unit...

Never a good idea...

2 hours ago, Ian Branch said:

function IsFileOpen(const FileName: string): Boolean;
var
  HFile: THandle;
begin
  HFile := CreateFile(PChar(FileName), GENERIC_READ or GENERIC_WRITE,
    0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
  Result := (HFile = INVALID_HANDLE_VALUE);
  if not Result then
    CloseHandle(HFile);
end;

This function is not very accurate. A file can fail to open for any number of reasons, and you are treating all errors as success.  A more accurate approach would be to open the file in exclusive mode and then check if the error code is ERROR_SHARING_VIOLATION specifically.

14 minutes ago, Ian Branch said:

That solved that issue but unfortunately I don't understand enough about using Windows stuff to understand why

       GetTokenInformation(TokenHandle, TokenUser, nil, 0, ReturnLength);

and

        if GetTokenInformation(TokenHandle, TokenUser, ReturnLength, ReturnLength) then

are not hapy in this context.  😞

Can you be more specific? What is the actual problem you are having with it?

[Lars Fosdal 1793]

https://learn.microsoft.com/en-us/windows/win32/api/securitybaseapi/nf-securitybaseapi-gettokeninformation

 

BOOL GetTokenInformation(
  [in]            HANDLE                  TokenHandle,
  [in]            TOKEN_INFORMATION_CLASS TokenInformationClass,
  [out, optional] LPVOID                  TokenInformation,
  [in]            DWORD                   TokenInformationLength,
  [out]           PDWORD                  ReturnLength
);

TokenInformationLength should be the size of the TokenInformationClass?

[Ian Branch 128]

26 minutes ago, Remy Lebeau said:

A more accurate approach would be to open the file in exclusive mode and then check if the error code is ERROR_SHARING_VIOLATION specifically.

Noted.  Tks.  A minor aspect I can resolve later.

26 minutes ago, Remy Lebeau said:

What is the actual problem you are having with it?

Delphi gives me this:  [dcc32 Error] Unit20.pas(58): E2010 Incompatible types: 'TTokenInformationClass' and 'PTokenUser'

Edited October 24 by Ian Branch

[DelphiUdIT 187]

"TokenUser" is a an enum member of TTokenInformationClass defined in WinApi.Windows.

You have redefined it in you local variables.

 

EDIT: of course you can use TTokenInformationClass.TokenUser instaed ...

Edited October 24 by DelphiUdIT

[Ian Branch 128]

My thanks to all.

This is clearly all out of my league. 😞

I will drop this idea.

Thanks again to all for your input/advice.

 

Ian 

[aehimself 399]

This is the unit I use before my application will be updated. It lists the PIDs of instances of the same executable. It's not exactly what you need but with a small modification you can get it to work.

 

CommandLineParameters (in uCommandLineParameters) is a singleton with easy access to general command line information... you safely can throw it out from your version.
 

Unit uOtherInstances;

Interface

Uses System.SysUtils;

Procedure TerminateOtherInstances;
Function OtherInstances: TArray<Cardinal>;

Implementation

Uses WinApi.Windows, WinApi.TlHelp32, uCommandLineParameters;

Type
  PTOKEN_USER = ^TOKEN_USER;

Function GetUserAndDomainFromPID(inPID: Cardinal; Var User, Domain: String): Boolean;
Var
  phandle, hToken: THandle;
  cbBuf: Cardinal;
  ptiUser: PTOKEN_USER;
  snu: SID_NAME_USE;
  UserSize, DomainSize: DWORD;
  bSuccess: Boolean;
Begin
  Result := False;

  phandle := OpenProcess(PROCESS_QUERY_INFORMATION, False, inPID);

  If phandle = 0 Then
    Exit;

//  EnableProcessPrivilege(ProcessHandle, 'SeSecurityPrivilege', True);
  Try
    If Not OpenProcessToken(phandle, TOKEN_QUERY, hToken) Then
      Exit;

    Try
      bSuccess := GetTokenInformation(hToken, TokenUser, nil, 0, cbBuf);
      ptiUser  := nil;

      While Not bSuccess And (GetLastError = ERROR_INSUFFICIENT_BUFFER) Do
      Begin
        ReallocMem(ptiUser, cbBuf);
        bSuccess := GetTokenInformation(hToken, TokenUser, ptiUser, cbBuf, cbBuf);
      End;
    Finally
     CloseHandle(hToken);
    End;

    If Not bSuccess Then
      Exit;

    Try
      UserSize := 0;
      DomainSize := 0;
      LookupAccountSid(nil, ptiUser.User.Sid, nil, UserSize, nil, DomainSize, snu);

      If (UserSize = 0) Or (DomainSize = 0) Then
        Exit;

      SetLength(User, UserSize);
      SetLength(Domain, DomainSize);
      If Not LookupAccountSid(nil, ptiUser.User.Sid, PChar(User), UserSize, PChar(Domain), DomainSize, snu) Then
        Exit;

      Result := True;
      User := StrPas(PChar(User));
      Domain := StrPas(PChar(Domain));
    Finally
      FreeMem(ptiUser);
    End;
  Finally
    CloseHandle(phandle);
  End;
End;

Function ProcessBelongsToUser(Const inPID: Cardinal; Const inUser: String): Boolean;
Var
  domain, user: String;
Begin
  Result := GetUserAndDomainFromPID(inPid, user, domain) And (user = inUser);
End;

Function OtherInstances: TArray<Cardinal>;
Var
  len: DWord;
  user, exe: String;
  success: Boolean;
  psnapshot: THandle;
  pe: TProcessEntry32;
  currentpid: Cardinal;
Begin
  exe := CommandLineParameters.ExeName.ToLower;
  currentpid := GetCurrentProcessId;

  len := 256;
  SetLength(user, len);

  If Not GetUserName(PChar(user), len) Then
    RaiseLastOSError;

  SetLength(user, len - 1);
  user := user.ToLower;

  SetLength(Result, 0);

  psnapshot := CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0);
  Try
    pe.dwSize := SizeOf(pe);
    success := Process32First(psnapshot, pe);

    While success Do
    Begin
      If (pe.th32ProcessID <> currentpid) And (String(pe.szExeFile).ToLower = exe) And (CommandLineParameters.Portable Or ProcessBelongsToUser(pe.th32ProcessID, user)) Then
      Begin
        SetLength(Result, Length(Result) + 1);
        Result[High(Result)] := pe.th32ProcessID;
      End;

      success := Process32Next(psnapshot, pe);
    End;
  Finally
    CloseHandle(psnapshot);
  End;
End;

Procedure TerminateOtherInstances;
Var
  pid: Cardinal;
  phandle: THandle;
Begin
  For pid In OtherInstances Do
  Begin
    phandle := OpenProcess(PROCESS_TERMINATE, False, pid);

    If phandle = 0 Then
      RaiseLastOSError;

    Try
      TerminateProcess(phandle, 1);
    Finally
      CloseHandle(phandle);
    End;
  End;
End;

End.

 

[Ian Branch 128]

Thank you one and all.  For the record, I have it working with the following code: 

unit Unit20;

interface

uses
  Winapi.Windows, Winapi.TlHelp32,
  System.SysUtils, System.Classes,
  Vcl.Controls, Vcl.Forms, Vcl.StdCtrls;

type
  TForm20 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form20: TForm20;

implementation

{$R *.dfm}

type
  PTOKEN_USER = ^TOKEN_USER;
  //

function IsFileOpen(const FileName: string): Boolean;
var
  HFile: THandle;
begin
  // Try to open the file with exclusive access (no sharing allowed)
  HFile := CreateFile(PChar(FileName), GENERIC_READ or GENERIC_WRITE, 0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);

  // Check if the file handle is invalid, which indicates an error
  if HFile = INVALID_HANDLE_VALUE then
    // Check if the error is due to a sharing violation
    Result := GetLastError = ERROR_SHARING_VIOLATION
  else
  begin
    // If the file was successfully opened, it means there’s no sharing violation
    Result := False;
    CloseHandle(HFile); // Close the handle if we managed to open the file
  end;
  //
end;

function GetUserNameForProcess(ProcessID: DWORD): string;
var
  hProcess: THandle;
  TokenHandle: THandle;
  //TokenUser: PTOKENUSER;
  ptiUser: PTOKEN_USER;
  ReturnLength: DWORD;
  Name: array[0..255] of Char;
  NameLength: DWORD;
  Domain: array[0..255] of Char;
  DomainLength: DWORD;
  Use: SID_NAME_USE;
begin
  //
  Result := 'Unknown';
  hProcess := OpenProcess(PROCESS_QUERY_INFORMATION, False, ProcessID);
  //
  if hProcess <> 0 then
  begin
    if OpenProcessToken(hProcess, TOKEN_QUERY, TokenHandle) then
      try
        GetTokenInformation(TokenHandle, TokenUser, nil, 0, ReturnLength);
        ptiUser := AllocMem(ReturnLength);
        try
          if GetTokenInformation(TokenHandle, TokenUser, ptiUser, ReturnLength, ReturnLength) then
          begin
            NameLength := SizeOf(Name);
            DomainLength := SizeOf(Domain);
            if LookupAccountSid(nil, ptiUser.User.Sid, Name, NameLength, Domain, DomainLength, Use) then
              Result := Format('%s\%s', [Domain, Name]);
          end;
        finally
          FreeMem(ptiUser);
        end;
      finally
        CloseHandle(TokenHandle);
      end;
    CloseHandle(hProcess);
  end;
  //
end;

procedure ScanForDBiFiles(const Directory: string; var Results: TStringList);
var
  SearchRec: TSearchRec;
  ProcessEntry: TProcessEntry32;
  Snapshot: THandle;
  FileName: string;
begin
  //
  Results.Clear;
  //
  if FindFirst(IncludeTrailingPathDelimiter(Directory) + 'DBi*.exe', faAnyFile, SearchRec) = 0 then
  begin
    try
      repeat
        FileName := IncludeTrailingPathDelimiter(Directory) + SearchRec.Name;

        // Check if the file is open
        if IsFileOpen(FileName) then
        begin
          // Enumerate processes to find the one using this file
          Snapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
          if Snapshot <> INVALID_HANDLE_VALUE then
          begin
            ProcessEntry.dwSize := SizeOf(TProcessEntry32);
            if Process32First(Snapshot, ProcessEntry) then
            begin
              repeat
                // Check if the process has the same file name as the one we're looking for
                if SameText(ExtractFileName(ProcessEntry.szExeFile), SearchRec.Name) then
                begin
                  //                  Results.Add(Format('File: %s, User: %s', [FileName, GetUserNameForProcess(ProcessEntry.th32ProcessID)]));
                  Results.Add(Format('File: %-17s User: %s', [ExtractFileName(FileName), GetUserNameForProcess(ProcessEntry.th32ProcessID)]));
                  //                  Break;
                end;
              until not Process32Next(Snapshot, ProcessEntry);
            end;
            CloseHandle(Snapshot);
          end;
        end;
      until FindNext(SearchRec) <> 0;
    finally
      FindClose(SearchRec);
    end;
  end;
  //
end;

procedure TForm20.Button1Click(Sender: TObject);
var
  Results: TStringList;
begin
  //
  Results := TStringList.Create;
  try
    ScanForDBiFiles('E:\DBiWorkflow', Results);
    Memo1.Lines.Assign(Results); // This line adds the results to Memo1
  finally
    Results.Free;
  end;
  //
end;

end.

My thanks to all for your input.  Appreciated.

 

Ian