Solved

Major Socket Help...

Posted on 1998-12-11
15
228 Views
Last Modified: 2010-04-04
I need to create a client/server type app over the web.  Basically, I want the clients to "register" when they come online.  I want the server to be able to display all of the current clients and be able to send messages to all of them or just one of them.  The server needs to know when the client has left the net also.  Everything I find is one to one relationship, and I need to make it a one to many.  All I will be passing is a small string to the clients.  I don't need to be able to get to the db.  Any help will be greatly appreciated.  I am looking for a GOOD example.  If yuo want an example, look at ICQ.  I want something similiar to that.

Please Help!!!

Boris - the chat app is one to one...
0
Comment
Question by:MichaelB2
  • 6
  • 6
  • 2
  • +1
15 Comments
 
LVL 5

Expert Comment

by:JimBob091197
Comment Utility
Hi

What are you talking to Boris about?  I have written a chat program using TCP/IP sockets that has a server with one-to-many links to clients.  Each client is the chat program which connects to the server.  The server routes the messages to each client.

Is this what Boris was talking about?

JB
0
 

Author Comment

by:MichaelB2
Comment Utility
JB, Boris was pointing me at the Delphi smaple chat program.  You mind letting me know how you did this?  Sockets are one part of programming that I am unfamiliar with...
0
 
LVL 8

Expert Comment

by:ZifNab
Comment Utility
MichaelB2,

Look at this site for examples :

http://www.rtfm.be/fpiette/indexuk.htm

and http://sme.belgium.eu.net/~vip107/user/minichat.zip

An extension of the TWSChat sample program that comes with ICS, MiniChat is a client/server chat system that demonstrates how to manage multiple client connections to a single server without using multithreading. Lots of comments throughout the code for easier understanding. Written and tested in Delphi 3. Zip file contains source code for both the client and server.

But now to ICQ. Does it not works like this : You come online and register you to the server. (In a database boolean field is set to true). When somebody others enters the server, the server now knows that you are online... because a field is set to true...

Regards, Zif.

But, maybe JB example is better.
0
 
LVL 3

Expert Comment

by:williams2
Comment Utility
Ok I got a simple working example, that might help you out on your quest:

The sample requires two projects, where you just need to create a FormOnCreate event on both before pasting the contents below to unit1. Afterwards you'll need to save the two different projects in two different folders and run both projects.

The Client are connecting to the default IP-address 127.0.0.1 at port 2500, but that is all optional.

Note: TCP/IP and the TClientSocket as the TServerSockets needs to be available in your system/component pallete:

Server:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ScktComp, StdCtrls;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    ServerSocket1: TServerSocket;
    Button1: TButton;
    Edit1: TEdit;
    procedure ServerSocket1ClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure Button1Click(Sender: TObject);
    procedure ServerSocket1ClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocket1ClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
  private
    { Private declarations }
    List: TList;
    procedure GetMeAllClients(Socket: TCustomWinSocket);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.ServerSocket1ClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
var
  i: Integer;
  Client: TCustomWinSocket;
begin
  i:= 0;
  While i<List.count do
  begin
    Client:= TCustomWinSocket(List.Items[i]);
    Client.SendText('[connected '+Socket.LocalHost+'] '+Edit1.text);
    inc(i);
  End;
  List.Add(Socket);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  List:= TList.Create;
  SetBounds(Left,Top,309,94);
  Button1:= TButton.Create(Self);
  With Button1 do
  begin
    SetBounds(168,8,75,25);
    Caption:= 'To everyone';
    OnClick:= Button1Click;
    Parent:= Self;
  end;
  Edit1:= TEdit.Create(Self);
  With Edit1 do
  begin
    SetBounds(40,8,121,21);
    Text:= 'I love you all man!';
    Parent:= Self;
  end;
  ServerSocket1:= TServerSocket.Create(Self);
  With ServerSocket1 do
  begin
    Port:= 2500;
    ServerType:= stNonBlocking;
    OnClientConnect:= ServerSocket1ClientConnect;
    OnClientDisconnect:= ServerSocket1ClientDisconnect;
    OnClientRead:= ServerSocket1ClientRead;
    Active:= True;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  i: Integer;
  Socket: TCustomWinSocket;
begin
  i:= 0;
  While i<List.count do
  begin
    Socket:= TCustomWinSocket(List.Items[i]);
    Socket.SendText('[Server Generel Message] '+Edit1.text);
    inc(i);
  End;
end;

procedure TForm1.GetMeAllClients(Socket: TCustomWinSocket);
const
  Separator = #13;
var
  i: Integer;
  S: String;
  Client: TCustomWinSocket;
begin
  S:= '[AllClients]';
  i:= 0;
  While (i<List.count) do
  begin
    Client:= TCustomWinSocket(List.Items[i]);
    If Client<>Socket then
      S:= S + Client.LocalHost+Separator;
    inc(i);
  End;
  Socket.SendText(S);
End;

procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
  i: Integer;
  Client: TCustomWinSocket;
  S: String;
begin
  S:= Socket.ReceiveText;
  If S='[Get me all clients]' then GetMeAllClients(Socket) else
  Begin
    i:= 0;
    While (i<List.count) do
    begin
      Client:= TCustomWinSocket(List.Items[i]);
      If Client<>Socket then
        Client.SendText('['+Socket.LocalHost+'] '+S);
      inc(i);
    End;
  End;
end;

procedure TForm1.ServerSocket1ClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
var
  i: Integer;
  Client: TCustomWinSocket;
begin
  //Remove client from list
  i:= List.IndexOf(Socket);
  If i>0 then List.Delete(i);
  //Notify all clients
  i:= 0;
  While (i<List.count) do
  begin
    Client:= TCustomWinSocket(List.Items[i]);
    If Client<>Socket then
      Client.SendText('[Disconnected '+Socket.LocalHost+']');
    inc(i);
  End;
end;

end.




Client:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ScktComp;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    ClientSocket1: TClientSocket;
    Button1: TButton;
    Memo1: TMemo;
    Edit1: TEdit;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure ClientSocket1Connect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
  private
    { Private declarations }
    procedure getAllClients(S: String);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
  ClientSocket1.Open;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  ClientSocket1.Socket.SendText(Edit1.Text);
  Memo1.Lines.Add('['+ClientSocket1.Socket.LocalHost+'] '+Edit1.text);
end;

