dxircservercore.pas

Well known and usefull component for delphi 7

Procedure TDXIRCServerCore.SetOnCommandPART(Value:IRCTBasicEvent);
Begin
   fOnCommandPART:=Value;
   AddBasicEvent('PART',Value);
End;

Procedure TDXIRCServerCore.SetOnCommandMODE(Value:IRCTMultipleEvent);
Begin
   fOnCommandMODE:=Value;
   AddMultipleEvent('MODE',Value);
End;

Procedure TDXIRCServerCore.SetOnCommandTOPIC(Value:IRCTComplexEvent);
Begin
   fOnCommandTOPIC:=Value;
   AddComplexEvent('TOPIC',Value);
End;

Procedure TDXIRCServerCore.SetOnCommandNAMES(Value:IRCTBasicEvent);
Begin
   fOnCommandNAMES:=Value;
   AddBasicEvent('NAMES',Value);
End;

Procedure TDXIRCServerCore.SetOnCommandLIST(Value:IRCTComplexEvent);
Begin
   fOnCommandLIST:=Value;
   AddComplexEvent('LIST',Value);
End;

Procedure TDXIRCServerCore.SetOnCommandINVITE(Value:IRCTComplexEvent);
Begin
   fOnCommandINVITE:=Value;
   AddComplexEvent('INVITE',Value);
End;

Procedure TDXIRCServerCore.SetOnCommandKICK(Value:IRCTMultipleEvent);
Begin
   fOnCommandKICK:=Value;
   AddMultipleEvent('KICK',Value);
End;

Procedure TDXIRCServerCore.SetOnCommandVERSION(Value:IRCTBasicEvent);
Begin
   fOnCommandVERSION:=Value;
   AddBasicEvent('VERSION',Value);
End;

Procedure TDXIRCServerCore.SetOnCommandSTATS(Value:IRCTComplexEvent);
Begin
   fOnCommandSTATS:=Value;
   AddComplexEvent('STATS',Value);
End;

Procedure TDXIRCServerCore.SetOnCommandLINKS(Value:IRCTComplexEvent);
Begin
   fOnCommandLINKS:=Value;
   AddComplexEvent('LINKS',Value);
End;

Procedure TDXIRCServerCore.SetOnCommandTIME(Value:IRCTBasicEvent);
Begin
   fOnCommandTIME:=Value;
   AddBasicEvent('TIME',Value);
End;

Procedure TDXIRCServerCore.SetOnCommandCONNECT(Value:IRCTMultipleEvent);
Begin
   fOnCommandCONNECT:=Value;
   AddMultipleEvent('CONNECT',Value);
End;

Procedure TDXIRCServerCore.SetOnCommandTRACE(Value:IRCTBasicEvent);
Begin
   fOnCommandTRACE:=Value;
   AddBasicEvent('TRACE',Value);
End;

Procedure TDXIRCServerCore.SetOnCommandADMIN(Value:IRCTBasicEvent);
Begin
   fOnCommandADMIN:=Value;
   AddBasicEvent('ADMIN',Value);
End;

Procedure TDXIRCServerCore.SetOnCommandINFO(Value:IRCTBasicEvent);
Begin
   fOnCommandINFO:=Value;
   AddBasicEvent('INFO',Value);
End;

Procedure TDXIRCServerCore.SetOnCommandPRIVMSG(Value:IRCTComplexEvent);
Begin
   fOnCommandPRIVMSG:=Value;
   AddComplexEvent('PRIVMSG',Value);
End;

Procedure TDXIRCServerCore.SetOnCommandNOTICE(Value:IRCTComplexEvent);
Begin
   fOnCommandNOTICE:=Value;
   AddComplexEvent('NOTICE',Value);
End;

Procedure TDXIRCServerCore.SetOnCommandWHO(Value:IRCTComplexEvent);
Begin
   fOnCommandWHO:=Value;
   AddComplexEvent('WHO',Value);
End;

Procedure TDXIRCServerCore.SetOnCommandWHOIS(Value:IRCTComplexEvent);
Begin
   fOnCommandWHOIS:=Value;
   AddComplexEvent('WHOIS',Value);
End;

Procedure TDXIRCServerCore.SetOnCommandWHOWAS(Value:IRCTMultipleEvent);
Begin
   fOnCommandWHOWAS:=Value;
   AddMultipleEvent('WHOWAS',Value);
