Locate Critical Thread Sections

program CriticalSection;

{$APPTYPE CONSOLE}

uses
  windows;

const
  MAX_TIMES = 1000;

var
  g_Index: Integer = 0;
  g_cs: RTL_CRITICAL_SECTION;
  F: TextFile;

function IntToStr(Int: integer): string;
begin
  Str(Int, result);
end;

function CutFilename(s: string): string;
var
  i: integer;
begin
  result := s;
  for i := length(s) downto 1 do
    if s[i] = '\' then
    begin
      result := copy(s, 1, i);
      break;
    end;
end;

function FirstThread(p: Pointer): Integer;
begin
  result := 0;
  while g_Index < MAX_TIMES do
  begin
    // in CriticalSection eintreten, Ressource sperren
    EnterCriticalSection(g_cs);
    writeln(F, IntToStr(GetTickCount()));
    Inc(g_Index);
    // CriticalSection verlassen
    LeaveCriticalSection(g_cs);
    Sleep(0);
  end;
end;

function SecondThread(p: Pointer): Integer;
begin
  result := 0;
  while g_Index < MAX_TIMES do
  begin
    // in CriticalSection eintreten, Ressource sperren
    EnterCriticalSection(g_cs);
    Inc(g_Index);
    writeln(F, IntToStr(GetTickCount()));
    // CriticalSection verlassen
    LeaveCriticalSection(g_cs);
    Sleep(0);
  end;
end;

var
  hFirst, hSecond: THandle;
  ThreadID: LongWord;
  FirstExitCode, SecExitCode: Cardinal;
  Finished: Boolean = False;

begin
  // CriticalSection initialisieren
  InitializeCriticalSection(g_cs);
  // Datei anlegen
  AssignFile(F, CutFilename(paramStr(0)) + '\TimesFile.txt');
  Rewrite(F);
  // Threads starten
  hFirst := BeginThread(nil, 0, @FirstThread, nil, 0, ThreadID);
  hSecond := BeginThread(nil, 0, @SecondThread, nil, 0, ThreadID);

  writeln('Bitte warten, Datei wird geschrieben...');
  // auf Threads warten
  while not Finished do
  begin
    GetExitCodeThread(hFirst, FirstExitCode);
    GetExitCodeThread(hSecond, SecExitCode);
    if (FirstExitCode = 0) and (SecExitCode = 0) then
      Finished := True;
  end;
  // Datei schließen
  CloseFile(f);

  writeln(#13#10 + 'Fertig.');
  readln;
  // CriticalSection löschen
  DeleteCriticalSection(g_cs);
end.