procedure TForm1.ClientSocket1Connect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  Socket.SendText('[Get me all clients]');
end;

procedure TForm1.getAllClients(S: String);
Begin
  If S='' then S:= 'Nobody is currently connected!';
  ShowMessage(S);
End;

procedure TForm1.ClientSocket1Read(Sender: TObject;
  Socket: TCustomWinSocket);
const
  cmd1 = '[AllClients]';
  cmd2 = '[Disconnected ';
var
  S,T: String;
begin
  S:= Socket.ReceiveText;
  If Copy(S,1,Length(cmd1))=cmd1 then
    getAllClients(Copy(S,Length(cmd1)+1,Length(S)))
  else
  if Copy(S,1,Length(cmd2))=cmd2 then
  Begin
    T:= Copy(S,Length(cmd2),Length(S)-Length(cmd2)-1);
    Memo1.Lines.Add(T+' disconnected.');
  End else
    Memo1.Lines.Add(S);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  SetBounds(Left,Top,579,322);
  Button1:= TButton.Create(self);
  With Button1 do
  Begin
    SetBounds(40,8,75,25);
    Caption := 'Connect';
    OnClick := Button1Click;
    parent:= Self;
  end;
  Memo1:= TMemo.Create(Self);
  With Memo1 do
  Begin
    SetBounds(120,8,305,225);
    Parent:= Self;
  end;
  Edit1:= TEdit.Create(Self);
  With Edit1 do
  Begin
    SetBounds(120,240,305,21);
    Text := 'Got for it!';
    Parent:= Self;
  end;
  Button3:= TButton.Create(Self);
  With Button3 do
  Begin
    SetBounds(432,240,75,25);
    Caption := 'Send';
    OnClick := Button3Click;
    Parent:= Self;
  end;
  ClientSocket1:= TClientSocket.Create(Self);
  With ClientSocket1 do
  Begin
    Address := '127.0.0.1';
    ClientType := ctNonBlocking;
    Port := 2500;
    OnConnect := ClientSocket1Connect;
    OnRead := ClientSocket1Read;
  end;
end;

end.

Regards,
Williams
0
 
LVL 3

Expert Comment

by:williams2
Comment Utility
If you need anything else, just say so. I can also do exactly the same with Francois Piettes excellent implementation of the socket components.

The sample above could use some improvements as errorhandling, special operator commands, logging users etc. but it does mainly concern the question you asked in generel.

Cheers,
Williams
0
 

Author Comment

by:MichaelB2
Comment Utility
Williams2,

That looks great, but how can I distinguished between the clients currently connected?  I mean, what if I want to send the a certain client a message and no one else...
0
 

Author Comment

by:MichaelB2
Comment Utility
Really, I don't have to have the clients talk to eachother.  It is a little better if they can, but not required.  I need communication from the client to the server and server to client.  

Williams2, email if you can (cmbstu1@america.net) or ICQ me: 22462589
0
Free Trending Threat Insights Every Day

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

 

Author Comment

by:MichaelB2
Comment Utility
ZifNab,

I am looking at your demo now.

As for how ICQ works.  I believe you are right.  Whenever I log onto the internet, my ICQ logs my at a server (tells them I am online).  I assume they also track my IP address, but could be wrong about that.  Whenever someone elses logs into the system, if I am on their list, it checks to see if I am online or not.  I need the same sort of system, but I am starting without the db at first then build into that.  I might not of explained what I was looking for correctly.  Williams2 is down the right path.  
0
 
LVL 8

Expert Comment

by:ZifNab
Comment Utility
MichaelB2, the demo isn't what you are looking far?
0
 

Author Comment

by:MichaelB2
Comment Utility
ZifNab,

I didn't say that.  It does start to get into what I need, but not completely.  I am playing with it right now to decide...
0
 

Author Comment

by:MichaelB2
Comment Utility
William Has A Better Solution
0
 
LVL 3

Accepted Solution

by:
williams2 earned 400 total points
Comment Utility
Ok guys, this is a total ICQ Client/Server system, which provide all the basic needs to an ICQ system.

You need to open two projects and then create an OnFormCreate event procedure on both, then the rest is cut'n'paste to unit1 on both.

SERVER:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ScktComp, StdCtrls, inifiles;

  //ICQ Server v1.1
  //Example of an ICQ (I Seek you) system v1.1 (c) Thomas Williams 1998
  //This source is freeware which means, that you may distribute this in
  //any commercial way or modify the contents as you like.
  //Author is not responsible to any damage what so ever vaused by this
  //system.

Const
  //When sending a command, the client must send his identification number as
  //a 8 Cifres HEX number
  cmd1 = 'GAFR'; //Friends connected as 8 Cifres HEX
                 //followed by a 32 char long name on each friend
  cmd2 = 'FDIS'; //One disconnect
  cmd3 = 'FCON'; //One friend Connect
  cmd4 = 'SNDM'; //Send message: To MessageNumber as 8 Cifres HEX
  cmd4b= 'SNDR'; //message has successfully been sent
  cmd5 = 'SYSM'; //System generel message
  cmd6 = 'RFON'; //Register user as friend
  cmd7 = 'RFOF'; //Remove friend
  cmd8 = 'IDEN'; //Identification number as 8 Cifres HEX
  cmd9 = 'REQA'; //Request user to add user by number to friend group
  cmdA = 'REQG'; //Request granted;
  cmdB = 'REQD'; //Request denied;
  cmdC = 'REQR'; //Request granted + add user to your grouplist;
  cmdD = 'UNAV'; //User is unavailable
  cmdE = 'RELE'; //The applied relationship allready exists
