API tools faq
paste
Advertisement
Guest User

JD Custom Command Server/Client Sockets

a guest
Dec 5th, 2011
451
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 67.74 KB | None | 0 0
raw download clone embed print report
  1. {
  2.   JD Command Socket Components
  3.   by Jerry Dodge
  4.  
  5.   TJDServerSocket: Wraps TServerSocket
  6.   TJDClientSocket: Wraps TClientSocket
  7.   TJDClientServerSocket: Wraps client side TCustomWinSocket  
  8.   TJDServerClientSocket: Wraps server side TCustomWinSocket
  9.   TSvrCommands: Collection of TSvrCommand
  10.   TSvrCommand: Executed on server when command is received from client
  11.   TCliCommands: Collection of TCliCommand
  12.   TCliCommand: Executed on client when command is received from server
  13.   TScktProps: List of property strings referenced by name strings
  14.  
  15.   Abilities:
  16.            
  17.   > Command/Parameter based packet structure
  18.     > Both sides send/receive command packets the same way
  19.     > Integer based command ID
  20.     > Either array of string or TStrings as parameters in commands
  21.     > Overloaded procedure "SendPacket" to send commands
  22.       > procedure SendPacket(const Cmd: Integer; const Data: TStrings);
  23.       > procedure SendPacket(const Cmd: Integer; const Data: array of String);
  24.       > procedure SendPacket(const Cmd: Integer);
  25.     > Event "OnCommand" triggered on either side when packet is received
  26.     > Command collections are ADDITIONAL to OnCommand event (see below)
  27.       > OnCommand is called first, then the command collection events next
  28.          
  29.   > Collection of commands with unique events
  30.     > TCollection property on both sides, holding a set of Commands
  31.     > TSvrCommands on Server and TCliCommands on Client (command collections)
  32.     > TSvrCommand on Server and TCliCommand on Client (individual commands)
  33.     > Each command has unique ID (command number) and a Name
  34.     > Each command has its own event handler (OnCommand)
  35.       > Provides packet data received as TStrings
  36.     > Each command has its pre-defined number of parameters
  37.       > -1 = Any, 0 = None, 1+ = Fixed
  38.       > (PARAMETER COUNT CHECKING NOT YET IMPLEMENTED)
  39.     > TO DO: Make sure all ID's are unique and not repeating
  40.     > TO DO: Implement enforcement of parameter count
  41.  
  42.   > Automatic login authentication
  43.     > Client specifies credentials
  44.     > Server triggers event OnLoginRequest, and property "Accept" is set accordingly
  45.     > Client triggers event OnLoginResponse, and property "Accept" is used accordingly
  46.     > Client can be set either to login automatically or login on demand
  47.     > Client and server can be set to different levels of authentication
  48.       > None, Login, Login/Cookie, Fixed
  49.       > Fixed login allows all clients to use same user/pass
  50.       > Both Server and Client are expected to have same authentication mode set
  51.     > In event handler OnLoginRequest or OnCookieLoginRequest on the Server,
  52.       you can pass back SessionID, UserID, and Cookie as var parameters
  53.  
  54.   > Cookie authentication
  55.     > Server produces unique cookie string for new sessions
  56.     > Existing session can be resumed by using cookie login
  57.     > Server event "OnCookieLoginRequest" when client logs in with cookie
  58.       > Works similar to OnLoginRequest but providing cookie instead of user/pass
  59.     > Server automatically generates cookies
  60.       > Event "OnCookieLookup" when server needs to know just if a cookie exists
  61.     > Property on server "CookieSize" to specify number of characters in cookies
  62.  
  63.   > Custom property synchronizing
  64.     > Name/Value properties stored on both sides per session
  65.     > Wrapped in class TScktProps
  66.       > Implemented in TJDServerClientSocket and TJDClientServerSocket as "Props"
  67.     > Custom properties, not associated with sockets
  68.     > Changing a property from one place syncs that value with other end
  69.     > Event when a property has been synchronized
  70.     > TO DO: Restrict property names to only alpha-numeric strings
  71.     > Property names are CASE SENSITIVE
  72.  
  73.   > Other features
  74.     > IP Blacklist on Server - immediately drops connections from any IP listed
  75.     > Encryption with auto key gen and synchronization
  76.    
  77.      
  78.   Event orders
  79.   > Server Events
  80.     > Client connected
  81.       - OnConnection(csConnecting)
  82.       - OnConnecting
  83.         <if Accept = True>
  84.         - OnConnection(csConnected)
  85.     > Client disconnected
  86.       - OnConnection(csDisconnecting)
  87.         <if LoginState = lsAllow>
  88.         - OnLogout (not yet implemented)
  89.       - OnConnection(csDisconnected)
  90.     > Client logs in with user/pass
  91.       - OnLoginRequest
  92.  
  93.   > Both directions
  94.     > Command packet received
  95.       - OnCommand
  96.         <if Cmd ID is listed in collection>
  97.         - CollectionItem.OnCommand
  98.         <else>
  99.         - Collection.OnUnknownCommand
  100.  
  101.        
  102.   Notes
  103.   > Sockets internally use negative numbers for their own commands,
  104.     so custom commands must always use positive numbers.
  105.  
  106.  
  107.   TO DO LIST
  108.   > Force use of positive numbers in command ID's
  109.     > Add internal command SendPacketX which does not restrict negatives
  110.     > Modify SendPacket to accept only positives
  111.     > Modify command collection items to accept only positive ID's
  112.   > Load-test and check for proper exception handling
  113.   > Wrap TJDServerClientSocket and TJDClientServerSocket into threads
  114.     > Need option of whether or not to use threads
  115.   > Implement sending streams (partially started)
  116.   > Monitor data sent/received and keep records
  117.   > Properly implement login/logout when AutoLogin is False
  118.     > Differentiate "Connection Sessions" from "Login Sessions"
  119.     > Two different session structures, with their own ID's
  120.   > Change "OnConnection" to "OnClientConnected" and "OnClientDisconnected"
  121.     > (No need to have connecting and disconnecting)
  122.   > Finish implementing cross-error handling
  123.     > Error occurs on one end
  124.     > Error alert sent to opposite end
  125.     > Event triggered on opposite end OnRemoteError
  126.  
  127. }      
  128.  
  129. unit JDSockets;
  130.  
  131. interface
  132.  
  133. uses
  134.   Classes, Windows, SysUtils, StrUtils, ScktComp, ExtCtrls;
  135.  
  136. const
  137.   JDS_DAT_DIV =           '#';  //Used as packet divider
  138.  
  139.   JDS_CMD_LOGIN =         -1;
  140.   JDS_CMD_ERROR =         -2;
  141.   JDS_CMD_COOKIE =        -3;
  142.   JDS_CMD_USER_ID =       -4;
  143.   JDS_CMD_SESS_ID =       -5;
  144.   JDS_CMD_LOGOUT =        -6;
  145.   JDS_CMD_PROP =          -7;
  146.   JDS_CMD_KEY =           -8;
  147.                          
  148. type
  149.   TJDServerClientSocket = class;
  150.   TJDClientServerSocket = class;
  151.   TJDServerSocket = class;
  152.   TJDClientSocket = class;
  153.   TSvrCommands = class;
  154.   TSvrCommand = class;
  155.   TCliCommands = class;
  156.   TCliCommand = class;
  157.   TScktProps = class;
  158.  
  159.   TJDScktConnState = (csConnected, csDisconnected, csConnecting, csDisconnecting);
  160.   TJDScktLoginState = (lsNone, lsAllow, lsDeny, lsError);
  161.   TJDScktRecState = (rsIdle, rsCommand);
  162.   TJDScktAuthMode = (amNone, amLogin, amLoginCookie, amFixed);
  163.   TJDScktErrorType = (etSocket, etInternal, etRemote);
  164.  
  165.   //amNone: No authentication required
  166.   //amLogin: Login/password required, and are each unique
  167.   //amLoginCookie: Same as amLogin, but includes cookie authentication
  168.   //amFixed: Login/password required, and are always the same
  169.  
  170. ////////////////////////////////////////////////////////////////////////////////
  171. //  Command Collections
  172. //  Goal: Allow entering pre-set commands with unique Name and ID
  173. //  Each command has its own event which is triggered when command is received
  174.  
  175.   //Determines how commands are displayed in collection editor in design-time
  176.   TJDCmdDisplay = (cdName, cdID, cdCaption, cdIDName, cdIDCaption);
  177.  
  178.   //Server side commands
  179.  
  180.   TJDScktSvrCmdEvent = procedure(Sender: TObject; Socket: TJDServerClientSocket;
  181.     const Data: TStrings) of object;
  182.  
  183.   TSvrCommands = class(TCollection)
  184.   private
  185.     fOwner: TPersistent;
  186.     fOnUnknownCommand: TJDScktSvrCmdEvent;
  187.     fDisplay: TJDCmdDisplay;
  188.     function GetItem(Index: Integer): TSvrCommand;
  189.     procedure SetItem(Index: Integer; Value: TSvrCommand);
  190.     procedure SetDisplay(const Value: TJDCmdDisplay);
  191.   protected
  192.     function GetOwner: TPersistent; override;
  193.   public
  194.     constructor Create(AOwner: TPersistent);
  195.     destructor Destroy;
  196.     procedure DoCommand(const Socket: TJDServerClientSocket;
  197.       const Cmd: Integer; const Data: TStrings);
  198.     function Add: TSvrCommand;
  199.     property Items[Index: Integer]: TSvrCommand read GetItem write SetItem;
  200.   published
  201.     property Display: TJDCmdDisplay read fDisplay write SetDisplay;
  202.     property OnUnknownCommand: TJDScktSvrCmdEvent
  203.       read fOnUnknownCommand write fOnUnknownCommand;
  204.   end;
  205.  
  206.   TSvrCommand = class(TCollectionItem)
  207.   private
  208.     fID: Integer;
  209.     fOnCommand: TJDScktSvrCmdEvent;
  210.     fName: String;
  211.     fParamCount: Integer;
  212.     fCollection: TSvrCommands;
  213.     fCaption: String;
  214.     procedure SetID(Value: Integer);
  215.     procedure SetName(Value: String);
  216.     procedure SetCaption(const Value: String);
  217.   protected
  218.     function GetDisplayName: String; override;
  219.   public
  220.     procedure Assign(Source: TPersistent); override;
  221.     constructor Create(Collection: TCollection); override;
  222.     destructor Destroy; override;
  223.   published
  224.     property ID: Integer read fID write SetID;
  225.     property Name: String read fName write SetName;
  226.     property Caption: String read fCaption write SetCaption;
  227.     property ParamCount: Integer read fParamCount write fParamCount;
  228.     property OnCommand: TJDScktSvrCmdEvent read fOnCommand write fOnCommand;
  229.   end;
  230.  
  231.   //Client side commands
  232.  
  233.   TJDScktCliCmdEvent = procedure(Sender: TObject; Socket: TJDClientServerSocket;
  234.     const Data: TStrings) of object;
  235.              
  236.   TCliCommands = class(TCollection)
  237.   private
  238.     fOwner: TPersistent;
  239.     fOnUnknownCommand: TJDScktCliCmdEvent;
  240.     fDisplay: TJDCmdDisplay;
  241.     function GetItem(Index: Integer): TCliCommand;  
  242.     procedure SetItem(Index: Integer; Value: TCliCommand);
  243.     procedure SetDisplay(const Value: TJDCmdDisplay);
  244.   protected
  245.     function GetOwner: TPersistent; override;
  246.   public
  247.     constructor Create(AOwner: TPersistent);
  248.     destructor Destroy;
  249.     procedure DoCommand(const Socket: TJDClientServerSocket;
  250.       const Cmd: Integer; const Data: TStrings);
  251.     function Add: TCliCommand;
  252.     property Items[Index: Integer]: TCliCommand read GetItem write SetItem;
  253.   published              
  254.     property Display: TJDCmdDisplay read fDisplay write SetDisplay;
  255.     property OnUnknownCommand: TJDScktCliCmdEvent
  256.       read fOnUnknownCommand write fOnUnknownCommand;
  257.   end;
  258.  
  259.   TCliCommand = class(TCollectionItem)
  260.   private
  261.     fCollection: TCliCommands;
  262.     fID: Integer;
  263.     fName: String;
  264.     fOnCommand: TJDScktCliCmdEvent;
  265.     fParamCount: Integer;
  266.     fCaption: String;
  267.     procedure SetID(Value: Integer);
  268.     procedure SetName(Value: String);
  269.     procedure SetCaption(const Value: String);
  270.   protected
  271.     function GetDisplayName: String; override;
  272.   public
  273.     procedure Assign(Source: TPersistent); override;
  274.     constructor Create(Collection: TCollection); override;
  275.     destructor Destroy; override;
  276.   published
  277.     property ID: Integer read fID write SetID;
  278.     property Name: String read fName write SetName;
  279.     property Caption: String read fCaption write SetCaption;
  280.     property ParamCount: Integer read fParamCount write fParamCount;
  281.     property OnCommand: TJDScktCliCmdEvent read fOnCommand write fOnCommand;
  282.   end;
  283.  
  284. //  END Command Collections
  285. ////////////////////////////////////////////////////////////////////////////////
  286.  
  287. ////////////////////////////////////////////////////////////////////////////////
  288. //  TScktProps - Socket Property Synchronization    
  289. //  Represents a group of string properties referenced by string names
  290. //  Goal: Provide custom properties which automatically synchronize
  291. //    between the TJDServerClientSocket and the TJDClientServerSocket
  292. //  NOTE: Property names are CASE SENSITIVE so 'myprop' is different from 'MyProp'
  293. //  property Props: TScktProps on TJDServerClientSocket and TJDClientServerSocket
  294. //  Read Example: MyStr:= Props['PropNameStr'];
  295. //  Write Example: Props['PropNameStr']:= MyStr;
  296. //  Write Example (no event): Props.SetPropX('PropNameStr', MyStr);
  297. //    Use SetPropX to set a property value WITHOUT triggering event
  298. //    Primarily when property is received from remote socket
  299. //    Using the standard method will trigger event (which synchs new value)
  300.  
  301.   TJDScktPropEvent = procedure(Sender: TObject; const Name, Val: String) of object;
  302.  
  303.   TScktProps = class(TObject)
  304.   private
  305.     fItems: TStringList;
  306.     fOnGotProp: TJDScktPropEvent;
  307.     function GetProp(Name: String): String;
  308.     procedure SetProp(Name: String; const Value: String);
  309.     procedure SetPropX(Name: String; const Value: String);
  310.   public
  311.     constructor Create;
  312.     destructor Destroy; override;
  313.     property Prop[Name: String]: String read GetProp write SetProp; default;
  314.     function PropExists(Name: String): Bool;
  315.     property OnGotProp: TJDScktPropEvent read fOnGotProp write fOnGotProp;
  316.   end;
  317.  
  318. //  END Socket Property Synchronization
  319. ////////////////////////////////////////////////////////////////////////////////
  320.  
  321. ////////////////////////////////////////////////////////////////////////////////
  322. //  TJDServerClientSocket
  323. //  Server side - client connection
  324. //  Represents unique socket on the server for a single connection from a client
  325.  
  326.   TJDSvrCliConnEvent = procedure(Sender: TObject; Socket: TJDServerClientSocket;
  327.     const OldState, NewState: TJDScktConnState) of object;
  328.   TJDSvrCliErrEvent = procedure(Sender: TObject; Socket: TJDServerClientSocket;
  329.     var ErrMsg: String; var ErrCode: Integer) of object;
  330.   TJDSvrCliCmdEvent = procedure(Sender: TObject; Socket: TJDServerClientSocket;
  331.     const Cmd: Integer; const Data: TStrings) of object;
  332.   TJDScktLoginRequestEvent = procedure(Sender: TObject; Socket: TJDServerClientSocket;
  333.     const Username, Password: String; var Accept: Bool; var Cookie: String;
  334.     var UserID, SessionID: Integer) of object;
  335.   TJDScktCookieLoginRequestEvent = procedure(Sender: TObject; Socket: TJDServerClientSocket;
  336.     const Cookie: String; var Accept: Bool; var Username: String;
  337.     var UserID, SessionID: Integer) of object;
  338.   TJDSvrCliAcceptEvent = procedure(Sender: TObject; Socket: TJDServerClientSocket;
  339.     var Accept: Bool) of object;
  340.   TJDSvrCookieLookupEvent = procedure(Sender: TObject; const Cookie: String;
  341.     var Exists: Bool) of object;      
  342.   TJDSvrScktPropEvent = procedure(Sender: TObject; Socket: TJDServerClientSocket;
  343.     const Name, Val: String) of object;
  344.  
  345.   TJDServerClientSocket = class(TObject)
  346.   private
  347.     //Created Objects
  348.     fErrors: TStringList;
  349.     fTimer: TTimer;
  350.     fProps: TScktProps;
  351.     //Assigned Objects
  352.     fOwner: TJDServerSocket;
  353.     fSocket: TCustomWinSocket;
  354.     //More Variables
  355.     fConnState: TJDScktConnState;
  356.     fLoginState: TJDScktLoginState;
  357.     fRecState: TJDScktRecState;
  358.     fBusy: Bool;
  359.     fBuffer: String;
  360.     fSize: Integer;
  361.     fCommand: Integer;
  362.     fProtocol: Integer;
  363.     fData: Pointer;
  364.     fUserID: Integer;
  365.     fUsername: String;  
  366.     fSessionID: Integer;
  367.     fCookie: String;
  368.     //Events
  369.     fOnConnection: TJDSvrCliConnEvent;
  370.     fOnCommand: TJDSvrCliCmdEvent;
  371.     fOnError: TJDSvrCliErrEvent;
  372.     fOnLoginRequest: TJDScktLoginRequestEvent;
  373.     fOnCookieLoginRequest: TJDScktCookieLoginRequestEvent;
  374.     fOnCookieLookup: TJDSvrCookieLookupEvent;
  375.     fOnGotProp: TJDSvrScktPropEvent;
  376.     fKey: Word;
  377.     //Child event handlers
  378.     procedure TimerOnTimer(Sender: TObject);
  379.     procedure PropsGotProp(Sender: TObject; const Name, Val: String);
  380.     //Internal methods
  381.     procedure ProcessCommand(const S: String);
  382.     procedure SetCookie(const Value: String);
  383.     procedure SetSessionID(const Value: Integer);
  384.     procedure SetUsername(const Value: String);
  385.     procedure SetUserID(const Value: Integer);
  386.     procedure SetKey(const Value: Word);
  387.   public
  388.     //Construct/Destruct
  389.     constructor Create(ASocket: TCustomWinSocket; AOwner: TJDServerSocket);
  390.     destructor Destroy; override;
  391.     //Public methods
  392.     procedure SendPacket(Cmd: Integer; Data: TStrings); overload;
  393.     procedure SendPacket(Cmd: Integer; Data: array of String); overload;
  394.     procedure SendPacket(Cmd: Integer); overload;
  395.     procedure SendStream(Cmd: Integer; Data: TStream);
  396.     //Public properties
  397.     property Owner: TJDServerSocket read fOwner;
  398.     property Socket: TCustomWinSocket read fSocket;
  399.     property ConnState: TJDScktConnState read fConnState;
  400.     property LoginState: TJDScktLoginState read fLoginState;
  401.     property ReceiveState: TJDScktRecState read fRecState;
  402.     property Command: Integer read fCommand;
  403.     property Size: Integer read fSize;
  404.     property Protocol: Integer read fProtocol;
  405.     property Data: Pointer read fData write fData;
  406.     property Username: String read fUsername write SetUsername;
  407.     property SessionID: Integer read fSessionID write SetSessionID;
  408.     property UserID: Integer read fUserID write SetUserID;
  409.     property Cookie: String read fCookie write SetCookie;
  410.     property Props: TScktProps read fProps;
  411.     property EncrKey: Word read fKey write SetKey;
  412.     //Public events
  413.     property OnConnection: TJDSvrCliConnEvent
  414.       read fOnConnection write fOnConnection;
  415.     property OnCommand: TJDSvrCliCmdEvent
  416.       read fOnCommand write fOnCommand;
  417.     property OnError: TJDSvrCliErrEvent
  418.       read fOnError write fOnError;
  419.     property OnLoginRequest: TJDScktLoginRequestEvent
  420.       read fOnLoginRequest write fOnLoginRequest;
  421.     property OnCookieLoginRequest: TJDScktCookieLoginRequestEvent
  422.       read fOnCookieLoginRequest write fOnCookieLoginRequest;
  423.     property OnCookieLookup: TJDSvrCookieLookupEvent
  424.       read fOnCookieLookup write fOnCookieLookup;
  425.     property OnGotProp: TJDSvrScktPropEvent
  426.       read fOnGotProp write fOnGotProp;
  427.   end;
  428.  
  429. ////////////////////////////////////////////////////////////////////////////////
  430. //Client side - server connection    
  431. //  Represents unique socket on the client for a single connection to the server
  432.      
  433.   TJDCliSvrConnEvent = procedure(Sender: TObject; Socket: TJDClientServerSocket;
  434.     const OldState, NewState: TJDScktConnState) of object;
  435.   TJDCliSvrErrEvent = procedure(Sender: TObject; Socket: TJDClientServerSocket;
  436.     var ErrMsg: String; var ErrCode: Integer) of object;
  437.   TJDCliSvrCmdEvent = procedure(Sender: TObject; Socket: TJDClientServerSocket;
  438.     const Cmd: Integer; const Data: TStrings) of object;
  439.   TJDScktLoginResponseEvent = procedure(Sender: TObject; Socket: TJDClientServerSocket;
  440.     const Accept: Bool) of object;
  441.   TJDScktStringEvent = procedure(Sender: TObject; Socket: TJDClientServerSocket;
  442.     const NewValue: String) of object;
  443.   TJDScktIntegerEvent = procedure(Sender: TObject; Socket: TJDClientServerSocket;
  444.     const NewValue: Integer) of object;
  445.   TJDScktSvrNeedLoginEvent = procedure(Sender: TObject; Socket: TJDClientServerSocket;
  446.     var Username, Password: String) of object;
  447.  
  448.   TJDClientServerSocket = class(TObject)
  449.   private
  450.     //Created objects
  451.     fErrors: TStringList;
  452.     fTimer: TTimer;
  453.     fProps: TScktProps;
  454.     //Assigned objects
  455.     fOwner: TJDClientSocket;
  456.     fSocket: TCustomWinSocket;
  457.     //Variables
  458.     fConnState: TJDScktConnState;
  459.     fLoginState: TJDScktLoginState;
  460.     fRecState: TJDScktRecState;
  461.     fBusy: Bool;
  462.     fBuffer: String;
  463.     fSize: Integer;
  464.     fCommand: Integer;
  465.     fProtocol: Integer;  
  466.     fCookie: String;    
  467.     fSessionID: Integer;
  468.     fUserID: Integer;
  469.     //Events
  470.     fOnConnection: TJDCliSvrConnEvent;
  471.     fOnCommand: TJDCliSvrCmdEvent;
  472.     fOnError: TJDCliSvrErrEvent;
  473.     fOnLoginResponse: TJDScktLoginResponseEvent;
  474.     fOnGotUserID: TJDScktIntegerEvent;
  475.     fOnGotSessID: TJDScktIntegerEvent;
  476.     fOnGotCookie: TJDScktStringEvent;
  477.     fOnNeedLogin: TJDScktSvrNeedLoginEvent;
  478.     fKey: Word;
  479.     //Child event handlers
  480.     procedure TimerOnTimer(Sender: TObject);  
  481.     procedure PropsGotProp(Sender: TObject; const Name, Val: String);
  482.     //Other
  483.     procedure ProcessCommand(const S: String);
  484.     procedure HandleError(Sender: TObject; const ErrType: TJDScktErrorType;
  485.       const ErrMsg: String; var ErrCode: Integer);
  486.     procedure SetKey(const Value: Word);
  487.   public
  488.     constructor Create(ASocket: TCustomWinSocket; AOwner: TJDClientSocket);
  489.     destructor Destroy; override;
  490.     procedure SendPacket(Cmd: Integer; Data: TStrings); overload;
  491.     procedure SendPacket(Cmd: Integer; Data: Array of String); overload;
  492.     procedure SendPacket(Cmd: Integer); overload;  
  493.     procedure Login(const Username, Password: String);
  494.     procedure CookieLogin(const Cookie: String);
  495.     property Socket: TCustomWinSocket read fSocket;
  496.     property ConnState: TJDScktConnState read fConnState;
  497.     property LoginState: TJDScktLoginState read fLoginState;
  498.     property ReceiveState: TJDScktRecState read fRecState;
  499.     property Command: Integer read fCommand;
  500.     property Size: Integer read fSize;
  501.     property Buffer: String read fBuffer;
  502.     property Protocol: Integer read fProtocol;
  503.     property Cookie: String read fCookie;
  504.     property SessionID: Integer read fSessionID;
  505.     property UserID: Integer read fUserID;
  506.     property Props: TScktProps read fProps;
  507.     property EncrKey: Word read fKey write SetKey;
  508.     property OnConnection: TJDCliSvrConnEvent
  509.       read fOnConnection write fOnConnection;
  510.     property OnCommand: TJDCliSvrCmdEvent
  511.       read fOnCommand write fOnCommand;
  512.     property OnError: TJDCliSvrErrEvent
  513.       read fOnError write fOnError;
  514.     property OnLoginResponse: TJDScktLoginResponseEvent
  515.       read fOnLoginResponse write fOnLoginResponse;  
  516.     property OnGotCookie: TJDScktStringEvent read fOnGotCookie write fOnGotCookie;
  517.     property OnGotUserID: TJDScktIntegerEvent read fOnGotUserID write fOnGotUserID;
  518.     property OnGotSessID: TJDScktIntegerEvent read fOnGotSessID write fOnGotSessID;
  519.     property OnNeedLogin: TJDScktSvrNeedLoginEvent read fOnNeedLogin write fOnNeedLogin;
  520.   end;
  521.  
  522. ////////////////////////////////////////////////////////////////////////////////
  523. //Server Socket Component
  524. //  Represents all server side functionality
  525.  
  526.   TJDServerEvent = procedure(Sender: TObject; Socket: TJDServerSocket) of object;
  527.  
  528.   TJDServerSocket = class(TComponent)
  529.   private
  530.     fSocket: TServerSocket;
  531.     fClients: TList;
  532.     fBlackList: TStringList;
  533.     fCommands: TSvrCommands;    
  534.     fFixedUsername: String;
  535.     fFixedPassword: String;  
  536.     fMaxConnect: Integer;
  537.     fLastSessionID: Integer;
  538.     fCookieSize: Integer;  
  539.     fAuth: TJDScktAuthMode;
  540.     fOnConnection: TJDSvrCliConnEvent;
  541.     fOnError: TJDSvrCliErrEvent;
  542.     fOnLoginRequest: TJDScktLoginRequestEvent;
  543.     fOnCommand: TJDSvrCliCmdEvent;
  544.     fOnActivate: TJDServerEvent;
  545.     fOnDeactivate: TJDServerEvent;
  546.     fOnConnecting: TJDSvrCliAcceptEvent;
  547.     fOnCookieLoginRequest: TJDScktCookieLoginRequestEvent;
  548.     fOnCookieLookup: TJDSvrCookieLookupEvent;
  549.     fOnGotProp: TJDSvrScktPropEvent;
  550.     fEncryption: Bool;
  551.     procedure ScktConnect(Sender: TObject; Socket: TCustomWinSocket);
  552.     procedure ScktDisconnect(Sender: TObject; Socket: TCustomWinSocket);
  553.     procedure ScktRead(Sender: TObject; Socket: TCustomWinSocket);
  554.     procedure ScktError(Sender: TObject; Socket: TCustomWinSocket;
  555.       ErrorEvent: TErrorEvent; var ErrorCode: Integer);
  556.     procedure ScktCommand(Sender: TObject; Socket: TJDServerClientSocket;
  557.       const Cmd: Integer; const Data: TStrings);
  558.     procedure ScktLoginRequest(Sender: TObject; Socket: TJDServerClientSocket;
  559.       const Username, Password: String; var Accept: Bool; var Cookie: String;
  560.       var UserID, SessionID: Integer);
  561.     procedure ScktCookieLoginRequest(Sender: TObject; Socket: TJDServerClientSocket;
  562.       const Cookie: String; var Accept: Bool; var Username: String;
  563.       var UserID, SessionID: Integer);
  564.     procedure ScktCookieLookup(Sender: TObject; const Cookie: String;
  565.       var Exists: Bool);    
  566.     function GetPort: Integer;
  567.     function GetActive: Bool;
  568.     function GetClient(Index: Integer): TJDServerClientSocket;
  569.     function GetClientCount: Integer;
  570.     function GetNextSessionID: Integer;
  571.     function GetNewCookie: String;
  572.     function GetBlackList: TStrings;
  573.     procedure SetPort(Value: Integer);
  574.     procedure SetActive(Value: Bool);
  575.     procedure SetAuth(const Value: TJDScktAuthMode);
  576.     procedure SetFixedPassword(const Value: String);
  577.     procedure SetFixedUsername(const Value: String);
  578.     procedure SetMaxConnect(const Value: Integer);
  579.     procedure SetLastSessionID(const Value: Integer);
  580.     procedure SetCookieSize(const Value: Integer);
  581.     procedure SetBlackList(const Value: TStrings);
  582.   public
  583.     constructor Create(AOwner: TComponent); override;
  584.     destructor Destroy; override;
  585.     property Clients[Index: Integer]: TJDServerClientSocket read GetClient;
  586.     procedure SendGroupPacket(const Cmd: Integer; const Data: TStrings); overload;
  587.     procedure SendGroupPacket(const Cmd: Integer; const Data: Array of String); overload;
  588.     function CookieExists(const Cookie: String): Bool;
  589.     property ClientCount: Integer read GetClientCount;
  590.   published
  591.     property Active: Bool read GetActive write SetActive;
  592.     property Port: Integer read GetPort write SetPort;
  593.     property Commands: TSvrCommands read fCommands write fCommands;
  594.     property Authentication: TJDScktAuthMode read fAuth write SetAuth;
  595.     property FixedUsername: String read fFixedUsername write SetFixedUsername;
  596.     property FixedPassword: String read fFixedPassword write SetFixedPassword;
  597.     property MaxConnect: Integer read fMaxConnect write SetMaxConnect;
  598.     property LastSessionID: Integer read fLastSessionID write SetLastSessionID;
  599.     property CookieSize: Integer read fCookieSize write SetCookieSize;
  600.     property BlackList: TStrings read GetBlackList write SetBlackList;
  601.     property Encryption: Bool read fEncryption write fEncryption;
  602.     property OnConnection: TJDSvrCliConnEvent
  603.       read fOnConnection write fOnConnection;
  604.     property OnError: TJDSvrCliErrEvent read fOnError write fOnError;
  605.     property OnLoginRequest: TJDScktLoginRequestEvent
  606.       read fOnLoginRequest write fOnLoginRequest;
  607.     property OnCommand: TJDSvrCliCmdEvent
  608.       read fOnCommand write fOnCommand;
  609.     property OnActivate: TJDServerEvent read fOnActivate write fOnActivate;
  610.     property OnDeactivate: TJDServerEvent read fOnDeactivate write fOnDeactivate;
  611.     property OnConnecting: TJDSvrCliAcceptEvent
  612.       read fOnConnecting write fOnConnecting;
  613.     property OnCookieLoginRequest: TJDScktCookieLoginRequestEvent
  614.       read fOnCookieLoginRequest write fOnCookieLoginRequest;
  615.     property OnCookieLookup: TJDSvrCookieLookupEvent
  616.       read fOnCookieLookup write fOnCookieLookup;
  617.     property OnGotProp: TJDSvrScktPropEvent read fOnGotProp write fOnGotProp;
  618.   end;
  619.  
  620. ////////////////////////////////////////////////////////////////////////////////
  621. //Client Socket Component  
  622. //  Represents all client side functionality
  623.  
  624.   TJDClientSocket = class(TComponent)
  625.   private    
  626.     fSocket: TClientSocket;
  627.     fUsername: String;
  628.     fPassword: String;  
  629.     fCommands: TCliCommands;    
  630.     fAuth: TJDScktAuthMode;  
  631.     fAutoLogin: Bool;
  632.     fOnConnection: TJDCliSvrConnEvent;        
  633.     fOnError: TJDCliSvrErrEvent;
  634.     fOnLoginResponse: TJDScktLoginResponseEvent;
  635.     fOnCommand: TJDCliSvrCmdEvent;
  636.     fOnGotUserID: TJDScktIntegerEvent;
  637.     fOnGotSessID: TJDScktIntegerEvent;
  638.     fOnGotCookie: TJDScktStringEvent;
  639.     fOnNeedLogin: TJDScktSvrNeedLoginEvent;
  640.     fOnGotProp: TJDScktPropEvent;
  641.     fEncryption: Bool;
  642.     function GetPort: Integer;
  643.     function GetHost: String;
  644.     function GetActive: Bool;
  645.     function GetSocket: TJDClientServerSocket;
  646.     procedure SetPort(Value: Integer);
  647.     procedure SetHost(Value: String);
  648.     procedure SetActive(Value: Bool);
  649.     procedure SetUsername(Value: String);
  650.     procedure SetPassword(Value: String);
  651.     procedure ScktConnection(Sender: TObject; Socket: TJDClientServerSocket;
  652.       const OldState, NewState: TJDScktConnState);
  653.     procedure ScktCommand(Sender: TObject; Socket: TJDClientServerSocket;
  654.       const Cmd: Integer; const Data: TStrings);
  655.     procedure ScktLoginResponse(Sender: TObject; Socket: TJDClientServerSocket;
  656.       const Accept: Bool);      
  657.     procedure ScktGotCookie(Sender: TObject; Socket: TJDClientServerSocket;
  658.       const NewValue: String);
  659.     procedure ScktGotSessID(Sender: TObject; Socket: TJDClientServerSocket;
  660.       const NewValue: Integer);
  661.     procedure ScktGotUserID(Sender: TObject; Socket: TJDClientServerSocket;
  662.       const NewValue: Integer);    
  663.     procedure ScktNeedLogin(Sender: TObject; Socket: TJDClientServerSocket;
  664.       var Username, Password: String);
  665.     procedure ScktConnect(Sender: TObject; Socket: TCustomWinSocket);
  666.     procedure ScktDisconnect(Sender: TObject; Socket: TCustomWinSocket);
  667.     procedure ScktRead(Sender: TObject; Socket: TCustomWinSocket);
  668.     procedure ScktError(Sender: TObject; Socket: TCustomWinSocket;
  669.       ErrorEvent: TErrorEvent; var ErrorCode: Integer);
  670.     procedure SetAuth(const Value: TJDScktAuthMode);
  671.     procedure SetCookie(const Value: String);
  672.     function GetCookie: String;
  673.   public
  674.     constructor Create(AOwner: TComponent); override;
  675.     destructor Destroy; override;
  676.     property Socket: TJDClientServerSocket read GetSocket;
  677.   published
  678.     property Host: String read GetHost write SetHost;
  679.     property Port: Integer read GetPort write SetPort default 0;
  680.     property Active: Bool read GetActive write SetActive;
  681.     property Username: String read fUsername write SetUsername;
  682.     property Password: String read fPassword write SetPassword;
  683.     property Commands: TCliCommands read fCommands write fCommands;
  684.     property Cookie: String read GetCookie write SetCookie;
  685.     property Authentication: TJDScktAuthMode read fAuth write SetAuth;
  686.     property AutoLogin: Bool read fAutoLogin write fAutoLogin default True;  
  687.     property Encryption: Bool read fEncryption write fEncryption;
  688.     property OnConnection: TJDCliSvrConnEvent
  689.       read fOnConnection write fOnConnection;
  690.     property OnError: TJDCliSvrErrEvent read fOnError write fOnError;
  691.     property OnLoginResponse: TJDScktLoginResponseEvent
  692.       read fOnLoginResponse write fOnLoginResponse;
  693.     property OnCommand: TJDCliSvrCmdEvent
  694.       read fOnCommand write fOnCommand;
  695.     property OnGotCookie: TJDScktStringEvent read fOnGotCookie write fOnGotCookie;
  696.     property OnGotUserID: TJDScktIntegerEvent read fOnGotUserID write fOnGotUserID;
  697.     property OnGotSessID: TJDScktIntegerEvent read fOnGotSessID write fOnGotSessID;
  698.     property OnNeedLogin: TJDScktSvrNeedLoginEvent read fOnNeedLogin write fOnNeedLogin;
  699.     property OnGotProp: TJDScktPropEvent read fOnGotProp write fOnGotProp;
  700.   end;
  701.  
  702. //Misc. Methods
  703. function CopyToDelim(var S: String; const Delim: String): String; overload;
  704. function CopyToDelim(var S: String): String; overload;
  705.        
  706. function Encrypt(const s: string; Key: Word): string;
  707. function Decrypt(const s: string; Key: Word): string;
  708.  
  709. procedure Register;
  710.              
  711. ////////////////////////////////////////////////////////////////////////////////
  712. implementation
  713. {$R JDSockets.dcr}
  714. ////////////////////////////////////////////////////////////////////////////////
  715.  
  716. { Component Registration }
  717.  
  718. procedure Register;
  719. begin
  720.   RegisterComponents('JD Custom', [TJDServerSocket, TJDClientSocket]);
  721. end;
  722.      
  723. { Encryption }
  724.  
  725. const
  726.   c1 = 52845;
  727.   c2 = 22719;
  728.  
  729. function Encrypt(const s: string; Key: Word): string;
  730. var
  731.   i: byte;
  732.   ResultStr: string;
  733. begin
  734.   Result:= s;      
  735.   SetLength(Result, Length(S));
  736.   for i:= 1 to (length(Result)) do begin
  737.     Result[i]:= Char(byte(s[i]) xor (Key shr 8));
  738.     Key:= (byte(Result[i]) + Key) * c1 + c2;
  739.   end;
  740. end;
  741.  
  742. function Decrypt(const s: string; Key: Word): string;
  743. var
  744.   i : byte;
  745. begin
  746.   Result:= s;
  747.   SetLength(Result, Length(S));
  748.   for i:= 1 to (length(Result)) do begin
  749.     Result[i]:= Char(byte(s[i]) xor (Key shr 8));
  750.     Key:= (byte(s[i]) + Key) * c1 + c2;
  751.   end;
  752. end;
  753.  
  754. { Shared Methods }
  755.  
  756. //Searches for first found deliminator
  757. //  If found, returns everything up to deliminator and removes deliminator
  758. function CopyToDelim(var S: String; const Delim: String): String;
  759. begin
  760.   if Pos(Delim, S) > 1 then begin
  761.     Result:= Copy(S, 1, Pos(Delim, S)-1);
  762.     Delete(S, 1, Pos(Delim, S)+Length(Delim)-1);
  763.   end else begin
  764.     Result:= '';
  765.   end;
  766. end;
  767.  
  768. function CopyToDelim(var S: String): String;
  769. begin
  770.   Result:= CopyToDelim(S, JDS_DAT_DIV);
  771. end;
  772.    
  773. { TScktProps }
  774.  
  775. constructor TScktProps.Create;
  776. begin
  777.   fItems:= TStringList.Create;
  778. end;
  779.  
  780. destructor TScktProps.Destroy;
  781. begin
  782.   fItems.Free;
  783.   inherited;
  784. end;
  785.  
  786. function TScktProps.GetProp(Name: String): String;
  787. var
  788.   X, L: Integer;
  789.   N: String;
  790. begin
  791.   Result:= '';
  792.   //Name must be alpha-numeric
  793.   L:= Length(Name)+1;
  794.   for X:= 0 to fItems.Count - 1 do begin
  795.     N:= fItems[X];
  796.     if Name+'#' = Copy(N, 1, L) then begin
  797.       Result:= Copy(N, L, Length(N));
  798.       Break;
  799.     end;
  800.   end;
  801. end;
  802.  
  803. function TScktProps.PropExists(Name: String): Bool;
  804. var
  805.   X, L: Integer;
  806.   N: String;
  807. begin
  808.   Result:= False;
  809.   //Name must be alpha-numeric  
  810.   L:= Length(Name)+1;
  811.   for X:= 0 to fItems.Count - 1 do begin
  812.     N:= fItems[X];
  813.     if Name+'#' = Copy(N, 1, L) then begin
  814.       Result:= True;
  815.       Break;
  816.     end;
  817.   end;
  818. end;
  819.  
  820. procedure TScktProps.SetProp(Name: String; const Value: String);
  821. var
  822.   X, L: Integer;
  823.   N: String;
  824.   S: Bool;
  825. begin
  826.   S:= False;
  827.   //Name must be alpha-numeric
  828.   L:= Length(Name)+1;
  829.   for X:= 0 to fItems.Count - 1 do begin
  830.     N:= fItems[X];
  831.     if Name+'#' = Copy(N, 1, L) then begin
  832.       fItems[X]:= Name+'#'+Value;
  833.       S:= True;
  834.       Break;
  835.     end;
  836.   end;
  837.   if not S then
  838.     fItems.Append(Name+'#'+Value);      
  839.   if assigned(fOnGotProp) then
  840.     Self.fOnGotProp(Self, Name, Value);
  841. end;
  842.  
  843. procedure TScktProps.SetPropX(Name: String; const Value: String);
  844. var
  845.   X, L: Integer;
  846.   N: String;
  847.   S: Bool;
  848. begin
  849.   S:= False;
  850.   //Name must be alpha-numeric
  851.   L:= Length(Name)+1;
  852.   for X:= 0 to fItems.Count - 1 do begin
  853.     N:= fItems[X];
  854.     if Name+'#' = Copy(N, 1, L) then begin
  855.       fItems[X]:= Name+'#'+Value;
  856.       S:= True;
  857.       Break;
  858.     end;
  859.   end;
  860.   if not S then
  861.     fItems.Append(Name+'#'+Value);
  862. end;
  863.      
  864. { TSvrCommands }
  865.  
  866. function TSvrCommands.Add: TSvrCommand;
  867. begin
  868.   Result:= inherited Add as TSvrCommand;
  869. end;
  870.  
  871. constructor TSvrCommands.Create(AOwner: TPersistent);
  872. begin
  873.   inherited Create(TSvrCommand);
  874.   Self.fOwner:= AOwner;
  875. end;
  876.  
  877. destructor TSvrCommands.Destroy;
  878. begin
  879.   inherited Destroy;
  880. end;
  881.  
  882. procedure TSvrCommands.DoCommand(const Socket: TJDServerClientSocket;
  883.   const Cmd: Integer; const Data: TStrings);
  884. var
  885.   X: Integer;
  886.   C: TSvrCommand;
  887.   F: Bool;
  888. begin
  889.   F:= False;
  890.   for X:= 0 to Self.Count - 1 do begin
  891.     C:= GetItem(X);
  892.     if C.ID = Cmd then begin
  893.       F:= True;
  894.       try
  895.         if assigned(C.fOnCommand) then
  896.           C.fOnCommand(Self, Socket, Data);
  897.       except
  898.         on e: exception do begin
  899.           raise Exception.Create(
  900.             'Failed to execute command '+IntToStr(Cmd)+': '+#10+e.Message);
  901.         end;
  902.       end;
  903.       Break;
  904.     end;
  905.   end;
  906.   if not F then begin
  907.     //Command not found
  908.  
  909.   end;
  910. end;
  911.  
  912. function TSvrCommands.GetItem(Index: Integer): TSvrCommand;
  913. begin
  914.   Result:= TSvrCommand(inherited GetItem(Index));
  915. end;
  916.  
  917. function TSvrCommands.GetOwner: TPersistent;
  918. begin
  919.   Result:= fOwner;
  920. end;
  921.  
  922. procedure TSvrCommands.SetDisplay(const Value: TJDCmdDisplay);
  923. begin
  924.   fDisplay := Value;
  925.   //Refresh collection items
  926.  
  927. end;
  928.  
  929. procedure TSvrCommands.SetItem(Index: Integer; Value: TSvrCommand);
  930. begin
  931.   inherited SetItem(Index, Value);
  932. end;
  933.  
  934. { TSvrCommand }
  935.  
  936. procedure TSvrCommand.Assign(Source: TPersistent);
  937. begin
  938.   inherited;
  939.  
  940. end;
  941.  
  942. constructor TSvrCommand.Create(Collection: TCollection);
  943. begin
  944.   inherited Create(Collection);
  945.   fCollection:= TSvrCommands(Collection);
  946. end;
  947.  
  948. destructor TSvrCommand.Destroy;
  949. begin
  950.  
  951.   inherited Destroy;
  952. end;
  953.  
  954. function TSvrCommand.GetDisplayName: String;
  955. begin        
  956.   case Self.fCollection.fDisplay of
  957.     cdName: begin
  958.       Result:= fName;
  959.     end;
  960.     cdID: begin
  961.       Result:= '['+IntToStr(fID)+']';
  962.     end;
  963.     cdCaption: begin
  964.       Result:= fCaption;
  965.     end;
  966.     cdIDName: begin
  967.       Result:= '['+IntToStr(fID)+'] '+fName;
  968.     end;
  969.     cdIDCaption: begin
  970.       Result:= '['+IntToStr(fID)+'] '+fCaption;
  971.     end;
  972.   end;
  973. end;
  974.  
  975. procedure TSvrCommand.SetCaption(const Value: String);
  976. begin
  977.   fCaption := Value;
  978. end;
  979.  
  980. procedure TSvrCommand.SetID(Value: Integer);
  981. begin
  982.   fID:= Value;
  983. end;
  984.  
  985. procedure TSvrCommand.SetName(Value: String);
  986. begin
  987.   fName:= Value;
  988. end;
  989.  
  990. { TCliCommands }
  991.  
  992. function TCliCommands.Add: TCliCommand;
  993. begin
  994.   Result:= inherited Add as TCliCommand;
  995. end;
  996.  
  997. constructor TCliCommands.Create(AOwner: TPersistent);
  998. begin
  999.   inherited Create(TCliCommand);
  1000.   Self.fOwner:= AOwner;
  1001.   Self.fDisplay:= cdName;
  1002. end;
  1003.  
  1004. destructor TCliCommands.Destroy;
  1005. begin
  1006.   inherited Destroy;
  1007. end;
  1008.  
  1009. procedure TCliCommands.DoCommand(const Socket: TJDClientServerSocket;
  1010.   const Cmd: Integer; const Data: TStrings);
  1011. var
  1012.   X: Integer;
  1013.   C: TCliCommand;
  1014.   F, E: Bool;
  1015. begin
  1016.   F:= False;
  1017.   E:= False;
  1018.   for X:= 0 to Self.Count - 1 do begin
  1019.     C:= GetItem(X);
  1020.     if C.ID = Cmd then begin
  1021.       F:= True;
  1022.       if assigned(C.fOnCommand) then begin
  1023.         E:= True;
  1024.         C.fOnCommand(Self, Socket, Data);
  1025.       end;
  1026.       Break;
  1027.     end;
  1028.   end;
  1029.   if not F then begin
  1030.     //Command not found
  1031.  
  1032.   end else begin
  1033.     if not E then begin
  1034.       //No event handler assigned to OnCommand - RAISE ERROR
  1035.  
  1036.     end;
  1037.   end;
  1038. end;
  1039.  
  1040. function TCliCommands.GetItem(Index: Integer): TCliCommand;
  1041. begin
  1042.   Result:= TCliCommand(inherited GetItem(Index));
  1043. end;
  1044.  
  1045. function TCliCommands.GetOwner: TPersistent;
  1046. begin
  1047.   Result:= fOwner;
  1048. end;
  1049.  
  1050. procedure TCliCommands.SetDisplay(const Value: TJDCmdDisplay);
  1051. begin
  1052.   fDisplay := Value;
  1053.   //Refresh collection items
  1054.  
  1055. end;
  1056.  
  1057. procedure TCliCommands.SetItem(Index: Integer; Value: TCliCommand);
  1058. begin
  1059.   inherited SetItem(Index, Value);
  1060. end;
  1061.  
  1062. { TCliCommand }
  1063.  
  1064. procedure TCliCommand.Assign(Source: TPersistent);
  1065. begin
  1066.   inherited;
  1067.  
  1068. end;
  1069.  
  1070. constructor TCliCommand.Create(Collection: TCollection);
  1071. begin
  1072.   inherited;
  1073.   Self.fCollection:= TCliCommands(Collection);
  1074. end;
  1075.  
  1076. destructor TCliCommand.Destroy;
  1077. begin
  1078.  
  1079.   inherited;
  1080. end;
  1081.  
  1082. function TCliCommand.GetDisplayName: String;
  1083. begin
  1084.   case Self.fCollection.fDisplay of
  1085.     cdName: begin
  1086.       Result:= fName;
  1087.     end;
  1088.     cdID: begin
  1089.       Result:= '['+IntToStr(fID)+']';
  1090.     end;
  1091.     cdCaption: begin
  1092.       Result:= fCaption;
  1093.     end;
  1094.     cdIDName: begin
  1095.       Result:= '['+IntToStr(fID)+'] '+fName;
  1096.     end;
  1097.     cdIDCaption: begin
  1098.       Result:= '['+IntToStr(fID)+'] '+fCaption;
  1099.     end;
  1100.   end;
  1101. end;
  1102.  
  1103. procedure TCliCommand.SetCaption(const Value: String);
  1104. begin
  1105.   fCaption := Value;
  1106. end;
  1107.  
  1108. procedure TCliCommand.SetID(Value: Integer);
  1109. begin
  1110.   fID:= Value;
  1111. end;
  1112.  
  1113. procedure TCliCommand.SetName(Value: String);
  1114. begin
  1115.   fName:= Value;
  1116. end;
  1117.  
  1118. { TJDServerClientSocket }
  1119.  
  1120. constructor TJDServerClientSocket.Create(ASocket: TCustomWinSocket;
  1121.   AOwner: TJDServerSocket);
  1122. begin
  1123.   fBusy:= True;
  1124.   try
  1125.     fOwner:= AOwner;
  1126.     fSocket:= ASocket;
  1127.     fSocket.Data:= Self;  
  1128.     fErrors:= TStringList.Create;
  1129.     fProps:= TScktProps.Create;
  1130.       fProps.OnGotProp:= PropsGotProp;
  1131.     fTimer:= TTimer.Create(nil);
  1132.       fTimer.OnTimer:= TimerOnTimer;
  1133.       fTimer.Interval:= 1;
  1134.     fLoginState:= lsNone;    
  1135.     fKey:= 1;
  1136.   finally
  1137.     fBusy:= False;
  1138.   end;
  1139. end;
  1140.  
  1141. destructor TJDServerClientSocket.Destroy;
  1142. begin                                  
  1143.   if assigned(fTimer) then fTimer.Free;
  1144.   if assigned(fProps) then fProps.Free;
  1145.   if assigned(fErrors) then fErrors.Free;
  1146.   inherited;
  1147. end;
  1148.  
  1149. procedure TJDServerClientSocket.ProcessCommand(const S: String);
  1150. var
  1151.   X, P, Z: Integer;
  1152.   Str, T: String;
  1153.   L: TStringList;
  1154.   Pas: String;
  1155.   Val: Bool;
  1156.   CID: Integer;
  1157. begin
  1158.   L:= TStringList.Create;
  1159.   try
  1160.     Str:= S;
  1161.     while Length(Str) > 0 do begin
  1162.       T:= CopyToDelim(Str);
  1163.       if Length(T) > 0 then begin
  1164.         Z:= StrToIntDef(T, 0);
  1165.         T:= Copy(Str, 1, Z);
  1166.         Delete(Str, 1, Z);
  1167.         L.Append(T);
  1168.       end else begin
  1169.         Str:= '';
  1170.         //Raise error - invalid packet
  1171.       end;
  1172.     end;
  1173.     case fCommand of
  1174.       JDS_CMD_LOGIN: begin
  1175.         //Client sent request to log in
  1176.         if assigned(fOnLoginRequest) then begin
  1177.           fUsername:= L[0];
  1178.           Pas:= L[1];
  1179.           Val:= False;
  1180.           fOnLoginRequest(Self, Self, fUsername, Pas, Val, fCookie,
  1181.             fUserID, fSessionID);
  1182.           if Val then begin  
  1183.             Self.fLoginState:= lsAllow;
  1184.             Self.SendPacket(JDS_CMD_LOGIN, ['1']);
  1185.           end else begin
  1186.             Self.fLoginState:= lsDeny;
  1187.             Self.SendPacket(JDS_CMD_LOGIN, ['0']);
  1188.           end;
  1189.         end else begin
  1190.           //No procedure assigned to event - raise error (no login event)
  1191.           Self.SendPacket(JDS_CMD_LOGIN, ['0']);
  1192.          
  1193.         end;
  1194.       end;
  1195.       JDS_CMD_ERROR: begin
  1196.         //Client sent error
  1197.  
  1198.       end;
  1199.       JDS_CMD_COOKIE: begin
  1200.         if assigned(fOnCookieLoginRequest) then begin
  1201.           fCookie:= L[0];
  1202.           Self.fOnCookieLoginRequest(Self, Self, fCookie, Val, fUsername,
  1203.             fUserID, fSessionID);
  1204.           if Val then begin
  1205.             Self.fLoginState:= lsAllow;
  1206.             Self.SendPacket(JDS_CMD_LOGIN, ['1']);
  1207.             Self.SendPacket(JDS_CMD_SESS_ID, [IntToStr(fSessionID)]);
  1208.             Self.SendPacket(JDS_CMD_USER_ID, [IntToStr(fUserID)]);
  1209.           end else begin
  1210.             Self.fLoginState:= lsDeny;
  1211.             Self.SendPacket(JDS_CMD_LOGIN, ['0']);
  1212.           end;
  1213.         end else begin
  1214.           //No procedure assigned to event - raise error (no cookie login event)
  1215.  
  1216.         end;
  1217.       end;
  1218.       JDS_CMD_PROP: begin
  1219.         Self.fProps.SetPropX(L[0], L[1]);
  1220.         if assigned(fOwner.fOnGotProp) then
  1221.           Self.fOwner.fOnGotProp(fOwner, Self, L[0], L[1]);
  1222.       end;      
  1223.       JDS_CMD_KEY: begin
  1224.         if L.Count > 0 then
  1225.           Self.fKey:= StrToIntDef(L[0], 1);
  1226.       end;
  1227.       else begin
  1228.         if fCommand >= 0 then begin
  1229.           if fLoginState = lsAllow then begin
  1230.             if assigned(fOnCommand) then
  1231.               fOnCommand(Self, Self, fCommand, L);
  1232.           end;
  1233.           fOwner.fCommands.DoCommand(Self, fCommand, L);
  1234.         end else begin
  1235.         end;
  1236.       end;
  1237.     end; //case  
  1238.   finally
  1239.     L.Free;
  1240.   end;
  1241. end;
  1242.    
  1243. procedure TJDServerClientSocket.PropsGotProp(Sender: TObject;
  1244.   const Name, Val: String);
  1245. begin
  1246.   Self.SendPacket(JDS_CMD_PROP, [Name, Val]);
  1247. end;
  1248.  
  1249. procedure TJDServerClientSocket.SendPacket(Cmd: Integer; Data: TStrings);
  1250. var
  1251.   S: String;
  1252.   X: Integer;
  1253. begin
  1254.   S:= '';
  1255.   if assigned(Data) then
  1256.     if Data <> nil then
  1257.       for X:= 0 to Data.Count - 1 do
  1258.         S:= S + IntToStr(Length(Data[X])) + JDS_DAT_DIV + Data[X];
  1259.   if fOwner.fEncryption then
  1260.     if Cmd <> JDS_CMD_KEY then
  1261.       S:= Encrypt(S, fKey);
  1262.   Socket.SendText(
  1263.     IntToStr(Cmd) + JDS_DAT_DIV +
  1264.     IntToStr(Length(S)) + JDS_DAT_DIV +
  1265.     IntToStr(fKey) + JDS_DAT_DIV +
  1266.     S);
  1267. end;
  1268.  
  1269. procedure TJDServerClientSocket.SendPacket(Cmd: Integer;
  1270.   Data: array of String);
  1271. var
  1272.   S: String;
  1273.   X: Integer;
  1274. begin
  1275.   S:= '';
  1276.   for X:= 0 to Length(Data) - 1 do
  1277.     S:= S + IntToStr(Length(Data[X])) + JDS_DAT_DIV + Data[X];
  1278.   if fOwner.fEncryption then
  1279.     if Cmd <> JDS_CMD_KEY then
  1280.       S:= Encrypt(S, fKey);
  1281.   Socket.SendText(
  1282.     IntToStr(Cmd) + JDS_DAT_DIV +
  1283.     IntToStr(Length(S)) + JDS_DAT_DIV +
  1284.     IntToStr(fKey) + JDS_DAT_DIV +
  1285.     S);
  1286. end;
  1287.        
  1288. procedure TJDServerClientSocket.SendPacket(Cmd: Integer);
  1289. begin
  1290.   Socket.SendText(
  1291.     IntToStr(Cmd) + JDS_DAT_DIV +
  1292.     '0' + JDS_DAT_DIV +
  1293.     IntToStr(fKey) + JDS_DAT_DIV);
  1294. end;
  1295.  
  1296. procedure TJDServerClientSocket.SendStream(Cmd: Integer; Data: TStream);
  1297. begin
  1298.   Data.Position:= 0;
  1299.   Socket.SendText(IntToStr(Cmd) + JDS_DAT_DIV + IntToStr(Data.Size) + JDS_DAT_DIV);
  1300.   Socket.SendStream(Data);
  1301. end;
  1302.  
  1303. procedure TJDServerClientSocket.SetCookie(const Value: String);
  1304. begin
  1305.   fCookie := Value;
  1306.   Self.SendPacket(JDS_CMD_COOKIE, [Value]);
  1307. end;
  1308.  
  1309. procedure TJDServerClientSocket.SetSessionID(const Value: Integer);
  1310. begin
  1311.   fSessionID := Value;
  1312.   Self.SendPacket(JDS_CMD_SESS_ID, [IntToStr(Value)]);
  1313. end;
  1314.  
  1315. procedure TJDServerClientSocket.SetUserID(const Value: Integer);
  1316. begin
  1317.   fUserID := Value;  
  1318.   Self.SendPacket(JDS_CMD_USER_ID, [IntToStr(Value)]);
  1319. end;
  1320.  
  1321. procedure TJDServerClientSocket.SetUsername(const Value: String);
  1322. begin
  1323.   fUsername := Value;
  1324. end;
  1325.  
  1326. procedure TJDServerClientSocket.TimerOnTimer(Sender: TObject);
  1327. var
  1328.   S: String;
  1329.   P: Integer;
  1330. begin
  1331.   if not fBusy then begin
  1332.     fBusy:= True;
  1333.     try
  1334.       case fRecState of
  1335.         rsIdle: begin
  1336.           if Length(fBuffer) > 0 then begin
  1337.             try
  1338.               S:= CopyToDelim(fBuffer);
  1339.               fCommand:= StrToIntDef(S, 0);
  1340.               S:= CopyToDelim(fBuffer);
  1341.               fSize:= StrToIntDef(S, 0);
  1342.               S:= CopyToDelim(fBuffer);
  1343.               fKey:= StrToIntDef(S, 1);
  1344.             finally
  1345.               fRecState:= rsCommand;
  1346.             end;
  1347.           end;
  1348.         end;
  1349.         rsCommand: begin
  1350.           if Length(fBuffer) >= fSize then begin
  1351.             try    
  1352.               S:= Copy(fBuffer, 1, fSize);
  1353.               Delete(fBuffer, 1, fSize);
  1354.               if fOwner.fEncryption then
  1355.                 S:= Decrypt(S, fKey);
  1356.               ProcessCommand(S);
  1357.             finally
  1358.               fRecState:= rsIdle;
  1359.             end;
  1360.           end;
  1361.         end;
  1362.       end;
  1363.     finally
  1364.       fBusy:= False;
  1365.     end;
  1366.   end;
  1367. end;
  1368.  
  1369. procedure TJDServerClientSocket.SetKey(const Value: Word);
  1370. begin
  1371.   Self.SendPacket(JDS_CMD_KEY, [IntToStr(Value)]);
  1372. end;
  1373.  
  1374. { TJDClientServerSocket }
  1375.  
  1376. constructor TJDClientServerSocket.Create(ASocket: TCustomWinSocket; AOwner: TJDClientSocket);
  1377. begin
  1378.   fOwner:= AOwner;
  1379.   fSocket:= ASocket;
  1380.   fProps:= TScktProps.Create;
  1381.     fProps.OnGotProp:= Self.PropsGotProp;
  1382.   fErrors:= TStringList.Create;
  1383.   fTimer:= TTimer.Create(nil);    
  1384.     fTimer.Interval:= 1;
  1385.     fTimer.OnTimer:= TimerOnTimer;
  1386.     fTimer.Enabled:= True;
  1387.   fSocket.Data:= Self;
  1388.   fCookie:= '';
  1389.   fSessionID:= 0;
  1390.   fUserID:= 0;
  1391.   fKey:= 1;
  1392. end;
  1393.  
  1394. destructor TJDClientServerSocket.Destroy;
  1395. begin
  1396.   if assigned(fErrors) then fErrors.Free;
  1397.   if assigned(fTimer) then fTimer.Free;
  1398.   if assigned(fProps) then fProps.Free;
  1399.   inherited;
  1400. end;
  1401.  
  1402. procedure TJDClientServerSocket.Login(const Username, Password: String);
  1403. begin
  1404.   Self.SendPacket(JDS_CMD_LOGIN, [Username, Password]);
  1405. end;
  1406.        
  1407. procedure TJDClientServerSocket.CookieLogin(const Cookie: String);
  1408. begin
  1409.   Self.SendPacket(JDS_CMD_COOKIE, [Cookie]);
  1410. end;
  1411.  
  1412. procedure TJDClientServerSocket.ProcessCommand(const S: String);
  1413. var
  1414.   Z: Integer;
  1415.   Str, T: String;
  1416.   L: TStringList;
  1417.   Val: Bool;
  1418. begin
  1419.   L:= TStringList.Create;
  1420.   try
  1421.     Str:= S;
  1422.     while Length(Str) > 0 do begin
  1423.       T:= CopyToDelim(Str);
  1424.       if Length(T) > 0 then begin
  1425.         Z:= StrToIntDef(T, 0);
  1426.         L.Append(Copy(Str, 1, Z));
  1427.         Delete(Str, 1, Z);
  1428.       end else begin
  1429.         Str:= '';
  1430.         //Raise error - invalid packet
  1431.       end;
  1432.     end;
  1433.     case fCommand of
  1434.       JDS_CMD_LOGIN: begin
  1435.         //Server is sending login response to client
  1436.         if assigned(fOnLoginResponse) then begin
  1437.           Val:= L[0] = '1';
  1438.           if Val then begin
  1439.             Self.fLoginState:= lsAllow;
  1440.             Self.fOnLoginResponse(Self, Self, True);
  1441.           end else begin
  1442.             Self.fLoginState:= lsDeny;
  1443.             if (fCookie <> '') and (fOwner.Username <> '') then begin
  1444.               fCookie:= ''; //Clear cookie so it doesn't try again
  1445.               //Retry login with username/password instead of cookie
  1446.               SendPacket(JDS_CMD_LOGIN, [fOwner.Username, fOwner.Password]);
  1447.             end else begin
  1448.               Self.fOnLoginResponse(Self, Self, False);
  1449.             end;
  1450.           end;
  1451.         end else begin
  1452.           //No procedure assigned to event - raise error (no login event assigned)
  1453.         end;
  1454.       end;
  1455.       JDS_CMD_LOGOUT: begin
  1456.         Self.fLoginState:= lsNone;
  1457.       end;
  1458.       JDS_CMD_ERROR: begin
  1459.         //Server is sending error to client
  1460.         //  P0: Error Code (int)
  1461.         //  P1: Error Severity (int 0-5)
  1462.         //  P2: Error Message (str)
  1463.       end;
  1464.       JDS_CMD_COOKIE: begin
  1465.         Self.fCookie:= L[0];
  1466.         if assigned(fOnGotCookie) then
  1467.           Self.fOnGotCookie(Self, Self, fCookie);
  1468.       end;
  1469.       JDS_CMD_USER_ID: begin
  1470.         Self.fUserID:= StrToIntDef(L[0], 0);
  1471.         if assigned(fOnGotUserID) then
  1472.           Self.fOnGotUserID(Self, Self, fUserID);
  1473.       end;
  1474.       JDS_CMD_SESS_ID: begin
  1475.         Self.fSessionID:= StrToIntDef(L[0], 0);
  1476.         if assigned(fOnGotSessID) then
  1477.           Self.fOnGotSessID(Self, Self, fSessionID);
  1478.       end;  
  1479.       JDS_CMD_PROP: begin
  1480.         Self.fProps.SetPropX(L[0], L[1]);
  1481.         if assigned(fOwner.fOnGotProp) then
  1482.           Self.fOwner.fOnGotProp(fOwner, L[0], L[1]);
  1483.       end;    
  1484.       JDS_CMD_KEY: begin
  1485.         if L.Count > 0 then begin
  1486.           Self.SendPacket(JDS_CMD_KEY, [L[0]]);
  1487.           Self.fKey:= StrToIntDef(L[0], 1);
  1488.           Sleep(100);
  1489.           Sleep(100);
  1490.           Sleep(100);
  1491.           Sleep(100);
  1492.         end;
  1493.       end;
  1494.       else begin
  1495.         if fCommand >= 0 then begin
  1496.           fOwner.fCommands.DoCommand(Self, fCommand, L);
  1497.           if assigned(fOnCommand) then
  1498.             fOnCommand(Self, Self, fCommand, L);
  1499.         end;
  1500.       end;  
  1501.     end;
  1502.   finally
  1503.     L.Free;
  1504.   end;
  1505. end;
  1506.  
  1507. procedure TJDClientServerSocket.SendPacket(Cmd: Integer;
  1508.   Data: array of String);
  1509. var
  1510.   S: String;
  1511.   X: Integer;
  1512. begin
  1513.   S:= '';
  1514.   for X:= 0 to Length(Data) - 1 do
  1515.     S:= S + IntToStr(Length(Data[X])) + JDS_DAT_DIV + Data[X];
  1516.   if fOwner.fEncryption then
  1517.     S:= Encrypt(S, fKey);
  1518.   Socket.SendText(
  1519.     IntToStr(Cmd) + JDS_DAT_DIV +
  1520.     IntToStr(Length(S)) + JDS_DAT_DIV +
  1521.     IntToStr(fKey) + JDS_DAT_DIV +
  1522.     S);
  1523. end;
  1524.  
  1525. procedure TJDClientServerSocket.SendPacket(Cmd: Integer; Data: TStrings);
  1526. var
  1527.   S: String;
  1528.   X: Integer;
  1529. begin
  1530.   S:= '';
  1531.   if assigned(Data) then
  1532.     if Data <> nil then
  1533.       for X:= 0 to Data.Count - 1 do
  1534.         S:= S + IntToStr(Length(Data[X])) + JDS_DAT_DIV + Data[X];
  1535.   if fOwner.fEncryption then
  1536.     S:= Encrypt(S, fKey);
  1537.   Socket.SendText(
  1538.     IntToStr(Cmd) + JDS_DAT_DIV +
  1539.     IntToStr(Length(S)) + JDS_DAT_DIV +  
  1540.     IntToStr(fKey) + JDS_DAT_DIV +
  1541.     S);
  1542. end;
  1543.                
  1544. procedure TJDClientServerSocket.SendPacket(Cmd: Integer);
  1545. begin
  1546.   Socket.SendText(
  1547.     IntToStr(Cmd) + JDS_DAT_DIV +
  1548.     '0' + JDS_DAT_DIV +
  1549.     IntToStr(fKey) + JDS_DAT_DIV);
  1550. end;
  1551.  
  1552. procedure TJDClientServerSocket.TimerOnTimer(Sender: TObject);
  1553. var
  1554.   S: String;
  1555.   P: Integer;
  1556. begin
  1557.   if not fBusy then begin
  1558.     fBusy:= True;
  1559.     try
  1560.       case fRecState of
  1561.         rsIdle: begin
  1562.           if Pos(JDS_DAT_DIV, fBuffer) >= 1 then begin
  1563.             try
  1564.               S:= CopyToDelim(fBuffer);
  1565.               fCommand:= StrToIntDef(S, 0);
  1566.               S:= CopyToDelim(fBuffer);
  1567.               fSize:= StrToIntDef(S, 0);
  1568.               S:= CopyToDelim(fBuffer);
  1569.               fKey:= StrToIntDef(S, 1);
  1570.             finally
  1571.               fRecState:= rsCommand;
  1572.             end;
  1573.           end;
  1574.         end;
  1575.         rsCommand: begin
  1576.           if Length(fBuffer) >= fSize then begin
  1577.             try  
  1578.               S:= Copy(fBuffer, 1, fSize);
  1579.               Delete(fBuffer, 1, fSize);
  1580.               if fOwner.fEncryption then
  1581.                 if Self.fCommand <> JDS_CMD_KEY then
  1582.                   S:= Decrypt(S, fKey);
  1583.               ProcessCommand(S);
  1584.             finally
  1585.               fRecState:= rsIdle;
  1586.             end;
  1587.           end;
  1588.         end;
  1589.       end;
  1590.     finally
  1591.       fBusy:= False;
  1592.     end;
  1593.   end;
  1594. end;
  1595.  
  1596. procedure TJDClientServerSocket.PropsGotProp(Sender: TObject; const Name,
  1597.   Val: String);
  1598. begin
  1599.   //Local property has been set, sync with server
  1600.   Self.SendPacket(JDS_CMD_PROP, [Name, Val]);
  1601. end;
  1602.  
  1603. procedure TJDClientServerSocket.HandleError(Sender: TObject;
  1604.   const ErrType: TJDScktErrorType; const ErrMsg: String; var ErrCode: Integer);
  1605. var
  1606.   EM: String;
  1607. begin
  1608.   case ErrType of
  1609.     etSocket: begin
  1610.       if assigned(fOnError) then
  1611.         fOnError(Sender, Self, EM, ErrCode);
  1612.       if ErrCode <> 0 then begin
  1613.         raise Exception.Create(
  1614.           'Socket Error (Code '+IntToStr(ErrCode)+'): '+ErrMsg);
  1615.       end;
  1616.     end;
  1617.     etInternal: begin
  1618.       if assigned(fOnError) then
  1619.         fOnError(Sender, Self, EM, ErrCode);
  1620.       if ErrCode <> 0 then begin
  1621.         raise Exception.Create(
  1622.           'Internal Error (Code '+IntToStr(ErrCode)+'): '+ErrMsg);
  1623.       end;
  1624.     end;
  1625.     etRemote: begin
  1626.       if assigned(fOnError) then
  1627.         fOnError(Sender, Self, EM, ErrCode);
  1628.       if ErrCode <> 0 then begin
  1629.         raise Exception.Create(
  1630.           'Remote Error (Code '+IntToStr(ErrCode)+'): '+ErrMsg);
  1631.       end;
  1632.     end;
  1633.   end;
  1634. end;
  1635.  
  1636. procedure TJDClientServerSocket.SetKey(const Value: Word);
  1637. begin
  1638.   fKey := Value;
  1639. end;
  1640.  
  1641. { TJDServerSocket }
  1642.  
  1643. constructor TJDServerSocket.Create(AOwner: TComponent);
  1644. begin
  1645.   inherited;
  1646.   fSocket:= TServerSocket.Create(nil);
  1647.     fSocket.OnClientConnect:= ScktConnect;
  1648.     fSocket.OnClientDisconnect:= ScktDisconnect;
  1649.     fSocket.OnClientRead:= ScktRead;
  1650.     fSocket.OnClientError:= ScktError;
  1651.   fCommands:= TSvrCommands.Create(Self);
  1652.   fBlackList:= TStringList.Create;
  1653.   fMaxConnect:= 30;
  1654.   fLastSessionID:= 0;
  1655.   fCookieSize:= 10;
  1656. end;
  1657.  
  1658. destructor TJDServerSocket.Destroy;
  1659. begin
  1660.   fSocket.Free;
  1661.   fCommands.Free;
  1662.   fBlackList.Free;
  1663.   inherited;
  1664. end;
  1665.  
  1666. function TJDServerSocket.GetActive: Bool;
  1667. begin
  1668.   Result:= fSocket.Active;
  1669. end;
  1670.  
  1671. function TJDServerSocket.GetClient(Index: Integer): TJDServerClientSocket;
  1672. begin
  1673.   Result:= TJDServerClientSocket(fSocket.Socket.Connections[Index].Data);
  1674. end;
  1675.  
  1676. function TJDServerSocket.GetPort: Integer;
  1677. begin
  1678.   Result:= fSocket.Port;
  1679. end;
  1680.  
  1681. procedure TJDServerSocket.ScktCommand(Sender: TObject;
  1682.   Socket: TJDServerClientSocket; const Cmd: Integer; const Data: TStrings);
  1683. begin
  1684.   if assigned(fOnCommand) then fOnCommand(Self, Socket, Cmd, Data);
  1685. end;
  1686.  
  1687. procedure TJDServerSocket.ScktConnect(Sender: TObject; Socket: TCustomWinSocket);
  1688. var
  1689.   S: TJDServerClientSocket;
  1690.   A: Bool;
  1691.   Addr: String;
  1692.   K: Word;
  1693. begin
  1694.   //Check black list
  1695.   Addr:= Socket.RemoteAddress;
  1696.   if fBlackList.IndexOf(Addr) >= 0 then begin
  1697.     Socket.Close; //Deny access
  1698.   end else begin
  1699.     A:= True;
  1700.     S:= TJDServerClientSocket.Create(Socket, Self);
  1701.     Socket.Data:= S;
  1702.       S.OnCommand:= ScktCommand;
  1703.       S.OnLoginRequest:= ScktLoginRequest;
  1704.       S.OnCookieLoginRequest:= ScktCookieLoginRequest;
  1705.       S.OnCookieLookup:= ScktCookieLookup;
  1706.       S.fSessionID:= GetNextSessionID;
  1707.     if Self.fSocket.Socket.ActiveConnections >= Self.fMaxConnect then begin
  1708.       A:= False;
  1709.     end;
  1710.     if A then begin
  1711.       if assigned(fOnConnecting) then
  1712.         fOnConnecting(Self, S, A);
  1713.     end;
  1714.     if A then begin        
  1715.       Randomize;
  1716.       K:= Random(250) + 5;
  1717.       S.SendPacket(JDS_CMD_KEY, [IntToStr(K)]);
  1718.       S.EncrKey:= K;
  1719.       case Self.fAuth of
  1720.         amNone: begin
  1721.           S.fLoginState:= lsAllow;
  1722.         end;
  1723.  
  1724.       end;
  1725.       if assigned(fOnConnection) then
  1726.         fOnConnection(Self, S, csConnecting, csConnected);
  1727.     end else begin
  1728.       S.Free;
  1729.       Socket.Close;
  1730.     end;
  1731.   end;
  1732. end;
  1733.  
  1734. procedure TJDServerSocket.ScktDisconnect(Sender: TObject;
  1735.   Socket: TCustomWinSocket);
  1736. var
  1737.   S: TJDServerClientSocket;
  1738. begin
  1739.   S:= TJDServerClientSocket(Socket.Data);
  1740.   if assigned(S) then begin
  1741.     if S <> nil then begin
  1742.       if assigned(fOnConnection) then begin
  1743.         fOnConnection(Self, S, csDisconnecting, csDisconnected);
  1744.       S.Free;
  1745.       end;
  1746.     end;
  1747.   end;
  1748. end;
  1749.  
  1750. procedure TJDServerSocket.ScktError(Sender: TObject;
  1751.   Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  1752.   var ErrorCode: Integer);
  1753. var
  1754.   EM: String;
  1755. begin
  1756.   EM:= 'Error in server socket';
  1757.   Self.fOnError(Self, TJDServerClientSocket(Socket.Data),
  1758.     EM, ErrorCode);
  1759.   if ErrorCode <> 0 then begin
  1760.     ErrorCode:= 0;
  1761.   end;
  1762. end;
  1763.        
  1764. procedure TJDServerSocket.ScktCookieLoginRequest(Sender: TObject;
  1765.   Socket: TJDServerClientSocket; const Cookie: String; var Accept: Bool;
  1766.   var Username: String; var UserID, SessionID: Integer);
  1767. begin
  1768.   case fAuth of
  1769.     amNone: begin
  1770.       Accept:= True;
  1771.     end;
  1772.     amLogin: begin
  1773.       Accept:= False;
  1774.     end;
  1775.     amLoginCookie: begin
  1776.       Accept:= False;
  1777.     end;
  1778.     amFixed: begin
  1779.       //Cookie login not allowed in fixed mode
  1780.     end;
  1781.   end;
  1782.   if assigned(fOnCookieLoginRequest) then begin
  1783.     Self.fOnCookieLoginRequest(Self, Socket, Cookie, Accept, Username,
  1784.       UserID, SessionID);
  1785.   end else begin
  1786.     if fAuth in [amLoginCookie] then begin
  1787.       //Event not assigned - raise error (no cookie login event assigned)
  1788.      
  1789.     end;
  1790.   end;
  1791. end;
  1792.  
  1793. procedure TJDServerSocket.ScktLoginRequest(Sender: TObject;
  1794.   Socket: TJDServerClientSocket; const Username, Password: String;
  1795.   var Accept: Bool; var Cookie: String; var UserID, SessionID: Integer);
  1796. begin
  1797.   case fAuth of
  1798.     amNone: begin
  1799.       Accept:= True;
  1800.     end;
  1801.     amLogin: begin
  1802.       Accept:= False;
  1803.     end;
  1804.     amLoginCookie: begin
  1805.       Accept:= False;
  1806.       Cookie:= Self.GetNewCookie;
  1807.     end;
  1808.     amFixed: begin
  1809.       Accept:= (UpperCase(Username) = UpperCase(fFixedUsername)) and
  1810.         (Password = fFixedPassword);
  1811.     end;
  1812.   end;
  1813.   if assigned(fOnLoginRequest) then begin
  1814.     fOnLoginRequest(Self, Socket, Username, Password, Accept, Cookie,
  1815.       UserID, SessionID);
  1816.     if Accept then begin
  1817.       if fAuth = amLoginCookie then begin
  1818.         Socket.fCookie:= Cookie;
  1819.         Socket.SendPacket(JDS_CMD_COOKIE, [Cookie]);
  1820.       end;
  1821.       if fAuth in [amLogin, amLoginCookie] then begin
  1822.         Socket.fSessionID:= SessionID;
  1823.         Socket.SendPacket(JDS_CMD_SESS_ID, [IntToStr(SessionID)]);
  1824.         Socket.fUserID:= UserID;
  1825.         Socket.SendPacket(JDS_CMD_USER_ID, [IntToStr(UserID)]);
  1826.       end;
  1827.     end;
  1828.   end else begin
  1829.     if fAuth in [amLogin, amLoginCookie] then begin
  1830.       //Event not assigned - raise error (No login event assigned)
  1831.      
  1832.     end;
  1833.   end;
  1834. end;
  1835.  
  1836. procedure TJDServerSocket.ScktRead(Sender: TObject;
  1837.   Socket: TCustomWinSocket);
  1838. var
  1839.   S: TJDServerClientSocket;
  1840. begin
  1841.   S:= TJDServerClientSocket(Socket.Data);
  1842.   S.fBuffer:= S.fBuffer + Socket.ReceiveText;
  1843. end;
  1844.  
  1845. procedure TJDServerSocket.SendGroupPacket(const Cmd: Integer;
  1846.   const Data: TStrings);
  1847. var
  1848.   X: Integer;
  1849.   S: TJDServerClientSocket;
  1850. begin
  1851.   for X:= 0 to Self.fSocket.Socket.ActiveConnections - 1 do begin
  1852.     S:= TJDServerClientSocket(fSocket.Socket.Connections[X].Data);
  1853.     if S.LoginState = lsAllow then begin
  1854.       S.SendPacket(Cmd, Data);
  1855.     end;
  1856.   end;
  1857. end;
  1858.  
  1859. procedure TJDServerSocket.SendGroupPacket(const Cmd: Integer;
  1860.   const Data: array of String);
  1861. var
  1862.   X: Integer;
  1863.   S: TJDServerClientSocket;
  1864. begin
  1865.   for X:= 0 to Self.fSocket.Socket.ActiveConnections - 1 do begin
  1866.     S:= TJDServerClientSocket(fSocket.Socket.Connections[X].Data);
  1867.     if S.LoginState = lsAllow then begin
  1868.       S.SendPacket(Cmd, Data);
  1869.     end;
  1870.   end;
  1871. end;
  1872.  
  1873. procedure TJDServerSocket.SetActive(Value: Bool);
  1874. var
  1875.   S: TJDServerClientSocket;
  1876.   X: Integer;
  1877. begin
  1878.   if Value then begin
  1879.     try
  1880.       fSocket.Active:= True;
  1881.       if assigned(fOnActivate) then
  1882.         fOnActivate(Self, Self);
  1883.     except
  1884.       on e: exception do begin
  1885.         fSocket.Active:= False;
  1886.         if assigned(fOnDeactivate) then
  1887.           fOnDeactivate(Self, Self);
  1888.         raise Exception.Create('Failed to activate server socket: '+e.Message);
  1889.       end;
  1890.     end;
  1891.   end else begin
  1892.     for X:= 0 to Self.fSocket.Socket.ActiveConnections - 1 do begin
  1893.       S:= TJDServerClientSocket(fSocket.Socket.Connections[X].Data);
  1894.       S.Socket.Close;
  1895.     end;
  1896.     fSocket.Active:= False;
  1897.     if assigned(fOnDeactivate) then
  1898.       fOnDeactivate(Self, Self);
  1899.   end;
  1900. end;
  1901.  
  1902. procedure TJDServerSocket.SetAuth(const Value: TJDScktAuthMode);
  1903. begin
  1904.   fAuth := Value;
  1905. end;
  1906.  
  1907. procedure TJDServerSocket.SetFixedPassword(const Value: String);
  1908. begin
  1909.   fFixedPassword := Value;
  1910. end;
  1911.  
  1912. procedure TJDServerSocket.SetFixedUsername(const Value: String);
  1913. begin
  1914.   fFixedUsername := Value;
  1915. end;
  1916.  
  1917. procedure TJDServerSocket.SetPort(Value: Integer);
  1918. begin
  1919.   fSocket.Port:= Value;
  1920. end;
  1921.  
  1922. procedure TJDServerSocket.SetMaxConnect(const Value: Integer);
  1923. begin
  1924.   fMaxConnect := Value;
  1925. end;
  1926.  
  1927. procedure TJDServerSocket.SetLastSessionID(const Value: Integer);
  1928. begin
  1929.   if Self.Active then begin
  1930.     if Value > fLastSessionID then
  1931.       fLastSessionID := Value
  1932.     else begin
  1933.       //Cannot set last session ID smaller than current when active
  1934.       //  Raise error
  1935.     end;
  1936.   end else begin
  1937.     fLastSessionID:= Value;
  1938.   end;
  1939. end;
  1940.  
  1941. function TJDServerSocket.GetNextSessionID: Integer;
  1942. begin
  1943.   Inc(fLastSessionID);
  1944.   Result:= fLastSessionID;
  1945. end;
  1946.  
  1947. function TJDServerSocket.GetNewCookie: String;
  1948. var
  1949.   X, I, P: Integer;
  1950. begin
  1951.   repeat
  1952.     Result:= '';
  1953.     for X:= 1 to fCookieSize do begin
  1954.       Randomize;
  1955.       P:= Random(30);
  1956.       if P > 20 then begin
  1957.         I:= Random(26) + 65;
  1958.       end else
  1959.       if P < 10 then begin
  1960.         I:= Random(26) + 97;
  1961.       end else begin
  1962.         I:= Random(10) + 48;
  1963.       end;
  1964.       Result:= Result + Chr(I);
  1965.     end;
  1966.   until not CookieExists(Result);
  1967. end;
  1968.  
  1969. procedure TJDServerSocket.SetCookieSize(const Value: Integer);
  1970. begin
  1971.   fCookieSize := Value;
  1972. end;
  1973.  
  1974. function TJDServerSocket.CookieExists(const Cookie: String): Bool;
  1975. var
  1976.   X: Integer;
  1977.   S: TJDServerClientSocket;
  1978. begin
  1979.   Result:= False;
  1980.   for X:= 0 to Self.fSocket.Socket.ActiveConnections - 1 do begin
  1981.     S:= Self.Clients[X];
  1982.     if S.Cookie = Cookie then begin
  1983.       Result:= True;
  1984.       Break;
  1985.     end;
  1986.   end;
  1987.   if not Result then begin
  1988.     if assigned(fOnCookieLookup) then
  1989.       fOnCookieLookup(Self, Cookie, Result);
  1990.   end;
  1991. end;
  1992.  
  1993. procedure TJDServerSocket.ScktCookieLookup(Sender: TObject;
  1994.   const Cookie: String; var Exists: Bool);
  1995. begin
  1996.   if assigned(fOnCookieLookup) then
  1997.     fOnCookieLookup(Self, Cookie, Exists);
  1998. end;
  1999.  
  2000. function TJDServerSocket.GetClientCount: Integer;
  2001. begin
  2002.   Result:= Self.fSocket.Socket.ActiveConnections;
  2003. end;
  2004.  
  2005. function TJDServerSocket.GetBlackList: TStrings;
  2006. begin
  2007.   Result:= TStrings(fBlackList);
  2008. end;
  2009.  
  2010. procedure TJDServerSocket.SetBlackList(const Value: TStrings);
  2011. begin
  2012.   fBlackList.Assign(Value);
  2013. end;
  2014.  
  2015. { TJDClientSocket }
  2016.  
  2017. constructor TJDClientSocket.Create(AOwner: TComponent);
  2018. var
  2019.   S: TJDClientServerSocket;
  2020. begin
  2021.   inherited;
  2022.   fSocket:= TClientSocket.Create(nil);
  2023.  
  2024.   S:= TJDClientServerSocket.Create(fSocket.Socket, Self);
  2025.     S.OnCommand:= Self.ScktCommand;
  2026.     S.OnLoginResponse:= Self.ScktLoginResponse;
  2027.     S.OnGotCookie:= Self.ScktGotCookie;
  2028.     S.OnGotSessID:= Self.ScktGotSessID;
  2029.     S.OnGotUserID:= Self.ScktGotUserID;
  2030.  
  2031.   fSocket.Socket.Data:= S;
  2032.     fSocket.OnConnect:= ScktConnect;
  2033.     fSocket.OnDisconnect:= ScktDisconnect;
  2034.     fSocket.OnRead:= ScktRead;
  2035.     fSocket.OnError:= ScktError;
  2036.   fCommands:= TCliCommands.Create(Self);
  2037.   Self.fAutoLogin:= True;
  2038. end;
  2039.  
  2040. destructor TJDClientSocket.Destroy;
  2041. var
  2042.   S: TJDClientServerSocket;
  2043. begin
  2044.   S:= TJDClientServerSocket(fSocket.Socket.Data);
  2045.   S.Free;
  2046.   fSocket.Free;
  2047.   fCommands.Free;
  2048.   inherited;
  2049. end;
  2050.  
  2051. function TJDClientSocket.GetActive: Bool;
  2052. begin
  2053.   Result:= fSocket.Active;
  2054. end;
  2055.  
  2056. function TJDClientSocket.GetHost: String;
  2057. begin
  2058.   Result:= fSocket.Host;
  2059. end;
  2060.  
  2061. function TJDClientSocket.GetPort: Integer;
  2062. begin
  2063.   Result:= fSocket.Port;
  2064. end;
  2065.  
  2066. function TJDClientSocket.GetSocket: TJDClientServerSocket;
  2067. begin
  2068.   Result:= TJDClientServerSocket(fSocket.Socket.Data);
  2069. end;
  2070.  
  2071. procedure TJDClientSocket.ScktCommand(Sender: TObject;
  2072.   Socket: TJDClientServerSocket; const Cmd: Integer; const Data: TStrings);
  2073. begin
  2074.   if assigned(fOnCommand) then
  2075.     fOnCommand(Self, Socket, Cmd, Data);
  2076. end;
  2077.      
  2078. procedure TJDClientSocket.ScktConnection(Sender: TObject;
  2079.   Socket: TJDClientServerSocket; const OldState,
  2080.   NewState: TJDScktConnState);
  2081. begin
  2082.   if assigned(fOnConnection) then
  2083.     fOnConnection(Self, Socket, OldState, NewState);
  2084. end;
  2085.  
  2086. procedure TJDClientSocket.ScktConnect(Sender: TObject;
  2087.   Socket: TCustomWinSocket);
  2088. begin
  2089.   ScktConnection(Self, Self.GetSocket, csConnecting, csConnected);
  2090.   case fAuth of
  2091.     amLogin: begin
  2092.       if Self.fAutoLogin then begin
  2093.         Self.Socket.Login(fUsername, fPassword);
  2094.       end;
  2095.     end;
  2096.     amLoginCookie: begin
  2097.       if Self.fAutoLogin then begin
  2098.         if Self.Socket.fCookie <> '' then begin
  2099.           Self.Socket.CookieLogin(Self.Socket.fCookie);
  2100.         end else begin
  2101.           Self.Socket.Login(fUsername, fPassword);
  2102.         end;
  2103.       end;
  2104.     end;
  2105.     amFixed: begin      
  2106.       if Self.fAutoLogin then begin
  2107.         Self.Socket.Login(fUsername, fPassword);
  2108.       end;
  2109.     end;
  2110.   end;
  2111. end;
  2112.  
  2113. procedure TJDClientSocket.ScktDisconnect(Sender: TObject;
  2114.   Socket: TCustomWinSocket);
  2115. begin
  2116.   Self.Socket.fLoginState:= lsNone;
  2117.   ScktConnection(Self, Self.GetSocket, csDisconnecting, csDisconnected);
  2118. end;
  2119.  
  2120. procedure TJDClientSocket.ScktError(Sender: TObject;
  2121.   Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  2122.   var ErrorCode: Integer);
  2123. var
  2124.   EM: String;
  2125. begin
  2126.   EM:= 'Socket Error Code: '+IntToStr(ErrorCode);
  2127.   if assigned(fOnError) then
  2128.     fOnError(Self, TJDClientServerSocket(Socket.Data), EM, ErrorCode);
  2129.   if ErrorCode <> 0 then begin
  2130.     raise Exception.Create(EM);  
  2131.     ErrorCode:= 0;
  2132.   end;
  2133. end;
  2134.  
  2135. procedure TJDClientSocket.ScktRead(Sender: TObject;
  2136.   Socket: TCustomWinSocket);
  2137. var
  2138.   S: TJDClientServerSocket;
  2139. begin
  2140.   S:= TJDClientServerSocket(Socket.Data);
  2141.   S.fBuffer:= S.fBuffer + Socket.ReceiveText;
  2142. end;
  2143.      
  2144. procedure TJDClientSocket.ScktLoginResponse(Sender: TObject;
  2145.   Socket: TJDClientServerSocket; const Accept: Bool);
  2146. begin
  2147.   if assigned(fOnLoginResponse) then
  2148.     fOnLoginResponse(Self, Socket, Accept);
  2149. end;
  2150.  
  2151. procedure TJDClientSocket.SetActive(Value: Bool);
  2152. begin
  2153.   if Value then begin
  2154.     if assigned(fOnConnection) then
  2155.       fOnConnection(Self, Self.GetSocket, csDisconnected, csConnecting);
  2156.   end else begin
  2157.     if assigned(fOnConnection) then
  2158.       fOnConnection(Self, Self.GetSocket, csConnected, csDisconnecting);
  2159.   end;
  2160.   fSocket.Active:= Value;
  2161. end;
  2162.  
  2163. procedure TJDClientSocket.SetHost(Value: String);
  2164. begin
  2165.   fSocket.Host:= Value;
  2166. end;
  2167.  
  2168. procedure TJDClientSocket.SetPort(Value: Integer);
  2169. begin
  2170.   fSocket.Port:= Value;
  2171. end;
  2172.  
  2173. procedure TJDClientSocket.SetPassword(Value: String);
  2174. begin
  2175.   fPassword:= Value;
  2176. end;
  2177.  
  2178. procedure TJDClientSocket.SetUsername(Value: String);
  2179. begin
  2180.   fUsername:= Value;
  2181. end;
  2182.  
  2183. procedure TJDClientSocket.ScktGotCookie(Sender: TObject;
  2184.   Socket: TJDClientServerSocket; const NewValue: String);
  2185. begin
  2186.   if assigned(fOnGotCookie) then
  2187.     Self.fOnGotCookie(Self, Socket, NewValue);
  2188. end;
  2189.  
  2190. procedure TJDClientSocket.ScktGotSessID(Sender: TObject;
  2191.   Socket: TJDClientServerSocket; const NewValue: Integer);
  2192. begin
  2193.   if assigned(fOnGotSessID) then
  2194.     Self.fOnGotSessID(Self, Socket, NewValue);
  2195. end;
  2196.  
  2197. procedure TJDClientSocket.ScktGotUserID(Sender: TObject;
  2198.   Socket: TJDClientServerSocket; const NewValue: Integer);
  2199. begin
  2200.   if assigned(fOnGotUserID) then
  2201.     Self.fOnGotUserID(Self, Socket, NewValue);
  2202. end;
  2203.  
  2204. procedure TJDClientSocket.SetAuth(const Value: TJDScktAuthMode);
  2205. begin
  2206.   fAuth := Value;
  2207. end;
  2208.  
  2209. procedure TJDClientSocket.SetCookie(const Value: String);
  2210. begin
  2211.   if assigned(Self.Socket) then begin
  2212.     if Self.Socket <> nil then begin
  2213.       Self.Socket.fCookie:= Value;
  2214.     end;
  2215.   end;
  2216. end;
  2217.  
  2218. function TJDClientSocket.GetCookie: String;
  2219. begin
  2220.   if assigned(Self.Socket) then begin
  2221.     if Self.Socket <> nil then begin
  2222.       Result:= Self.Socket.fCookie;
  2223.     end;
  2224.   end;
  2225. end;
  2226.  
  2227. procedure TJDClientSocket.ScktNeedLogin(Sender: TObject;
  2228.   Socket: TJDClientServerSocket; var Username, Password: String);
  2229. begin
  2230.   if assigned(fOnNeedLogin) then begin
  2231.     fOnNeedLogin(Self, Socket, Username, Password);
  2232.   end else begin
  2233.  
  2234.   end;
  2235. end;
  2236.  
  2237. end.
  2238.  
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!