       

     24 

      

        ,     
    Windows 95  Windows NT.  
    (      
)     ,      
 .       , 
       32-  
Windows.  ,   ,   ,   
  Windows 95  Windows NT 4.0,     
 ,         . 
           
(^ ,       
).       ,  
 , ,   PC    
           , .. 
    ,   
.           
     ,  
 -  32-  .   
         
,          
 . 
                
          
.  , ,    ,  
      (,  ,  
  -   ,     ! 
  !).  ,   ,     ,  
       -| 

     

     ,  ,    
 ,      . 

     

     ,   ,   ,      
  . 

      

        ,   
Windows     .   , 
  ! 

       

     ,       ,   
    . 

     Delphi TThread 

       ,     
 Borland  TThread  ,   . 

560

 .   ,     
,       -  , 
     .     
   ,   ,     
   ,       Delphi.  
      ,     . 

    ,    

        ,       
      .   ,  
  . 
       Win32.     .  
Win32    Windows 95,  Windows NT (  ,   
), 32-   Windows (    , 
   Windows 95 32-  ,  
       16-  DLL).    
  -       , 
   .  :   ,  
132- (Win32 routine),    _,     
 Delphi Windows (   WINDOWS . PAS). 
       .    ,  Win32 
  . Win32      
 .          
(task),  (application)   (programm),  Win32 SDK 
Microsoft (Software Development Kit)    . 
         (thread;     
     , , 
, .  . .). , ,     . 
    Win32.  Win32    
( ),    ,   
 .    .    
          ,    
        .  
  ,    ,  ,  
  .   -    .  
       ,     
   .     
,       . 
      : ,   ,    . 
  ,      
 ,    . 

      

          ,  ,  
     ,  ,   , 
    ..     
. Win32      , 
    -     . 
      . ,   
          
 ,      . , , 
      ,     
Win32        
,       . ( 
 ,     ,    
       , 
    ,     
_^1.  ..         .) 
    "       .  
,        ,    
    .       
        ,      
      .  ,  
         ,   
   .       
.    , Win32    
      ,     
.       ,   
  .         
  .    ,    
  .       
      Win32,  
  ,        
      . 
    ,       .    
     ?     
     ,     
,   Win32    .    ,  
    

     24.    561 

     . (  .  
        ,   
:   , , .    
       "" ...)  
     :        - 
,  ,   ;   ,     
      .  
      ,     
 .  ,     
 ,        , 
        . 
     : ,    -   
,    ,   ,     
     "".     
- -,        , 
   -^,"." 
    ,        
   .  "     
            
.         
      .   
,        .   
  ,    ,  
    ,    
,        ,  
,,...  ),    
   . 
     ,       .  
    ,   ,  
    ,     ( ,   
Word 97).         
, , ,      ,  
     .   ,  
      .      
   :      . 
          
,        .. Win32   
,        
  ,   . 
      .    ,  
  ,      
.       ,   
       .  
           
   "     ?".     
,     ,      
    - .  ,  
 ,       ,   
           . 
  ,       , 
        ,   
   "  ".    
    ,       
 .       
   ,       . 
    1      .      
 Win32      ,   - 
  .  Windows NT     
,  Windows 95.  ,      
,         ,   
   ,  , -     
    ,      . 

         

        ,       .  
         
Win32 CreateThread.  Delphi, ,      
   ,     Delphi CreateThread 
    ,   .    
   ,     (runtime 
library)   .    . -, 
    CreateThread,     
IsMultiThread (    System) H?   True. 
  (heap manager)  Delphi   ,  , 
    "";  ,    
      . , -, 
BeginThread      ,  
 CreateThread   .	. --..... 

    562	 VI.   


     
         createThread   
.      ,   
    Delphi. 

     System    CreateThread,  
BeginThread.      .	* "'""  .- . .- 

    function BeginThread   (SecurityAttributes:   Pointer; 
    StackSize;   Integer; 
    ThreadFunc:   TThreadFunc; 
    Parameter   :   Pointer; 
    CreationFlags   :   Integer; 
    varThreadld   :   Integer)    :   Integer; 

    SecurityAttributes         
 (        ; 
    Win32). StackSize      
 ;     0,     
Delphi  ,  1 . ThreadFunc    
    Delphi,     .    TThreadFunc: 

    TThreadFunc =  function(Parameter   :   Pointer)    :   Integer; 

     Parameter  ,      
 BeginThread.    Nil (     
 ),     (    
).      long integer  pointer   
    . 
       ,  BeginThread, 
    - 1 |   ,   
    BeginThread   .   
^^  JjJLgaJLnJ-bxfiad   "" 
       .    
         
   BeginThread. 
        BeginThread. CreationFlags  
,     .    0,  
   (, ,    , 
     ).    CREATE_SUSPENDED, 
    ,        
   ,      Win32 ResumeThread. 
 Threadld     (    
)  .      BeginThread. 
       BeginThread    