type
  //PLEASE NOTE: The database is simulated in an inifile that is loaded on
  //startup and saved at end. This is NOT a fair treatment of persistent data.
  //This example only shows the possibility using a ICQ system, and should
  //therefore only be used as the example it is. Author will therefore not be
  //held responsible for any loss of data due to the following implementation.

  PUserData = ^TUserData;
  TUserData = record
    ID: LongInt;
    Name: String[32];
    Connected: Boolean;
    Socket: TCustomWinSocket; //This is ONLY a pointer to a socket. It should
                              //ONLY be used if connected = true!
    // anything else ?
  End;

  PRelated = ^TRelated;
  TRelated = Record //Many-to-Many relationsship
    UserData1: PUserData;
    ForeignData: PUserData; //This simulates a foreign key
  End;

  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    ServerSocket1: TServerSocket;
    Button1: TButton;
    Edit1: TEdit;
    ConCountLabel: TLabel;
    RelationsCountLabel: TLabel;
    MsgCountLabel: TLabel;
    procedure ServerSocket1ClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure Button1Click(Sender: TObject);
    procedure ServerSocket1ClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocket1ClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocket1ClientError(Sender: TObject;
      Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
      var ErrorCode: Integer);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    Relations: TList;
    UserList: TList;
    LastNumber: Integer;
    MessageCount: Integer;
    procedure UpdateConCountLabel;
    procedure UpdateRelationsCountLabel;
    procedure UpdateMsgCountLabel;
    procedure ReadRelations;
    procedure WriteRelations;
    Function GetUserData(ID: Integer): PUserData;
    Function GetRelationsAndNotify(HexID: String; Online: Boolean): String;
    procedure UserLogin(var HexID: String; Socket: TCustomWinSocket);
    procedure SendToRelation(S: String; Socket: TCustomWinSocket);
    function AddNewRelation(HexID1,HexID2: String;
      var AllreadyExists: Boolean): PUserData;
    procedure RemoveRelation(S: String; Socket: TCustomWinSocket);
    procedure ForwardRequest(Cmd,S: String; Socket: TCustomWinSocket);
    procedure RequestForeignersPermission(S: String;
      Socket: TCustomWinSocket);
    Procedure ForeignUserGrants(S: String; Socket: TCustomWinSocket;
      AddBoth: Boolean);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

Function HexToInt(const Hex: String): LongInt;
Const
  Standard = ['0'..'9'];
  ExtStandard = ['A'..'F'];
  Ident: Array['0'..'9'] of Integer = (0,1,2,3,4,5,6,7,8,9);
  HexIdent: Array['A'..'F'] of Integer = (10,11,12,13,14,15);
var
  i,n: Integer;
Begin
  Result:= 0;
  If Length(Hex)>8 then
    raise EConvertError.Create('S is not a valid hexadecimal number')
  else
    For i:= 1 to Length(Hex) do
    Begin
      If Hex[i] in Standard then n:= Ident[Hex[i]] else
      If Hex[i] in ExtStandard then n:= hexIdent[Hex[i]] else
      raise EConvertError.Create(Hex+' is not a valid hexadecimal number');
      Result:= Result shl 4+n;
    End;
End;

// ------------- Stat update labels ------------

procedure TForm1.UpdateConCountLabel;
var
  cnt,i: Integer;
Begin
  i:= 0; cnt:= 0;
  While i<UserList.count do
  begin
    if PUserData(UserList.Items[i])^.Connected then inc(cnt);
    inc(i);
  End;
  ConCountLabel.Caption:= IntToStr(cnt);
End;

procedure TForm1.UpdateRelationsCountLabel;
begin
  RelationsCountLabel.Caption:= IntToStr(Relations.count);
End;

procedure TForm1.UpdateMsgCountLabel;
Begin
  MsgCountLabel.Caption:= IntToStr(MessageCount);
End;

// ---------- Server Socket handling -----------

procedure TForm1.ServerSocket1ClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
end;

procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var // Parse command and do what you are told to do!
  Cmd,S: String;
begin
  S:= Socket.ReceiveText;
  cmd:= Copy(S,1,4);
  Delete(S,1,4);

  // Sorry, but "Case .. of" won't work here :-(
  if cmd = cmd1 then //Get all connected friends
    Socket.SendText(cmd1+GetRelationsAndNotify(S,True)) else
  if cmd = cmd4 then //Send message from user to his friend
    SendToRelation(S,Socket) else
  if cmd = cmd7 then
    RemoveRelation(S,Socket) else //Remove friend
  if cmd = cmd8 then //Identification number as 8 Cifres HEX
    UserLogin(S,Socket) else
  if cmd = cmd9 then //Foreign user requests to add you to his friend group
    RequestForeignersPermission(S,Socket) else
  if cmd = cmdA then //Request to be added granted by other part
    ForeignUserGrants(S,Socket,False) else
  if cmd = cmdB then //Request to be added denied!
    ForwardRequest(cmdB,S,Socket) else
  if cmd = cmdC then //Both parts adds each other
    ForeignUserGrants(S,Socket,True);
end;

procedure TForm1.ServerSocket1ClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
var
  i: Integer;
begin
  //Notify all clients if user is disconnecting
  i:= 0;
  //Identify my socket, to be sure that I'm still inside
  While (i<UserList.count) AND (Socket<>PUSerData(UserList.Items[i])^.Socket) do
    inc(i);
  //Now go tell all my friends that I'm offline
  if i<UserList.count then
    GetRelationsAndNotify(IntToHex(PUSerData(UserList.Items[i])^.ID,8),False);
end;

procedure TForm1.ServerSocket1ClientError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
  ServerSocket1ClientDisconnect(Sender,Socket);
  ErrorCode:= 0;
end;

// -------- Formcreate - setup components ---------

procedure TForm1.FormCreate(Sender: TObject);
  Function AddLabel(ALeft,ATop,AWidth,AHeight: Integer;
    ACaption: String): TLabel;
  Begin
    Result:= TLabel.Create(self);
    Result.SetBounds(ALeft,ATop,AWidth,AHeight);
    Result.Caption:= ACaption;
    Result.Parent:= Self;
  End;
begin
  Relations:= TList.Create;
  UserList:=  TList.Create;
  SetBounds(Left,Top,309,175);
  OnClose:= FormClose;
  MessageCount:= 0;

  AddLabel(40,32,127,13,'Users currently connected:');
  ConCountLabel:= AddLabel(40,48,6,13,'0');
  AddLabel(40,72,136,13,'Number of user relationships:');
  RelationsCountLabel:= AddLabel(40,88,3,13,'');
  AddLabel(40,112,74,13,'Messages sent:');
  MsgCountLabel:= AddLabel(40,128,6,13,'0');

  Button1:= TButton.Create(Self);
  With Button1 do
  begin
    SetBounds(168,8,75,25);
    Caption:= 'To everyone';
    OnClick:= Button1Click;
    Parent:= Self;
  end;
  Edit1:= TEdit.Create(Self);
  With Edit1 do
  begin
    SetBounds(40,8,121,21);
    Text:= 'I love you all man!';
    Parent:= Self;
  end;
  ServerSocket1:= TServerSocket.Create(Self);
  With ServerSocket1 do
  begin
    Port:= 2500;
    ServerType:= stNonBlocking;
    OnClientConnect:= ServerSocket1ClientConnect;
    OnClientDisconnect:= ServerSocket1ClientDisconnect;
    OnClientError:= ServerSocket1ClientError;
    OnClientRead:= ServerSocket1ClientRead;
    Active:= True;
  end;
  ReadRelations;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  WriteRelations;
