Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

I need some help with a piece of code 1

Status
Not open for further replies.

Snake26

Programmer
Sep 11, 2004
7
RO
first of all - sorry for bad english.
hi! i need some help from someone more experienced on a project that i am working. i am even looking for a partener on a Chat program (current project that i am working at).
I don't really want to post here the hole source code of the engine , i want you to leave me some e-mail or some YAHOO Mesenger id's so I can contact you if you can help me (i have some stupid error and i don't know why because everything looks ok and it compiles with no errors), or would like to be envolved in developing software in delphi togheter.
So far I have not released no files for the project but i have the project registered at Sourceforge.net ( ) so..it's something serious.
Thx in anticipation
 
You are being too vague. :)

Give us some code and the exception (the exact wording) you are getting.
 
code.
Code:
unit engine;
{    AdvChat  - a simple chat program                                          }
{    Copyright (C) 2004  Patulea Andrei                                       }
{                                                                             }
{    This program is free software; you can redistribute it and/or modify     }
{    it under the terms of the GNU General Public License as published by     }
{    the Free Software Foundation                                             }
{                                                                             }
{    This program is distributed in the hope that it will be useful,          }
{    but WITHOUT ANY WARRANTY; without even the implied warranty of           }
{    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the            }
{    GNU General Public License for more details.                             }
{                                                                             }
{    You should have received a copy of the GNU General Public License        }
{    along with this program; if not, write to the Free Software              }
{    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA}

interface

uses ScktComp,uRoomChatWindow,uPrivateChatWindow,Forms,Dialogs,SysUtils;

const

end_line = '#13#10';

s_pmsg      = '!pmsg'; //!pmsg:fromuser(touser):msg -private chat
s_roommsg   = '!roommsg'; //!roommsg:nick:room:msg;
s_joined    = '!joined';    // !joined:room opens a new room window
s_joinroom  = '!joinroom'; // !join:room -client request to join a room
s_members   = '!members'; // !members:mem1,mem2,... - fills the list with users
s_newmember = '!newmember'; //!newmember:nick:room - add a user to a room
s_mempart   = '!mempart'; //!mempart:nick:room - removes a user form the list
s_part      = '!part'; //!part:roomname client sends that he parts the room


type TNick = String[14];
     TRoom_name = String[20];

     TRoom = record
     Free_slot : boolean;
     RoomName  : TRoom_name;
     end;

    TUser = record
     Free  : boolean;
     Nick  : String[14];
     Socket: Integer;
     Chats : array of TRoom_name;
    end;

var Users : array of TUser;
    aServerSock : TServerSocket;
    aClientSock : TClientSocket;

    ChatRooms : array of tRoomChatWindow;
    PrivateChats : array of tPrivateChatWindow;

procedure MsgToHandle(sHandle: integer; raw_msg: string);
procedure MsgToUser(var aUser : TUser; raw_msg : string);
procedure MsgToNick(aNick : TNick ;raw_msg: string);
procedure MsgToAllInRoom(aRoom: TRoom_name; raw_msg: string);
procedure JoinUserToRoom(aRoom : tRoom_name; var aUser : TUser);
procedure PartUserFromRoom(aRoom: tRoom_name;var  aUser: TUser);
procedure client_handle_rcvd_line(var Line : string);
procedure server_handle_rcvd_line(var Line : string; aHandle:integer);
function GetNickFromHandle(sHandle:integer): TNick;
function GetIndexFromHandle(sHandle:integer) : Integer;
function IsUserInRoom(aRoom: tRoom_name;var aUser : TUser): boolean;
function GetUserIndexFromNick(aNick : tNick): integer;
function GetRoomIndex(aRoom : tRoom_name): integer;

implementation

uses uServerMain;
//this send a message to a socket handle
//aceasta procedura trmite un mesaj cunoscand numai Handle-ul
procedure MsgToHandle(sHandle: integer; raw_msg: string);
var I : Integer;
begin
Application.ProcessMessages;
For i := 0 to (aServerSock.Socket.ActiveConnections -1) //search for the handle
   do if (aServerSock.Socket.Connections[i].SocketHandle = sHandle)
        then begin
         aServerSock.Socket.Connections[i].SendText(raw_msg+end_line);//send it
         exit;
        end;
end;

procedure MsgToUser(var aUser : TUser; raw_msg : string);
begin
MsgToHandle(aUser.Socket,raw_msg);
end;

procedure MsgToNick(aNick : TNick;raw_msg: string);
var i: integer;
begin
For i := Low(Users) to High(Users) do
 If (Users[i].Free = False) and (Users[i].Nick = aNick)
  then begin
   MsgToUser(Users[i],raw_msg);
   exit;
  end;
end;

function GetIndexFromHandle(sHandle:integer): Integer;
var i: integer;
begin
For i := low(Users) to High(Users) do
 If (Users[i].Free = False) and (Users[i].Socket = sHandle)
   then begin
    Result := i;
    exit;
   end;
end;

function IsUserInRoom(aRoom: tRoom_name;var aUser : TUser): boolean;
var i: integer;
begin
Result := False;
if (aRoom = '') then exit;
for i := low(aUser.Chats) to High(aUser.Chats) do
 If (aUser.Chats[i] = aRoom)
  then begin
   Result := True;
   exit;
   end;
end;

procedure MsgToAllInRoom(aRoom: TRoom_name; raw_msg: string);
var i: Integer;
begin
if (aRoom = '') then exit;
For i := Low(Users) to High(Users) do
 If IsUserInRoom(aRoom,Users[i]) then
  MsgToUser(Users[i],raw_msg);
end;

function GetUserIndexFromNick(aNick : tNick): integer;
var I : Integer;
begin
if (aNick = '') then exit;
Result := -1;
if (aNick = '') then exit;
for i := Low(Users) to High(Users) do
 if (Users[i].Free = False) and (Users[i].Nick = aNick)
  then begin
  Result := i;
  exit;
  end;
end;

procedure JoinUserToRoom(aRoom : tRoom_name;var  aUser : TUser);
var i,j: integer;
    members : String;
    NoSpace : boolean;
begin
if (aRoom = '') then exit;
members := (s_members+':'+aRoom+':');

for i := Low(Users) to High(Users) do
 if IsUserInRoom(aRoom,Users[i]) then
    begin
    if (members <> (s_members+':'+aRoom+':')) then members := members +','+Users[i].Nick;
    if (members = (s_members+':'+aRoom+':')) then members := members + Users[i].Nick;
    end;

MsgToHandle(aUser.Socket,s_joined+':'+aRoom);
MsgToHandle(aUser.Socket,members);
MsgToAllInRoom(aRoom,s_newmember+':'+aUser.Nick+':'+aRoom);

{
j := High(aUser.Chats);
if (j = 0) then begin
SetLength(aUser.Chats,1);
aUser.Chats[1].Free_slot := True;
end;

NoSpace := True;

for i := Low(aUser.Chats) to High(aUser.Chats) do
if aUser.Chats[i].Free_slot then begin
aUser.Chats[i].RoomName := aRoom;
aUser.Chats[i].Free_slot := False;
NoSpace := False;
end;

 }
end;

procedure PartUserFromRoom(aRoom: tRoom_name;var aUser: TUser);
var i:Integer;
begin
if (aRoom = '') then exit;
MsgToAllInRoom(aRoom,s_mempart+':'+aUser.Nick+':'+aRoom);
//MsgToUser(aUser,s_leftroom+':'+aRoom);
For i := Low(aUser.Chats) to High(aUser.Chats) do
 If (aUser.Chats[i] = aRoom)
  then begin
  aUser.Chats[i] := '';
  exit;
  end;
end;

function GetRoomIndex(aRoom : tRoom_name): integer;
var i: integer;
begin
for i := Low(ChatRooms) to High(ChatRooms) do
 if (ChatRooms[i].RoomName = aRoom) then
  begin
  Result := i;
  exit;
  end;
end;

function GetNickFromHandle(sHandle:integer): TNick;
var i: integer;
begin
for i := Low(Users) to High(Users) do
 if (Users[i].Socket = sHandle) then
  begin
  Result := Users[i].Nick;
  exit;
  end;
end;

procedure client_handle_rcvd_line(var Line : string);
var p,i,k: integer;
    comm, s1,s2 :string;
    room : tRoom_name;
    nick : tNick;
    found_chat_window : Boolean;
begin
p := pos(':',line);
if (p = 0) then comm := line;
if (p <> 0) then comm := copy(line,1,p-1);

//!pmsg:fromnick:msg
if (comm = s_pmsg) then begin
Delete(Line,1,p+1);
p := pos(':',line);
nick := Copy(line,1,p-1); //fromnick
s2 := Copy(line,p+1,Length(line));

found_chat_window := False;

for i:= Low(PrivateChats) to High(PrivateChats) do
if (PrivateChats[i].aUser = nick)then
  begin
   PrivateChats[i].AddChatLine(nick,s2) ;
   found_chat_window := True;
  end;

if (not found_chat_window) then begin
SetLength(PrivateChats,High(PrivateChats)+1);
i := High(PrivateChats);
PrivateChats[i].Create(Application);
PrivateChats[i].Show;
PrivateChats[i].aUser := nick;
PrivateChats[i].AddChatLine(nick,s2);
PrivateChats[i].Caption := 'Private Chat with: '+ nick;
end;

end; //end of !pmsg command
//!joined:room
if (comm = s_joined) then begin
p := pos(':',line);
room := Copy(line,p+1,Length(Line));
SetLength(ChatRooms,High(ChatRooms)+1);
i := High(ChatRooms);
ChatRooms[i].Create(Application);
ChatRooms[i].RoomName := room;
ChatRooms[i].Caption := room;
end;  //end of joined command

//!members:room:mem1,mem2...
if (comm = s_members) then begin
p:= pos(':', line);   //!members:room:mem1,mem2..
Delete(Line,1,p+1);  //room:mem1,mem2...
p := pos(':',Line);
room := Copy(Line,1,p-1); //room = roomname
Delete(Line,1,p+1); //mem1,mem2...

k := GetRoomIndex(room);
ChatRooms[k].memberlist.Clear;

while (p <> 0) do begin
p := pos(',',Line);
ChatRooms[k].memberlist.Items.Add(Copy(Line,1,p-1));
Delete(Line,1,p+1);
end;
end; //end of members command


// !roommsg:nick:room:msg
if (comm = s_roommsg) then begin
p := pos(':',Line);
Delete(Line,1,p+1); //nick:room:msg
p := pos(':',Line);
nick := Copy(Line,1,p-1);  //sender
Delete(Line,1,p+1); //room:msg
p := pos(':',Line);
room := Copy(line,1,p-1); // roomname
Delete(Line,1,p+1); //msg (line = msg);

for i := Low(ChatRooms) to High(ChatRooms) do
if (ChatRooms[i].RoomName  = room) then
 begin
 ChatRooms[i].AddChatLine(nick,line);
 exit;
 end;
end;

//!newmember:nick:room
if (comm = s_newmember) then begin
p := pos(':',Line);
Delete(Line,1,p+1); //nick:room
p := pos(':',Line);
nick := Copy(Line,1,p-1); // members nickname
room := Copy(Line,p+1,Length(Line)); //room name
ChatRooms[GetRoomIndex(room)].memberlist.Items.Add(nick)

end; // end of newmember command

//!mempart:nick:room
if (comm = s_mempart) then  begin
p := pos(':',Line);
Delete(Line,1,p+1); //nick:room
p := pos(':',Line);
nick := Copy(Line,1,p-1); // nickname
room := Copy(Line,p+1,Length(Line)); //room name
k := ChatRooms[GetRoomIndex(room)].memberlist.Count -1;
for i:= 0 to k do
 if (ChatRooms[GetRoomIndex(room)].memberlist.Items.Strings[i] = nick)
   then begin
    ChatRooms[GetRoomIndex(room)].memberlist.Items.Delete(i);
    exit;
   end;
end;
end;


procedure server_handle_rcvd_line(var Line : string; aHandle: integer);
var p,i,k: integer;
    comm, s1,s2 :string;
    nick,nick1 : tNick;
    room : tRoom_name;
begin
p := pos(':',line);
if (p = 0) then comm := line;
if (p <> 0) then comm := copy(line,1,p-1);

// client sends !pmsg:nick:msg
if (comm = s_pmsg) then begin
p := pos(':',Line);
Delete(Line,1,p+1); //nick:msg
p := pos(':',Line);
Delete(Line,1,p+1);//line = msg
nick := Copy(Line,1,p-1); // RECEIVERS nick
nick1 := GetNickFromHandle(aHandle); //  SENDERS nick
MsgToNick(nick,s_pmsg+':'+nick1+':'+Line);
end; //end of !pmsg

//client sends !roommsg:room:msg
if (comm = s_roommsg) then begin
nick := GetNickFromHandle(aHandle); // SENDER nick
p := pos(':',Line);
Delete(Line,1,p+1); //room:msg
p := pos(':',Line);
room := Copy(Line,1,p-1); // room name
Delete(Line,1,p+1);// line = msg
MsgToAllInRoom(room,s_roommsg+':'+nick+':'+room+':'+Line);
end;// end of roommsg command

//client sends !joinroom:roomname
if (comm = s_joinroom) then begin
p := pos(':',Line);
room := Copy(Line,p+1,Length(Line)); //roomname
JoinUserToRoom(room,Users[GetIndexFromHandle(aHandle)]);
end; //end of joinroom command

if (comm = s_part) then begin
p := pos(':',Line);
room := Copy(Line,p+1,Length(Line));
PartUserFromRoom(room,Users[GetIndexFromHandle(aHandle)]);
end; //end of part command

end;




initialization
SetLength(Users,1); //initialization

end.


after i start a (test) server anc connect the (test) client to it I send the !joinroom coomand and the folowing error comes: "Acces violation at adress 00464223 in module 'advchatserv.exe'.Read of address 012584B8"

After i close the server the folowing runtime error comes:
"Runtime error 216 at 00403546"

that's just one of the problems i encountered. i think there are more, so if there's someone there who would like to help me put this project togheter...
 
I don't see any part in the code were you're assigning the server/client sockets

--------------------------------------
What You See Is What You Get
 
this is just the unit, the chat engine.
i haven't posted here the .dpr and unit1.pas where the server/client sockets are assigned.
 
it's unclear for me at the moment where the error is coming from but I would do the following to make your code more robust :

I'll take one procedure as a sample :
Code:
function GetRoomIndex(aRoom : tRoom_name): integer;
var i: integer;
begin
try
 for i := Low(ChatRooms) to High(ChatRooms) do
  if (ChatRooms[i].RoomName = aRoom) then
   begin
   Result := i;
   exit;
   end;
 except
  on E : Exception do
   begin
    Logmessage(Format('GetRoomIndex -> function failed : "",[E.Message]));
   end;
 end;
end;

I see that you're using dynamic arrays for storing data.
this is ok, but you have to take care that you test the length of your array before doing anything.
for example the line
"for i := Low(ChatRooms) to High(ChatRooms)"
is ok for non-empty arrays, but when chatrooms is zero length, High(Chatrooms) wil return -1 so this wil fail...

I prefer using Tlist or TObjectlist for storing dynamic data as they are easier to work with.

--------------------------------------
What You See Is What You Get
 
saw a litlle typo :

Logmessage(Format('GetRoomIndex -> function failed : "%s",[E.Message]));


--------------------------------------
What You See Is What You Get
 
i see. your post is very useful to me.
i woul like an example on hoe to work with tList or tObjectlist.
esepecialy tobjectlist. i don;t think it's mucth diferent then working with a ..let's say tstrings but do be on the safe side. a little example.
oh..and..a re you interested in working with me on this project?

 
also i've started a new engine.pas based on Indy's TCP/IP component. just started to work on it and it seems to be more easy. take a look ( it's not finished. just a few lines );

Code:
unit engine;
{    AdvChat  - a messenger program                                           }
{    Copyright (C) 2004  Patulea Andrei                                       }
{                                                                             }
{    This program is free software; you can redistribute it and/or modify     }
{    it under the terms of the GNU General Public License as published by     }
{    the Free Software Foundation                                             }
{                                                                             }
{    This program is distributed in the hope that it will be useful,          }
{    but WITHOUT ANY WARRANTY; without even the implied warranty of           }
{    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the            }
{    GNU General Public License for more details.                             }
{                                                                             }
{    You should have received a copy of the GNU General Public License        }
{    along with this program; if not, write to the Free Software              }
{    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA}


interface
uses sysutils, classes,forms,idTCPServer;

type

   tUser   = object
     Free    : Boolean;
     Thread  : TIdPeerThread;
     LoggedIn: Boolean;
     UserName:String[15];
     Password:String[69];
     NickName:String[10];
      public
        procedure SendMsg(raw_msg:string);
      private
   end;

  tRoom = object
    Free : boolean;
    RoomName : String[20];
    UsersInRoom : array of tUser;
   public
    procedure AddUser(aUser : tUser);
    procedure MsgToRoom(raw_msg : string);
  end;

var Users : array of TUser;
    Chats : array of TRoom;

implementation

{ tUser }

procedure tUser.SendMsg(raw_msg: string);
begin
Thread.Connection.WriteLn(raw_msg);
end;

{ tRoom }

procedure tRoom.AddUser(aUser: tUser);
var i: integer;
    NoSpace : Boolean;
begin
NoSpace := True;
for i := Low(UsersInRoom) to High(UsersInRoom) do
 if UsersInRoom[i].Free then begin
  UsersInRoom[i] := aUser;
  NoSpace := False;
  exit;
 end;

If NoSpace then begin
i := (High(UsersInRoom) +1);
SetLength(UsersInRoom,i);
UsersInRoom[i] := aUser;
end;

end;

procedure tRoom.MsgToRoom(raw_msg: string);
var i : integer;
begin
for i := Low(UsersInRoom) to High(UsersInRoom) do
 if (UsersInRoom[i].Free = False) then UsersInRoom[i].SendMsg(raw_msg);
end;




end.
 
add me if your still wanting to make a chat system djgalaxy2k@hotmail.com cheers
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top