(   0,        
, _2_ Ge. t La.s tEr   , [   
).     ,     
BeginThread      !    
   . ,    ,,   
   . 
      ,        
.    ,   Win32 GetExitCodeThread: 

    function GetExitCodeThread(hThread:   THandle; 
    var   IpExitCode:   DWORD)    :   BOOL; 

             
(      end;),    
 Win32 ExitThread. ,     
 ,   EndThread   SYSTEM,  
 ExitThread  Win32^PI:	"""* .. . , . . 

    procedure  EndThread(ExitCode   :   Integer); 

     ExitCode      . 
     ,        BeginThread, Win32 
  ,          
 .      (  
    end;    EndThread), Win32 
          .  
           
 ,   ,    ( 
    ,        
 Win32 WaitForSignalObject  WaitForMultipleObject. .  

     24.   	563 

    " "    ).     
    .     .  
,     .     
  ,        
Win32 CloseHandle,    :	' 

    function CloseHandle   (hObject   :   THandle)    :   BOOL; 

     hObject   .   
  True,        ,  
False    . 
            .  
  CloseHandle.     . 

    I  1 

     
       CloseHandle,     
,      .    , 
 ,  .     
   ,       CloseHandle. 

       Win32       
  (   ,      
).    ,   , 
  , :  ,   
 ,  ,      .  
,      ,    
.     1 ,  16  
 .    ,   Delphi 
 ,     ,    Print^Options   
   Linker  MinStackSize (  )  
MaxStackSize (  ).       
,   .  ,  ,  
     . (    ,  
         .) 

      

         Win32    
 ,     ,  
 ,         
.        , 
        .   
        ,    
,         , 
      .   
       ,     
      . 
    ,     ,   
  (base priority),    ,   
 ,        
.  ,    ,    
   ,    , 
     .      
,  ,     ,     
    ,      . 
         (      
 ),       .  
   ,     
  . 24.1:  (idle),  (normal),  (high) 
     (realtime). 

     24.1      

     	  

    IDLE_PRIORITY_CLASS	4 
    NORMAL_PRIORITY_CLASS__________7 ()  9 ( )  ____   
____ ___    __ 
    HIGH_PRIORITY_CLASS	13 REALTIME_PRIORITY_CLASS                         24 


    564  VI.   

        - ,  
  Win32 SetPriori-tyClass. ,   
   ,     . 
             
       .   
  ,    -*       
  ,     . 

     
      ,     ?    -  
 ,      .     , 
  ,    .   
   ,   Win32 SetThreadPriority: 

    function  SetThreadPriority:    (hThread:   THandle; 
    nPriority   :   Integer)    :   BOOL; 

       hThread   ,     
. nPriority  ,     
  .       ,  
   Delphi WINDOWS . PAS.    . 24.2. 

    I  24.2     SetThreadPriority 

     Win32		  

    THREAD   PRIORITY	ABOVE  NORMAL	 1    
    THREAD_PRIORITY_	BELOW   NORMAL	 1    
    THREAD   PRIORITY	HIGHEST	 2    
    THREAD   PRIORITY	IDLE	     real  time  
 16,       1 
    THREAD_PRIORITY_	_LOWEST	 2    
    THREAD_PRIORITY_	NORMAL	  
    THREAD_PRIORITY_	_TIME_CRITICAL	     real  
time   31,        1 5 

          , ,  
SetThreadPriority,  GetThreadPriority: 

    functional   GetThreadPriority   (hThread   :   THandle)    :   Integer; 

    hTHread   ,      
  ,  SetThreadPriority    . 24.2. 
          ,  
  .         
       THREAD_PRIORITY_TIME_CRITICAL,  
       .    
,     ,    ,   
    .         
,   Windows 95    ;   
       ,   
    . 
               
,    .      Windows  
  .        
      ,     .  
 ,    ( 
           -),  
 .  ,   _| Windows 3.x,    
   ,6j>i     , 
     Windows,      
      . 

     24.    565 


     
        ,   ,   ,  Win32  
  -    .  
  ,      1  ,  
   1   2.  ,   ,    
.    ,         ,  
          
 Pentium.      ,   ,    
.   ,  , ,^ ,   . 
    ,    ,     
      ,    
.    ,   . ,~   
Windows 95,    Windows NT. ,   !  
   . 

      

    ,  ,          
: nrjOjCj^aHCTBQ.jiaMS'Hjkix  .     
      .    ( 
-"   ),      .   
 ... 
      ,       
 ,   .    
    ,    
 .  ,    ... 
              
 .    ""    
,      ,    
.    ""  .  ,  
     .     
,     , ,    , 
. Windows 95  Windows NT    
" " (      
),      . 
     ,        
  .    , 
      .     
          , 
  .   ,   ,  
   ,       . 
    -      
.           
(,         
,      ,   
"";   ,     ). 
     ,  VCL    .    
    (,    )     
     ,     
. ;  Borland     
TThread (   ).      , 
          
 ,        VCL. 
      ,      . 
        
"',  GetMem  FreeMem     
 .         
      . 
     Borland Database ?_?  .    
 ,     ,   BDE.  
     ,      
 .

      

            , 
,        ,    
 .   ,    
   ,    ,    
   . 
          .   
      ,   
          
  . 
            
        
    .    
  Win32 (   ),  
    . ,   
     ,     
    

    566	 VI.   

        .  ,      
 ,      .   
 ,       ,  
  ,      .    
      (   
,  ",       
 "),           
,   . 
    1.	   . 
    2.	,     . 
    3.	    . 
    ,       ,     
 .       (Win32 SDK 
     ).     , 
      .  
     ,      
,      .   ,  
     (Win32 SDK    
  ).   ,    , 
    ,     
,           
  . 
        .     
,    ,     .  ,  
        
.  ,    .    
 .     _  
(           
  ^^jiepepbi,    
.   , ,    
  ,  ,      
,    ,      
(      ,    ).  
 Win32       . 
, ,      . 
' ,      
___,    .  , 
   "  ,_   , 
  ,      
.	" ' --... 
           
,         
    .   24.1   
''" 'TsePadlock.  "    
, PADLOCK. PAS (    ,    
  ),    . 

     24.1. \UDELPHI3\CHP24\PADLOCK. PAS.  Padlock,  
  

    unit Padlock; 
    interface 
    uses 
    Windows; 
    type 
    TsePadlock = class private 
    FCritSect : TRTLCriticalSection; protected 
    procedure SetLocked(L : boolean); public 
    constructor Create; destructor Destroy; override; property Locked : 
boolean write SetLocked; end; 
    implementation 
    constructor TsePadlock.Create; begin 
    InitializeCriticalSection(FCritSect); end; 


     24.   	567 


    destructor TsePadlock.Destroy; begin 
    DeleteCriticalSection(FCritSect); end; 
    procedure TsePadlock.SetLocked(L : boolean); begin 
    if L then 
    EnterCriticalSection(FCritSect) else 
    LeaveCriticalSection(FCritSect) ; end; 
    end. 

     Create    , 
 Destroy  .       , 
  Locked  True,    ,   
 Locked  False.   . 
          ,   
24.2         
,     -  .   
    ,     .    
    UsePadlock ,  ,  
    ,       
-" . 

    | 24.2. \UDELPHI3\CHP24\TESTPADLOCK.PAS.   Padlock 
program TestPadlock; 

    {$APPTYPE CONSOLE) 
    //      (   //  
$),  ,  ,  Padlock //    
  . {$DEFINE UsePadlock} 
    uses 
    SysUtilp, 
    Windows, 
    Padlock; 
    var 
    ConsolePadlock : TsePadlock; 
    procedure SafeWriteLn(const S : string); begin 
    ($IFDEF UsePadlock} 
    ConsolePadlock.Locked := True; 
    try 
    writeln (S) ; 
    finally 
    ConsolePadlock.Locked := False; 
    end; 
    {$ELSE} 
    writeln(S); 
    {$ENDIF} end; 
    function EnglishThreadRoutine(P : pointer) : integer; var 
    ThreadID : integer; 
    i       : integer; begin 
    Result := 0; 


    568	 VI.   


    ThreadID := GetCurrentThreadID; for i := 1 to 20 do 
    SafeWriteLn(Format('[%x] current line: %d', [ThreadID, intend; 
    function FrenchTreadRoutine(P : pointer) : integer; var 
    ThreadID : integer; 
    i        : integer; begin 
    Result := 0; 
    ThreadID := GetCurrentThreadID; 
    for i := 1 to 20 do 
    SafeWriteLn(Format('[%x] ligne courant: %d', [ThreadID, i])); end; 
    var 
    Handles : array [0..1] of integer; TreadID : integer; 
    begin 
    FillChar_(_Handles, sizeof(Handles) , 0) ; Cons'oTePadlock := TsePadlock. 
Create; try 
    Handles[0] := BeginThread(nil, 0, EnglishThreadRoutine, 
    nil, 0, ThreadID); Handles[1] := BeginThread(nil, 0, FrenchThreadRoutine, 
    nil, 0, ThreadID); 
    WaitForMultipleObjects(2,    @Handles,   True,    INFINITE); finally 
    if   (Handles[0]   <>   0)   then CloseHandle(Handles [0]); if   
(Handles[1]   <>   0)   then CloseHandle(Handles[1]); ConsolePadlock.Free; end; 
    writeln ('Press   <Enter>   to  close...'); readln; end. 

       Padlock,     ,   
   :    EnglishThreadRoutine.  
      ,    FrenchThreadRoutine 
  .        
,     .      
,      ,   
SafeWriteLn.  ,   Padlock,   
    Padlock.	-....,...,..--
      Padlock        
,    (,    ,   
,    Padlock). ,   
Padlock   ,   ,  .   
   Padlock     ,   
    . ,      
,    .    
Padlock,     .       
 ,    Padlock,    
 ,   ,   .   
     . 
     ,         , 
    Padlock (  ). 
,    Padlock   .    
    ,    
   Padlock.     Padlock2  
Padlockl,      Padlockl  Padlock2,   
,   ,   Padlockl,    
  ,   Padlock2 .     , 
     ,     Padlock, 
   ,     .  , 
   (  ,    
   ):  

     24.   	569 

         ,      
Padlock,    (  ).   
  ,     Padlock   
.             . 

      

        (  ) .  
   ,        
 ,   .     -  
       . 

    function  GetCurrentThread   :   Thandle; 

          , 
   - ,     
 .       ,   
 ( CloseHandle    
).     , 
  GetCurrentThread,   ,    
.    ""  ,   
Win32 DuplicateHandle (   !5   
 ).   ,   GetCurrentThread  
,      ,   
,      .	" .. "" - 

    function  GetCurrentThreadID   :   DWORD;    
 ID ()  . 
    function TerminateThread(hThread:   THandle; 
    dwExitCode:   DWORD)    :   BOOL; 

       ,   hThread,  
   dwExitCode     ,    
    CreateThread  ExitThread,..   
TerminateThread. ,  ,   .   
 ,     (    
Win32),          . 
 TerminateThread     . 

    function  SuspendThread   (hThread   :   THandle)    :   DWORD; 

         ,  
 hThread.      ,   
    ResumeThread. 

    function ResumeThread   (hThread   :   THandle)    :   DWORD; 

         .  
   ,      SuspendThread. 
,  ResumeThread    ,     
 (    ),    ,   
   . 

      

        Win32   
   (      ) 
   .  ,   ""   
,    -        
   .      , 
,     (  
-       True  
  ,    ,   
;        ^ ,  
  ,   ).     
Win32,    .  ,    
  ,  -     
>  -:      
 , ,        
.     . 
     :     ]   
,          - 
    Win32 WaitForSignalObject  WaitForMul-tipleObject. 

    570	 VI.   

       (KERNEL)   . (,   
!)       ,   
 ,        .    
     ,   , () 
    (       ,     
  )  () ,      .  
   ,     (   
 ),   ,     ( 
   ). 
          ,   
   .     ,   
        
.     ,  ,    
.    ,   Win32 
WaitForSingleObject  WaitForMultipleObject.  ,   
         ,  
      .   
     ,       
          . 

    function WaitForSingleObject    (hHandle:   THandle; 
    dwMilliseconds:    DWORD)    :    DWORD; function  WaitForMultipleObject   
 (nCount   :   DWORD; 
    IpHandles   :   PWOHandleArray; 
    bWaitAll:   BOOL; 
    dwMilliseconds:   DWORD)    :   DWORD; 

      WaitForSingleObject  hHandle    
,     ; dwMilliseconds ,    
  (     INFINITE,   
     ).     
WAIT_FAILED  WAIT_OBJECT_0. 
    u	    ,    
WaitForSingleObject   WAIT_ABANDONED.      
,  ,   ,   
  .    . 
      WaitForMultipleObj ect  nCount     
 ,    , a IpHandles    
  . bWaitAll  True,      
 ,  False,       ,   
    . dwMilliseconds ,    
WaitForSingleObject.     WAIT_FAILED,  
,    .     bWaitAll  True 
    , ,    ,    
       (    
 WAIT_FAILED).  , ,    bWaitAll  False  
   ,      
 ,   . _  ^ 
   WAIT OBJECT 0.   ,     
   ,     
   . 
    , , ,   ,    , 
,        ,_   
..        .   
-~   ,        
. ,         . 
            ,  
   Padlock,   ,     
 .      , 
,    WaitForMultipleObject.   , 
 ,        
   . 

       

         ,   ,  
   ( ).   :   
  ,   ! 
        ,     
 (,    ),    
          
,        .  
      ,      
,        ,     . 

     24.   	571 

           :     
,      . 
         . 
          , ,   
   .    ,   
  ,      WaitForSir,-gleObject  
WaitForMultipleObject. ,      
          ( 
,      ,    
). ,         
    ,     Wait,  ,  
   .         
.      .    
,      - , 
    .      ,  
 .   ,   
     ,    . 

     

         .     
  .  ,  ,   - 
     .   ,  
 Win32       Delphi:   
 ,    ,    
       . 
          . 
  WaitForSingleOb-ject (   
WaitForMultipleObject)   .     
 ,       ,   
        ( 
   )        
 . 
              
,  .   ,  
        , 
  ,    
(   ).    
       
  Win32. 
      ,     , 
     .     
    ,      
(     ,    
     ).    
   ,   . 
        .,    (  ,  
      ):      
.        .   
   ,  ,   
:  ,   ,   
,     (    ).  
      : 
   ,    . 
      24.3  Win32   TseWin32Event 
(     WIN32EVENT. PAS  ). 

     24.3. \UDELPHi3\CHP24\wiN32EVENT. PAS.  Win32Event - 
  Win32	I 

    unit Win32Event; 
    interface 
    uses 
    SysUtils, Windows; 
    type 
    EWin32EventError = class(Exception) private 
    FErrorCode : intege-r; public 
    constructor Create(aErrorCode : integer); property ErrorCode : integer 
read FErrorCode; end; 


    572	 VI.   


    TEventResetType = (erAuto, erManual); 
    TseWin32Event = class     private      
    FEvent    : THandle; protected 
    procedure SetReady(R : boolean); public 
    constructor Create(const aEventName : string; 
    aResetType : TEventResetType; alnitiallySignaled : boolean); destructor 
Destroy; override/procedure JPu.Lg.g.; 
    function WaitForEvent(TimeOut : integer) : boolean; property Handle : 
THandle read FEvent; property Ready : boolean write SetReady; end; 
    implementation 
    constructor EWin32EventError.Create(aErrorCode : integer); begin 
    FErrorCode := aErrorCode; 
    inherited Create(Format('Win32 event error: %d', [aErrorCode])); end; 
    constructor TseWin32Event.Create(const aEventName : string; 
    aResetType : TEventResetType; alnitiallySignaled : boolean); begin 
    FEvent := CreateEvent(nil, (aResetType = erManual), 
    alnitiallySignaled, PChar(aEventName)); if (FEvent = 0) then 
    raise EWin32EventError.Create(GetLastError); end; 
    destructor TseWin32Event.Destroy; begin 
    if (FEvent <> 0) then CloseHandle(FEvent); end; 
    procedure TseWin32Event.Pulse; begin	 
    _PulseEvent (FEvent) ;  >v\  A<^i_ endl        ' ~	       .  .   . 
    procedure TseWin32Event.SetReady(R : boolean); begin 
    if R then 
    SetEvent(FEvent) else " 
    ResetEvent(FEvent); end; 
    function TseWin32Event.WaitForEvent(TimeOut : integer) : boolean; begin 
    Result := WaitForSingleObject(FEvent, TimeOut) <> WAIT_FAILED; 
    end. 

     Create   .    , 
,    (    
),      .  Destroy 
  .  WaitForEvent    
   

     24.   	573 

     .  TimeOut ,      
(    INFINITE     ). 
 Pulse      .  -ejrty 
  :  True    , 
 False   . 
           ,   
 ,      Win32 CreateEvent.  
    ,    Win32 
GetLastError   ,  -    CreateEvent. 
    ,     Create,   
  .      ,    
  ,  ,    " ,   
.     :      
Create    ,       . 
 ,        
(      , ,  , 
   ).       
    ,     
   ,   .     
      . 
     TestWin32Event        . 
    , ,   Win32,    
 ,     . , 
         , 
 ,         (  
 ).       Padlock  
 .         ,    
 ,    ,   Padlock,  
,      Padlock.      
     ,     
,           
. ,         
     . ,  
 ,    ,  
,       (   
      ,  ). 
  ,      
.        ,   
       .    
 '- _   '  ""
"  .	! 
     ,  *   ,   
        
 ,         
   ,     ( ,  
)  ,   .    "  
;       ,  ,  
        , 
.         
  . 
    JOiaccT's'eGetkeeper (  GATEKEEPER. PAS)    
.     ,     
 ,        "":   
,     .    
 (gatekeeper),         Kew 
Garden  ,  ,   -  
( 24.4). 

     24.4. \UDELPHI3\CHP24\GATEKEEPER. PAS.  Gatekeeper,  
 " / " 

    unit Gatekeeper; interface 
    uses 
    Windows, Padlock, Win32Event; 
    type 
    TseGatekeeper = class private 
    Padlock        *    TsePadlock; WaitingReaderCount   integer; 
RunningReaderCount   integer; ReaderCanStart      TseWin32Event; 
RunningWriterCount   integer; WaitingWriterCount   integer; 


    574	 VI.   


    WriterCanStart     : TseWin32Event; public 
    constructor Create(aGateName : string); destructor Destroy; override; 
procedure StartReading; procedure StartWriting; procedure StopReading; 
procedure StopWriting; end; 
    implementation 
    constructor TseGatekeeper.Create(aGateName : string); begin 
    Padlock := TsePadlock.Create; 
    ReaderCanStart := TseWin32Event.Create(aGateName+'Read', erAuto, false); 
    WriterCanStart := TseWin32Event.Create(aGateName+'Write', erAuto, false); end; 
    destructor TseGatekeeper.Destroy; begin 
    WriterCanStart.Free; 
    ReaderCanStart.Free; 
    Padlock.Free; end; 
    procedure TseGatekeeper.StartReading; begin 
    Padlock.Locked := true; 
    if (RunningWriterCount > 0) or (WaitingWriterCount > 0) then begin 
inc(WaitingReaderCount); Padlock.Locked := false; 
ReaderCanStart.WaitForEvent(INFINITE); end else begin 
    inc(RunningReaderCount); Padlock.Locked := false; end; end; 
    procedure TseGatekeeper.StartWriting; begin 
    Padlock.Locked := true; 
    if (RunningWriterCount > 0) or (RunningReaderCount > 0) then begin 
inc(WaitingWriterCount); Padlock.Locked := false; 
WriterCanStart.WaitForEvent(INFINITE); end else begin 
    inc(RunningWriterCount); Padlock. Locked := false/end; end; 
    procedure TseGatekeeper.StopReading; begin 
    Padlock.Locked := true; dec(RunningReaderCount); 
    if (RunningReaderCount = 0) and (WaitingWriterCount > 0) then begin 
dec(WaitingWriterCount); inc(RunningWriterCount); WriterCanStart.Ready := 
true; end; 
    Padlock.Locked := false; end; 


     24.   	575 


    procedure TseGatekeeper.StopWriting; begin 
    Padlock.Locked := true; dec(RunningWriterCount); if (WaitingReaderCount > 
0) then begin while (WaitingReaderCount > 0) do begin dec(WaitingReaderCount); 
inc(RunningReaderCount); ReaderCanStart.Ready := true; end; end else begin 
    dec(WaitingWriterCount); inc(RunningWriterCount); WriterCanStart.Ready := 
true; end; 
    Padlock.Locked := false; end; 
    end. 

     TseGetkeeper   : StartReading, StartWritting, 
StopReading  StopWriting.  ,   Padlock    
Win32Event         
  . 
            . 
       ,    
Gatekeeper,    StartReading.  ,    
-  ,      .  
 ,      
-      ReaderCanStart.   
- ,   ,     
 .   ,     
StopReading.  ,     -.  
 ,   ,     -.  
,     WriteCanStart.    ,  
 (  )      . 
            .  
       ,   
 StartWritting.   ,       
-  .   ,   
          
WriteCanStart.       ,  
 .   ,    
 StopWriting.   ,   -  
,   .   ,     
,   ReaderCanStart      
-.    ,  ,   
 -.  -   ,  
    WriteCanStart. 
      Padlock     
           . 
       ,  Gatekeeper    
 " / ".      
    . (  ,    
   FIFO (    ),     , 
    :   ,    
  .) ,    ,   ,  
  -    ,    
     (  ,   
 ),     -,    
  .. 
       ,    .   : 
     .   ,  
,   .    StopWriting.   
 -,     ,   
ReaderCanStart ,      ,   
 while.    ,   - ,    
 .   ReaderCanStart     
     .       
 .  ?    ,  
  . 
         . 

    if   (WaitingReaderCount   >   0)   then  begin 
    RunningReaderCount   :=  WaitingReaderCount; 
    WaitingReaderCount   :=   0; 
    ReaderCanStart.Pulse; end;  


    576	 VI.   

     ,  !   StartReading.  
 ,    ,    
 -,    Padlock    
ReaderCanStart.         
Padlock     .      
 . ,  ,   , 
  ""' .  - (  
  )    ,  Gatekeeper 
 ,      ,    . 
        ,  , 
  - , ,    
   ,        
(   ,        
-).     -  
 ,      ,    
 ReaderCanStart.       ,  
      -,   
StopWriting,   - ,     . 
 ,     ""... 
      ,        
,   -    ,  
          
  ,      .    
,  . 

     

     (MUTual Exclusions  )   
       . , ,   
.    ,        
     .        
   (   : ,  
    ). , ,  ,  
     ,   
 .      ,   
,       .   
        ,  
 .          
    ,    . 
          ,      
    24.5. 

     24.5. \UDELPHI3\CHP24\MUTEX. PAS.  Mutex -   

    unit Mutex; 
    interface 
    uses 
    SysUtils, Windows; 
    type 
    EMutexError = class(Exception) private 
    FErrorCode : integer; public 
    constructor Create(aErrorCode : integer); property ErrorCode : integer 
read FErrorCode; end; 
    TseMutex = class 
    private 
    FHandle : THandle; 
    protected 
    public 
    constructor Create(aName : string); destructor Destroy; override/function 
Lock(aTimeOut : integer) : boolean; procedure Unlock; 
    property Handle : THandle read FHandle; end; 
    implementation 


     24.    577 
    19  Delphi 3.   


    constructor EMutexError.Create(aErrorCode : integer); begin 
    FErrorCode := aErrorCode; 
    inherited Create(Format('Win32 mutex error: %d', [aErrorCode])); end; 
    constructor TseMutex.Create(aName : string); begin 
    FHandle := CreateMutex(nil, false, PChar(aName)); 
    if (FHandle i"""   then""" 
    raise EMutexError.Create(GetLastError); end; 
    destructor TseMutex.Destroy; begin 
    if (FHandle <> 0) then CloseHandle(FHandle); end; 
    function TseMutex.Lock(aTimeOut : integer) : boolean; begin 
    Result := (WaitForSingleObject(FHandle, aTimeOut) <> WAIT_FAILED); end;    
    procedure TseMutex.Unlock; begin 
    ReleaseMutex(FHandle); end; 
    end. 

      Mutex   ,      . 
    Mutex  ,   ,    
    . 

     

         Win32,    
)'     ,    . 
  ,   .     ,  
        
  (    ).  
    ,     
 .      ,     
  ;     ,   
,        . 
       Win32.  , 
      : Win32   . 
        ,    
    .      
     ,  NetBIOS,   
       .    
          
      .  , 
^-  ,       
 4.    ".  
    ,    . 
         ,   
            
 . 
    ,    ,    , , 
    .  ,    
     .     . 
      24.6   . 

     24.6. \UDELPHI3\CHP24\SEMAPHORE. PAS.   Win32 

    unit Semaphore; 
    interface 
    uses 


    578	 VI.   


    SysUtils, Windows; 
    type 
    ESemaphoreError = class(Exception) private 
    FErrorCode : integer; public 
    constructor Create(aErrorCode : integer); property ErrorCode : integer 
read FErrorCode; end; 
    TseSemaphore = class private 
    FHandle : THandle; protected public 
    constructor Create(aName : string; 
    alnitialCount : integer; aMaximumCount : integer); destructor Destroy; override; 
    function DecCount(aTimeOut : integer) : boolean; procedure IncCount; 
    property Handle : THandle read FHandle; end; 
    implementation 
    constructor ESemaphoreError.Create(aErrorCode : integer); begin 
    FErrorCode := aErrorCode; 
    inherited Create(Format('Win32 semaphore error: %d', [aErrorCode])); end; 
    constructor TseSemaphore.Create(aName : string; 
    alnitialCount : integer; aMaximumCount : integer); begin 
    FHandle := CreateSjsmajghore (nil, alnitialCount, aMaximumCount, PChar 
(aName) ); if (FHandle = 0) then' 
    raise ESemaphoreError.Create(GetLastError) ; end; 
    destructor TseSemaphore.Destroy; begin 
    if (FHandle <> 0) then CloseHandle(FHandle); end; 
    function TseSemaphore.DecCount(aTimeOut : integer) : boolean; begin 
    Result := (WaitForSingleObject(FHandle, aTimeOut) <> WAIT_FAILED); end; 
    procedure TseSemaphore.IncCount; begin 
    ReleaseSemaphore(FHandle, 1, nil); end; 
    end. 

     ,    .  ,    
( ,  ),    .  
DecCount   True       
.      False,   ,  
      

     24.   	579 


      : TLS  Threadvar 

        ,    BeginThread  
EndThread,    ,      
   ,      
 .    ,      
  , ,  ,   -   
  (  )       
,   ,      
      .     
,         . 
         (  TLS  Thread Local 
Storage) Win32 ,        
.  TLS  (      
),      .     :  
    TLS    ,    
    (      ). 
    Win32     64 .     
 Win32    64       
.       ,    
TLS.           
 . ,     , .  
          . 
 ,         
  .     Win32 TlsAlloc, 
      TLS: 

    function  TlsAlloc   :   DWORD; 

    Win32        .   
,   ,      (  
,     TLS_OUT_OF_INDEX).     
  (, ,    ).  
     ,     
 .  ,  TlsAlloc     15, 
      15      
       . 
              
TLS,   TlsSet-Value  : 

    function  TlsSetValue   (dwTlsIndex   :   DWORD; 
    IpTlsValue   :   Pointer)    :   BOOL; 

      ,     (dwTlsIndex),  
 ,     (IpTlsValue). Win32  
     ,    .   
     ,      
  ,           TLS 
  . 
        TLS,  TlsGetValue  : 

    function  TlsGetValue(dwTlsIndex   :   DWORD)    :   Pointer; 

       ,      TlsAlloc,  
 dwTlsIndex.         
 :       . 
    , ,     ,  TlsFree,  
     (     ): 

    function TlsFree   (dwTlsIndex   :   DWORD)    :   BOOL; 

      dwTlsIndex   ,    . 
     ,    TLS,   ,   
 ^>_     ,   
       ,   
 ~;        TLS.   
    ,        
  TLS.  ,  ,   64  ,  
   . 
    ,  .   24.7   ,  
 TLS   Win32. 

     24.7. \UDELPHl3\CHP24\TestTLSRoutines. DPR.   
TLS Win32 

    program TestTLSRoutines; 
    ($APPTYPE CONSOLE} 
    uses 
    SysUtils, 


    580	 VI.   


    Windows, Padlock; 
    var 
    ConsolePadlock : TsePadlock; OurTlsIndex    : integer; 
    type 
    PThreadLocalData = PThreadLocalData; TThreadLocalData = record Number : 
integer; ID     : integer; end; 
    procedure SafeWriteLn(const S : string); begin 
    ConsolePadlock.Locked := True; try 
    writeln(S); finally 
    ConsolePadlock.Locked := False; end; end; 
    procedure WriteThreadNumber; var 
    TLD : PThreadocalData; begin 
    TLD := TlsGetValue(OurTlsIndex); 
    SafeWriteLn(Format('Thread ID %x is number %d', 
    [TLD.ID, TLD.Number])); end; 
    function MyThreadFunction(Parameter : pointer) : integer; var 
    TLD : PThreadLocalData; begin 
    Result = 0; New(TLD); try 
    TLD.Number := longint(Parameter) ; TLD.ID := GetCurrentThreadID; 
TlsSetValue(OurTlsIndex, TLD); WriteThreadNumber; finally 
    Dispose(TLD); end; end; 
    const 
    NumHandles := 20; 
    var 
    Handles  : array [0..pred(NumHandles)] of integer; ThreadID : integer; i   
     : integer; 
    begin 
    OurTlsIndex := -1; 
    FillChar(Handles, sizeof(Handles), 0); 
    ConsolePadlock := nil; 
    try 
    OurTlsIndex := TlsAlloc; 
    ConsolePadlock := TsePadlock.Create; 
    Handles[i] := BeginThread(nil, 0, MyThreadFunction, 


     24.   	581 


    >	pointer(i),    0,   ThreadID); 
    WaitForMultipleObjects(NumHandles,    @Handles,   True,    INFINITE); finally 
    for  i   :=  0  to pred(NumHandles)   do if   (Handles[i]   <>   0)   then 
CloseHandle(Handles[i]); if   (OurTlsIndex   <>   -1)   then 
    TlsFree(OurTlsIndex   ) ConsolePadlock.Free; end; 
    writeln('Press   <Enter>  to  close...'); readln; end. 

        TLS,  TlsAlloc.   
    OurTlsIndex.   20   
      (ID   
  7~",   .    
      T 
    LS   TlsSetValue      
OurTlsIndex.    WriteThreadNumber.   
    ,     
      ,    
.     ,  TlsGetValue   
  TLS,   OurTlsIndex. 
    ( -         
 :       
  .  ,    , 
         (  
 ),         
    (,  ).    
     TLS,    
   ,   ,     
,    -.  ,  
       
,   .      
   ,         
     ,        
     . ,     
     procedure WriteThreadNumber (TLD: 
PThreadocalData) ;      MyThreadFunction   
 TLD,        . 
(,        :     
      .  . .) 
    ,   ,     TLS, 
     . ?   threadvar. Borland 
,       ,  
  Delphi    .   threadvar 
   ,   var,    ,  
 : ,    threadvar,  
   . 
           TlsAlloc, TlsSetValue  ..: 
   ,    .   
  :       threadvar  
        System  , 
            
    .     
   threadvar        
   - (,  ,  DLL-).   
  ,     
,      TLS,     
   threadvar      . 
    _           .  
      threadvar  , 
       . 
     ,       threadvar 
   . ,      
   (     
 ,     threadvar).  , 
    threadvar    (   
       ), ,      
  ,    .	""  ---.---- ............ 
    I  I 


    582	 VI.   

      24.8     TLS-, 
 .      threadvar 
(  ,    -  ).   
 TLS . 

    |  24.8. \UDELPHI3\CHP24\TESTTHREADVAR. PAS.   
  ; threadvar   TLS 

    treadyar 
    ~~~Du : integer; OurlD     : integer; 
    //  . 
    procedure WriteTreadNumber 
    SafeWriteLn(Format('Thread ID %x is number %d', 
    [OurlD, OurNumber])); end; 
    function MyThreadFunction(P : pointer) : integer; begin 
    Result = 0; 
    OurNumber := longint(P); 
     .= GetCurrentTYixeadTD; 
    WriteThreadNumber; end; 

      .   ,         . 
      ,    . ,   ?.. 
     ,  ,    . Win32   
 ,     64 .  ,    
 64        TlsAlloc.  , 
    (  ) threadvar  ,  
   Delphi,  , ,   
    TLS? 
    ,         DLL Delphi.  
DLL  Delphi     threadvar (      
 ,     System).   
       ,   
,   TLS.  ,    
   63 DLL,     
-  64-  threadvar   
(      ,    
TLS   ).  ,    
  ,   (, , ) 
        , 
      . 

     TThread 

    ,            
,      Delphi TThread  ,  
 . ,        , 
       ,   
     Execute  Synchronize. 
     TThread    ,    
     VCL (   
   ).   ,  VCL 
    .      , 
    ,         
   Access Violation  .  Borland 
   ,  VCL     , 
  , __   ,   
 ,  VCL . 
     ,     ,      
   .  ,  
 TThread,   ,    ( 
Synchronize),       ,   
 ,       . 
,   TThread,     
 . 

     24.   	583 

     TThread 
       TThread,    Classes VCL. 

    TThread = class private 
    //  , protected 
    procedure DoTerminate; virtual; procedure Execute;    virtual; abstract; 
procedure Synchronize(Method : TThreadMethod); property ReturnValue:Integer 
read FReturnValue 
    write FReturnValue; 
    property Terminated:Boolean  read FTerminated; public 
    constructor Create (CreateSuspended : Boolean); 
    destructor Destroy; override; 
    procedure Resume; 
    procedure  Suspend; 
    procedure  Terminate; 
    function  WaitFor : Integer; 
    property  FreeOnTerminate : Boolean read FFreeOnTerminate 
    write FFreeOnTerminate; 
    property Handle   : THandle read FHandle; property Priority : 
TThreadPriority read GetPriority 
    write SetPriority; 
    property Suspended: Boolean read Fsuspended 
    write SetSuspended; 
    property ThreadID : THandle read FThreadID; property OnTerminate : 
TNotifyEvent read FOnTerminate 
    write FOnTerminate; end; 
    Public 

     -   . 

     Create 

         TThread.    
   ( ),   
      BeginThread.   
   ,   CreateSuspended  True. 

     Destroy 

         TThread.   
  ,      Terminate. 
        WaitFor.  
   CloseHandle.    Destroy 
    . 

     Resume 

         ,  ResumeThread. 

     Suspend 

        ,  SuspendThread. 

     Terminate 

        ,  ,   
     .     
 Terminated.  Execute       
    ,     True.  
  Execute   ,        
 ( ,     ,   , 
      Execute!). 

    584	 VI.   


     FreeOnTerminate 

     ,    ,  , ,   
   TThred,    . 

     Handle 

              
  Begin-Thread.	, ' 

     Priority 

     ,    ,  ,   
 ,    SetThreadPriority  
  GetThreadPriority. 

     Suspended 

     ,    ,  , ,  
  .      
  Suspend  Resume. 

     ThreadiD 

            
 (ID) ,   BeginThread. 

     OnTerminate 

        ,     Execute,  
   TThread.       ,  
   EndThread  ,   OnTerminate 
    .      
VCL,    OnTerminate    Synchronize. 

    Protected 
     DoTerminate 
        OnTerminate   Synchronize. 
     ReturnValue 
      . EndThread      . 
     Terminated 
            True,  
       .  
     Execute,    
 ,    ,  ,  Terminated 
 True.     Terminate. 

     TThread 

           TThread: Execute  Synchronize. 

    Execute 

        .   TThread  
   (virtual)   (abstract).  , 
TThread    ,         
,     (   ).  , 
       TThread, ,. 
Execute.  Execute     ,   
 Create. 

    Synchronize 

        ,    ,   
  ,     ( ),  
   ,    .  
    (   
            
 ,     ).  
    ,     
 ,    . 

     24.   	585 

           Win32 
SendMessage (  PostMes-sage), Synchronize    
.   ,       
    (     
). , ,  on-^^11^ ^91,,) 
,,     .11?^, .  
       . 
^"2!:^:^"'}  .       
  TThread,  :!I-'V.?"'',,.,. ,   
Execute  Synchronize. ,    ,  
 ,  /     
 .   WWW ^     
,  ,          
,   Zip  LZW ( ,     66%  
  ).  ,  , ,   
   .        
   (W. Jones Douglas) "Application of Splay Trees to Data 
Compression" ("      ", 
Communication of the ACM,  1988, . 996).    
  Pascal,    (Kirn Kokkonen), 
TurboPowerSoftware,      SPLAY. LZH   http: 

    //www.turbopower.com. 

        ,    .     
,   .      
      .    
      Execute,     
 (progress bar)   Synchronize. 
         ,   . 
    1.    . 
    2.       (Tbutton    Standart)    
  (TProgressBar    Win95).    
Start     StartButton.  ,      
  (TLabel)  ,     
.     . 24.1. 
            ,  
        . 

    . 24.1.     TThread 

    3.       (  File^New  
 Thread Object   ).    
TSplayCompressThread.   (File^Save All),  Unitl 
Main,  Unit2  SplayCompressThread,    Projectl  DemoTThread. 
    4.     SplayCompressThread   TSplayCompressThread, 
      ,   . 

    TSplayCompressThread =  class(TThread) private 
    {   Private  declarations   } 
    FInFileName      :   string; 
    FOutFileName   :   string; 
    FDoCompress      :   boolean; 
    FPercentDone   :   integer; 
    FProgressBar   :   TProgressBar; protected 
    procedure  PercentDoneNotif(Percent   :   integer); 
    procedure   DisplayPercentDone; public 
    constructor  Create   (InFileName,   OutFileName   :   string; Decompress  
 :   boolean); 
    procedure Execute	:   override; 
    property PercentDone   :   integer  read FPercentDone; 
    property  ProgressBar   :   TProgressBar write  FProgressBar; end; 


    586  VI.   

    5.        Create    . 

    constructor TSplayCompressThread.Create(InFileName, 
    OutFileName   :   string;   Decompress   :   boolean); begin 
    inherited Create   (True); FInFileName   :=  InFileName; FOutFileName   
:=OutFileName; FDoCompress   :=   Decompress; FPercentDone   :=  0; end; 

        .      
.   Create    True  
CreateSuspended,  ,      
 . 
    6.        Execute.... 

    procedure TSplayCompressThread.Execute; var 
    SCE : TSplayCompressThreadEngine; begin 
    SCE := TSplayCompressThreadEngine.Create (FInFileName, FOutFileName); 
    SCE.PercentDone := PercentDoneNotify; 
    if FDoCompress then SCE.Compress 
    else 
    SCE.Expand 
    SCE.Free end; 

         TSplayCompressThreadEngine.  
  PercentDone      
PercentDoneNotif .  , PercentDoneNotif    101 
:        0  100 .   
 Execute        .  
    . 
    7.        PercentDoneNotif . 

    procedure  TSplayCompressThread.PercentDoneNotif(Percent   :integer); begin 
    FPercentDone   :=   Percent; 
    Synchronize   (DisplayPercentDone); end; 

             
  ( -) .    
Synchronize,    DisplayPercentDone. 
    8.        DisplayPercentDone. 

    procedure  TSplayCompressThread.DisplayPercentDone; begin 
    FProgressBar.Position   :=   FPercentDone; end; 

     ,       ,   . 
    , -    ,    Execute  
Synchronize.  Execute    ,   
 ,    ,    . 
 Synchronize    ,    
  ,  ,      , 
  DisplayProgressDone. 
     " "   TForml   Main. 
    9.     private  TForml   . 

    TerminatedCount   :   integer; Threadl   :   TSplayCompressThread; Thread2 
  :   TSplayCompressThread; Threads   :   TSplayCompressThread; 


     24.   	587 

    10.       public    . 
    procedure ThreadTerminated (Sender : TObject); 
    11.   ThreadTerminated. 

    procedure  TForral.ThreadTerminated   (Sender   :   Tobject); begin 
    inc   (TerminatedCount); if   (TerminatedCount  =  3)   then begin 
StartButton.Enabled   :=  true; ProgressBarl.Position   := 0; end; end; 

     ,    ,   ,   
    ,     Start  
    . 
    12.     OnClick  Start. 

    procedure  TForml.StartButtonClick   (Sender   :   Tobject); begin 
    StartButton.Enabled   :=  false; 
    TerminatedCount   :=  0; 
    Threadl   := TSplayCompressThread.Create('\8-73.HTML1, 'Testl.SCF',   true); 
    Thread2   := TSplayCompressThread.Create('\8-73.HTML*, 'Test2.SCF',   true); 
    Threads   := TSplayCompressThread.Create('\8-73.HTML', 'Test3.SCF',   true); 
    Threadl.ProgressBar   := ProgressBarl; 
    Threads.ProgressBar   :=  ProgressBar2; 
    Threads.ProgressBar   :=  ProgressBarS; 
    Threadl.FreeOnTerminate   := true; 
    Thread2.FreeOnTerminate   :=  true; 
    Threads.FreeOnTerminate   :=  true; 
    Threadl.OnTerminate   :=  ThreadTerminated; 
    Thread2.0nTerminate   := ThreadTerminated; 
    Threads.OnTerminate   := ThreadTerminated; 
    Threadl.Resume; 
    Thread2.Resume; 
    Threads.Resume; end; 

         Start,   
         .  
     ,      
  ,     (     
   '\8-73.HTML',          
  ,     ;    
  ,     (  ,  ),  
     ).    
    ,      
    ,   ,  
            
 ThreadTerminated.        
 (,      ?). 
    13.      .   
 Start,          
 . 

     TThread 

    ?    ? ,     ... 
  Borland,   TThread,  
   .   . 
       TThread,    
"  ".      
 TThread.     TThread,     
  ,   Synchronize  -  
.   ,  

    588	 VI.   

      TThread ,    .     
     ,    
  .     . 

    if ThreadCount  =  0  then 
    ThreadWindow   := AllocateWindow; Inc   (ThreadCount); 

        . 

    Dec   (ThreadCount}; 
    if ThreadCount  =  0  then  DestroyWindow(ThreadWindow}; 

        ,    . 
,           
BeginThread.   ( ,  )    
TThread.  ,    ,    
TThread     ,       
  TThread.      
         ( 
    ),      
   . ( ,    
       ; Win32 
   ,    , 
    . Win32    , 
     .  Win32    
 ,    .)   
   ,    ,  
 . ,  . , ,   
        , 
     TThread,      
,  BeginThread. 
           ,      
   . 
    , ... 

        

             .    
 - ,         ,    
- , ,       
,     (,  ). 
       ,        
  . 
       Win32   - .   
 ,  ,     
  (   )       
    - .  ,   
  ,      ,    
,   ;      
  -.  -    
         
.  Microsoft      
  .	, 
       Windows NT 4.0     .  (fiber  )  
 ,  ,   (     
).    (     
).       
         , 
         
     .     
    . Windows NT 4.0   
     ;    
  ,     ,   
      -_ .   
   (Jeffrey Richter) Advanced Windows (Microsoft Press) 
   . 

     24.   	589 


     

          .     
    .    
  ,       , 
     ,   ,   ,  
      . 
     ,     ,  
 ,  ,       
    ,      .  
        
 .      
,       .   
   . 
          TThread,    . 
     ,    !       
   .    ,  . 
     ! 

    590	 VI.   

