?? wsockets.pas
字號:
end;
{ And finally destroy ourself }
inherited Destroy;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ Message handler }
procedure TCustomWSocketServer.WndProc(var MsgRec: TMessage);
begin
with MsgRec do begin
if Msg = WM_CLIENT_CLOSED then begin
{ We *MUST* handle all exception to avoid application shutdown }
try
WMClientClosed(MsgRec)
except
on E:Exception do
HandleBackGroundException(E);
end;
end
else
inherited WndProc(MsgRec);
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ Called by destructor when child component (a clients) is create or }
{ destroyed. }
procedure TCustomWSocketServer.Notification(
AComponent : TComponent;
Operation : TOperation);
begin
inherited Notification(AComponent, Operation);
if Assigned(FClientList) and (AComponent is TWSocketClient) then begin
if Operation = opInsert then
{ A new client has been created, add it to our list }
FClientList.Add(AComponent)
else if Operation = opRemove then
{ If one of our client has been destroyed, remove it from our list }
FClientList.Remove(AComponent);
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ Called when a session is available, that is when a client is connecting }
procedure TCustomWSocketServer.TriggerSessionAvailable(Error : Word);
var
Client : TWSocketClient;
begin
{ Call parent event handler }
inherited TriggerSessionAvailable(Error);
{ In case of error, do nothing }
if Error <> 0 then
Exit;
Inc(FClientNum);
Client := FClientClass.Create(Self);
TriggerClientCreate(Client);
Client.Name := Name + 'Client' + IntToStr(FClientNum);
Client.Banner := FBanner;
Client.Server := Self;
Client.HSocket := Accept;
TriggerClientConnect(Client, Error);
{ The event handler may have destroyed the client ! }
if FClientList.IndexOf(Client) < 0 then
Exit;
{ The event handler may have closed the connection }
if Client.State <> wsConnected then
Exit;
{ Ok, the client is still there, process with the connection }
if (FMaxClients > 0) and (FMaxClients < ClientCount) then begin
{ Sorry, toomuch clients }
Client.Banner := FBannerToBusy;
Client.StartConnection;
Client.Close;
end
else
Client.StartConnection;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomWSocketServer.TriggerClientConnect(
Client : TWSocketClient; Error : Word);
begin
if Assigned(FOnClientConnect) then
FOnClientConnect(Self, Client, Error);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomWSocketServer.TriggerClientCreate(Client : TWSocketClient);
begin
if Assigned(FOnClientCreate) then
FOnClientCreate(Self, Client);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TCustomWSocketServer.TriggerClientDisconnect(
Client : TWSocketClient; Error : Word);
begin
if Assigned(FOnClientDisconnect) then
FOnClientDisconnect(Self, Client, Error);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ get number of connect clients }
function TCustomWSocketServer.GetClientCount : Integer;
begin
if Assigned(FClientList) then
Result := FClientList.Count
else
Result := 0;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ Acces method to return a client by index. }
{ Return nil if index is out of range. }
function TCustomWSocketServer.GetClient(nIndex : Integer) : TWSocketClient;
begin
if not Assigned(FClientList) then begin
Result := nil;
Exit;
end;
if (nIndex < 0) or (nIndex >= FClientList.Count) then begin
Result := nil;
Exit;
end;
Result := TWSocketClient(FClientList.Items[nIndex]);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ Client has closed. Remove it from client list and destroy component. }
procedure TCustomWSocketServer.WMClientClosed(var msg: TMessage);
var
Client : TWSocketClient;
begin
Client := TWSocketClient(Msg.LParam);
try
TriggerClientDisconnect(Client, Error);
finally
{ Calling Destroy will automatically remove client from list because }
{ we installed a notification handler. }
Client.Destroy;
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ Check if a given object is one of our clients. }
function TCustomWSocketServer.IsClient(SomeThing : TObject) : Boolean;
begin
if not Assigned(FClientList) then
Result := FALSE
else
Result := (FClientList.IndexOf(Pointer(SomeThing)) >= 0);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{* *}
{* TWSocketClient *}
{* *}
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TWSocketClient.StartConnection;
begin
if Length(FBanner) > 0 then
SendStr(FBanner + #13#10);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ Triggered when socket is closed. Need to inform server socket to update }
{ client list and trigger client disconnect event. }
procedure TWSocketClient.TriggerSessionClosed(Error : Word);
begin
if not FSessionClosedFlag then begin
FSessionClosedFlag := TRUE;
PostMessage(Server.Handle, WM_CLIENT_CLOSED, 0, LongInt(Self));
inherited TriggerSessionClosed(Error);
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ This override base class GetPeerAddr. It return cached value. }
function TWSocketClient.GetPeerAddr: String;
begin
Result := FPeerAddr;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ This override base class GetPeerPort. It return cached value. }
function TWSocketClient.GetPeerPort: String;
begin
Result := FPeerPort;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ Override base class. Dup is called when a client is assigned to a }
{ TWSocket. Assigning HSocket property will call Dup. }
procedure TWSocketClient.Dup(newHSocket : TSocket);
begin
inherited Dup(newHSocket);
{ Cache PeerAddr value }
FPeerAddr := inherited GetPeerAddr;
FPeerPort := inherited GetPeerPort;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
end.
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -