Ian Branch 128 Posted October 24 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 Share this post Link to post
Lajos Juhász 294 Posted October 24 A quick search returned instead of PToken_User it is definied as PTokenUser in Winapi,Windows. Share this post Link to post
Ian Branch 128 Posted October 24 (edited) 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 Share this post Link to post
Remy Lebeau 1420 Posted October 24 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? Share this post Link to post
Lars Fosdal 1793 Posted October 24 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? Share this post Link to post
Ian Branch 128 Posted October 24 (edited) 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 Share this post Link to post
DelphiUdIT 182 Posted October 24 (edited) "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 Share this post Link to post
Ian Branch 128 Posted October 24 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 Share this post Link to post
aehimself 399 Posted October 26 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. Share this post Link to post
Ian Branch 128 Posted October 28 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 Share this post Link to post