Error raised on Freemem

[TyneBridges]

I'm probably doing something stupid here but I can't figure out what. The FindInProcesses function is code from an old Delphi program that worked there. I know that Lazarus isn't Delphi and that @ and ^ are often needed (although I still find it difficult to work out when I should use an address or pointer symbol). I can step through FindInProcesses until the second last line, reading the values of variables from watches. However, on the first occurrence of Freemem the following error appears:

Project FIPTest raised except class 'External: SIGSEGV'

Code: [Select]

Function GetProcessName(Var dwProcessID: DWord): PChar;
Var strProcessName: PChar;
hProcessSnapshot: THandle;
PE: TProcessEntry32;
begin
hProcessSnapshot:= CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0) ;
if hProcessSnapshot <> INVALID_HANDLE_VALUE then
begin
PE.dwSize:= sizeof(PE);
if(Process32First(hProcessSnapshot, PE)) then
repeat
if (dwProcessID = PE.th32ProcessID) then
strProcessName:= PE.szExeFile;
until (strProcessName <> '') or (Not Process32Next(hProcessSnapshot, PE)) ;
CloseHandle(hProcessSnapshot);
end;
Result:= strProcessName;
end; // Function 

function FindInProcesses(const PName: String): DWord;
  const STR_SIZE = 256;
      ListSize = 1024;
  var
     PIDList: array[1..Listsize] of DWORD;
     cbNeeded, cbProcesses, GotName: DWORD;
     I: integer;
     hProcess: HWND;
     hMod: HMODULE;
     CurrentProcName: PChar;
  begin
       // Enumerate all processes on the system
       EnumProcesses(@PIDList, ListSize, cbNeeded);
       cbProcesses:= cbNeeded div SizeOf(DWORD);
       Writeln('cbProcesses is ' + IntToStr(cbProcesses));
       Result:= 0;
       for i:= 1 to cbProcesses do
       begin
            Write('Process ID: ' + IntToStr(PIDList[i]) + ' ');
            hProcess:= OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, FALSE, PIDList[i]);
            EnumProcessModules(hProcess, @hMod, SizeOf(hMod), cbNeeded);
            GetMem(CurrentProcName, STR_SIZE);
            CurrentProcName:= GetProcessName(PIDList[i]);
            If CurrentProcName = '' then Writeln('Failed to get a process name') else Writeln(AnsiString(CurrentProcName) + '. ');
            CloseHandle(hProcess);
            If UpperCase(PChar(CurrentProcName)) = UpperCase(PName) then
            { Found the name. Set Result to the PID of process found }
                 Result:= PIDList[i];
            FreeMem(CurrentProcName);
       end; // For
  end; // FindInProcesses
I've looked through the code and can't see anything wrong, except that I'm hazy on how memory is allocated for a PChar when it's passed to a procedure. Experimenting with the syntax doesn't seem to help - I still get the error if I add , STR_SIZE to the Freemem line. (If FreeMem needed an @, wouldn't GetMem also need this and raise the error earlier in the procedure?)

Thanks in advance for any help.

[marcov]

It's not. You are passing pointers around to some structure on the heap (pe) that is destroyed on procedure exit.

Easiest solution (untested) is to just change the return value to a string. The appropriate conversion of the pointer type to managed string type will then happen.

[TyneBridges]

Thanks, Marcov. I've tried changing the return type of the called procedure to a string:

Code: [Select]

Function GetProcessName(Var dwProcessID: DWord): String;
Var strProcessName: Array[0..512] of Char;
Unfortunately I still get the same error. Did I misunderstand you?