end;

// ----------- Buttons ------------

procedure TForm1.Button1Click(Sender: TObject);
var //Send a message to every client connected
  i: Integer;
  Success: Boolean;
begin
  i:= 0;
  Success:= False;
  While (i<UserList.count) do
  begin
    If PUserData(userList.Items[i])^.Connected then
    begin
      PUserData(userList.Items[i])^.Socket.SendText(cmd5+Edit1.text);
      Success:= True;
    End;
    inc(i);
  End;
  if Success then Inc(MessageCount);
end;

// --------------- User defined methods --------------

Function NameAdjust(S: String): String;
begin
  Result:= S;
  While Length(Result)<32 do Result:= Result+' ';
End;

procedure TForm1.ReadRelations;
var
  IniFile: TIniFile;
  i,ID,Index: Integer;
  Section: String;
  pUD: PUserData;
  pRel: PRelated;
begin
  IniFile:= TIniFile.Create(ExtractFilePath(ParamStr(0))+'Settings.ini');
  i:= 0;
  Repeat
    Section:= 'User'+IntToStr(i);
    ID:= IniFile.ReadInteger(section,'ID',-1);
    If ID<>-1 then
    Begin
      New(pUD);
      pUD^.ID:= ID;
      pUD^.Connected:= False;
      pUD^.Name:= NameAdjust(IniFile.ReadString(section,'Name',''));
      UserList.Add(pUD);
      if ID>LastNumber then LastNumber:= ID;
    End;
    Inc(i);
  Until ID=-1;
  i:= 0;
  Repeat
    Section:= 'Relation'+IntToStr(i);
    Index:= IniFile.ReadInteger(section,'Index1',-1);
    If Index<>-1 then
    Begin
      New(pRel);
      pRel^.UserData1:= UserList.Items[Index];
      pRel^.ForeignData:= UserList.Items[IniFile.ReadInteger(section,'Index2',0)];
      UserList.Add(pRel);
    End;
    Inc(i);
  Until Index=-1;
  Inifile.free;
  UpdateRelationsCountLabel;
End;

procedure TForm1.WriteRelations;
var
  IniFile: TIniFile;
  i: Integer;
  Section,Old,Bak,Path: String;
  pUD: PUserData;
  pRel: PRelated;
begin
  //Be sure to have closed all connections first!
  ServerSocket1.Close;
  Path:= ExtractFilePath(ParamStr(0));
  Old:= Path+'Settings.BAK';
  Bak:= Path+'Settings.INI';
  DeleteFile(Old);
  MoveFile(PChar(Bak),PChar(Old));
  IniFile:= TIniFile.Create(Path+'Settings.INI');
  i:= 0;
  While i<UserList.Count do
  Begin
    pUD:= UserList.Items[i];
    Section:= 'User'+IntToStr(i);
    IniFile.WriteInteger(section,'ID',pUD^.ID);
    IniFile.WriteString(section,'Name',pUD^.Name);
    Inc(i);
  End;
  i:= 0;
  While i<Relations.Count do
  Begin
    pRel:= Relations.Items[i];
    Section:= 'Relation'+IntToStr(i);
    IniFile.WriteInteger(section,'Index1',UserList.IndexOf(pRel^.UserData1));
    IniFile.WriteInteger(section,'Index2',UserList.IndexOf(pRel^.ForeignData));
    Inc(i);
  End;
  Inifile.free;
End;

Function TForm1.GetUserData(ID: Integer): PUserData;
var
  i: Integer;
Begin
  i:= 0;
  While (i<userList.Count) AND (PUserData(UserList.items[i])^.ID<>ID) do Inc(i);
  if i<userList.Count then
    Result:= PUserData(UserList.items[i])
  else
    Result:= nil;
End;

Function TForm1.GetRelationsAndNotify(HexID: String; Online: Boolean): String;
Var //If Online=False, then Result = '' as user does not need gather a list
  ID: LongInt;
  i: Integer;
  pRel: PRelated;
  pMyData: PUserData;
Begin
  ID:= HexToInt(HexID);
  pMyData:= GetUserData(ID);
  Result:= '';
  i:= 0;
  If pMyData<>nil then
  begin
    pMyData^.Connected:= Online;
    UpdateConCountLabel;
    While (i<Relations.Count) do
    Begin
      pRel:= Relations.items[i];
      // My related friends xor foreigners related to me
      With pRel^ do
      if (UserData1^.ID = ID) then
      Begin
        if ForeignData^.Connected then
        Begin
          If Online then
          Begin
            //Gather my related friends, but I'll tell them later!
            Result:= Result + IntToHex(ForeignData^.ID,8) + ForeignData^.Name;
          End else
            //Tell friends I'm offline!
            ForeignData^.Socket.SendText(cmd2+HexID);
        End;
      End else
      if (ForeignData^.ID = ID) AND UserData1^.Connected then
      begin
        If Online then
        Begin
          //Tell foreigners I'm online!
          UserData1^.Socket.SendText(cmd3+HexID+ForeignData^.Name);
        End else
          //Tell foreigners I'm offline!
          UserData1^.Socket.SendText(cmd2+HexID);
      End;
      Inc(i);
    end;
  End;
End;

procedure TForm1.UserLogin(var HexID: String; Socket: TCustomWinSocket);
Var
  ID: LongInt;
  pUD: PUserData;
begin
  ID:= HexToInt(HexID);
  pUD:= GetUserData(ID);
  If pUD=nil then
  Begin
    // New User!
    Inc(LastNumber);
    ID:= LastNumber;
    HexID:= IntToHex(ID,8); //Get him a new number!
    New(pUD);
    pUD^.Name:= NameAdjust(Socket.LocalHost);
    pUD^.ID:= ID;
    UserList.Add(pUD);
  End;
  pUD^.Socket:= Socket; //Allready here, the socket is connected, but not
                        //ready to gain the list, he must ask for it first.
  Socket.SendText(cmd8+HexID); //Notify user that he has got access to the system
End;

