1
2uses
3  lCommon;
4
5const
6  G_IO_IN   =  1;
7  G_IO_OUT  =  4;
8  G_IO_PRI  =  2;
9  G_IO_ERR  =  8;
10  G_IO_HUP  = 16;
11  G_IO_NVAL = 32;
12
13  ALL_FLAGS = G_IO_ERR or G_IO_NVAL or G_IO_HUP or G_IO_PRI or G_IO_IN or G_IO_OUT;
14
15procedure TLCLEventer.HandleIgnoreError(aHandle: TLHandle);
16begin
17  // TODO fix or remove alltogether
18end;
19
20procedure TLCLEventer.HandleIgnoreWrite(aHandle: TLHandle);
21var
22  LHI: PLCLHandleInfo;
23begin
24  LHI := GetInternalData(aHandle);
25  if aHandle.IgnoreWrite then
26    LHI^.Flags := LHI^.Flags and (not G_IO_OUT)
27  else
28    LHI^.Flags := LHI^.Flags or G_IO_OUT;
29  SetEventHandlerFlags(LHI^.EventHandle, LHI^.Flags);
30end;
31
32procedure TLCLEventer.HandleIgnoreRead(aHandle: TLHandle);
33var
34  LHI: PLCLHandleInfo;
35begin
36  LHI := GetInternalData(aHandle);
37  if aHandle.IgnoreRead then
38    LHI^.Flags := LHI^.Flags and (not G_IO_IN)
39  else
40    LHI^.Flags := LHI^.Flags or G_IO_IN;
41  SetEventHandlerFlags(LHI^.EventHandle, LHI^.Flags);
42end;
43
44procedure TLCLEventer.HandleEvents(aData: PtrInt; aFlags: DWord);
45var
46  LHI: PLCLHandleInfo;
47  Temp: TLHandle;
48begin
49  LHI := PLCLHandleInfo(aData);
50  Temp := LHI^.Handle;
51  if not FInLoop then begin
52    FInLoop := True;
53
54    if aFlags and G_IO_OUT = G_IO_OUT then
55      if not Temp.Dispose and Assigned(Temp.OnWrite) then
56        Temp.OnWrite(Temp);
57
58    if aFlags and G_IO_IN = G_IO_IN then
59      if not Temp.Dispose and Assigned(Temp.OnRead) then
60        Temp.OnRead(Temp);
61
62    if  (not Temp.Dispose)
63    and ((aFlags and G_IO_ERR = G_IO_ERR)
64      or (aFlags and G_IO_NVAL = G_IO_NVAL)
65      or (aFlags and G_IO_HUP = G_IO_HUP)) then
66      if Assigned(Temp.OnError) then
67        Temp.OnError(Temp, 'Handle error' + LStrError(LSocketError));
68
69    SetEventHandlerFlags(LHI^.EventHandle, LHI^.Flags);
70
71    if Temp.Dispose then
72      AddForFree(Temp);
73    FInLoop := False;
74
75    if Assigned(FFreeRoot) then
76      FreeHandles;
77  end else
78    SetEventHandlerFlags(LHI^.EventHandle, 0);
79end;
80
81function TLCLEventer.AddHandle(aHandle: TLHandle): Boolean;
82var
83  LHI: PLCLHandleInfo;
84begin
85  Result := False;
86
87  SetHandleEventer(aHandle);
88
89  LHI := GetMem(SizeOf(TLCLHandleInfo));
90  LHI^.Handle := aHandle;
91  SetInternalData(aHandle, LHI);
92  LHI^.EventHandle := AddEventHandler(aHandle.Handle, ALL_FLAGS,
93                                    @HandleEvents, PtrUInt(LHI));
94  LHI^.Flags := ALL_FLAGS;
95  if not Assigned(LHI^.EventHandle) then
96    Bail('Error on handler', -1)
97  else
98    Result  :=  True;
99end;
100
101procedure TLCLEventer.InternalUnplugHandle(aHandle: TLHandle);
102var
103  LHI: PLCLHandleInfo;
104begin
105  LHI := GetInternalData(aHandle);
106  RemoveEventHandler(LHI^.EventHandle);
107  FreeMem(LHI);
108  inherited InternalUnplugHandle(aHandle);
109end;
110
111
112