多线程程序样例

{$mode objFPc}
{$threading on}
Uses
 Sysutils;

Var
 k,Times:Longint;
 ok:Wordbool;
 Thread:Longint;

Threadvar
 thr:Longint;

Function run(f:Pointer):Longint;
 Var
  fout:Text;
  td:Longint;
 Begin
  Writeln(‘Thread ‘,Longint(f),’ Started!’);
  Assign(fout,’out.txt’);
  Rewrite(fout);
  While thr<100 Do InterLockedIncrement(thr);
  For td:=1 To 4 Do
   Writeln(fout,Hexstr(td,2));
  Thread:=GetCurrentThreadId;
  Writeln(‘CurrentThreadId Is ‘,Thread);
  Close(fout);
  Writeln(‘Thread ‘,Longint(f),’ Finished!’);
  ok:=True;
  Erase(fout);
 End;

Function get(f:Pointer):Longint;
 Begin
  Writeln(‘Thread ‘,Longint(f),’ Started!’);
  Writeln(thr,’ ‘,Longint(f));
  If (thr=100)And ok Then Writeln(‘OK’) Else Writeln(‘Thr=’,thr);
  Writeln(‘GetCurrentThreadId Is ‘,GetCurrentThreadId);
  Writeln(‘Thread ‘,Longint(f),’ Finished!’);
 End;

Begin
 thr:=25;
 k:=1;
 Beginthread(@run,Pointer(k));
 Inc(k);
 Beginthread(@get,Pointer(k));
 Times:=WaitForThreadTerminate(Thread,100000);
 Writeln(‘Times=’,Times);
 While Not ok Do;
 Writeln(thr,’ Thread=’,Thread);
End.

写了很久了,有兴趣的看看吧