procedure TForm1.SendToRelation(S: String; Socket: TCustomWinSocket);
var
  ID1,ID2: LongInt;
  i: Integer;
begin
  ID1:= HexToInt(Copy(S,1,8)); //My ID
  ID2:= HexToInt(Copy(S,9,8)); //receivers ID
  Delete(S,1,16);
  i:= 0;
  While (i<Relations.Count) do
    With PRelated(Relations.items[i])^ do
    begin
      If (UserData1^.ID=ID1) AND (ForeignData^.ID=ID2) AND ForeignData^.Connected then
      begin
        ForeignData^.Socket.SendText(cmd4+UserData1^.Name+S);
        i:= Relations.Count+1;
        Inc(MessageCount);
        UpdateMsgCountLabel;
      End else
        Inc(i);
    End;
  if i = Relations.Count+1 then
    Socket.SendText(cmd4b) // Transmission went ok!
  else
    Socket.SendText(cmdD); // User is unavailable
End;

function TForm1.AddNewRelation(HexID1,HexID2: String;
  var AllreadyExists: Boolean): PUserData;
Var // AllreadyExist is true if the relation is allready in use
    // Add ID2 as friend to ID1 ..IF the other part exist?
    // Result is the userdata of the other part if he is connected else nil
    // (I don't want to look once more!)
  ID1,ID2: LongInt;
  i: Integer;
  pRelation: PRelated;
Begin
  ID1:= HexToInt(HexID1);
  ID2:= HexToInt(HexID2);
  i:= 0;

  While (i<Relations.Count) AND
      not(PRelated(Relations.Items[i])^.UserData1^.ID = ID1) AND
      not(PRelated(Relations.Items[i])^.ForeignData^.ID = ID2) do Inc(i);

  If i<Relations.Count then
  begin
    AllreadyExists:= True;
    Result:= PRelated(Relations.Items[i])^.ForeignData
  End else
  begin
    AllreadyExists:= False;
    i:= 0;
    While (i<UserList.Count) AND not(PUserData(UserList.Items[i])^.ID = ID2) do
      Inc(i);
    if i<UserList.Count then
    Begin
      new(pRelation);
      pRelation^.UserData1:= GetUserData(ID1);
      pRelation^.ForeignData := UserList.Items[i];
      Relations.Add(pRelation);
      UpdateRelationsCountLabel;
      Result:= pRelation^.ForeignData;
    End else
      Result:= nil;
  End;
End;

procedure TForm1.RemoveRelation(S: String; Socket: TCustomWinSocket);
var
  ID1,ID2: LongInt;
  i: Integer;
  pRelation: PRelated;
begin
  ID1:= HexToInt(Copy(S,1,8));
  ID2:= HexToInt(Copy(S,9,8));
  i:= 0;
  While (i<Relations.Count) do
  begin
    pRelation:= PRelated(Relations.Items[i]);
    if (pRelation^.UserData1^.ID = ID1) AND (pRelation^.ForeignData^.ID = ID2) then
    begin
      Relations.Delete(i);
      Dispose(pRelation);
      i:= Relations.Count+1;
      UpdateRelationsCountLabel;
    End else
      Inc(i);
  End;
  If i = Relations.Count+1 then
    Socket.Sendtext(cmd7+Copy(S,9,8)) // Send successfull removal back
  else
    Socket.SendText(cmdD);// user is unavailable
End;

procedure TForm1.ForwardRequest(Cmd,S: String; Socket: TCustomWinSocket);
var
  ReqID: LongInt;
  Success: Boolean;
  pUD: PUserData;
begin
  ReqID:= HexToInt(Copy(S,9,8));
  pUD  := GetUserData(ReqID);
  Success:= False;
  If pUD<>nil then
    If pUD^.Connected then
      Success:= True;
  If Success then
    pUD^.Socket.SendText(cmd+S) //Request sent to requested user
  else
    Socket.SendText(cmdD);      //user is not available;
End;

procedure TForm1.RequestForeignersPermission(S: String;
  Socket: TCustomWinSocket);
var
  HexID: String;
  ReqID: LongInt;
  Success: Boolean;
  pUD: PUserData;
  ReqSocket: TCustomWinSocket;
begin
  HexID:= Copy(S,1,8);
  ReqID:= HexToInt(Copy(S,9,8));
  Delete(S,1,16);
  pUD  := GetUserData(ReqID);
  Success:= False;
  If pUD<>nil then
    If pUD^.Connected then
      Success:= True;
  If Success then
  begin
    ReqSocket:= pUD^.Socket;
    pUD := GetUserData(ReqID);
    ReqSocket.SendText(cmd9+HexID+pUD^.Name+S) //Request sent to requested user
  End else
    Socket.SendText(cmdD);                     //user is not available;
End;

Procedure TForm1.ForeignUserGrants(S: String; Socket: TCustomWinSocket;
  AddBoth: Boolean);
var
  pUD,pFUD: PUserData;
  HexID,FHexID: String;
  AllreadyExists: Boolean;
begin
   HexID:= Copy(S,9,8);
  FHexID:= Copy(S,1,8); //The user who sends a message will always have his own
                        //ID as the first one represented!
  pFUD:= AddNewRelation(HexID,FHexID,AllreadyExists);
  If pFUD=nil then // User is unavailable!
    socket.Sendtext(cmdD) else //Hmm some errror happened as user doesn't exist!
  begin
    pUD:= GetUserData(HexToInt(HexID));
    If pUD^.connected then
    begin
      If AllreadyExists then
        //Notify user, that this relation allready exists
        pUD^.socket.Sendtext(cmdE+pFUD^.Name) else
      Begin
        //Notify user that his request is permitted
        pUD^.socket.Sendtext(cmdA);
        //Notify user that foreigner is currently connected!
        pUD^.socket.Sendtext(cmd3+FHexID+pFUD^.Name);
      End;
    End;
    If AddBoth then
    begin
      AddNewRelation(FHexID,HexID,AllreadyExists);
      If AllreadyExists then
        //Notify that this relation allready exists
        socket.Sendtext(cmdE+pUD^.Name)
      else
        //Notify user is connected (Approval is not necessary)
        socket.Sendtext(cmd3+HexID+pUD^.Name);
    End;
  End;
End;

end.


______________________________________________________________________________


CLIENT:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ScktComp, registry, Spin;

  //ICQ Client v1.1
  //Example of an ICQ (I Seek you) system v1.1 (c) Thomas Williams 1998
  //This source is freeware which means, that you may distribute this in
  //any commercial way or modify the contents as you like.
  //Author is not responsible to any damage what so ever vaused by this
  //system.

const
  AppKey = 'SoftWare\MyICQ';

  //ServerIP = '209.186.13.14';
  ServerIP = '127.0.0.1';
  //When sending a command, the client must send his identification number as
  //a 8 Cifres HEX number
  cmd1 = 'GAFR'; //Friends connected as 8 Cifres HEX
                 //followed by a 32 char long name on each friend
  cmd2 = 'FDIS'; //One disconnect
  cmd3 = 'FCON'; //One friend Connect
  cmd4 = 'SNDM'; //Send message: To MessageNumber as 8 Cifres HEX
  cmd4b= 'SNDR'; //message has successfully been sent
  cmd5 = 'SYSM'; //System generel message
  cmd6 = 'RFON'; //Register user as friend
  cmd7 = 'RFOF'; //Remove friend
  cmd8 = 'IDEN'; //Identification number as 8 Cifres HEX
  cmd9 = 'REQA'; //Request user to add user by number to friend group
  cmdA = 'REQG'; //Request granted;
  cmdB = 'REQD'; //Request denied;
  cmdC = 'REQR'; //Request granted + add user to your grouplist;
  cmdD = 'UNAV'; //User is unavailable
  cmdE = 'RELE'; //The applied relationship allready exists
type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    ListBox1: TListBox;
    ConnectLabel,
    Label2: TLabel;
    ClientSocket1: TClientSocket;
    Memo1: TMemo;
    Edit1,
    Edit2: TEdit;
    Button1,
    Button2,
    Button3,
    Button4: TButton;
    MyNumber: LongInt;
    procedure Button2Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure ClientSocket1Connect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
    procedure ClientSocket1Disconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
  private
    { Private declarations }
    Procedure WriteMyNumber;
    Procedure GetMyNumber;
    Function IndexByUser(ID: Integer): Integer; //Returns -1 if not found
    Function GetIDbySelected: Integer;
    Procedure BldUserList(S: String);
    procedure ClearUserList;
    procedure DeleteUser(Index: Integer);
    procedure RemoveUser(S: String);
    procedure AddToUsers(S: String);
    procedure ReceiveMessage(S: String);
    procedure TreatRequest(S: String; Socket: TCustomWinSocket);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

Function HexToInt(const Hex: String): LongInt;
Const
  Standard = ['0'..'9'];
  ExtStandard = ['A'..'F'];
  Ident: Array['0'..'9'] of Integer = (0,1,2,3,4,5,6,7,8,9);
  HexIdent: Array['A'..'F'] of Integer = (10,11,12,13,14,15);
var
  i,n: Integer;
Begin
  Result:= 0;
  If Length(Hex)>8 then
    raise EConvertError.Create('S is not a valid hexadecimal number')
  else
    For i:= 1 to Length(Hex) do
    Begin
      If Hex[i] in Standard then n:= Ident[Hex[i]] else
      If Hex[i] in ExtStandard then n:= hexIdent[Hex[i]] else
      raise EConvertError.Create(Hex+' is not a valid hexadecimal number');
      Result:= Result shl 4+n;
    End;
End;

// ----------- Buttons ----------

procedure TForm1.Button1Click(Sender: TObject);
begin //Connect
  Button1.Enabled:= False;
  If not ClientSocket1.Active then
  begin
    ClientSocket1.Address:= Edit2.Text;
    ClientSocket1.Open;
    ConnectLabel.Caption:='Connecting..';
    Edit2.Enabled:= False;
  End else
    ClientSocket1.Close;
end;

procedure TForm1.Button2Click(Sender: TObject);
var //Remove user
  ID: LongInt;
