Error raised on Freemem
lazarus / 34-Windows

----------------------------------------------------------------------
TyneBridges · 2013-03-26 19:53

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 · 2013-03-26 20:57

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 · 2013-03-26 21:55

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?