End;

Procedure TDXIRCServerCore.SetOnCommandKILL(Value:IRCTComplexEvent);
Begin
   fOnCommandKILL:=Value;
   AddComplexEvent('KILL',Value);
End;

Procedure TDXIRCServerCore.SetOnCommandPING(Value:IRCTComplexEvent);
Begin
   fOnCommandPING:=Value;
   AddComplexEvent('PING',Value);
End;

Procedure TDXIRCServerCore.SetOnCommandPONG(Value:IRCTComplexEvent);
Begin
   fOnCommandPONG:=Value;
   AddComplexEvent('PONG',Value);
End;

Procedure TDXIRCServerCore.SetOnCommandAWAY(Value:IRCTBasicEvent);
Begin
   fOnCommandAWAY:=Value;
   AddBasicEvent('AWAY',Value);
End;

Procedure TDXIRCServerCore.SetOnCommandREHASH(Value:IRCTSimpleEvent);
Begin
   fOnCommandREHASH:=Value;
   AddSimpleEvent('REHASH',Value);
End;

Procedure TDXIRCServerCore.SetOnCommandRESTART(Value:IRCTSimpleEvent);
Begin
   fOnCommandRESTART:=Value;
   AddSimpleEvent('RESTART',Value);
End;

Procedure TDXIRCServerCore.SetOnCommandSUMMON(Value:IRCTComplexEvent);
Begin
   fOnCommandSUMMON:=Value;
   AddComplexEvent('SUMMON',Value);
End;

Procedure TDXIRCServerCore.SetOnCommandUSERS(Value:IRCTBasicEvent);
Begin
   fOnCommandUSERS:=Value;
   AddBasicEvent('USERS',Value);
End;

Procedure TDXIRCServerCore.SetOnCommandWALLOPS(Value:IRCTBasicEvent);
Begin
   fOnCommandWALLOPS:=Value;
   AddBasicEvent('WALLOPS',Value);
End;

Procedure TDXIRCServerCore.SetOnCommandUSERHOST(Value:IRCTComplexEvent);
Begin
   fOnCommandUSERHOST:=Value;
   AddComplexEvent('USERHOST',Value);
End;

Procedure TDXIRCServerCore.SetOnCommandISON(Value:IRCTComplexEvent);
Begin
   fOnCommandISON:=Value;
   AddComplexEvent('ISON',Value);
End;

Procedure TDXIRCServerCore.SetOnCommandERROR(Value:IRCTMultipleEvent);
Begin
   fOnCommandERROR:=Value;
   AddMultipleEvent('ERROR',Value);
End;

Procedure TDXIRCServerCore.SayError(ErrorCode:Integer;OptionalText:String;ClientThread:TDXClientThread); // 3.0a
Var
  Ws:String;
  Loop:Integer;

