home *** CD-ROM | disk | FTP | other *** search
/ synchro.net / synchro.net.tar / synchro.net / main / BBS / D32_01.ZIP / THREADS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-11-25  |  10.2 KB  |  402 lines
  1. unit THREADS;
  2. (*
  3. **
  4. ** Serial and TCP/IP communication routines for DOS, OS/2 and Win9x/NT.
  5. ** Tested with: TurboPascal   v7.0,    (DOS)
  6. **              VirtualPascal v2.0,    (OS/2, Win32)
  7. **              FreePascal    v0.99.12 (DOS, Win32)
  8. **              Delphi        v4.0.    (Win32)
  9. **
  10. ** Version : 1.01
  11. ** Created : 07-Mar-1999
  12. ** Last update : 26-Sep-1999
  13. **
  14. ** Note: (c) 1998-1999 by Maarten Bekers
  15. **
  16. *)
  17.  
  18. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  19.  INTERFACE
  20. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  21.  
  22. {$IFDEF OS2}
  23.  uses Os2Base;
  24. {$ENDIF}
  25.  
  26. {$IFDEF WIN32}
  27.  uses Windows;
  28. {$ENDIF}
  29.  
  30. {$IFDEF OS2}
  31.   Type THandle = Longint;
  32.        DWORD   = Longint;
  33. {$ENDIF}
  34.  
  35. {$IFDEF WIN32}
  36.  {$IFDEF FPC}
  37.    Type THandle = Handle;
  38.  {$ENDIF}
  39. {$ENDIF}
  40.  
  41. type TSysEventObj = Object
  42.        {$IFDEF OS2}
  43.          SemHandle: HEV;
  44.        {$ENDIF}
  45.  
  46.        {$IFDEF WIN32}
  47.          SemHandle: THandle;
  48.        {$ENDIF}
  49.  
  50.        constructor init;
  51.        destructor done;
  52.  
  53.        procedure DisposeEvent;
  54.        procedure SignalEvent;
  55.        procedure ResetEvent;
  56.        function  CreateEvent(InitialState: Boolean): Boolean;
  57.        function  WaitForEvent(TimeOut: Longint): Boolean;
  58.      end; { TSysEventObj }
  59.  
  60. Type PSysEventObj = ^TSysEventObj;
  61.  
  62. type TExclusiveObj = Object
  63.        {$IFDEF OS2}
  64.          Exclusive: PHMtx;
  65.        {$ENDIF}
  66.  
  67.        {$IFDEF WIN32}
  68.          Exclusive: PRTLCriticalSection;
  69.        {$ENDIF}
  70.  
  71.        constructor Init;
  72.        destructor Done;
  73.  
  74.        procedure CreateExclusive;
  75.        procedure DisposeExclusive;
  76.  
  77.        procedure EnterExclusive;
  78.        procedure LeaveExclusive;
  79.      end; { TExclusiveObj }
  80.  
  81. Type PExclusiveObj = ^TExclusiveObj;
  82.  
  83.  
  84. type TThreadsObj = Object
  85.        ThreadHandle : THandle;
  86.        ThreadID     : DWORD;
  87.  
  88.        constructor Init;
  89.        destructor Done;
  90.  
  91.        function CreateThread(StackSize    : Longint;
  92.                              CallProc,
  93.                              Parameters   : Pointer;
  94.                              CreationFlags: Longint): Boolean;
  95.        procedure CloseThread;
  96.        procedure TerminateThread(ExitCode: Longint);
  97.      end; { TThreadsObj }
  98.  
  99. Type PThreadsObj = ^TThreadsObj;
  100.  
  101. procedure ExitThisThread;
  102.  
  103. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  104.  IMPLEMENTATION
  105. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  106.  
  107. constructor TSysEventObj.Init;
  108. begin
  109.   SemHandle := 0;
  110. end; { constructor Init }
  111.  
  112. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  113.  
  114. destructor TSysEventObj.Done;
  115. begin
  116.   if SemHandle <> -1 then
  117.     begin
  118.       SignalEvent;
  119.       DisposeEvent;
  120.     end; { if }
  121. end; { destructor Done }
  122.  
  123. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  124.  
  125. function TSysEventObj.CreateEvent(InitialState: Boolean): Boolean;
  126. var Returncode: longint;
  127. begin
  128.   CreateEvent := true;
  129.  
  130.   {$IFDEF WIN32}
  131.     SemHandle := Windows.CreateEvent(nil, true, InitialState, nil);
  132.     if SemHandle = -1 then CreateEvent := false;
  133.   {$ENDIF}
  134.  
  135.   {$IFDEF OS2}
  136.     returncode := DosCreateEventSem(nil, SemHandle, 0, InitialState);
  137.     CreateEvent := (returncode=0);
  138.   {$ENDIF}
  139. end; { func. CreateEvent }
  140.  
  141. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  142.  
  143. procedure TSysEventObj.SignalEvent;
  144. var RC: Longint;
  145. begin
  146.   {$IFDEF WIN32}
  147.     if SemHandle <> -1 then
  148.       SetEvent(SemHandle);
  149.   {$ENDIF}
  150.  
  151.   {$IFDEF OS2}
  152.     if SemHandle <> -1 then
  153.       RC := DosPostEventSem(SemHandle);
  154.   {$ENDIF}
  155. end; { proc. SignalEvent }
  156.  
  157. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  158.  
  159. procedure TSysEventObj.ResetEvent;
  160. var Flag: Longint;
  161.     RC  : Longint;
  162. begin
  163.   {$IFDEF WIN32}
  164.     if SemHandle <> -1 then
  165.       Windows.ResetEvent(SemHandle);
  166.   {$ENDIF}
  167.  
  168.   {$IFDEF OS2}
  169.     Flag := 0;
  170.     if SemHandle <> -1 then
  171.       RC := DosResetEventSem(SemHandle, Flag);
  172.   {$ENDIF}
  173. end; { proc. ResetEvent }
  174.  
  175. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  176.  
  177. function TSysEventObj.WaitForEvent(TimeOut: Longint): Boolean;
  178. var ReturnCode: Longint;
  179.     Flag      : Longint;
  180. begin
  181.   {$IFDEF WIN32}
  182.     if SemHandle <> -1 then
  183.       ReturnCode := WaitForSingleObject(SemHandle, Timeout);
  184.     WaitForEvent := (ReturnCode = WAIT_OBJECT_0);
  185.   {$ENDIF}
  186.  
  187.   {$IFDEF OS2}
  188.     if SemHandle <> -1 then
  189.       ReturnCode := DosWaitEventSem(SemHandle, TimeOut);
  190.  
  191.     Flag := 0;
  192.     DosResetEventSem(SemHandle, Flag);
  193.     WaitForEvent := (ReturnCode = 0);
  194. {$ENDIF}
  195. end; { func. WaitForEvent }
  196.  
  197. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  198.  
  199. procedure TSysEventObj.DisposeEvent;
  200. var Flag: Longint;
  201. begin
  202.   {$IFDEF WIN32}
  203.     if SemHandle <> -1 then CloseHandle(SemHandle);
  204.     SemHandle := 0;
  205.   {$ENDIF}
  206.  
  207.   {$IFDEF OS2}
  208.     Flag := 0;
  209.     if SemHandle <> -1 then DosCloseEventSem(SemHandle);
  210.     SemHandle := -1;
  211.   {$ENDIF}
  212. end; { proc. DisposeEvent }
  213.  
  214. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  215.  
  216. constructor TExclusiveObj.Init;
  217. begin
  218.   Exclusive := nil;
  219. end; { constructor Init }
  220.  
  221. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  222.  
  223. destructor TExclusiveObj.Done;
  224. begin
  225.   if Exclusive <> nil then
  226.     DisposeExclusive;
  227. end; { destructor Done }
  228.  
  229. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  230.  
  231. procedure TExclusiveObj.CreateExclusive;
  232. begin
  233.   {$IFDEF WIN32}
  234.     New(Exclusive);
  235.     InitializeCriticalSection(Exclusive^);
  236.   {$ENDIF}
  237.  
  238.   {$IFDEF OS2}
  239.     New(Exclusive);
  240.     DosCreateMutexSem(nil, Exclusive^, dcmw_Wait_All, false);
  241.   {$ENDIF}
  242. end; { proc. CreateExclusive }
  243.  
  244. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  245.  
  246. procedure TExclusiveObj.DisposeExclusive;
  247. begin
  248.   {$IFDEF WIN32}
  249.     if Exclusive <> nil then
  250.       begin
  251.         DeleteCriticalSection(Exclusive^);
  252.         Dispose(Exclusive);
  253.       end; { if }
  254.  
  255.     Exclusive := nil;
  256.   {$ENDIF}
  257.  
  258.   {$IFDEF OS2}
  259.     if Exclusive <> nil then
  260.       begin
  261.         DosCloseMutexSem(Exclusive^);
  262.         Dispose(Exclusive);
  263.       end; { if }
  264.  
  265.     Exclusive := nil;
  266.   {$ENDIF}
  267. end; { proc. DisposeExclusive }
  268.  
  269. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  270.  
  271. procedure TExclusiveObj.EnterExclusive;
  272. begin
  273.   {$IFDEF WIN32}
  274.      EnterCriticalSection(Exclusive^);
  275.   {$ENDIF}
  276.  
  277.   {$IFDEF OS2}
  278.     DosRequestMutexSem(Exclusive^, sem_Indefinite_Wait);
  279.   {$ENDIF}
  280. end; { proc. EnterExclusive }
  281.  
  282. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  283.  
  284. procedure TExclusiveObj.LeaveExclusive;
  285. begin
  286.   {$IFDEF WIN32}
  287.     LeaveCriticalSection(Exclusive^);
  288.   {$ENDIF}
  289.  
  290.   {$IFDEF OS2}
  291.     DosReleaseMutexSem(Exclusive^);
  292.   {$ENDIF}
  293. end; { proc. LeaveExclusive }
  294.  
  295. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  296.  
  297. constructor TThreadsObj.Init;
  298. begin
  299.   ThreadHandle := 0;
  300.   ThreadId := 0;
  301. end; { constructor Init }
  302.  
  303. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  304.  
  305. destructor TThreadsObj.Done;
  306. begin
  307.   CloseThread;
  308.   ThreadHandle := 0;
  309. end; { destructor Done }
  310.  
  311. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  312.  
  313. function TThreadsObj.CreateThread(StackSize    : Longint;
  314.                                   CallProc,
  315.                                   Parameters   : Pointer;
  316.                                   CreationFlags: Longint): Boolean;
  317. var ReturnCode: Longint;
  318. begin
  319.  {$IFNDEF VirtualPascal}
  320.   {$IFDEF WIN32}
  321.     ThreadHandle := Windows.CreateThread(nil,               { Security attrs }
  322.                                  StackSize,                     { Stack size }
  323.                                  CallProc,                { Actual procedure }
  324.                                  Parameters,                    { Parameters }
  325.                                  CreationFlags,             { Creation flags }
  326.                                  ThreadID);                   { Thread ID ?? }
  327.  
  328.      CreateThread := (ThreadHandle <> -1);
  329.   {$ENDIF}
  330.  
  331.   {$IFDEF OS2}
  332.     ReturnCode :=
  333.       DosCreateThread(ThreadHandle,                           { ThreadHandle }
  334.                       CallProc,                           { Actual procedure }
  335.                       Longint(Parameters),                      { Parameters }
  336.                       CreationFlags,                        { Creation flags }
  337.                       StackSize);                                { Stacksize }
  338.  
  339.      CreateThread := (ReturnCode = 0);
  340.      if ReturnCode <> 0 then ThreadHandle := -1;
  341.   {$ENDIF}
  342.  
  343.   {$IFDEF LINUX}
  344.     
  345.   {$ENDIF}
  346.  
  347.  
  348.  {$ELSE}
  349.    ThreadHandle := BeginThread(nil, StackSize, CallProc, Parameters, 0, ReturnCode);
  350.    CreateThread := (ThreadHandle > -1);
  351.  {$ENDIF}
  352. end; { proc. CreateThread }
  353.  
  354. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  355.  
  356. procedure TThreadsObj.CloseThread;
  357. begin
  358.   {$IFDEF WIN32}
  359.     if ThreadHandle <> -1 then CloseHandle(ThreadHandle);
  360.     ThreadHandle := 0;
  361.   {$ENDIF}
  362.  
  363.   {$IFDEF OS2}
  364.     {!! DosClose() on a ThreadHandle doesn't work - will eventually close }
  365.     {!! other handles ... }
  366.     { if ThreadHandle <> -1 then DosClose(ThreadHandle); }
  367.     ThreadHandle := -1;
  368.   {$ENDIF}
  369. end; { proc. CloseThread }
  370.  
  371. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  372.  
  373. procedure TThreadsObj.TerminateThread(ExitCode: Longint);
  374. begin
  375.   {$IFDEF WIN32}
  376.     if ThreadHandle <> -1 then Windows.TerminateThread(ThreadHandle, ExitCode);
  377.     ThreadHandle := 00;
  378.   {$ENDIF}
  379.  
  380.   {$IFDEF OS2}
  381.     if ThreadHandle <> -1 then DosKillThread(ThreadHandle);
  382.     ThreadHandle := -1;
  383.   {$ENDIF}
  384. end; { proc. TerminateThread }
  385.  
  386. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  387.  
  388. procedure ExitThisThread;
  389. begin
  390.   {$IFDEF WIN32}
  391.     Windows.ExitThread(0);
  392.   {$ENDIF}
  393.  
  394.   {$IFDEF OS2}
  395.     Os2Base.DosExit(exit_Thread, 0);
  396.   {$ENDIF}
  397. end; { proc. ExitThread }
  398.  
  399. (*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
  400.  
  401. end. { unit THREADS }
  402.