begin
  ID:= GetIDbySelected;
  If ID<>0 then
    If messageDlg('Are you sure you want to delete user ''' +
                  TrimRight(ListBox1.Items[IndexByUser(ID)]) + '''?',
                  mtWarning,
                  [mbYes,mbNo],0) = id_yes
    then
      ClientSocket1.Socket.SendText(cmd7+
                                    IntToHex(MyNumber,8)+
                                    IntToHex(ID,8));
end;

procedure TForm1.Button3Click(Sender: TObject);
var
  ID: LongInt;
begin
  ID:= GetIDbySelected;
  If ID<>0 then
    ClientSocket1.Socket.SendText(cmd4+
                                  IntToHex(MyNumber,8)+
                                  IntToHex(ID,8)+
                                  Edit1.Text);
end;

procedure TForm1.Button4Click(Sender: TObject);
const
  ident = ['0','1','2','3','4','5','6','7','8','9'];
var
  Value,S: String;
  v,i: Integer;
begin //Add new User
  If InputQuery('Please enter the number of the user you want to request:',
                'User number:',Value) then
    If InputQuery('Please enter a message with your request:',
                  'Message:',S) then
    begin
      i:= 1;
      While (i<length(Value)) AND (value[i] in ident) do Inc(i);
      If i=Length(Value) then
      Begin
        v:= StrToInt(value);
        If v<>MyNumber then
          ClientSocket1.Socket.SendText(cmd9+IntToHex(MyNumber,8)+IntToHex(v,8)+S)
        else
          MessageDlg('You cannot be in group with yourself.',mtError,[mbOk],0);
      End else
        ShowMessage(Value+' is not a valid number!');
    End;
end;

// --------- Socket event handling ----------

procedure TForm1.ClientSocket1Connect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  Socket.SendText(cmd8+IntToHex(MyNumber,8)); //Identify myself!
  Button1.Caption:= 'Disconnect';
  Button1.Enabled:= True;
end;

procedure TForm1.ClientSocket1Read(Sender: TObject;
  Socket: TCustomWinSocket);
var
  S: String;
  cmd: String;
begin
  S:= Socket.ReceiveText;
  cmd:= Copy(S,1,4);
  Delete(S,1,4);
  if cmd = cmd1 then
    BldUserList(S) else//Friends connected as 8 Cifres HEX
                                        //One friend Connect
                                        //followed by a 32 char
                                        //long name
  if cmd = cmd2 then RemoveUser(S) else //One disconnect
  if cmd = cmd3 then AddToUsers(S) else //One friend Connect
                                        //followed by a 32 char
                                        //long name
  if cmd = cmd4 then ReceiveMessage(S) else //New message received
  if cmd = cmd4b then //message sent successfully
    Memo1.Lines.Add('* Message sent *') else
  if cmd = cmd5 then
    Memo1.Lines.Add('Message from server: '+S) else
  if cmd = cmd6 then ShowMessage('Friend registered') else //Register as friend
  if cmd = cmd7 then RemoveUser(S) else//Remove friend
  if cmd = cmd8 then //Identification number as 8 Cifres HEX
  begin
    MyNumber:= HexToInt(S);
    ConnectLabel.Caption:= 'Connected';
    Button4.Enabled:= True;
    Caption:= 'My number is: '+IntToStr(MyNumber);
    Socket.SendText(cmd1+S); //Give ME MY FRIENDS! hehe
  end else
  if cmd = cmd9 then //User requests to add you to his friend group
    TreatRequest(S,Socket) else
  if cmd = cmdA then //Request granted
    Memo1.Lines.Add('* Request granted *') else
  if cmd = cmdB then //Request denied
    Memo1.Lines.Add('* Request denied *') else
  if cmd = cmdD then //User is unavailable
    Memo1.Lines.Add('* User is unavailable *') else
  if cmd = cmdE then //Relations allready exists
    Memo1.Lines.Add('* The relation between you and '+TrimRight(S)+
                    ' allready exists *');
end;

procedure TForm1.ClientSocket1Disconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  Button1.Enabled:= True;
  Button1.Caption:= 'Connect';
  ConnectLabel.Caption:= 'Disconnected';
  Button4.Enabled:= False;
  Edit2.Enabled:= True;
  ClearUserList;
end;

procedure TForm1.ClientSocket1Error(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
var
  Reason: String;
begin
  Case ErrorEvent of
    eeGeneral    : Reason:='Generel socket failure.';
    eeSend       : Reason:='Error ocurred during sending.';
    eeReceive    : Reason:='Error ocurred during receive.';
    eeConnect,
    eeAccept     : Reason:='Error ocurred an attempt to connect.';
  End;
  ShowMessage('Connection error: '+Reason+'  Try to reconnect later.');
  ErrorCode:= 0;
  ClientSocket1Disconnect(Self,Socket);
end;

// -------- Form create - setup components ------

procedure TForm1.FormCreate(Sender: TObject);
  function AddButton(Cap: String): TButton;
  begin
    Result:= TButton.Create(self);
    Result.Caption:= Cap;
    Result.Parent:= Self;
  End;
begin
  GetMyNumber;
  SetBounds(Left,Top,579,322);
  OnClose:= FormClose;
  ConnectLabel:= TLabel.Create(Self);
  ConnectLabel.SetBounds(40,88,66,13);
  ConnectLabel.Caption:= 'Disconnected';
  ConnectLabel.Parent:= Self;
  Button1:= AddButton('Connect');
  Button1.SetBounds(40,8,75,25);
  Button1.OnClick := Button1Click;
  Button2:= AddButton('Remove user');
  Button2.SetBounds(40,32,75,25);
  Button2.Enabled:= False;
  Button2.OnClick:= Button2Click;
  Button3:= AddButton('Send');
  Button3.SetBounds(432,240,120,21);
  Button3.OnClick := Button3Click;
  Button3.enabled := False;
  Button4:= AddButton('Add user');
  Button4.SetBounds(40,56,75,25);
  Button4.Caption:= 'Add user';
  Button4.Enabled:= False;
  Button4.OnClick:= Button4Click;
  Memo1:= TMemo.Create(Self);
  Memo1.SetBounds(120,8,305,225);
  Memo1.Parent:= Self;
  ListBox1:= TListBox.Create(Self);
  ListBox1.SetBounds(432,8,120,225);
  ListBox1.Parent:= Self;
  Edit1:= TEdit.Create(Self);
  Edit1.SetBounds(120,240,305,21);
  Edit1.Text := 'Got for it!';
  Edit1.Parent:= Self;
  Edit2:= TEdit.Create(Self);
  Edit2.SetBounds(40,240,73,21);
  Edit2.Text := '127.0.0.1';
  Edit2.Parent:= Self;
  Label2:= TLabel.Create(Self);
  Label2.SetBounds(40,224,71,13);
  Label2.Caption:= 'Server IP addr:';
  Label2.Parent:= Self;
  ClientSocket1:= TClientSocket.Create(Self);
  With ClientSocket1 do
  Begin
    Address := ServerIP;
    ClientType := ctNonBlocking;
    Port := 2500;
    OnConnect := ClientSocket1Connect;
    OnRead := ClientSocket1Read;
    OnError:= ClientSocket1Error;
    OnDisconnect:= ClientSocket1Disconnect;
  end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  WriteMyNumber;
  ClearUserList;
end;

// --------------- User defined methods -------------

Procedure TForm1.WriteMyNumber;
var
  Reg: TRegistry;
Begin
  Reg:= TRegistry.Create;
  Reg.RootKey:= HKEY_CURRENT_USER;
  Reg.OpenKey(AppKey,True);
  If (MyNumber<>0) then
    Reg.WriteInteger('MyNumber',MyNumber);
  Reg.free;
End;

Procedure TForm1.GetMyNumber;
var
  Reg: TRegistry;
Begin
  Reg:= TRegistry.Create;
  Reg.RootKey:= HKEY_CURRENT_USER;
  Reg.OpenKey(AppKey,True);
  If Reg.ValueExists('MyNumber') then
  begin
    MyNumber:= Reg.ReadInteger('MyNumber');
    Caption:= 'My number is: '+IntToStr(MyNumber);
  End else
    MyNumber:= 0;
  Reg.free;
End;

Procedure TForm1.BldUserList(S: String);
var
  pUserID: ^LongInt;
  HexID,Name: String;
begin
  While S<>'' do
  Begin
    HexID:= Copy(S,1,8);
    Name:= Copy(S,9,32);
    Delete(S,1,40);
    new(pUserID);
    pUserID^:= HexToInt(HexID);
    ListBox1.Items.AddObject(Name,TObject(pUserID));
  End;
  Button2.enabled := ListBox1.Items.Count>0;
  Button3.enabled := True;
End;

Function TForm1.GetIDbySelected: Integer;
Type //Send message
  PID = ^LongInt;
var
  Index: Integer;
begin
  Index:= ListBox1.ItemIndex;
  If Index>-1 then
  begin
    Result:= PID(ListBox1.Items.Objects[Index])^;
  End else
  begin
    ShowMessage('Please select a user first!');
    Result:= 0;
  End;
End;

Function TForm1.IndexByUser(ID: Integer): Integer; //Returns -1 if not found
Type
  PID = ^LongInt;
var
  i: Integer;
Begin
  i:= 0;
  While (i<ListBox1.Items.Count) AND (PID(ListBox1.Items.Objects[i])^<>ID) do
    Inc(i);
  if i=ListBox1.Items.Count then Result:= -1 else Result:= i;
End;

procedure TForm1.DeleteUser(Index: Integer);
var
  pUserID: ^LongInt;
begin
  pUserID:= Pointer(ListBox1.Items.Objects[Index]);
  Dispose(pUserID);
  ListBox1.items.Delete(Index);
  Button2.enabled := ListBox1.Items.Count>0;
End;

procedure TForm1.RemoveUser(S: String);
Var
  Index: Integer;
Begin
  Index:= IndexByUser(HexToInt(S));
  If Index>-1 then DeleteUser(Index);
End;

procedure TForm1.AddToUsers(S: String);
var
  pUserID: ^LongInt;
  A,B: String;
begin
  A:= Copy(S,1,8);
  B:= Copy(S,9,32);
  new(pUserID);
  pUserID^:= HexToInt(A);
  ListBox1.Items.AddObject(B,TObject(pUserID));
  Button2.enabled := True;
  Button3.enabled := True;
End;

procedure TForm1.ClearUserList;
var
  pUserID: ^LongInt;
  i: Integer;
begin
  For i:= 0 to ListBox1.Items.Count-1 do
  Begin
    pUserID:= Pointer(ListBox1.Items.Objects[i]);
    Dispose(pUserID);
  End;
  ListBox1.Clear;
End;

procedure TForm1.ReceiveMessage(S: String);
var
  Uname: String;
begin
  UName:= TrimRight(Copy(S,1,32));
  Delete(S,1,32);
  memo1.Lines.Add('['+UName+']: '+S);
End;

procedure TForm1.TreatRequest(S: String; Socket: TCustomWinSocket);
var
  HexID1,HexID2,UName: String;
begin
  HexID1:= IntToHex(MyNumber,8);
  HexID2:= Copy(S,1,8);
  UName:= TrimRight(Copy(S,9,32));
  If MessageDlg(''''+UName+''' asks permission to add you to his grouplist:'+#13+#10+
                Copy(S,9+32,length(S)),
                mtInformation,
                [mbYes,mbNo],0) = id_Yes then
  Begin
    //1. Don't ask next question if User is allready in the userlist
    If (IndexByUser(HexToInt(HexID2))=-1) AND
    //2. Ask if user he wants to add foreigners account to his userlist
       (MessageDlg('Do you want to add '''+UName+''' to your grouplist?',
                   mtInformation,
                   [mbYes,mbNo],0) = id_Yes) then
      Socket.SendText(cmdC+HexID1+HexID2) //Request granted + Add
    else
      Socket.SendText(cmdA+HexID1+HexID2) //Request granted
  end else
    Socket.SendText(cmdB+HexID1+HexID2)   //Deny!
End;

end.

Regards,
Williams
0
 
LVL 3

Expert Comment

by:williams2
Comment Utility
Always, there's a little bug hidden somewhere in the system. It's the naming problem. When the user is given a name, the server picks it up by using the 'Socket.RemoteHost' feature.

Now the Client must send it with his/her attempt to connect.

The changes are as follows:

Server app:

The procedure named:

procedure TForm1.UserLogin(Var HexID: String; Socket: TCustomWinSocket);

has changed to: (Note the header has changed too, to preserve understanding)

procedure TForm1.UserLogin(S: String; Socket: TCustomWinSocket);
Var
  ID: LongInt;
  pUD: PUserData;
  HexID: String;
begin
  HexID:= Copy(S,1,8);
  Delete(S,1,8); //The rest is the username
  ID:= HexToInt(HexID);
  pUD:= GetUserData(ID);
  If pUD=nil then
  Begin
    // New User!
    Inc(LastNumber);
    ID:= LastNumber;
    HexID:= IntToHex(ID,8); //Get him a new number!
    New(pUD);
    pUD^.Name:= S;
    pUD^.ID:= ID;
    UserList.Add(pUD);
  End;
  If pUD^.Name = S then
  Begin
    //Allready here, the socket is connected, but not
    //ready to gain the list, he must ask for it first.
    pUD^.Socket:= Socket;
    //Notify user that he has got access to the system
    Socket.SendText(cmd8+HexID);
  end else
    //user is not identified
    Socket.SendText(cmdD);
End;

No other changes necessary.

Client:

The clientSocket1Connect procedure has changed to:

procedure TForm1.ClientSocket1Connect(Sender: TObject;
  Socket: TCustomWinSocket);
  Function NameAdjust(S: String): String;
  begin
    Result:= S;
    While Length(Result)<32 do Result:= Result+' ';
  End;
begin
   //Identify myself!
  Socket.SendText(cmd8+IntToHex(MyNumber,8)+NameAdjust(Socket.LocalHost));
  Button1.Caption:= 'Disconnect';
  Button1.Enabled:= True;
end;

Regards,
Williams
0
 
LVL 3

Expert Comment

by:williams2
Comment Utility
If any of you have run the example above without the changes applied. You'll have to do two things:

1. Delete the INI file before starting up server
2. Delete a KeyValue in the registry using Regedit:
   HKEY_CURRENT_USER\Software\MyICQ\MyNumber

That should be everything for now :-)

Cheers,
Williams
0
 
LVL 3

Expert Comment

by:williams2
Comment Utility
A huge bug in the serverpart:

Search:

      UserList.Add(pRel);

And replace it with..

      Relations.Add(pRel);

then go delete the previois saved INI-file etc.

Regards,
Williams
0

Featured Post

Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

Join & Write a Comment

Introduction The parallel port is a very commonly known port, it was widely used to connect a printer to the PC, if you look at the back of your computer, for those who don't have newer computers, there will be a port with 25 pins and a small print…
Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…
This video shows how to remove a single email address from the Outlook 2010 Auto Suggestion memory. NOTE: For Outlook 2016 and 2013 perform the exact same steps. Open a new email: Click the New email button in Outlook. Start typing the address: …

743 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

15 Experts available now in Live!

Get 1:1 Help Now