Begin
   For Loop:=High(StatusCodes) downto Low(StatusCodes) do Begin
      If StatusCodes[Loop].Code=ErrorCode then Begin
         Ws:=StatusCodes[Loop].Msg;
         Break;
      End;
   End;
   If Copy(Ws,1,1)=#32 then Ws:=OptionalText+Ws;
   ClientThread.Socket.Writeln(':'+fServerName+#32+Ws);
End;

Procedure TDXIRCServerCore.SayWelcome(Nick:String;Text:TStrings;ClientThread:TDXClientThread); // 4.0
Var
   Loop:Integer;
   Ws:String;

Begin
   For Loop:=1 to Text.Count do Begin
      Ws:=IntToCommaStr(Loop);
      While Length(Ws)<3 do Ws:='0'+Ws;
      ClientThread.Socket.Writeln(':'+fServername+#32+Ws+#32+Nick+' :'+Text[Loop-1]);
   End;
End;

Procedure TDXIRCServerCore.SayMOTD(Nick:String;Text:TStrings;ClientThread:TDXClientThread); // 4.0
Var
   Loop:Integer;

Begin
   ClientThread.Socket.Writeln(':'+fServername+' 375 '+Nick+' :- '+fServerName+' Message of the Day');

   For Loop:=1 to Text.Count do Begin
      ClientThread.Socket.Writeln(':'+fServername+' 372 '+Nick+' :'+Text[Loop-1]);
   End;

   ClientThread.Socket.Writeln(':'+fServername+' 376 '+Nick+' :End of /MOTD Command.');
End;

Procedure TDXIRCServerCore.SayNOTICE(Nick,Text:String;ClientThread:TDXClientThread); // 4.0
Begin
   ClientThread.Socket.Writeln(':'+fServername+' NOTICE '+Nick+' :'+Text);
End;

Procedure TDXIRCServerCore.SayChannelList(Nick:String;Text:TStrings;ClientThread:TDXClientThread); // 4.0
Var
   Loop:Integer;

Begin
   ClientThread.Socket.Writeln(':'+fServername+' 321 '+Nick+' Channel :Users  Name');

   For Loop:=1 to Text.Count do Begin
      ClientThread.Socket.Writeln(':'+fServername+' 322 '+Nick+#32+Text[Loop-1]);
   End;

   ClientThread.Socket.Writeln(':'+fServername+' 323 '+Nick+' :End of /LIST Command.');
End;

procedure TDXIRCServerCore.ProcessSession(ClientThread:TDXClientThread);
var
  s,sCmd:string;
  Loop:Integer;
  WasHandled:Boolean;
  OutData:Pointer;
  PINGTries:Integer;

begin
   fbForceAbort:=False;
   with ClientThread.Socket do begin
      while connected do begin
         if fbForceAbort then Exit;
         PINGTries:=0;
         S:='';
         While (S='') do Begin
            s:=Readln(Timeout);
            If Not ValidSocket then Exit;
            If LastReadTimeout then Begin
               If Assigned(fOnCommandTimeout) then
                  fOnCommandTimeout(ClientThread)
               Else Begin
                  If PingTries<1 then Begin
                     ClientThread.Socket.Writeln('PING :'+fServerName);
                     Inc(PingTries);
                  End
                  Else Begin
                     ClientThread.Socket.Writeln('ERROR :Closing Link: ['+
                        ClientThread.Socket.PeerIPAddress+'] 011 (Ping timeout)');
                     Exit;
                  End;
               End;
            End;
         End;
         if assigned({$IFDEF TLS_EDITION}OnReadFilter{$ELSE}OnFilter{$ENDIF}) then begin
            Loop:=FilterRead(@S[1],OutData,Length(S),ClientThread);
            SetLength(S,Loop);
            If Assigned(OutData) then Begin
               FastMove(TDXBSArray(OutData^),S[1],Loop);
{$IFDEF TLS_EDITION}OnReadFilter{$ELSE}OnFilter{$ENDIF}(ddFreePointer,nil,OutData,Loop,Loop,WasHandled,ClientThread) ;
            End;
         End;
         sCmd:=UpperCase(Fetch(S,#32,False));
         Loop:=0;
         WasHandled:=False;
         If sCmd<>'' then {timeout}
         While (Loop<fEventArray.Count) and (Not WasHandled) do Begin
            If PIRCBasicEvent(fEventArray[Loop]).Command=sCMD then Begin
               Case PIRCBasicEvent(fEventArray[Loop]).Tag of
                  1:if Assigned(PIRCBasicEvent(fEventArray[Loop]).EventProcedure) then
                       IRCTBasicEvent(PIRCBasicEvent(fEventArray[Loop]).EventProcedure)(ClientThread,s);
                  2:if Assigned(PIRCSimpleEvent(fEventArray[Loop]).EventProcedure) then
                       IRCTSimpleEvent(PIRCSimpleEvent(fEventArray[Loop]).EventProcedure)(ClientThread);
                  3:if Assigned(PIRCComplexEvent(fEventArray[Loop]).EventProcedure) then Begin
                       sCmd:=FetchByChar(S,#32,False);
                       IRCTComplexEvent(PIRCComplexEvent(fEventArray[Loop]).EventProcedure)(ClientThread,sCmd,S);
                  End;
                  4:if Assigned(PIRCMultipleEvent(fEventArray[Loop]).EventProcedure) then
                       IRCTMultipleEvent(PIRCMultipleEvent(fEventArray[Loop]).EventProcedure)(ClientThread,s);
               End;
               WasHandled:=True;
            End
            Else Inc(Loop);
         End;
         If sCMD='QUIT' then Exit;
         If Not WasHandled then Begin
            if assigned(OnCommandOther) then
               OnCommandOther(ClientThread,sCmd,S,WasHandled);
         end;
         if not WasHandled then
            Writeln(':'+fServerName+' 421 '+sCmd+' :Unknown command');
      end;
   end;
end;

end.